Commit | Line | Data |
---|---|---|
3cb0bbe5 GS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
69026470 | 5 | @INC = qw(. ../lib); |
e83d50c9 | 6 | $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; |
81452d21 | 7 | require "./test.pl"; require "./charset_tools.pl"; |
3cb0bbe5 GS |
8 | } |
9 | ||
e83d50c9 | 10 | $DOWARN = 1; # enable run-time warnings now |
3cb0bbe5 | 11 | |
e83d50c9 | 12 | use Config; |
3cb0bbe5 | 13 | |
ff44333e | 14 | plan( tests => 58 ); |
fd36d4b8 | 15 | |
84251760 | 16 | eval 'use v5.5.640'; |
e83d50c9 | 17 | is( $@, '', "use v5.5.640; $@"); |
fd36d4b8 | 18 | |
e83d50c9 | 19 | require_ok('v5.5.640'); |
3cb0bbe5 | 20 | |
e526c9e6 | 21 | # printing characters should work |
83bcbc61 | 22 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 23 | is('ok ',v111.107.32,'ASCII printing characters'); |
7bd40e26 PP |
24 | |
25 | # hash keys too | |
26 | $h{v111.107} = "ok"; | |
e83d50c9 | 27 | is('ok',$h{v111.107},'ASCII hash keys'); |
7bd40e26 PP |
28 | } |
29 | else { # EBCDIC | |
e83d50c9 | 30 | is('ok ',v150.146.64,'EBCDIC printing characters'); |
7bd40e26 PP |
31 | |
32 | # hash keys too | |
33 | $h{v150.146} = "ok"; | |
9034b73c | 34 | is('ok',$h{v150.146},'EBCDIC hash keys'); |
7bd40e26 | 35 | } |
e526c9e6 GS |
36 | |
37 | # poetry optimization should also | |
38 | sub v77 { "ok" } | |
39 | $x = v77; | |
e83d50c9 | 40 | is('ok',$x,'poetry optimization'); |
e526c9e6 GS |
41 | |
42 | # but not when dots are involved | |
83bcbc61 | 43 | if ($::IS_ASCII) { # ASCII |
7bd40e26 PP |
44 | $x = v77.78.79; |
45 | } | |
46 | else { | |
47 | $x = v212.213.214; | |
48 | } | |
e83d50c9 | 49 | is($x, 'MNO','poetry optimization with dots'); |
e526c9e6 | 50 | |
e83d50c9 | 51 | is(v1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string'); |
3cb0bbe5 | 52 | |
dd629d5b GS |
53 | # |
54 | # now do the same without the "v" | |
84251760 | 55 | eval 'use 5.5.640'; |
e83d50c9 JP |
56 | is( $@, '', "use 5.5.640; $@"); |
57 | ||
58 | require_ok('5.5.640'); | |
dd629d5b GS |
59 | |
60 | # hash keys too | |
83bcbc61 | 61 | if ($::IS_ASCII) { # ASCII |
7bd40e26 PP |
62 | $h{111.107.32} = "ok"; |
63 | } | |
64 | else { | |
65 | $h{150.146.64} = "ok"; | |
66 | } | |
e83d50c9 | 67 | is('ok',$h{ok },'hash keys w/o v'); |
dd629d5b | 68 | |
83bcbc61 | 69 | if ($::IS_ASCII) { # ASCII |
7bd40e26 PP |
70 | $x = 77.78.79; |
71 | } | |
72 | else { | |
73 | $x = 212.213.214; | |
74 | } | |
e83d50c9 | 75 | is($x, 'MNO','poetry optimization with dots w/o v'); |
dd629d5b | 76 | |
e83d50c9 | 77 | is(1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string w/o v'); |
dd629d5b GS |
78 | |
79 | # test sprintf("%vd"...) etc | |
83bcbc61 | 80 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 81 | is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")'); |
7bd40e26 PP |
82 | } |
83 | else { | |
e83d50c9 | 84 | is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")'); |
7bd40e26 | 85 | } |
3cb0bbe5 | 86 | |
e83d50c9 | 87 | is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)'); |
b22c7a20 | 88 | |
83bcbc61 | 89 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 90 | is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")'); |
7bd40e26 PP |
91 | } |
92 | else { | |
e83d50c9 | 93 | is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")'); |
7bd40e26 | 94 | } |
b22c7a20 | 95 | |
e83d50c9 | 96 | is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)'); |
b22c7a20 | 97 | |
83bcbc61 | 98 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 99 | is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")'); |
7bd40e26 PP |
100 | } |
101 | else { | |
e83d50c9 | 102 | is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")'); |
7bd40e26 | 103 | } |
b22c7a20 | 104 | |
e83d50c9 JP |
105 | is(sprintf("%*vb", "##", v1.22.333.4444), |
106 | '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)'); | |
3cb0bbe5 | 107 | |
e83d50c9 | 108 | is(sprintf("%vd", join("", map { chr } |
fd36d4b8 | 109 | unpack 'U*', pack('U*',2001,2002,2003))), |
e83d50c9 | 110 | '2001.2002.2003','unpack/pack U*'); |
8dbfaa5d | 111 | |
3cb0bbe5 | 112 | { |
8058d7ab | 113 | use bytes; |
fd36d4b8 | 114 | |
83bcbc61 | 115 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 116 | is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl") w/use bytes'); |
7bd40e26 PP |
117 | } |
118 | else { | |
e83d50c9 | 119 | is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl") w/use bytes'); |
7bd40e26 | 120 | } |
b22c7a20 | 121 | |
83bcbc61 | 122 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 123 | is(sprintf("%vd", 1.22.333.4444), '1.22.197.141.225.133.156', 'ASCII sprintf("%vd", v1.22.333.4444 w/use bytes'); |
210db7fc PP |
124 | } |
125 | else { | |
e83d50c9 | 126 | is(sprintf("%vd", 1.22.333.4444), '1.22.142.84.187.81.112', 'EBCDIC sprintf("%vd", v1.22.333.4444 w/use bytes'); |
210db7fc | 127 | } |
b22c7a20 | 128 | |
83bcbc61 | 129 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 130 | is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")'); |
7bd40e26 PP |
131 | } |
132 | else { | |
e83d50c9 | 133 | is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")'); |
7bd40e26 | 134 | } |
b22c7a20 | 135 | |
83bcbc61 | 136 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 137 | is(sprintf("%vX", v1.22.333.4444), '1.16.C5.8D.E1.85.9C', 'ASCII sprintf("%vX", v1.22.333.4444)'); |
210db7fc PP |
138 | } |
139 | else { | |
e83d50c9 | 140 | is(sprintf("%vX", v1.22.333.4444), '1.16.8E.54.BB.51.70', 'EBCDIC sprintf("%vX", v1.22.333.4444)'); |
210db7fc | 141 | } |
b22c7a20 | 142 | |
83bcbc61 | 143 | if ($::IS_ASCII) { # ASCII |
e83d50c9 | 144 | is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%#*vo", ":", "Perl")'); |
7bd40e26 PP |
145 | } |
146 | else { | |
e83d50c9 | 147 | is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%#*vo", ":", "Perl")'); |
7bd40e26 | 148 | } |
b22c7a20 | 149 | |
83bcbc61 | 150 | if ($::IS_ASCII) { # ASCII |
e83d50c9 JP |
151 | is(sprintf("%*vb", "##", v1.22.333.4444), |
152 | '1##10110##11000101##10001101##11100001##10000101##10011100', | |
153 | 'ASCII sprintf("%*vb", "##", v1.22.333.4444)'); | |
210db7fc PP |
154 | } |
155 | else { | |
e83d50c9 JP |
156 | is(sprintf("%*vb", "##", v1.22.333.4444), |
157 | '1##10110##10001110##1010100##10111011##1010001##1110000', | |
158 | 'EBCDIC sprintf("%*vb", "##", v1.22.333.4444)'); | |
210db7fc | 159 | } |
3cb0bbe5 | 160 | } |
00387047 JH |
161 | |
162 | { | |
163 | # bug id 20000323.056 | |
164 | ||
e83d50c9 JP |
165 | is( "\x{41}", +v65, 'bug id 20000323.056'); |
166 | is( "\x41", +v65, 'bug id 20000323.056'); | |
167 | is( "\x{c8}", +v200, 'bug id 20000323.056'); | |
168 | is( "\xc8", +v200, 'bug id 20000323.056'); | |
169 | is( "\x{221b}", +v8731, 'bug id 20000323.056'); | |
00387047 | 170 | } |
fd36d4b8 JH |
171 | |
172 | # See if the things Camel-III says are true: 29..33 | |
173 | ||
174 | # Chapter 2 pp67/68 | |
175 | my $vs = v1.20.300.4000; | |
e83d50c9 JP |
176 | is($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}"); |
177 | is($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()"); | |
81452d21 | 178 | is('foo',($::IS_EBCDIC ? v134.150.150 : v102.111.111),"v-string ne ''"); |
fd36d4b8 JH |
179 | |
180 | # Chapter 15, pp403 | |
181 | ||
182 | # See if sane addr and gethostbyaddr() work | |
9eeec659 | 183 | eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) }; |
7a9ee8c4 | 184 | if ($@) { |
e83d50c9 | 185 | # No - so do not test insane fails. |
7a9ee8c4 | 186 | $@ =~ s/\n/\n# /g; |
7a9ee8c4 | 187 | } |
58d344df | 188 | SKIP: { |
189 | skip("No Socket::AF_INET # $@") if $@; | |
7a9ee8c4 JP |
190 | my $ip = v2004.148.0.1; |
191 | my $host; | |
9eeec659 | 192 | eval { $host = gethostbyaddr($ip,&Socket::AF_INET) }; |
1d662fb6 | 193 | like($@, qr/Wide character/, "Non-bytes leak to gethostbyaddr"); |
7a9ee8c4 | 194 | } |
fd36d4b8 JH |
195 | |
196 | # Chapter 28, pp671 | |
e83d50c9 JP |
197 | ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0"); |
198 | ||
199 | # part of 20000323.059 | |
200 | is(v200, chr(200), "v200 eq chr(200)" ); | |
201 | is(v200, +v200, "v200 eq +v200" ); | |
202 | is(v200, eval( "v200"), 'v200 eq "v200"' ); | |
203 | is(v200, eval("+v200"), 'v200 eq eval("+v200")' ); | |
204 | ||
205 | # Tests for string/numeric value of $] itself | |
8c5f6936 | 206 | my ($revision,$version,$subversion) = split /\./, sprintf("%vd",$^V); |
e83d50c9 | 207 | |
9137345a JP |
208 | # $^V always displays the leading 'v' but we don't want that here |
209 | $revision =~ s/^v//; | |
210 | ||
4282de36 JH |
211 | print "# revision = '$revision'\n"; |
212 | print "# version = '$version'\n"; | |
213 | print "# subversion = '$subversion'\n"; | |
214 | ||
e83d50c9 JP |
215 | my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion); |
216 | ||
4282de36 JH |
217 | print "# v = '$v'\n"; |
218 | print "# ] = '$]'\n"; | |
219 | ||
8c5f6936 | 220 | is( $v, "$]", qq{\$^V eq "\$]"}); |
e83d50c9 JP |
221 | |
222 | $v = $revision + $version/1000 + $subversion/1000000; | |
223 | ||
d7aa5382 | 224 | ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" ); |
e83d50c9 | 225 | |
c0236afe | 226 | { |
979699d9 | 227 | |
760c7c2f | 228 | no warnings 'deprecated'; # These are above IV_MAX on 32 bit machines |
979699d9 JH |
229 | # [ID 20010902.001] check if v-strings handle full UV range or not |
230 | if ( $Config{'uvsize'} >= 4 ) { | |
231 | is( sprintf("%vd", eval 'v2147483647.2147483648'), '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' ); | |
232 | is( sprintf("%vd", eval 'v3141592653'), '3141592653', 'IV_MAX < v-string < UV_MAX[32-bit]'); | |
233 | is( sprintf("%vd", eval 'v4294967295'), '4294967295', 'v-string == UV_MAX[32-bit] - 1'); | |
234 | } | |
235 | ||
236 | SKIP: { | |
237 | skip("No quads", 3) if $Config{uvsize} < 8; | |
238 | ||
239 | if ( $Config{'uvsize'} >= 8 ) { | |
240 | is( sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'), '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' ); | |
241 | is( sprintf("%vd", eval 'v17446744073709551615'), '17446744073709551615', 'IV_MAX < v-string < UV_MAX[64-bit]'); | |
242 | is( sprintf("%vd", eval 'v18446744073709551615'), '18446744073709551615', 'v-string == UV_MAX[64-bit] - 1'); | |
243 | } | |
244 | } | |
7a9ee8c4 | 245 | } |
439cb1c4 JP |
246 | |
247 | # Tests for magic v-strings | |
248 | ||
249 | $v = 1.2.3; | |
250 | is( ref(\$v), 'VSTRING', 'v-string objects' ); | |
251 | ||
252 | $v = v1.2_3; | |
253 | is( ref(\$v), 'VSTRING', 'v-string objects with v' ); | |
254 | is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' ); | |
3cd5fe90 JH |
255 | |
256 | # [perl #16010] | |
257 | %h = (v65 => 42); | |
258 | ok( exists $h{v65}, "v-stringness is not engaged for vX" ); | |
259 | %h = (v65.66 => 42); | |
260 | ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" ); | |
261 | %h = (65.66.67 => 42); | |
262 | ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" ); | |
263 | ||
190e89f0 FC |
264 | { |
265 | local $|; | |
266 | $| = v0; | |
267 | $| = 1; | |
268 | --$|; --$|; | |
269 | is $|, 1, 'clobbering vstrings does not clobber all magic'; | |
270 | } | |
271 | ||
81452d21 | 272 | $a = $::IS_EBCDIC ? v134 : v102; $a =~ s/f/f/; |
4499db73 FC |
273 | is ref \$a, 'SCALAR', |
274 | 's/// flattens vstrings even when the subst results in the same value'; | |
81452d21 | 275 | $a = $::IS_EBCDIC ? v134 : v102; $a =~ y/f/g/; |
4499db73 | 276 | is ref \$a, 'SCALAR', 'y/// flattens vstrings'; |
3cd5fe90 | 277 | |
ff44333e FC |
278 | sub { $_[0] = v3; |
279 | is ref \$h{nonexistent}, 'VSTRING', 'defelems can pass vstrings' } | |
280 | ->($h{nonexistent}); | |
281 | ||
6c336d06 RH |
282 | # The following tests whether v-strings are correctly |
283 | # interpreted by the tokeniser when it's in a XTERMORDORDOR | |
284 | # state (fittingly, the only tokeniser state to contain the | |
285 | # word MORDOR). | |
286 | ||
287 | *{"\3"} = *DATA; | |
288 | is( (readline v3), "This is what we expect to see!\n", "v-strings even work in Mordor" ); | |
289 | ||
290 | __DATA__ | |
291 | This is what we expect to see! |