1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '.'; 6 push @INC, '../lib'; 7} 8 9# don't make this lexical 10$i = 1; 11 12my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; 13my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/; 14my $total_tests = 30; 15if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 27; } 16print "1..$total_tests\n"; 17 18sub do_require { 19 %INC = (); 20 write_file('bleah.pm',@_); 21 eval { require "bleah.pm" }; 22 my @a; # magic guard for scope violations (must be first lexical in file) 23} 24 25sub write_file { 26 my $f = shift; 27 open(REQ,">$f") or die "Can't write '$f': $!"; 28 binmode REQ; 29 use bytes; 30 print REQ @_; 31 close REQ or die "Could not close $f: $!"; 32} 33 34eval {require 5.005}; 35print "# $@\nnot " if $@; 36print "ok ",$i++,"\n"; 37 38eval { require 5.005 }; 39print "# $@\nnot " if $@; 40print "ok ",$i++,"\n"; 41 42eval { require 5.005; }; 43print "# $@\nnot " if $@; 44print "ok ",$i++,"\n"; 45 46eval { 47 require 5.005 48}; 49print "# $@\nnot " if $@; 50print "ok ",$i++,"\n"; 51 52# new style version numbers 53 54eval { require v5.5.630; }; 55print "# $@\nnot " if $@; 56print "ok ",$i++,"\n"; 57 58eval { require 10.0.2; }; 59print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; 60print "ok ",$i++,"\n"; 61 62eval q{ use v5.5.630; }; 63print "# $@\nnot " if $@; 64print "ok ",$i++,"\n"; 65 66eval q{ use 10.0.2; }; 67print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; 68print "ok ",$i++,"\n"; 69 70my $ver = 5.005_63; 71eval { require $ver; }; 72print "# $@\nnot " if $@; 73print "ok ",$i++,"\n"; 74 75# check inaccurate fp 76$ver = 10.2; 77eval { require $ver; }; 78print "# $@\nnot " unless $@ =~ /^Perl v10\.200\.0 required/; 79print "ok ",$i++,"\n"; 80 81$ver = 10.000_02; 82eval { require $ver; }; 83print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; 84print "ok ",$i++,"\n"; 85 86print "not " unless 5.5.1 gt v5.5; 87print "ok ",$i++,"\n"; 88 89{ 90 print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; 91 print "ok ",$i++,"\n"; 92 93 print "not " unless v7.15 eq "\x{7}\x{f}"; 94 print "ok ",$i++,"\n"; 95 96 print "not " 97 unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; 98 print "ok ",$i++,"\n"; 99} 100 101# interaction with pod (see the eof) 102write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); 103require "bleah.pm"; 104$i++; 105 106# run-time failure in require 107do_require "0;\n"; 108print "# $@\nnot " unless $@ =~ /did not return a true/; 109print "ok ",$i++,"\n"; 110 111# compile-time failure in require 112do_require "1)\n"; 113# bison says 'parse error' instead of 'syntax error', 114# various yaccs may or may not capitalize 'syntax'. 115print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi; 116print "ok ",$i++,"\n"; 117 118# successful require 119do_require "1"; 120print "# $@\nnot " if $@; 121print "ok ",$i++,"\n"; 122 123# do FILE shouldn't see any outside lexicals 124my $x = "ok $i\n"; 125write_file("bleah.do", <<EOT); 126\$x = "not ok $i\\n"; 127EOT 128do "bleah.do"; 129dofile(); 130sub dofile { do "bleah.do"; }; 131print $x; 132 133# Test that scalar context is forced for require 134 135write_file('bleah.pm', <<'**BLEAH**' 136print "not " if !defined wantarray || wantarray ne ''; 137print "ok $i - require() context\n"; 1381; 139**BLEAH** 140); 141 delete $INC{"bleah.pm"}; ++$::i; 142$foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; 143@foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; 144 eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; 145 eval q{$_=$_+2;require bleah}; delete $INC{"bleah.pm"}; ++$::i; 146$foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; 147@foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; 148 eval {require bleah}; 149 150# UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input 151 152if ($Is_EBCDIC || $Is_UTF8) { exit; } 153 154my $utf8 = chr(0xFEFF); 155 156$i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); 157 158sub bytes_to_utf16 { 159 my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); 160 return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; 161} 162 163$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE 164$i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE 165 166END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; } 167 168# ***interaction with pod (don't put any thing after here)*** 169 170=pod 171