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