t/comp/require.t

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