testsuite for change#10192 (from Gisle Aas)
Gurusamy Sarathy [Mon, 4 Jun 2001 05:12:18 +0000 (05:12 +0000)]
p4raw-link: @10192 on //depot/perl: ec4ab249deaa88f5a071536b0473504f26c43486

p4raw-id: //depot/perl@10423

MANIFEST
t/op/override.t [new file with mode: 0755]

index 24b9a7b..1701463 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1765,6 +1765,7 @@ t/op/nothr5005.t  local @_ test which does not work under use5005threads
 t/op/numconvert.t      See if accessing fields does not change numeric values
 t/op/oct.t             See if oct and hex work
 t/op/ord.t             See if ord works
+t/op/override.t                See if operator overriding works
 t/op/pack.t            See if pack and unpack work
 t/op/pat.t             See if esoteric patterns work
 t/op/pos.t             See if pos works
diff --git a/t/op/override.t b/t/op/override.t
new file mode 100755 (executable)
index 0000000..d24bdee
--- /dev/null
@@ -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";