1#!./perl
2
3BEGIN {
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
11use Config;
12
13require "test.pl";
14plan( tests => 53 );
15
16eval 'use v5.5.640';
17is( $@, '', "use v5.5.640; $@");
18
19require_ok('v5.5.640');
20
21# printing characters should work
22if (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}
29else { # 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
38sub v77 { "ok" }
39$x = v77;
40is('ok',$x,'poetry optimization');
41
42# but not when dots are involved
43if (ord("\t") == 9) { # ASCII
44    $x = v77.78.79;
45}
46else {
47    $x = v212.213.214;
48}
49is($x, 'MNO','poetry optimization with dots');
50
51is(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"
55eval 'use 5.5.640';
56is( $@, '', "use 5.5.640; $@");
57
58require_ok('5.5.640');
59
60# hash keys too
61if (ord("\t") == 9) { # ASCII
62    $h{111.107.32} = "ok";
63}
64else {
65    $h{150.146.64} = "ok";
66}
67is('ok',$h{ok },'hash keys w/o v');
68
69if (ord("\t") == 9) { # ASCII
70    $x = 77.78.79;
71}
72else {
73    $x = 212.213.214;
74}
75is($x, 'MNO','poetry optimization with dots w/o v');
76
77is(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
80if (ord("\t") == 9) { # ASCII
81    is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")');
82}
83else {
84    is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")');
85}
86
87is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)');
88
89if (ord("\t") == 9) { # ASCII
90    is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")');
91}
92else {
93    is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")');
94}
95
96is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)');
97
98if (ord("\t") == 9) { # ASCII
99    is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")');
100}
101else {
102    is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")');
103}
104
105is(sprintf("%*vb", "##", v1.22.333.4444),
106    '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)');
107
108is(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
175my $vs = v1.20.300.4000;
176is($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}");
177is($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()");
178is('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
183eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) };
184if ($@) {
185    # No - so do not test insane fails.
186    $@ =~ s/\n/\n# /g;
187}
188SKIP: {
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
197ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0");
198
199# part of 20000323.059
200is(v200, chr(200),      "v200 eq chr(200)"      );
201is(v200, +v200,         "v200 eq +v200"         );
202is(v200, eval( "v200"), 'v200 eq "v200"'        );
203is(v200, eval("+v200"), 'v200 eq eval("+v200")' );
204
205# Tests for string/numeric value of $] itself
206my ($revision,$version,$subversion) = split '\.', sprintf("%vd",$^V);
207
208print "# revision   = '$revision'\n";
209print "# version    = '$version'\n";
210print "# subversion = '$subversion'\n";
211
212my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion);
213
214print "# v = '$v'\n";
215print "# ] = '$]'\n";
216
217$v =~ s/000$// if $subversion == 0;
218
219print "# v = '$v'\n";
220
221ok( $v eq "$]", qq{\$^V eq "\$]"});
222
223$v = $revision + $version/1000 + $subversion/1000000;
224
225ok( $v == $], "\$^V == \$] (numeric)" );
226
227SKIP: {
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;
252is( ref(\$v), 'SCALAR', 'v-strings are just scalars' );
253
254$v = v1.2_3;
255is( ref(\$v), 'SCALAR', 'v-strings with v are just scalars' );
256is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' );
257
258# [perl #16010]
259%h = (v65 => 42);
260ok( exists $h{v65}, "v-stringness is not engaged for vX" );
261%h = (v65.66 => 42);
262ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" );
263%h = (65.66.67 => 42);
264ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
265
266
267