1 | #!./perl |
---|
2 | |
---|
3 | BEGIN { |
---|
4 | chdir 't' if -d 't'; |
---|
5 | @INC = qw(. ../lib); |
---|
6 | $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; |
---|
7 | } |
---|
8 | |
---|
9 | $DOWARN = 1; # enable run-time warnings now |
---|
10 | |
---|
11 | use Config; |
---|
12 | |
---|
13 | require "test.pl"; |
---|
14 | plan( tests => 53 ); |
---|
15 | |
---|
16 | eval 'use v5.5.640'; |
---|
17 | is( $@, '', "use v5.5.640; $@"); |
---|
18 | |
---|
19 | require_ok('v5.5.640'); |
---|
20 | |
---|
21 | # printing characters should work |
---|
22 | if (ord("\t") == 9) { # ASCII |
---|
23 | is('ok ',v111.107.32,'ASCII printing characters'); |
---|
24 | |
---|
25 | # hash keys too |
---|
26 | $h{v111.107} = "ok"; |
---|
27 | is('ok',$h{v111.107},'ASCII hash keys'); |
---|
28 | } |
---|
29 | else { # EBCDIC |
---|
30 | is('ok ',v150.146.64,'EBCDIC printing characters'); |
---|
31 | |
---|
32 | # hash keys too |
---|
33 | $h{v150.146} = "ok"; |
---|
34 | is('ok',$h{v150.146},'EBCDIC hash keys'); |
---|
35 | } |
---|
36 | |
---|
37 | # poetry optimization should also |
---|
38 | sub v77 { "ok" } |
---|
39 | $x = v77; |
---|
40 | is('ok',$x,'poetry optimization'); |
---|
41 | |
---|
42 | # but not when dots are involved |
---|
43 | if (ord("\t") == 9) { # ASCII |
---|
44 | $x = v77.78.79; |
---|
45 | } |
---|
46 | else { |
---|
47 | $x = v212.213.214; |
---|
48 | } |
---|
49 | is($x, 'MNO','poetry optimization with dots'); |
---|
50 | |
---|
51 | is(v1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string'); |
---|
52 | |
---|
53 | # |
---|
54 | # now do the same without the "v" |
---|
55 | eval 'use 5.5.640'; |
---|
56 | is( $@, '', "use 5.5.640; $@"); |
---|
57 | |
---|
58 | require_ok('5.5.640'); |
---|
59 | |
---|
60 | # hash keys too |
---|
61 | if (ord("\t") == 9) { # ASCII |
---|
62 | $h{111.107.32} = "ok"; |
---|
63 | } |
---|
64 | else { |
---|
65 | $h{150.146.64} = "ok"; |
---|
66 | } |
---|
67 | is('ok',$h{ok },'hash keys w/o v'); |
---|
68 | |
---|
69 | if (ord("\t") == 9) { # ASCII |
---|
70 | $x = 77.78.79; |
---|
71 | } |
---|
72 | else { |
---|
73 | $x = 212.213.214; |
---|
74 | } |
---|
75 | is($x, 'MNO','poetry optimization with dots w/o v'); |
---|
76 | |
---|
77 | is(1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string w/o v'); |
---|
78 | |
---|
79 | # test sprintf("%vd"...) etc |
---|
80 | if (ord("\t") == 9) { # ASCII |
---|
81 | is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")'); |
---|
82 | } |
---|
83 | else { |
---|
84 | is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")'); |
---|
85 | } |
---|
86 | |
---|
87 | is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)'); |
---|
88 | |
---|
89 | if (ord("\t") == 9) { # ASCII |
---|
90 | is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")'); |
---|
91 | } |
---|
92 | else { |
---|
93 | is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")'); |
---|
94 | } |
---|
95 | |
---|
96 | is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)'); |
---|
97 | |
---|
98 | if (ord("\t") == 9) { # ASCII |
---|
99 | is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")'); |
---|
100 | } |
---|
101 | else { |
---|
102 | is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")'); |
---|
103 | } |
---|
104 | |
---|
105 | is(sprintf("%*vb", "##", v1.22.333.4444), |
---|
106 | '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)'); |
---|
107 | |
---|
108 | is(sprintf("%vd", join("", map { chr } |
---|
109 | unpack 'U*', pack('U*',2001,2002,2003))), |
---|
110 | '2001.2002.2003','unpack/pack U*'); |
---|
111 | |
---|
112 | { |
---|
113 | use bytes; |
---|
114 | |
---|
115 | if (ord("\t") == 9) { # ASCII |
---|
116 | is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl") w/use bytes'); |
---|
117 | } |
---|
118 | else { |
---|
119 | is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl") w/use bytes'); |
---|
120 | } |
---|
121 | |
---|
122 | if (ord("\t") == 9) { # ASCII |
---|
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'); |
---|
124 | } |
---|
125 | else { |
---|
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'); |
---|
127 | } |
---|
128 | |
---|
129 | if (ord("\t") == 9) { # ASCII |
---|
130 | is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")'); |
---|
131 | } |
---|
132 | else { |
---|
133 | is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")'); |
---|
134 | } |
---|
135 | |
---|
136 | if (ord("\t") == 9) { # ASCII |
---|
137 | is(sprintf("%vX", v1.22.333.4444), '1.16.C5.8D.E1.85.9C', 'ASCII sprintf("%vX", v1.22.333.4444)'); |
---|
138 | } |
---|
139 | else { |
---|
140 | is(sprintf("%vX", v1.22.333.4444), '1.16.8E.54.BB.51.70', 'EBCDIC sprintf("%vX", v1.22.333.4444)'); |
---|
141 | } |
---|
142 | |
---|
143 | if (ord("\t") == 9) { # ASCII |
---|
144 | is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%#*vo", ":", "Perl")'); |
---|
145 | } |
---|
146 | else { |
---|
147 | is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%#*vo", ":", "Perl")'); |
---|
148 | } |
---|
149 | |
---|
150 | if (ord("\t") == 9) { # ASCII |
---|
151 | is(sprintf("%*vb", "##", v1.22.333.4444), |
---|
152 | '1##10110##11000101##10001101##11100001##10000101##10011100', |
---|
153 | 'ASCII sprintf("%*vb", "##", v1.22.333.4444)'); |
---|
154 | } |
---|
155 | else { |
---|
156 | is(sprintf("%*vb", "##", v1.22.333.4444), |
---|
157 | '1##10110##10001110##1010100##10111011##1010001##1110000', |
---|
158 | 'EBCDIC sprintf("%*vb", "##", v1.22.333.4444)'); |
---|
159 | } |
---|
160 | } |
---|
161 | |
---|
162 | { |
---|
163 | # bug id 20000323.056 |
---|
164 | |
---|
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'); |
---|
170 | } |
---|
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; |
---|
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()"); |
---|
178 | is('foo',((chr(193) eq 'A') ? v134.150.150 : v102.111.111),"v-string ne ''"); |
---|
179 | |
---|
180 | # Chapter 15, pp403 |
---|
181 | |
---|
182 | # See if sane addr and gethostbyaddr() work |
---|
183 | eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) }; |
---|
184 | if ($@) { |
---|
185 | # No - so do not test insane fails. |
---|
186 | $@ =~ s/\n/\n# /g; |
---|
187 | } |
---|
188 | SKIP: { |
---|
189 | skip("No Socket::AF_INET # $@") if $@; |
---|
190 | my $ip = v2004.148.0.1; |
---|
191 | my $host; |
---|
192 | eval { $host = gethostbyaddr($ip,&Socket::AF_INET) }; |
---|
193 | like($@, qr/Wide character/, "Non-bytes leak to gethostbyaddr"); |
---|
194 | } |
---|
195 | |
---|
196 | # Chapter 28, pp671 |
---|
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 |
---|
206 | my ($revision,$version,$subversion) = split '\.', sprintf("%vd",$^V); |
---|
207 | |
---|
208 | print "# revision = '$revision'\n"; |
---|
209 | print "# version = '$version'\n"; |
---|
210 | print "# subversion = '$subversion'\n"; |
---|
211 | |
---|
212 | my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion); |
---|
213 | |
---|
214 | print "# v = '$v'\n"; |
---|
215 | print "# ] = '$]'\n"; |
---|
216 | |
---|
217 | $v =~ s/000$// if $subversion == 0; |
---|
218 | |
---|
219 | print "# v = '$v'\n"; |
---|
220 | |
---|
221 | ok( $v eq "$]", qq{\$^V eq "\$]"}); |
---|
222 | |
---|
223 | $v = $revision + $version/1000 + $subversion/1000000; |
---|
224 | |
---|
225 | ok( $v == $], "\$^V == \$] (numeric)" ); |
---|
226 | |
---|
227 | SKIP: { |
---|
228 | skip("In EBCDIC the v-string components cannot exceed 2147483647", 6) |
---|
229 | if ord "A" == 193; |
---|
230 | |
---|
231 | # [ID 20010902.001] check if v-strings handle full UV range or not |
---|
232 | if ( $Config{'uvsize'} >= 4 ) { |
---|
233 | is( sprintf("%vd", eval 'v2147483647.2147483648'), '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' ); |
---|
234 | is( sprintf("%vd", eval 'v3141592653'), '3141592653', 'IV_MAX < v-string < UV_MAX[32-bit]'); |
---|
235 | is( sprintf("%vd", eval 'v4294967295'), '4294967295', 'v-string == UV_MAX[32-bit] - 1'); |
---|
236 | } |
---|
237 | |
---|
238 | SKIP: { |
---|
239 | skip("No quads", 3) if $Config{uvsize} < 8; |
---|
240 | |
---|
241 | if ( $Config{'uvsize'} >= 8 ) { |
---|
242 | is( sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'), '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' ); |
---|
243 | is( sprintf("%vd", eval 'v17446744073709551615'), '17446744073709551615', 'IV_MAX < v-string < UV_MAX[64-bit]'); |
---|
244 | is( sprintf("%vd", eval 'v18446744073709551615'), '18446744073709551615', 'v-string == UV_MAX[64-bit] - 1'); |
---|
245 | } |
---|
246 | } |
---|
247 | } |
---|
248 | |
---|
249 | # Tests for magic v-strings |
---|
250 | |
---|
251 | $v = 1.2.3; |
---|
252 | is( ref(\$v), 'SCALAR', 'v-strings are just scalars' ); |
---|
253 | |
---|
254 | $v = v1.2_3; |
---|
255 | is( ref(\$v), 'SCALAR', 'v-strings with v are just scalars' ); |
---|
256 | is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' ); |
---|
257 | |
---|
258 | # [perl #16010] |
---|
259 | %h = (v65 => 42); |
---|
260 | ok( exists $h{v65}, "v-stringness is not engaged for vX" ); |
---|
261 | %h = (v65.66 => 42); |
---|
262 | ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" ); |
---|
263 | %h = (65.66.67 => 42); |
---|
264 | ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" ); |
---|
265 | |
---|
266 | |
---|