t/comp/hints.t

   1 #!./perl
   2
   3 # Tests the scoping of $^H and %^H
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = qw(. ../lib);
   8 }
   9
  10
  11 BEGIN { print "1..17\n"; }
  12 BEGIN {
  13     print "not " if exists $^H{foo};
  14     print "ok 1 - \$^H{foo} doesn't exist initially\n";
  15     if (${^OPEN}) {
  16         print "not " unless $^H & 0x00020000;
  17         print "ok 2 - \$^H contains HINT_LOCALIZE_HH initially with ${^OPEN}\n";
  18     } else {
  19         print "not " if $^H & 0x00020000;
  20         print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
  21     }
  22 }
  23 {
  24     # simulate a pragma -- don't forget HINT_LOCALIZE_HH
  25     BEGIN { $^H |= 0x04020000; $^H{foo} = "a"; }
  26     BEGIN {
  27         print "not " if $^H{foo} ne "a";
  28         print "ok 3 - \$^H{foo} is now 'a'\n";
  29         print "not " unless $^H & 0x00020000;
  30         print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
  31     }
  32     {
  33         BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
  34         BEGIN {
  35             print "not " if $^H{foo} ne "b";
  36             print "ok 5 - \$^H{foo} is now 'b'\n";
  37         }
  38     }
  39     BEGIN {
  40         print "not " if $^H{foo} ne "a";
  41         print "ok 6 - \$H^{foo} restored to 'a'\n";
  42     }
  43     # The pragma settings disappear after compilation
  44     # (test at CHECK-time and at run-time)
  45     CHECK {
  46         print "not " if exists $^H{foo};
  47         print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
  48         if (${^OPEN}) {
  49             print "not " unless $^H & 0x00020000;
  50             print "ok 10 - \$^H contains HINT_LOCALIZE_HH when compilation complete with ${^OPEN}\n";
  51         } else {
  52             print "not " if $^H & 0x00020000;
  53             print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
  54         }
  55     }
  56     print "not " if exists $^H{foo};
  57     print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
  58     if (${^OPEN}) {
  59         print "not " unless $^H & 0x00020000;
  60         print "ok 12 - \$^H contains HINT_LOCALIZE_HH at run-time with ${^OPEN}\n";
  61     } else {
  62         print "not " if $^H & 0x00020000;
  63         print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
  64     }
  65     # op_entereval should keep the pragmas it was compiled with
  66     eval q*
  67         print "not " if $^H{foo} ne "a";
  68         print "ok 13 - \$^H{foo} is 'a' at eval-\"\" time\n";
  69         print "not " unless $^H & 0x00020000;
  70         print "ok 14 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
  71     *;
  72 }
  73 BEGIN {
  74     print "not " if exists $^H{foo};
  75     print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
  76     if (${^OPEN}) {
  77         print "not " unless $^H & 0x00020000;
  78         print "ok 8 - \$^H contains HINT_LOCALIZE_HH while finishing compilation with ${^OPEN}\n";
  79     } else {
  80         print "not " if $^H & 0x00020000;
  81         print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
  82     }
  83 }
  84
  85 require 'test.pl';
  86
  87 # bug #27040: hints hash was being double-freed
  88 my $result = runperl(
  89     prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
  90     stderr => 1
  91 );
  92 print "not " if length $result;
  93 print "ok 15 - double-freeing hints hash\n";
  94 print "# got: $result\n" if length $result;
  95
  96 {
  97     BEGIN{$^H{x}=1};
  98     for(1..2) {
  99         eval q(
 100             print $^H{x}==1 && !$^H{y} ? "ok\n" : "not ok\n";
 101             $^H{y} = 1;
 102         );
 103         if ($@) {
 104             (my $str = $@)=~s/^/# /gm;
 105             print "not ok\n$str\n";
 106         }
 107     }
 108 }