This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
eliminate HINT_HH_FOR_EVAL
authorRobin Houston <robin@cpan.org>
Thu, 22 Dec 2005 11:54:55 +0000 (11:54 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Thu, 22 Dec 2005 14:55:52 +0000 (14:55 +0000)
Message-ID: <20051222115455.GB30301@rpc142.cs.man.ac.uk>

p4raw-id: //depot/perl@26447

lib/feature.pm
lib/overload.pm
lib/sort.pm
op.c
perl.h
t/comp/hints.t

index 345b288..4f03329 100644 (file)
@@ -1,7 +1,7 @@
 package feature;
 
 our $VERSION = '1.00';
 package feature;
 
 our $VERSION = '1.00';
-$feature::hint_bits = 0x04020000; # HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL
+$feature::hint_bits = 0x00020000; # HINT_LOCALIZE_HH
 
 # (feature name) => (internal name, used in %^H)
 my %feature = (
 
 # (feature name) => (internal name, used in %^H)
 my %feature = (
index 8a07efe..50f324c 100644 (file)
@@ -783,9 +783,6 @@ From these methods they may be called as
          overload::constant integer => sub {Math::BigInt->new(shift)};
        }
 
          overload::constant integer => sub {Math::BigInt->new(shift)};
        }
 
-B<BUGS> Currently overloaded-ness of constants does not propagate
-into C<eval '...'>.
-
 =head1 IMPLEMENTATION
 
 What follows is subject to change RSN.
 =head1 IMPLEMENTATION
 
 What follows is subject to change RSN.
index ded62c1..326724b 100644 (file)
@@ -5,7 +5,7 @@ our $VERSION = '2.00';
 # The hints for pp_sort are now stored in $^H{sort}; older versions
 # of perl used the global variable $sort::hints. -- rjh 2005-12-19
 
 # The hints for pp_sort are now stored in $^H{sort}; older versions
 # of perl used the global variable $sort::hints. -- rjh 2005-12-19
 
-$sort::hint_bits = 0x04020000; # HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL
+$sort::hint_bits = 0x00020000; # HINT_LOCALIZE_HH
 
 $sort::quicksort_bit   = 0x00000001;
 $sort::mergesort_bit   = 0x00000002;
 
 $sort::quicksort_bit   = 0x00000001;
 $sort::mergesort_bit   = 0x00000002;
diff --git a/op.c b/op.c
index e8e0193..f8caa99 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5299,8 +5299,7 @@ Perl_ck_eval(pTHX_ OP *o)
        o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
     }
     o->op_targ = (PADOFFSET)PL_hints;
        o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
     }
     o->op_targ = (PADOFFSET)PL_hints;
-    if ((PL_hints & HINT_HH_FOR_EVAL) != 0 && GvHV(PL_hintgv))
-    {
+    if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
        /* Store a copy of %^H that pp_entereval can pick up */
        OP *hhop = newSVOP(OP_CONST, 0, (SV*)newHVhv(GvHV(PL_hintgv)));
        cUNOPo->op_first->op_sibling = hhop;
        /* Store a copy of %^H that pp_entereval can pick up */
        OP *hhop = newSVOP(OP_CONST, 0, (SV*)newHVhv(GvHV(PL_hintgv)));
        cUNOPo->op_first->op_sibling = hhop;
diff --git a/perl.h b/perl.h
index ea01dda..4d8e719 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4137,9 +4137,6 @@ enum {            /* pass one of these to get_vtbl */
 #define HINT_ASSERTING          0x01000000
 #define HINT_ASSERTIONSSEEN     0x02000000
 
 #define HINT_ASSERTING          0x01000000
 #define HINT_ASSERTIONSSEEN     0x02000000
 
-#define HINT_HH_FOR_EVAL       0x04000000 /* Squirrel a copy of %^H away
-                                           * with every eval "string" */
-
 /* The following are stored in $sort::hints, not in PL_hints */
 #define HINT_SORT_SORT_BITS    0x000000FF /* allow 256 different ones */
 #define HINT_SORT_QUICKSORT    0x00000001
 /* The following are stored in $sort::hints, not in PL_hints */
 #define HINT_SORT_SORT_BITS    0x000000FF /* allow 256 different ones */
 #define HINT_SORT_QUICKSORT    0x00000001
index 07069e8..d15a44a 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 
 }
 
 
-BEGIN { print "1..17\n"; }
+BEGIN { print "1..15\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -16,54 +16,50 @@ BEGIN {
     print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
 }
 {
     print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
 }
 {
-    # simulate a pragma -- don't forget HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL
+    # simulate a pragma -- don't forget HINT_LOCALIZE_HH
     BEGIN { $^H |= 0x04020000; $^H{foo} = "a"; }
     BEGIN {
        print "not " if $^H{foo} ne "a";
        print "ok 3 - \$^H{foo} is now 'a'\n";
        print "not " unless $^H & 0x00020000;
        print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
     BEGIN { $^H |= 0x04020000; $^H{foo} = "a"; }
     BEGIN {
        print "not " if $^H{foo} ne "a";
        print "ok 3 - \$^H{foo} is now 'a'\n";
        print "not " unless $^H & 0x00020000;
        print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
-       print "not " unless $^H & 0x04000000;
-       print "ok 5 - \$^H contains HINT_HH_FOR_EVAL while compiling\n";
     }
     {
        BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
        BEGIN {
            print "not " if $^H{foo} ne "b";
     }
     {
        BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
        BEGIN {
            print "not " if $^H{foo} ne "b";
-           print "ok 6 - \$^H{foo} is now 'b'\n";
+           print "ok 5 - \$^H{foo} is now 'b'\n";
        }
     }
     BEGIN {
        print "not " if $^H{foo} ne "a";
        }
     }
     BEGIN {
        print "not " if $^H{foo} ne "a";
-       print "ok 7 - \$H^{foo} restored to 'a'\n";
+       print "ok 6 - \$H^{foo} restored to 'a'\n";
     }
     # The pragma settings disappear after compilation
     # (test at CHECK-time and at run-time)
     CHECK {
        print "not " if exists $^H{foo};
     }
     # The pragma settings disappear after compilation
     # (test at CHECK-time and at run-time)
     CHECK {
        print "not " if exists $^H{foo};
-       print "ok 10 - \$^H{foo} doesn't exist when compilation complete\n";
+       print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
        print "not " if $^H & 0x00020000;
        print "not " if $^H & 0x00020000;
-       print "ok 11 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
+       print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
     }
     print "not " if exists $^H{foo};
     }
     print "not " if exists $^H{foo};
-    print "ok 12 - \$^H{foo} doesn't exist at runtime\n";
+    print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
     print "not " if $^H & 0x00020000;
     print "not " if $^H & 0x00020000;
-    print "ok 13 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
-    print "not " if $^H & 0x04000000;
-    print "ok 14 - \$^H doesn't contain HINT_HH_FOR_EVAL at run-time\n";
+    print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
     # op_entereval should keep the pragmas it was compiled with
     eval q*
        print "not " if $^H{foo} ne "a";
     # op_entereval should keep the pragmas it was compiled with
     eval q*
        print "not " if $^H{foo} ne "a";
-       print "ok 15 - \$^H{foo} is 'a' at eval-\"\" time\n";
+       print "ok 13 - \$^H{foo} is 'a' at eval-\"\" time\n";
        print "not " unless $^H & 0x00020000;
        print "not " unless $^H & 0x00020000;
-       print "ok 16 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
+       print "ok 14 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
     *;
 }
 BEGIN {
     print "not " if exists $^H{foo};
     *;
 }
 BEGIN {
     print "not " if exists $^H{foo};
-    print "ok 8 - \$^H{foo} doesn't exist while finishing compilation\n";
+    print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
     print "not " if $^H & 0x00020000;
     print "not " if $^H & 0x00020000;
-    print "ok 9 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
+    print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
 }
 
 require 'test.pl';
 }
 
 require 'test.pl';
@@ -74,6 +70,6 @@ my $result = runperl(
     stderr => 1
 );
 print "not " if length $result;
     stderr => 1
 );
 print "not " if length $result;
-print "ok 17 - double-freeing hints hash\n";
+print "ok 15 - double-freeing hints hash\n";
 print "# got: $result\n" if length $result;
 
 print "# got: $result\n" if length $result;