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