This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/inc/variables: Grammar in comment
[perl5.git] / dist / Devel-PPPort / parts / inc / variables
CommitLineData
0d0f8426
MHM
1################################################################################
2##
b2049988 3## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
0d0f8426
MHM
4## Version 2.x, Copyright (C) 2001, Paul Marquess.
5## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7## This program is free software; you can redistribute it and/or
8## modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
679ad62d
MHM
14PL_ppaddr
15PL_no_modify
16PL_DBsignal
17PL_DBsingle
18PL_DBsub
19PL_DBtrace
20PL_Sv
c01be2ce
MHM
21PL_bufend
22PL_bufptr
679ad62d
MHM
23PL_compiling
24PL_copline
25PL_curcop
26PL_curstash
27PL_debstash
28PL_defgv
29PL_diehook
30PL_dirty
31PL_dowarn
32PL_errgv
8565c31a 33PL_error_count
679ad62d
MHM
34PL_expect
35PL_hexdigit
36PL_hints
8565c31a
MHM
37PL_in_my
38PL_in_my_stash
679ad62d 39PL_laststatval
c01be2ce
MHM
40PL_lex_state
41PL_lex_stuff
42PL_linestr
679ad62d 43PL_na
c01be2ce 44PL_parser
679ad62d
MHM
45PL_perl_destruct_level
46PL_perldb
47PL_rsfp_filters
48PL_rsfp
49PL_stack_base
50PL_stack_sp
51PL_statcache
52PL_stdingv
53PL_sv_arenaroot
54PL_sv_no
55PL_sv_undef
56PL_sv_yes
57PL_tainted
58PL_tainting
c01be2ce 59PL_tokenbuf
679ad62d 60PL_signals
a2347a4b 61PL_mess_sv
0d0f8426
MHM
62PERL_SIGNALS_UNSAFE_FLAG
63
64=implementation
65
66#ifndef PERL_SIGNALS_UNSAFE_FLAG
67
68#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
69
cac25305
MHM
70#if { VERSION < 5.8.0 }
71# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
72#else
73# define D_PPP_PERL_SIGNALS_INIT 0
74#endif
75
76__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
77
78#endif
0d0f8426 79
cac25305
MHM
80/* Hint: PL_ppaddr
81 * Calling an op via PL_ppaddr requires passing a context argument
82 * for threaded builds. Since the context argument is different for
83 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
84 * automatically be defined as the correct argument.
85 */
86
c58e738a 87#if { VERSION <= 5.005_05 }
cac25305
MHM
88/* Replace: 1 */
89# define PL_ppaddr ppaddr
90# define PL_no_modify no_modify
91/* Replace: 0 */
92#endif
93
94#if { VERSION <= 5.004_05 }
95/* Replace: 1 */
96# define PL_DBsignal DBsignal
97# define PL_DBsingle DBsingle
98# define PL_DBsub DBsub
99# define PL_DBtrace DBtrace
100# define PL_Sv Sv
c01be2ce
MHM
101# define PL_bufend bufend
102# define PL_bufptr bufptr
cac25305
MHM
103# define PL_compiling compiling
104# define PL_copline copline
105# define PL_curcop curcop
106# define PL_curstash curstash
107# define PL_debstash debstash
108# define PL_defgv defgv
109# define PL_diehook diehook
110# define PL_dirty dirty
111# define PL_dowarn dowarn
112# define PL_errgv errgv
8565c31a 113# define PL_error_count error_count
a89b7ab8 114# define PL_expect expect
cac25305
MHM
115# define PL_hexdigit hexdigit
116# define PL_hints hints
8565c31a 117# define PL_in_my in_my
cac25305 118# define PL_laststatval laststatval
c01be2ce
MHM
119# define PL_lex_state lex_state
120# define PL_lex_stuff lex_stuff
121# define PL_linestr linestr
cac25305
MHM
122# define PL_na na
123# define PL_perl_destruct_level perl_destruct_level
124# define PL_perldb perldb
125# define PL_rsfp_filters rsfp_filters
126# define PL_rsfp rsfp
127# define PL_stack_base stack_base
128# define PL_stack_sp stack_sp
129# define PL_statcache statcache
130# define PL_stdingv stdingv
131# define PL_sv_arenaroot sv_arenaroot
132# define PL_sv_no sv_no
133# define PL_sv_undef sv_undef
134# define PL_sv_yes sv_yes
135# define PL_tainted tainted
136# define PL_tainting tainting
c01be2ce 137# define PL_tokenbuf tokenbuf
a2347a4b 138# define PL_mess_sv mess_sv
cac25305 139/* Replace: 0 */
0d0f8426
MHM
140#endif
141
c01be2ce
MHM
142/* Warning: PL_parser
143 * For perl versions earlier than 5.9.5, this is an always
144 * non-NULL dummy. Also, it cannot be dereferenced. Don't
cf8ff603 145 * use it if you can avoid it, and unless you absolutely know
c01be2ce
MHM
146 * what you're doing.
147 * If you always check that PL_parser is non-NULL, you can
148 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
149 * a dummy parser structure.
679ad62d
MHM
150 */
151
53a7735b 152#if { VERSION >= 5.9.5 }
c01be2ce
MHM
153# ifdef DPPP_PL_parser_NO_DUMMY
154# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
155 (croak("panic: PL_parser == NULL in %s:%d", \
156 __FILE__, __LINE__), (yy_parser *) NULL))->var)
157# else
158# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
159# define D_PPP_parser_dummy_warning(var)
160# else
161# define D_PPP_parser_dummy_warning(var) \
162 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
163# endif
164# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
165 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
166__NEED_DUMMY_VAR__ yy_parser PL_parser;
167# endif
168
169/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
170/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
171 * Do not use this variable unless you know exactly what you're
94e22bd6 172 * doing. It is internal to the perl parser and may change or even
c01be2ce
MHM
173 * be removed in the future. As of perl 5.9.5, you have to check
174 * for (PL_parser != NULL) for this variable to have any effect.
175 * An always non-NULL PL_parser dummy is provided for earlier
176 * perl versions.
177 * If PL_parser is NULL when you try to access this variable, a
178 * dummy is being accessed instead and a warning is issued unless
179 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
180 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
181 * this variable will croak with a panic message.
182 */
183
184# define PL_expect D_PPP_my_PL_parser_var(expect)
185# define PL_copline D_PPP_my_PL_parser_var(copline)
186# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
187# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
188# define PL_linestr D_PPP_my_PL_parser_var(linestr)
189# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
190# define PL_bufend D_PPP_my_PL_parser_var(bufend)
191# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
192# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
193# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
8565c31a
MHM
194# define PL_in_my D_PPP_my_PL_parser_var(in_my)
195# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
196# define PL_error_count D_PPP_my_PL_parser_var(error_count)
197
c01be2ce
MHM
198
199#else
200
201/* ensure that PL_parser != NULL and cannot be dereferenced */
202# define PL_parser ((void *) 1)
203
53a7735b
DM
204#endif
205
0d0f8426
MHM
206=xsinit
207
208#define NEED_PL_signals
c01be2ce
MHM
209#define NEED_PL_parser
210#define DPPP_PL_parser_NO_DUMMY_WARNING
0d0f8426
MHM
211
212=xsmisc
213
214U32 get_PL_signals_1(void)
215{
b2049988
MHM
216#ifdef PERL_NO_GET_CONTEXT
217 dTHX;
218#endif
0d0f8426
MHM
219 return PL_signals;
220}
221
222extern U32 get_PL_signals_2(void);
223extern U32 get_PL_signals_3(void);
c01be2ce
MHM
224int no_dummy_parser_vars(int);
225int dummy_parser_warning(void);
226
94e22bd6
MH
227/* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */
228#if { VERSION > 5.004 }
229 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END
230#else
231 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END
232#endif
c01be2ce
MHM
233
234#define ppp_PARSERVAR(type, var) STMT_START { \
235 type volatile my_ ## var; \
236 type volatile *my_p_ ## var; \
237 my_ ## var = var; \
238 my_p_ ## var = &var; \
239 var = my_ ## var; \
240 var = *my_p_ ## var; \
241 mXPUSHi(&var != NULL); \
242 count++; \
243 } STMT_END
244
8565c31a
MHM
245#define ppp_PARSERVAR_dummy STMT_START { \
246 mXPUSHi(1); \
247 count++; \
248 } STMT_END
249
fd7af155
MHM
250#if { VERSION < 5.004 }
251# define ppp_rsfp_t FILE *
252#else
253# define ppp_rsfp_t PerlIO *
254#endif
255
256#if { VERSION < 5.6.0 }
c01be2ce 257# define ppp_expect_t expectation
fd7af155 258#elif { VERSION < 5.9.5 }
c01be2ce
MHM
259# define ppp_expect_t int
260#else
261# define ppp_expect_t U8
262#endif
0d0f8426 263
fd7af155 264#if { VERSION < 5.9.5 }
c01be2ce
MHM
265# define ppp_lex_state_t U32
266#else
267# define ppp_lex_state_t U8
268#endif
cac25305 269
8565c31a
MHM
270#if { VERSION < 5.6.0 }
271# define ppp_in_my_t bool
272#elif { VERSION < 5.9.5 }
273# define ppp_in_my_t I32
274#else
275# define ppp_in_my_t U16
276#endif
277
278#if { VERSION < 5.9.5 }
279# define ppp_error_count_t I32
280#else
281# define ppp_error_count_t U8
282#endif
283
0d0f8426
MHM
284=xsubs
285
286int
287compare_PL_signals()
b2049988
MHM
288 CODE:
289 {
290 U32 ref = get_PL_signals_1();
291 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
292 }
293 OUTPUT:
294 RETVAL
0d0f8426 295
cac25305
MHM
296SV *
297PL_sv_undef()
b2049988
MHM
298 CODE:
299 RETVAL = newSVsv(&PL_sv_undef);
300 OUTPUT:
301 RETVAL
cac25305
MHM
302
303SV *
304PL_sv_yes()
b2049988
MHM
305 CODE:
306 RETVAL = newSVsv(&PL_sv_yes);
307 OUTPUT:
308 RETVAL
cac25305
MHM
309
310SV *
311PL_sv_no()
b2049988
MHM
312 CODE:
313 RETVAL = newSVsv(&PL_sv_no);
314 OUTPUT:
315 RETVAL
cac25305
MHM
316
317int
318PL_na(string)
b2049988
MHM
319 char *string
320 CODE:
321 PL_na = strlen(string);
322 RETVAL = PL_na;
323 OUTPUT:
324 RETVAL
cac25305
MHM
325
326SV *
327PL_Sv()
b2049988
MHM
328 CODE:
329 PL_Sv = newSVpv("mhx", 0);
330 RETVAL = PL_Sv;
331 OUTPUT:
332 RETVAL
cac25305
MHM
333
334SV *
c01be2ce 335PL_tokenbuf()
b2049988
MHM
336 CODE:
337 RETVAL = newSViv(PL_tokenbuf[0]);
338 OUTPUT:
339 RETVAL
679ad62d
MHM
340
341SV *
c01be2ce 342PL_parser()
b2049988
MHM
343 CODE:
344 RETVAL = newSViv(PL_parser != NULL);
345 OUTPUT:
346 RETVAL
679ad62d
MHM
347
348SV *
cac25305 349PL_hexdigit()
b2049988
MHM
350 CODE:
351 RETVAL = newSVpv((char *) PL_hexdigit, 0);
352 OUTPUT:
353 RETVAL
cac25305
MHM
354
355SV *
356PL_hints()
b2049988
MHM
357 CODE:
358 RETVAL = newSViv((IV) PL_hints);
359 OUTPUT:
360 RETVAL
cac25305
MHM
361
362void
363PL_ppaddr(string)
b2049988
MHM
364 char *string
365 PPCODE:
366 PUSHMARK(SP);
367 mXPUSHs(newSVpv(string, 0));
368 PUTBACK;
369 ENTER;
370 (void)*(PL_ppaddr[OP_UC])(aTHXR);
371 SPAGAIN;
372 LEAVE;
373 XSRETURN(1);
cac25305
MHM
374
375void
376other_variables()
b2049988
MHM
377 PREINIT:
378 int count = 0;
379 PPCODE:
380 ppp_TESTVAR(PL_DBsignal);
381 ppp_TESTVAR(PL_DBsingle);
382 ppp_TESTVAR(PL_DBsub);
383 ppp_TESTVAR(PL_DBtrace);
384 ppp_TESTVAR(PL_compiling);
385 ppp_TESTVAR(PL_curcop);
386 ppp_TESTVAR(PL_curstash);
387 ppp_TESTVAR(PL_debstash);
388 ppp_TESTVAR(PL_defgv);
389 ppp_TESTVAR(PL_diehook);
49ef49fe
CBW
390#if { VERSION >= 5.13.7 }
391 /* can't get a pointer any longer */
392 mXPUSHi(PL_dirty ? 1 : 1);
393 count++;
627364f1 394#else
b2049988 395 ppp_TESTVAR(PL_dirty);
627364f1 396#endif
b2049988
MHM
397 ppp_TESTVAR(PL_dowarn);
398 ppp_TESTVAR(PL_errgv);
399 ppp_TESTVAR(PL_laststatval);
400 ppp_TESTVAR(PL_no_modify);
401 ppp_TESTVAR(PL_perl_destruct_level);
402 ppp_TESTVAR(PL_perldb);
403 ppp_TESTVAR(PL_stack_base);
404 ppp_TESTVAR(PL_stack_sp);
405 ppp_TESTVAR(PL_statcache);
406 ppp_TESTVAR(PL_stdingv);
407 ppp_TESTVAR(PL_sv_arenaroot);
408 ppp_TESTVAR(PL_tainted);
409 ppp_TESTVAR(PL_tainting);
410
411 ppp_PARSERVAR(ppp_expect_t, PL_expect);
412 ppp_PARSERVAR(line_t, PL_copline);
413 ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
414 ppp_PARSERVAR(AV *, PL_rsfp_filters);
415 ppp_PARSERVAR(SV *, PL_linestr);
416 ppp_PARSERVAR(char *, PL_bufptr);
417 ppp_PARSERVAR(char *, PL_bufend);
418 ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
419 ppp_PARSERVAR(SV *, PL_lex_stuff);
420 ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
421 ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
8565c31a 422#if { VERSION >= 5.5.0 }
b2049988 423 ppp_PARSERVAR(HV*, PL_in_my_stash);
8565c31a 424#else
b2049988 425 ppp_PARSERVAR_dummy;
8565c31a 426#endif
b2049988 427 XSRETURN(count);
cac25305 428
c01be2ce
MHM
429int
430no_dummy_parser_vars(check)
b2049988 431 int check
c01be2ce
MHM
432
433int
434dummy_parser_warning()
435
8565c31a 436=tests plan => 52
0d0f8426
MHM
437
438ok(Devel::PPPort::compare_PL_signals());
439
cac25305
MHM
440ok(!defined(&Devel::PPPort::PL_sv_undef()));
441ok(&Devel::PPPort::PL_sv_yes());
442ok(!&Devel::PPPort::PL_sv_no());
443ok(&Devel::PPPort::PL_na("abcd"), 4);
444ok(&Devel::PPPort::PL_Sv(), "mhx");
c01be2ce 445ok(defined &Devel::PPPort::PL_tokenbuf());
f551177d 446ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
cac25305
MHM
447ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
448ok(defined &Devel::PPPort::PL_hints());
449ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
450
451for (&Devel::PPPort::other_variables()) {
452 ok($_ != 0);
453}
c01be2ce
MHM
454
455{
456 my @w;
457 my $fail = 0;
458 {
459 local $SIG{'__WARN__'} = sub { push @w, @_ };
460 ok(&Devel::PPPort::dummy_parser_warning());
461 }
f551177d 462 if ("$]" >= 5.009005) {
c01be2ce
MHM
463 ok(@w >= 0);
464 for (@w) {
465 print "# $_";
466 unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
467 warn $_;
468 $fail++;
469 }
470 }
471 }
472 else {
473 ok(@w == 0);
474 }
475 ok($fail, 0);
476}
477
f551177d 478ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
c01be2ce
MHM
479
480eval { &Devel::PPPort::no_dummy_parser_vars(0) };
481
f551177d 482if ("$]" < 5.009005) {
c01be2ce
MHM
483 ok($@, '');
484}
485else {
486 if ($@) {
487 print "# $@";
488 ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
489 }
490 else {
491 ok(1);
492 }
493}