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