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