t/op/override.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '.';
   6     push @INC, '../lib';
   7 }
   8
   9 print "1..10\n";
  10
  11 #
  12 # This file tries to test builtin override using CORE::GLOBAL
  13 #
  14 my $dirsep = "/";
  15
  16 BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } }
  17
  18 print "not " unless getlogin eq "kilroy";
  19 print "ok 1\n";
  20
  21 my $t = 42;
  22 BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
  23
  24 print "not " unless 45 == time + 3;
  25 print "ok 2\n";
  26
  27 #
  28 # require has special behaviour
  29 #
  30 my $r;
  31 BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
  32
  33 require Foo;
  34 print "not " unless $r eq "Foo.pm";
  35 print "ok 3\n";
  36
  37 require Foo::Bar;
  38 print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
  39 print "ok 4\n";
  40
  41 require 'Foo';
  42 print "not " unless $r eq "Foo";
  43 print "ok 5\n";
  44
  45 require 5.6;
  46 print "not " unless $r eq "5.6";
  47 print "ok 6\n";
  48
  49 require v5.6;
  50 print "not " unless abs($r - 5.006) < 0.001 && $r eq "\x05\x06";
  51 print "ok 7\n";
  52
  53 eval "use Foo";
  54 print "not " unless $r eq "Foo.pm";
  55 print "ok 8\n";
  56
  57 eval "use Foo::Bar";
  58 print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
  59 print "ok 9\n";
  60
  61 eval "use 5.6";
  62 print "not " unless $r eq "5.6";
  63 print "ok 10\n";