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