This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make set-magic handle vstrings properly
[perl5.git] / t / op / ver.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = qw(. ../lib);
6     $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
7     require "test.pl";
8 }
9
10 $DOWARN = 1; # enable run-time warnings now
11
12 use Config;
13
14 plan( tests => 58 );
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 # $^V always displays the leading 'v' but we don't want that here
209 $revision =~ s/^v//;
210
211 print "# revision   = '$revision'\n";
212 print "# version    = '$version'\n";
213 print "# subversion = '$subversion'\n";
214
215 my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion);
216
217 print "# v = '$v'\n";
218 print "# ] = '$]'\n";
219
220 is( $v, "$]", qq{\$^V eq "\$]"});
221
222 $v = $revision + $version/1000 + $subversion/1000000;
223
224 ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
225
226 SKIP: {
227   skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
228     if ord "A" == 193;
229
230   # [ID 20010902.001] check if v-strings handle full UV range or not
231   if ( $Config{'uvsize'} >= 4 ) {
232     is(  sprintf("%vd", eval 'v2147483647.2147483648'),   '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
233     is(  sprintf("%vd", eval 'v3141592653'),              '3141592653',            'IV_MAX < v-string < UV_MAX[32-bit]');
234     is(  sprintf("%vd", eval 'v4294967295'),              '4294967295',            'v-string == UV_MAX[32-bit] - 1');
235   }
236
237   SKIP: {
238     skip("No quads", 3) if $Config{uvsize} < 8;
239
240     if ( $Config{'uvsize'} >= 8 ) {
241       is(  sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'),   '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' );
242       is(  sprintf("%vd", eval 'v17446744073709551615'),                      '17446744073709551615',                    'IV_MAX < v-string < UV_MAX[64-bit]');
243       is(  sprintf("%vd", eval 'v18446744073709551615'),                      '18446744073709551615',                    'v-string == UV_MAX[64-bit] - 1');
244     }
245   }
246 }
247
248 # Tests for magic v-strings 
249
250 $v = 1.2.3;
251 is( ref(\$v), 'VSTRING', 'v-string objects' );
252
253 $v = v1.2_3;
254 is( ref(\$v), 'VSTRING', 'v-string objects with v' );
255 is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' );
256
257 # [perl #16010]
258 %h = (v65 => 42);
259 ok( exists $h{v65}, "v-stringness is not engaged for vX" );
260 %h = (v65.66 => 42);
261 ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" );
262 %h = (65.66.67 => 42);
263 ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
264
265 {
266     local $|;
267     $| = v0;
268     $| = 1;
269     --$|; --$|;
270     is $|, 1, 'clobbering vstrings does not clobber all magic';
271 }
272
273 $a = v102; $a =~ s/f/f/;
274 is ref \$a, 'SCALAR',
275   's/// flattens vstrings even when the subst results in the same value';
276 $a = v102; $a =~ y/f/g/;
277 is ref \$a, 'SCALAR', 'y/// flattens vstrings';
278
279 sub { $_[0] = v3;
280       is ref \$h{nonexistent}, 'VSTRING', 'defelems can pass vstrings' }
281 ->($h{nonexistent});
282
283 # The following tests whether v-strings are correctly
284 # interpreted by the tokeniser when it's in a XTERMORDORDOR
285 # state (fittingly, the only tokeniser state to contain the
286 # word MORDOR).
287
288 *{"\3"} = *DATA;
289 is( (readline v3), "This is what we expect to see!\n", "v-strings even work in Mordor" );
290
291 __DATA__
292 This is what we expect to see!