Integrate mainline.

p4raw-id: //depot/perlio@10452

4 files changed, 113 insertions, 5 deletions

diff --git a/t/op/eval.t b/t/op/eval.t
index f4d4be5ab7..42a71e2593 100755
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -99,7 +99,7 @@ do_eval1('print "ok $x\n"');
 $x++;
 do_eval1('eval q[print "ok $x\n"]');
 $x++;
-do_eval1('sub { eval q[print "ok $x\n"] }->()');
+do_eval1('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()');
 $x++;
 
 # calls from within eval'' should clone outer lexicals
@@ -112,7 +112,7 @@ do_eval2('print "ok $x\n"');
 $x++;
 do_eval2('eval q[print "ok $x\n"]');
 $x++;
-do_eval2('sub { eval q[print "ok $x\n"] }->()');
+do_eval2('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()');
 $x++;
 EOT
 
diff --git a/t/op/misc.t b/t/op/misc.t
index 90df19a420..881f99dc18 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -575,6 +575,30 @@ print qw(ab a\b a\\b);
 EXPECT
 aba\ba\b
 ########
+# lexicals declared after the myeval() definition should not be visible
+# within it
+sub myeval { eval $_[0] }
+my $foo = "ok 2\n";
+myeval('sub foo { local $foo = "ok 1\n"; print $foo; }');
+die $@ if $@;
+foo();
+print $foo;
+EXPECT
+ok 1
+ok 2
+########
+# lexicals outside an eval"" should be visible inside subroutine definitions
+# within it
+eval <<'EOT'; die $@ if $@;
+{
+    my $X = "ok\n";
+    eval 'sub Y { print $X }'; die $@ if $@;
+    Y();
+}
+EOT
+EXPECT
+ok
+########
 # This test is here instead of pragma/locale.t because
 # the bug depends on in the internal state of the locale
 # settings and pragma/locale messes up that state pretty badly.
@@ -694,3 +718,24 @@ Execution of - aborted due to compilation errors.
 EXPECT
 Missing right brace on \x{} at - line 2, within string
 Execution of - aborted due to compilation errors.
+########
+my $foo = Bar->new();
+my @dst;
+END {
+    ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/;
+    print $_, "\n";
+}
+package Bar;
+sub new {
+    my Bar $self = bless [], Bar;
+    eval '$self';
+    return $self;
+}
+sub DESTROY { 
+    push @dst, "$_[0]";
+}
+EXPECT
+Bar=ARRAY(0x...)
+########
+eval "a.b.c.d.e.f;sub"
+EXPECT
diff --git a/t/op/override.t b/t/op/override.t
new file mode 100755
index 0000000000..d24bdee31a
--- /dev/null
+++ b/t/op/override.t
@@ -0,0 +1,63 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.';
+    push @INC, '../lib';
+}
+
+print "1..10\n";
+
+#
+# This file tries to test builtin override using CORE::GLOBAL
+#
+my $dirsep = "/";
+
+BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } }
+
+print "not " unless getlogin eq "kilroy";
+print "ok 1\n";
+
+my $t = 42;
+BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
+
+print "not " unless 45 == time + 3;
+print "ok 2\n";
+
+#
+# require has special behaviour
+#
+my $r;
+BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
+
+require Foo;
+print "not " unless $r eq "Foo.pm";
+print "ok 3\n";
+
+require Foo::Bar;
+print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
+print "ok 4\n";
+
+require 'Foo';
+print "not " unless $r eq "Foo";
+print "ok 5\n";
+
+require 5.6;
+print "not " unless $r eq "5.6";
+print "ok 6\n";
+
+require v5.6;
+print "not " unless $r == 5.006 && $r eq "\x05\x06";
+print "ok 7\n";
+
+eval "use Foo";
+print "not " unless $r eq "Foo.pm";
+print "ok 8\n";
+
+eval "use Foo::Bar";
+print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
+print "ok 9\n";
+
+eval "use 5.6";
+print "not " unless $r eq "5.6";
+print "ok 10\n";
diff --git a/t/op/ver.t b/t/op/ver.t
index 05bd854b24..18d101aeee 100755
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -202,17 +202,17 @@ okeq('foo',((chr(193) eq 'A') ? v134.150.150 : v102.111.111),"v-string ne ''");
 # Chapter 15, pp403
 
 # See if sane addr and gethostbyaddr() work
-eval { require Socket; gethostbyaddr(v127.0.0.1,Socket::AF_INET()) };
+eval { require Socket; gethostbyaddr(v127.0.0.1, Socket::AF_INET) };
 if ($@)
  {
   # No - so don't test insane fails.
-  skip("No Socket");
+  skip("No Socket::AF_INET # $@");
  }
 else
  {
   my $ip   = v2004.148.0.1;
   my $host;
-  eval { $host = gethostbyaddr($ip,Socket::AF_INET()) };
+  eval { $host = gethostbyaddr($ip,Socket::AF_INET) };
   okeq($@ =~ /Wide character/,1,"Non-bytes leak to gethostbyaddr");
  }