This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #27040] - hints hash was being double freed on scope exit
[perl5.git] / t / comp / hints.t
1 #!./perl
2
3 # Tests the scoping of $^H and %^H
4
5 BEGIN { print "1..15\n"; }
6 BEGIN {
7     print "not " if exists $^H{foo};
8     print "ok 1 - \$^H{foo} doesn't exist initially\n";
9     print "not " if $^H & 0x00020000;
10     print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
11 }
12 {
13     # simulate a pragma -- don't forget HINT_LOCALIZE_HH
14     BEGIN { $^H |= 0x00020000; $^H{foo} = "a"; }
15     BEGIN {
16         print "not " if $^H{foo} ne "a";
17         print "ok 3 - \$^H{foo} is now 'a'\n";
18         print "not " unless $^H & 0x00020000;
19         print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
20     }
21     {
22         BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
23         BEGIN {
24             print "not " if $^H{foo} ne "b";
25             print "ok 5 - \$^H{foo} is now 'b'\n";
26         }
27     }
28     BEGIN {
29         print "not " if $^H{foo} ne "a";
30         print "ok 6 - \$H^{foo} restored to 'a'\n";
31     }
32     # The pragma settings disappear after compilation
33     # (test at CHECK-time and at run-time)
34     CHECK {
35         print "not " if exists $^H{foo};
36         print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
37         print "not " if $^H & 0x00020000;
38         print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
39     }
40     print "not " if exists $^H{foo};
41     print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
42     print "not " if $^H & 0x00020000;
43     print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
44     # op_entereval should keep the pragmas it was compiled with
45     eval q*
46         print "not " if $^H{foo} ne "a";
47         print "ok 13 - \$^H{foo} is 'a' at eval-\"\" time # TODO\n";
48         print "not " unless $^H & 0x00020000;
49         print "ok 14 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
50     *;
51 }
52 BEGIN {
53     print "not " if exists $^H{foo};
54     print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
55     print "not " if $^H & 0x00020000;
56     print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
57 }
58
59 require 'test.pl';
60
61 # bug #27040: hints hash was being double-freed
62 my $result = runperl(
63     prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
64     stderr => 1
65 );
66 print "not " if length $result;
67 print "ok 15 - double-freeing hints hash\n";
68 print "# got: $result\n" if length $result;
69