ext/Devel/PPPort/parts/inc/variables

   1 ################################################################################
   2 ##
   3 ##  $Revision: 13 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2007/10/04 10:21:28 +0200 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004-2007, Marcus Holland-Moritz.
  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
  20 PL_ppaddr
  21 PL_no_modify
  22 PL_DBsignal
  23 PL_DBsingle
  24 PL_DBsub
  25 PL_DBtrace
  26 PL_Sv
  27 PL_compiling
  28 PL_copline
  29 PL_curcop
  30 PL_curstash
  31 PL_debstash
  32 PL_defgv
  33 PL_diehook
  34 PL_dirty
  35 PL_dowarn
  36 PL_errgv
  37 PL_expect
  38 PL_hexdigit
  39 PL_hints
  40 PL_laststatval
  41 PL_na
  42 PL_perl_destruct_level
  43 PL_perldb
  44 PL_rsfp_filters
  45 PL_rsfp
  46 PL_stack_base
  47 PL_stack_sp
  48 PL_statcache
  49 PL_stdingv
  50 PL_sv_arenaroot
  51 PL_sv_no
  52 PL_sv_undef
  53 PL_sv_yes
  54 PL_tainted
  55 PL_tainting
  56 PL_signals
  57 PERL_SIGNALS_UNSAFE_FLAG
  58
  59 =dontwarn
  60
  61 D_PPP_PERL_SIGNALS_INIT
  62
  63 =implementation
  64
  65 #ifndef PERL_SIGNALS_UNSAFE_FLAG
  66
  67 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
  68
  69 #if { VERSION < 5.8.0 }
  70 #  define D_PPP_PERL_SIGNALS_INIT   PERL_SIGNALS_UNSAFE_FLAG
  71 #else
  72 #  define D_PPP_PERL_SIGNALS_INIT   0
  73 #endif
  74
  75 __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
  76
  77 #endif
  78
  79 /* Hint: PL_ppaddr
  80  * Calling an op via PL_ppaddr requires passing a context argument
  81  * for threaded builds. Since the context argument is different for
  82  * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
  83  * automatically be defined as the correct argument.
  84  */
  85
  86 #if { VERSION <= 5.005_05 }
  87 /* Replace: 1 */
  88 #  define PL_ppaddr                 ppaddr
  89 #  define PL_no_modify              no_modify
  90 /* Replace: 0 */
  91 #endif
  92
  93 #if { VERSION <= 5.004_05 }
  94 /* Replace: 1 */
  95 #  define PL_DBsignal               DBsignal
  96 #  define PL_DBsingle               DBsingle
  97 #  define PL_DBsub                  DBsub
  98 #  define PL_DBtrace                DBtrace
  99 #  define PL_Sv                     Sv
 100 #  define PL_compiling              compiling
 101 #  define PL_copline                copline
 102 #  define PL_curcop                 curcop
 103 #  define PL_curstash               curstash
 104 #  define PL_debstash               debstash
 105 #  define PL_defgv                  defgv
 106 #  define PL_diehook                diehook
 107 #  define PL_dirty                  dirty
 108 #  define PL_dowarn                 dowarn
 109 #  define PL_errgv                  errgv
 110 #  define PL_expect                 expect
 111 #  define PL_hexdigit               hexdigit
 112 #  define PL_hints                  hints
 113 #  define PL_laststatval            laststatval
 114 #  define PL_na                     na
 115 #  define PL_perl_destruct_level    perl_destruct_level
 116 #  define PL_perldb                 perldb
 117 #  define PL_rsfp_filters           rsfp_filters
 118 #  define PL_rsfp                   rsfp
 119 #  define PL_stack_base             stack_base
 120 #  define PL_stack_sp               stack_sp
 121 #  define PL_statcache              statcache
 122 #  define PL_stdingv                stdingv
 123 #  define PL_sv_arenaroot           sv_arenaroot
 124 #  define PL_sv_no                  sv_no
 125 #  define PL_sv_undef               sv_undef
 126 #  define PL_sv_yes                 sv_yes
 127 #  define PL_tainted                tainted
 128 #  define PL_tainting               tainting
 129 /* Replace: 0 */
 130 #endif
 131
 132 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters
 133  * Do not use this variable. It is internal to the perl parser
 134  * and may change or even be removed in the future. Note that
 135  * as of perl 5.9.5 you cannot assign to this variable anymore.
 136  */
 137
 138 /* TODO: cannot assign to these vars; is it worth fixing? */
 139 #if { VERSION >= 5.9.5 }
 140 #  define PL_expect         (PL_parser ? PL_parser->expect : 0)
 141 #  define PL_copline        (PL_parser ? PL_parser->copline : 0)
 142 #  define PL_rsfp           (PL_parser ? PL_parser->rsfp : (PerlIO *) 0)
 143 #  define PL_rsfp_filters   (PL_parser ? PL_parser->rsfp_filters : (AV *) 0)
 144 #endif
 145
 146 =xsinit
 147
 148 #define NEED_PL_signals
 149
 150 =xsmisc
 151
 152 U32 get_PL_signals_1(void)
 153 {
 154   return PL_signals;
 155 }
 156
 157 extern U32 get_PL_signals_2(void);
 158 extern U32 get_PL_signals_3(void);
 159
 160 #define ppp_TESTVAR(var)   STMT_START { XPUSHs(newSViv(&var != NULL)); count++; } STMT_END
 161
 162 =xsubs
 163
 164 int
 165 compare_PL_signals()
 166         CODE:
 167                 {
 168                   U32 ref = get_PL_signals_1();
 169                   RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
 170                 }
 171         OUTPUT:
 172                 RETVAL
 173
 174 SV *
 175 PL_sv_undef()
 176         CODE:
 177                 RETVAL = newSVsv(&PL_sv_undef);
 178         OUTPUT:
 179                 RETVAL
 180
 181 SV *
 182 PL_sv_yes()
 183         CODE:
 184                 RETVAL = newSVsv(&PL_sv_yes);
 185         OUTPUT:
 186                 RETVAL
 187
 188 SV *
 189 PL_sv_no()
 190         CODE:
 191                 RETVAL = newSVsv(&PL_sv_no);
 192         OUTPUT:
 193                 RETVAL
 194
 195 int
 196 PL_na(string)
 197         char *string
 198         CODE:
 199                 PL_na = strlen(string);
 200                 RETVAL = PL_na;
 201         OUTPUT:
 202                 RETVAL
 203
 204 SV *
 205 PL_Sv()
 206         CODE:
 207                 PL_Sv = newSVpv("mhx", 0);
 208                 RETVAL = PL_Sv;
 209         OUTPUT:
 210                 RETVAL
 211
 212 SV *
 213 PL_copline()
 214         CODE:
 215                 RETVAL = newSViv((IV) PL_copline);
 216         OUTPUT:
 217                 RETVAL
 218
 219 SV *
 220 PL_expect()
 221         CODE:
 222                 RETVAL = newSViv((IV) PL_expect);
 223         OUTPUT:
 224                 RETVAL
 225
 226 SV *
 227 PL_rsfp()
 228         CODE:
 229                 RETVAL = newSViv(PL_rsfp != 0);
 230         OUTPUT:
 231                 RETVAL
 232
 233 SV *
 234 PL_rsfp_filters()
 235         CODE:
 236                 RETVAL = newSViv(PL_rsfp_filters != 0);
 237         OUTPUT:
 238                 RETVAL
 239
 240 SV *
 241 PL_hexdigit()
 242         CODE:
 243                 RETVAL = newSVpv((char *) PL_hexdigit, 0);
 244         OUTPUT:
 245                 RETVAL
 246
 247 SV *
 248 PL_hints()
 249         CODE:
 250                 RETVAL = newSViv((IV) PL_hints);
 251         OUTPUT:
 252                 RETVAL
 253
 254 void
 255 PL_ppaddr(string)
 256         char *string
 257         PPCODE:
 258                 PUSHMARK(SP);
 259                 XPUSHs(sv_2mortal(newSVpv(string, 0)));
 260                 PUTBACK;
 261                 ENTER;
 262                 (void)*(PL_ppaddr[OP_UC])(aTHXR);
 263                 SPAGAIN;
 264                 LEAVE;
 265                 XSRETURN(1);
 266
 267 void
 268 other_variables()
 269         PREINIT:
 270                 int count = 0;
 271         PPCODE:
 272                 ppp_TESTVAR(PL_DBsignal);
 273                 ppp_TESTVAR(PL_DBsingle);
 274                 ppp_TESTVAR(PL_DBsub);
 275                 ppp_TESTVAR(PL_DBtrace);
 276                 ppp_TESTVAR(PL_compiling);
 277                 ppp_TESTVAR(PL_curcop);
 278                 ppp_TESTVAR(PL_curstash);
 279                 ppp_TESTVAR(PL_debstash);
 280                 ppp_TESTVAR(PL_defgv);
 281                 ppp_TESTVAR(PL_diehook);
 282                 ppp_TESTVAR(PL_dirty);
 283                 ppp_TESTVAR(PL_dowarn);
 284                 ppp_TESTVAR(PL_errgv);
 285                 ppp_TESTVAR(PL_laststatval);
 286                 ppp_TESTVAR(PL_no_modify);
 287                 ppp_TESTVAR(PL_perl_destruct_level);
 288                 ppp_TESTVAR(PL_perldb);
 289                 ppp_TESTVAR(PL_stack_base);
 290                 ppp_TESTVAR(PL_stack_sp);
 291                 ppp_TESTVAR(PL_statcache);
 292                 ppp_TESTVAR(PL_stdingv);
 293                 ppp_TESTVAR(PL_sv_arenaroot);
 294                 ppp_TESTVAR(PL_tainted);
 295                 ppp_TESTVAR(PL_tainting);
 296                 XSRETURN(count);
 297
 298 =tests plan => 37
 299
 300 ok(Devel::PPPort::compare_PL_signals());
 301
 302 ok(!defined(&Devel::PPPort::PL_sv_undef()));
 303 ok(&Devel::PPPort::PL_sv_yes());
 304 ok(!&Devel::PPPort::PL_sv_no());
 305 ok(&Devel::PPPort::PL_na("abcd"), 4);
 306 ok(&Devel::PPPort::PL_Sv(), "mhx");
 307 ok(defined &Devel::PPPort::PL_copline());
 308 ok(defined &Devel::PPPort::PL_expect());
 309 ok(defined &Devel::PPPort::PL_rsfp());
 310 ok(defined &Devel::PPPort::PL_rsfp_filters());
 311 ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
 312 ok(defined &Devel::PPPort::PL_hints());
 313 ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
 314
 315 for (&Devel::PPPort::other_variables()) {
 316   ok($_ != 0);
 317 }