t/op/require_override.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 BEGIN {
   6     chdir 't';
   7     require './test.pl';
   8 }
   9
  10 plan(tests => 10);
  11
  12 my @warns;
  13 local $SIG{__WARN__}= sub { push @warns, $_[0] };
  14 my $error;
  15
  16 eval "require; 1" or $error = $@;
  17 ok(1, "Check that eval 'require' does not segv");
  18 ok(0 == @warns, "We expect the eval to die, without producing warnings");
  19 like($error, qr/Missing or undefined argument to require/, "Make sure we got the error we expect");
  20
  21 @warns= ();
  22 $error= undef;
  23
  24 sub TIESCALAR{bless[]}
  25 sub STORE{}
  26 sub FETCH{}
  27 tie my $x, "";
  28 $x = "x";
  29 eval 'require $x; 1' or $error = $@;
  30 ok(0 == @warns,
  31   'no warnings from require $tied_undef_after_str_assignment');
  32 like($error, qr/^Missing or undefined argument to require/,
  33     "Make sure we got the error we expect");
  34
  35 @warns= ();
  36 $error= undef;
  37
  38 $x = 3;
  39 eval 'require $x; 1' or $error = $@;
  40 ok(0 == @warns,
  41   'no warnings from require $tied_undef_after_num_assignment');
  42 like($error, qr/^Missing or undefined argument to require/,
  43     "Make sure we got the error we expect");
  44
  45 @warns= ();
  46 $error= undef;
  47
  48 *CORE::GLOBAL::require = *CORE::GLOBAL::require = sub { };
  49 eval "require; 1" or $error = $@;
  50 ok(1, "Check that eval 'require' on overloaded require does not segv");
  51 ok(0 == @warns, "We expect the eval to die, without producing warnings");
  52
  53 # NOTE! The following test does NOT represent a commitment or promise that the following logic is
  54 # the *right* thing to do. It may well not be. But this is how it works now, and we want to test it.
  55 # IOW, do not use this test as the basis to argue that this is how it SHOULD work. Thanks, yves.
  56 ok(!defined($error), "We do not expect the overloaded version of require to die from no arguments");
  57
  58
  59