This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
f197c6b93ff6ca36c50432538922b7bec19fe858
[perl5.git] / t / comp / hints.t
1 #!./perl
2
3 # Tests the scoping of $^H and %^H
4
5 @INC = '../lib';
6
7 BEGIN { print "1..32\n"; }
8 BEGIN {
9     print "not " if exists $^H{foo};
10     print "ok 1 - \$^H{foo} doesn't exist initially\n";
11     if (${^OPEN}) {
12         print "not " unless $^H & 0x00020000;
13         print "ok 2 - \$^H contains HINT_LOCALIZE_HH initially with ${^OPEN}\n";
14     } else {
15         print "not " if $^H & 0x00020000;
16         print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
17     }
18 }
19 {
20     # simulate a pragma -- don't forget HINT_LOCALIZE_HH
21     BEGIN { $^H |= 0x04020000; $^H{foo} = "a"; }
22     BEGIN {
23         print "not " if $^H{foo} ne "a";
24         print "ok 3 - \$^H{foo} is now 'a'\n";
25         print "not " unless $^H & 0x00020000;
26         print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
27     }
28     {
29         BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
30         BEGIN {
31             print "not " if $^H{foo} ne "b";
32             print "ok 5 - \$^H{foo} is now 'b'\n";
33         }
34     }
35     BEGIN {
36         print "not " if $^H{foo} ne "a";
37         print "ok 6 - \$^H{foo} restored to 'a'\n";
38     }
39     # The pragma settings disappear after compilation
40     # (test at CHECK-time and at run-time)
41     CHECK {
42         print "not " if exists $^H{foo};
43         print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
44         if (${^OPEN}) {
45             print "not " unless $^H & 0x00020000;
46             print "ok 10 - \$^H contains HINT_LOCALIZE_HH when compilation complete with ${^OPEN}\n";
47         } else {
48             print "not " if $^H & 0x00020000;
49             print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
50         }
51     }
52     print "not " if exists $^H{foo};
53     print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
54     if (${^OPEN}) {
55         print "not " unless $^H & 0x00020000;
56         print "ok 12 - \$^H contains HINT_LOCALIZE_HH at run-time with ${^OPEN}\n";
57     } else {
58         print "not " if $^H & 0x00020000;
59         print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
60     }
61     # op_entereval should keep the pragmas it was compiled with
62     eval q*
63         print "not " if $^H{foo} ne "a";
64         print "ok 13 - \$^H{foo} is 'a' at eval-\"\" time\n";
65         print "not " unless $^H & 0x00020000;
66         print "ok 14 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
67     *;
68 }
69 BEGIN {
70     print "not " if exists $^H{foo};
71     print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
72     if (${^OPEN}) {
73         print "not " unless $^H & 0x00020000;
74         print "ok 8 - \$^H contains HINT_LOCALIZE_HH while finishing compilation with ${^OPEN}\n";
75     } else {
76         print "not " if $^H & 0x00020000;
77         print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
78     }
79 }
80
81 {
82     BEGIN{$^H{x}=1};
83     for my $tno (15..16) {
84         eval q(
85             print $^H{x}==1 && !$^H{y} ? "ok $tno\n" : "not ok $tno\n";
86             $^H{y} = 1;
87         );
88         if ($@) {
89             (my $str = $@)=~s/^/# /gm;
90             print "not ok $tno\n$str\n";
91         }
92     }
93 }
94
95 {
96     $[ = 11;
97     print +($[ == 11 ? "" : "not "), "ok 17 - setting \$[ affects \$[\n";
98     our $t11; BEGIN { $t11 = $^H{'$['} }
99     print +($t11 == 11 ? "" : "not "), "ok 18 - setting \$[ affects \$^H{'\$['}\n";
100
101     BEGIN { $^H{'$['} = 22 }
102     print +($[ == 22 ? "" : "not "), "ok 19 - setting \$^H{'\$['} affects \$[\n";
103     our $t22; BEGIN { $t22 = $^H{'$['} }
104     print +($t22 == 22 ? "" : "not "), "ok 20 - setting \$^H{'\$['} affects \$^H{'\$['}\n";
105
106     BEGIN { %^H = () }
107     print +($[ == 0 ? "" : "not "), "ok 21 - clearing \%^H affects \$[\n";
108     our $t0; BEGIN { $t0 = $^H{'$['} }
109     print +($t0 == 0 ? "" : "not "), "ok 22 - clearing \%^H affects \$^H{'\$['}\n";
110 }
111
112 {
113     $[ = 13;
114     BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; }
115
116     our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; }
117     print +($[ == 13 ? "" : "not "), "ok 23 - \$[ correct before require\n";
118     print +($ri0 & 0x04000000 ? "" : "not "), "ok 24 - \$^H correct before require\n";
119     print +($rf0 eq "z" ? "" : "not "), "ok 25 - \$^H{foo} correct before require\n";
120
121     our($ra1, $ri1, $rf1, $rfe1);
122     BEGIN { require "comp/hints.aux"; }
123     print +($ra1 == 0 ? "" : "not "), "ok 26 - \$[ cleared for require\n";
124     print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 27 - \$^H cleared for require\n";
125     print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 28 - \$^H{foo} cleared for require\n";
126
127     our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; }
128     print +($[ == 13 ? "" : "not "), "ok 29 - \$[ correct after require\n";
129     print +($ri2 & 0x04000000 ? "" : "not "), "ok 30 - \$^H correct after require\n";
130     print +($rf2 eq "z" ? "" : "not "), "ok 31 - \$^H{foo} correct after require\n";
131 }
132
133 # Add new tests above this require, in case it fails.
134 require './test.pl';
135
136 # bug #27040: hints hash was being double-freed
137 my $result = runperl(
138     prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
139     stderr => 1
140 );
141 print "not " if length $result;
142 print "ok 32 - double-freeing hints hash\n";
143 print "# got: $result\n" if length $result;
144
145 __END__
146 # Add new tests above require 'test.pl'