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
1 ################################################################################
2 ##
3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
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
14 PL_ppaddr
15 PL_no_modify
16 PL_DBsignal
17 PL_DBsingle
18 PL_DBsub
19 PL_DBtrace
20 PL_Sv
21 PL_bufend
22 PL_bufptr
23 PL_compiling
24 PL_copline
25 PL_curcop
26 PL_curstash
27 PL_debstash
28 PL_defgv
29 PL_diehook
30 PL_dirty
31 PL_dowarn
32 PL_errgv
33 PL_error_count
34 PL_expect
35 PL_hexdigit
36 PL_hints
37 PL_in_my
38 PL_in_my_stash
39 PL_laststatval
40 PL_lex_state
41 PL_lex_stuff
42 PL_linestr
43 PL_na
44 PL_parser
45 PL_perl_destruct_level
46 PL_perldb
47 PL_rsfp_filters
48 PL_rsfp
49 PL_stack_base
50 PL_stack_sp
51 PL_statcache
52 PL_stdingv
53 PL_sv_arenaroot
54 PL_sv_no
55 PL_sv_undef
56 PL_sv_yes
57 PL_tainted
58 PL_tainting
59 PL_tokenbuf
60 PL_signals
61 PL_mess_sv
62 PERL_SIGNALS_UNSAFE_FLAG
63
64 =implementation
65
66 #ifndef PERL_SIGNALS_UNSAFE_FLAG
67
68 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
69
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
79
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
87 #if { VERSION <= 5.005_05 }
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
101 #  define PL_bufend                 bufend
102 #  define PL_bufptr                 bufptr
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
113 #  define PL_error_count            error_count
114 #  define PL_expect                 expect
115 #  define PL_hexdigit               hexdigit
116 #  define PL_hints                  hints
117 #  define PL_in_my                  in_my
118 #  define PL_laststatval            laststatval
119 #  define PL_lex_state              lex_state
120 #  define PL_lex_stuff              lex_stuff
121 #  define PL_linestr                linestr
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
137 #  define PL_tokenbuf               tokenbuf
138 #  define PL_mess_sv                mess_sv
139 /* Replace: 0 */
140 #endif
141
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
145  * use it if you can avoid it, and unless you absolutely know
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.
150  */
151
152 #if { VERSION >= 5.9.5 }
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
172  * doing. It is internal to the perl parser and may change or even
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)
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
198
199 #else
200
201 /* ensure that PL_parser != NULL and cannot be dereferenced */
202 # define PL_parser         ((void *) 1)
203
204 #endif
205
206 =xsinit
207
208 #define NEED_PL_signals
209 #define NEED_PL_parser
210 #define DPPP_PL_parser_NO_DUMMY_WARNING
211
212 =xsmisc
213
214 U32 get_PL_signals_1(void)
215 {
216 #ifdef PERL_NO_GET_CONTEXT
217   dTHX;
218 #endif
219   return PL_signals;
220 }
221
222 extern U32 get_PL_signals_2(void);
223 extern U32 get_PL_signals_3(void);
224 int no_dummy_parser_vars(int);
225 int dummy_parser_warning(void);
226
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
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
245 #define ppp_PARSERVAR_dummy       STMT_START {                   \
246                                     mXPUSHi(1);                  \
247                                     count++;                     \
248                                   } STMT_END
249
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 }
257 # define ppp_expect_t expectation
258 #elif { VERSION < 5.9.5 }
259 # define ppp_expect_t int
260 #else
261 # define ppp_expect_t U8
262 #endif
263
264 #if { VERSION < 5.9.5 }
265 # define ppp_lex_state_t U32
266 #else
267 # define ppp_lex_state_t U8
268 #endif
269
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
284 =xsubs
285
286 int
287 compare_PL_signals()
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
295
296 SV *
297 PL_sv_undef()
298         CODE:
299                 RETVAL = newSVsv(&PL_sv_undef);
300         OUTPUT:
301                 RETVAL
302
303 SV *
304 PL_sv_yes()
305         CODE:
306                 RETVAL = newSVsv(&PL_sv_yes);
307         OUTPUT:
308                 RETVAL
309
310 SV *
311 PL_sv_no()
312         CODE:
313                 RETVAL = newSVsv(&PL_sv_no);
314         OUTPUT:
315                 RETVAL
316
317 int
318 PL_na(string)
319         char *string
320         CODE:
321                 PL_na = strlen(string);
322                 RETVAL = PL_na;
323         OUTPUT:
324                 RETVAL
325
326 SV *
327 PL_Sv()
328         CODE:
329                 PL_Sv = newSVpv("mhx", 0);
330                 RETVAL = PL_Sv;
331         OUTPUT:
332                 RETVAL
333
334 SV *
335 PL_tokenbuf()
336         CODE:
337                 RETVAL = newSViv(PL_tokenbuf[0]);
338         OUTPUT:
339                 RETVAL
340
341 SV *
342 PL_parser()
343         CODE:
344                 RETVAL = newSViv(PL_parser != NULL);
345         OUTPUT:
346                 RETVAL
347
348 SV *
349 PL_hexdigit()
350         CODE:
351                 RETVAL = newSVpv((char *) PL_hexdigit, 0);
352         OUTPUT:
353                 RETVAL
354
355 SV *
356 PL_hints()
357         CODE:
358                 RETVAL = newSViv((IV) PL_hints);
359         OUTPUT:
360                 RETVAL
361
362 void
363 PL_ppaddr(string)
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);
374
375 void
376 other_variables()
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);
390 #if { VERSION >= 5.13.7 }
391                 /* can't get a pointer any longer */
392                 mXPUSHi(PL_dirty ? 1 : 1);
393                 count++;
394 #else
395                 ppp_TESTVAR(PL_dirty);
396 #endif
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);
422 #if { VERSION >= 5.5.0 }
423                 ppp_PARSERVAR(HV*, PL_in_my_stash);
424 #else
425                 ppp_PARSERVAR_dummy;
426 #endif
427                 XSRETURN(count);
428
429 int
430 no_dummy_parser_vars(check)
431         int check
432
433 int
434 dummy_parser_warning()
435
436 =tests plan => 52
437
438 ok(Devel::PPPort::compare_PL_signals());
439
440 ok(!defined(&Devel::PPPort::PL_sv_undef()));
441 ok(&Devel::PPPort::PL_sv_yes());
442 ok(!&Devel::PPPort::PL_sv_no());
443 ok(&Devel::PPPort::PL_na("abcd"), 4);
444 ok(&Devel::PPPort::PL_Sv(), "mhx");
445 ok(defined &Devel::PPPort::PL_tokenbuf());
446 ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
447 ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
448 ok(defined &Devel::PPPort::PL_hints());
449 ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
450
451 for (&Devel::PPPort::other_variables()) {
452   ok($_ != 0);
453 }
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   }
462   if ("$]" >= 5.009005) {
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
478 ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
479
480 eval { &Devel::PPPort::no_dummy_parser_vars(0) };
481
482 if ("$]" < 5.009005) {
483   ok($@, '');
484 }
485 else {
486   if ($@) {
487     print "# $@";
488     ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
489   }
490   else {
491     ok(1);
492   }
493 }