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