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