Re: [PATCH] optimize /[x]/ to /x/.

[p5sagit/p5-mst-13.2.git] / t / op / caller.t

diff --git a/t/op/caller.t b/t/op/caller.t
index 578aaaf..d0716be 100644 (file)
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 31 );
+    plan( tests => 71 );
 }
 
 my @c;
@@ -104,7 +104,7 @@ my $debugger_test =  q<
 sub pb { return (caller(0))[3] }
 
 my $i = eval $debugger_test;
-is( $i, 10, "do not skip over eval (and caller returns 10 elements)" );
+is( $i, 11, "do not skip over eval (and caller returns 10 elements)" );
 
 is( eval 'pb()', 'main::pb', "actually return the right function name" );
 
@@ -113,6 +113,157 @@ $^P = 16;
 $^P = $saved_perldb;
 
 $i = eval $debugger_test;
-is( $i, 10, 'do not skip over eval even if $^P had been on at some point' );
+is( $i, 11, 'do not skip over eval even if $^P had been on at some point' );
 is( eval 'pb()', 'main::pb', 'actually return the right function name even if $^P had been on at some point' );
 
+print "# caller can now return the compile time state of %^H\n";
+
+sub get_hash {
+    my $level = shift;
+    my @results = caller($level||0);
+    $results[10];
+}
+
+sub get_dooot {
+    my $level = shift;
+    my @results = caller($level||0);
+    $results[10]->{dooot};
+}
+
+sub get_thikoosh {
+    my $level = shift;
+    my @results = caller($level||0);
+    $results[10]->{thikoosh};
+}
+
+sub dooot {
+    is(get_dooot(), undef);
+    is(get_thikoosh(), undef);
+    my $hash = get_hash();
+    ok(!exists $hash->{dooot});
+    ok(!exists $hash->{thikoosh});
+    is(get_dooot(1), 54);
+    BEGIN {
+       $^H{dooot} = 42;
+    }
+    is(get_dooot(), 6 * 7);
+    is(get_dooot(1), 54);
+
+    BEGIN {
+       $^H{dooot} = undef;
+    }
+    is(get_dooot(), undef);
+    $hash = get_hash();
+    ok(exists $hash->{dooot});
+
+    BEGIN {
+       delete $^H{dooot};
+    }
+    is(get_dooot(), undef);
+    $hash = get_hash();
+    ok(!exists $hash->{dooot});
+    is(get_dooot(1), 54);
+}
+{
+    is(get_dooot(), undef);
+    is(get_thikoosh(), undef);
+    BEGIN {
+       $^H{dooot} = 1;
+       $^H{thikoosh} = "SKREECH";
+    }
+    is(get_dooot(), 1);
+    is(get_thikoosh(), "SKREECH");
+
+    BEGIN {
+       $^H{dooot} = 42;
+    }
+    {
+       {
+           BEGIN {
+               $^H{dooot} = 6 * 9;
+           }
+           is(get_dooot(), 54);
+           is(get_thikoosh(), "SKREECH");
+           {
+               BEGIN {
+                   delete $^H{dooot};
+               }
+               is(get_dooot(), undef);
+               my $hash = get_hash();
+               ok(!exists $hash->{dooot});
+               is(get_thikoosh(), "SKREECH");
+           }
+           dooot();
+       }
+       is(get_dooot(), 6 * 7);
+       is(get_thikoosh(), "SKREECH");
+    }
+    is(get_dooot(), 6 * 7);
+    is(get_thikoosh(), "SKREECH");
+}
+
+print "# which now works inside evals\n";
+
+{
+    BEGIN {
+       $^H{dooot} = 42;
+    }
+    is(get_dooot(), 6 * 7);
+
+    eval "is(get_dooot(), 6 * 7); 1" or die $@;
+
+    eval <<'EOE' or die $@;
+    is(get_dooot(), 6 * 7);
+    eval "is(get_dooot(), 6 * 7); 1" or die $@;
+    BEGIN {
+       $^H{dooot} = 54;
+    }
+    is(get_dooot(), 54);
+    eval "is(get_dooot(), 54); 1" or die $@;
+    eval 'BEGIN { $^H{dooot} = -1; }; 1' or die $@;
+    is(get_dooot(), 54);
+    eval "is(get_dooot(), 54); 1" or die $@;
+EOE
+}
+
+{
+    BEGIN {
+       $^H{dooot} = "FIP\0FOP\0FIDDIT\0FAP";
+    }
+    is(get_dooot(), "FIP\0FOP\0FIDDIT\0FAP", "Can do embedded 0 bytes");
+
+    BEGIN {
+       $^H{dooot} = chr 256;
+    }
+    is(get_dooot(), chr 256, "Can do Unicode");
+
+    BEGIN {
+       $^H{dooot} = -42;
+    }
+    is(get_dooot(), -42, "Can do IVs");
+
+    BEGIN {
+       $^H{dooot} = ~0;
+    }
+    cmp_ok(get_dooot(), '>', 42, "Can do UVs");
+}
+
+{
+    my ($k1, $k2, $k3);
+    BEGIN {
+       $k1 = chr 163;
+       $k2 = $k1;
+       $k3 = $k1;
+       utf8::upgrade $k2;
+       utf8::encode $k3;
+
+       $^H{$k1} = 1;
+       $^H{$k2} = 2;
+       $^H{$k3} = 3;
+    }
+
+       
+    is(get_hash()->{$k1}, 2, "UTF-8 or not, it's the same");
+    is(get_hash()->{$k2}, 2, "UTF-8 or not, it's the same");
+    is(get_hash()->{$k3}, 3, "Octect sequences and UTF-8 are distinct");
+}