| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | @INC = '../lib'; |
| 6 | } |
| 7 | |
| 8 | print "1..37\n"; |
| 9 | |
| 10 | my $test = 1; |
| 11 | |
| 12 | sub okeq { |
| 13 | my $ok = $_[0] eq $_[1];; |
| 14 | print "not " unless $ok; |
| 15 | print "ok ", $test++; |
| 16 | print " # $_[2]" if !$ok && @_ == 3; |
| 17 | print "\n"; |
| 18 | } |
| 19 | |
| 20 | sub skip { print "ok ", $test++, " # Skip: $_[0]\n" } |
| 21 | |
| 22 | use v5.5.640; |
| 23 | require v5.5.640; |
| 24 | print "ok $test\n"; ++$test; |
| 25 | |
| 26 | # printing characters should work |
| 27 | if (ord("\t") == 9) { # ASCII |
| 28 | print v111; |
| 29 | print v107.32; |
| 30 | print "$test\n"; ++$test; |
| 31 | |
| 32 | # hash keys too |
| 33 | $h{v111.107} = "ok"; |
| 34 | print "$h{ok} $test\n"; ++$test; |
| 35 | } |
| 36 | else { # EBCDIC |
| 37 | print v150; |
| 38 | print v146.64; |
| 39 | print "$test\n"; ++$test; |
| 40 | |
| 41 | # hash keys too |
| 42 | $h{v150.146} = "ok"; |
| 43 | print "$h{ok} $test\n"; ++$test; |
| 44 | } |
| 45 | |
| 46 | # poetry optimization should also |
| 47 | sub v77 { "ok" } |
| 48 | $x = v77; |
| 49 | print "$x $test\n"; ++$test; |
| 50 | |
| 51 | # but not when dots are involved |
| 52 | if (ord("\t") == 9) { # ASCII |
| 53 | $x = v77.78.79; |
| 54 | } |
| 55 | else { |
| 56 | $x = v212.213.214; |
| 57 | } |
| 58 | okeq($x, "MNO"); |
| 59 | |
| 60 | okeq(v1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}"); |
| 61 | |
| 62 | # |
| 63 | # now do the same without the "v" |
| 64 | use 5.5.640; |
| 65 | require 5.5.640; |
| 66 | print "ok $test\n"; ++$test; |
| 67 | |
| 68 | # hash keys too |
| 69 | if (ord("\t") == 9) { # ASCII |
| 70 | $h{111.107.32} = "ok"; |
| 71 | } |
| 72 | else { |
| 73 | $h{150.146.64} = "ok"; |
| 74 | } |
| 75 | print "$h{ok } $test\n"; ++$test; |
| 76 | |
| 77 | if (ord("\t") == 9) { # ASCII |
| 78 | $x = 77.78.79; |
| 79 | } |
| 80 | else { |
| 81 | $x = 212.213.214; |
| 82 | } |
| 83 | okeq($x, "MNO"); |
| 84 | |
| 85 | okeq(1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}"); |
| 86 | |
| 87 | # test sprintf("%vd"...) etc |
| 88 | if (ord("\t") == 9) { # ASCII |
| 89 | okeq(sprintf("%vd", "Perl"), '80.101.114.108'); |
| 90 | } |
| 91 | else { |
| 92 | okeq(sprintf("%vd", "Perl"), '215.133.153.147'); |
| 93 | } |
| 94 | |
| 95 | okeq(sprintf("%vd", v1.22.333.4444), '1.22.333.4444'); |
| 96 | |
| 97 | if (ord("\t") == 9) { # ASCII |
| 98 | okeq(sprintf("%vx", "Perl"), '50.65.72.6c'); |
| 99 | } |
| 100 | else { |
| 101 | okeq(sprintf("%vx", "Perl"), 'd7.85.99.93'); |
| 102 | } |
| 103 | |
| 104 | okeq(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C'); |
| 105 | |
| 106 | if (ord("\t") == 9) { # ASCII |
| 107 | okeq(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154'); |
| 108 | } |
| 109 | else { |
| 110 | okeq(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223'); |
| 111 | } |
| 112 | |
| 113 | okeq(sprintf("%*vb", "##", v1.22.333.4444), |
| 114 | '1##10110##101001101##1000101011100'); |
| 115 | |
| 116 | okeq(sprintf("%vd", join("", map { chr } |
| 117 | unpack 'U*', pack('U*',2001,2002,2003))), |
| 118 | '2001.2002.2003'); |
| 119 | |
| 120 | { |
| 121 | use bytes; |
| 122 | |
| 123 | if (ord("\t") == 9) { # ASCII |
| 124 | okeq(sprintf("%vd", "Perl"), '80.101.114.108'); |
| 125 | } |
| 126 | else { |
| 127 | okeq(sprintf("%vd", "Perl"), '215.133.153.147'); |
| 128 | } |
| 129 | |
| 130 | if (ord("\t") == 9) { # ASCII |
| 131 | okeq(sprintf("%vd", 1.22.333.4444), '1.22.197.141.225.133.156'); |
| 132 | } |
| 133 | else { |
| 134 | okeq(sprintf("%vd", 1.22.333.4444), '1.22.142.84.187.81.112'); |
| 135 | } |
| 136 | |
| 137 | if (ord("\t") == 9) { # ASCII |
| 138 | okeq(sprintf("%vx", "Perl"), '50.65.72.6c'); |
| 139 | } |
| 140 | else { |
| 141 | okeq(sprintf("%vx", "Perl"), 'd7.85.99.93'); |
| 142 | } |
| 143 | |
| 144 | if (ord("\t") == 9) { # ASCII |
| 145 | okeq(sprintf("%vX", v1.22.333.4444), '1.16.C5.8D.E1.85.9C'); |
| 146 | } |
| 147 | else { |
| 148 | okeq(sprintf("%vX", v1.22.333.4444), '1.16.8E.54.BB.51.70'); |
| 149 | } |
| 150 | |
| 151 | if (ord("\t") == 9) { # ASCII |
| 152 | okeq(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154'); |
| 153 | } |
| 154 | else { |
| 155 | okeq(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223'); |
| 156 | } |
| 157 | |
| 158 | if (ord("\t") == 9) { # ASCII |
| 159 | okeq(sprintf("%*vb", "##", v1.22.333.4444), |
| 160 | '1##10110##11000101##10001101##11100001##10000101##10011100'); |
| 161 | } |
| 162 | else { |
| 163 | okeq(sprintf("%*vb", "##", v1.22.333.4444), |
| 164 | '1##10110##10001110##1010100##10111011##1010001##1110000'); |
| 165 | } |
| 166 | } |
| 167 | |
| 168 | { |
| 169 | # 24..28 |
| 170 | |
| 171 | # bug id 20000323.056 |
| 172 | |
| 173 | print "not " unless "\x{41}" eq +v65; |
| 174 | print "ok $test\n"; |
| 175 | $test++; |
| 176 | |
| 177 | print "not " unless "\x41" eq +v65; |
| 178 | print "ok $test\n"; |
| 179 | $test++; |
| 180 | |
| 181 | print "not " unless "\x{c8}" eq +v200; |
| 182 | print "ok $test\n"; |
| 183 | $test++; |
| 184 | |
| 185 | print "not " unless "\xc8" eq +v200; |
| 186 | print "ok $test\n"; |
| 187 | $test++; |
| 188 | |
| 189 | print "not " unless "\x{221b}" eq v8731; |
| 190 | print "ok $test\n"; |
| 191 | $test++; |
| 192 | } |
| 193 | |
| 194 | # See if the things Camel-III says are true: 29..33 |
| 195 | |
| 196 | # Chapter 2 pp67/68 |
| 197 | my $vs = v1.20.300.4000; |
| 198 | okeq($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}"); |
| 199 | okeq($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()"); |
| 200 | okeq('foo',((chr(193) eq 'A') ? v134.150.150 : v102.111.111),"v-string ne ''"); |
| 201 | |
| 202 | # Chapter 15, pp403 |
| 203 | |
| 204 | # See if sane addr and gethostbyaddr() work |
| 205 | eval { require Socket; gethostbyaddr(v127.0.0.1,Socket::AF_INET()) }; |
| 206 | if ($@) |
| 207 | { |
| 208 | # No - so don't test insane fails. |
| 209 | skip("No Socket"); |
| 210 | } |
| 211 | else |
| 212 | { |
| 213 | my $ip = v2004.148.0.1; |
| 214 | my $host; |
| 215 | eval { $host = gethostbyaddr($ip,Socket::AF_INET()) }; |
| 216 | okeq($@ =~ /Wide character/,1,"Non-bytes leak to gethostbyaddr"); |
| 217 | } |
| 218 | |
| 219 | # Chapter 28, pp671 |
| 220 | okeq(v5.6.0 lt v5.7.0,1,"v5.6.0 lt v5.7.0 fails"); |
| 221 | |
| 222 | # floating point too messy |
| 223 | # my $v = ord($^V)+ord(substr($^V,1,1))/1000+ord(substr($^V,2,1))/1000000; |
| 224 | # okeq($v,$],"\$^V and \$] do not match"); |
| 225 | |
| 226 | # 34..37: part of 20000323.059 |
| 227 | print "not " unless v200 eq chr(200); |
| 228 | print "ok 34\n"; |
| 229 | |
| 230 | print "not " unless v200 eq +v200; |
| 231 | print "ok 35\n"; |
| 232 | |
| 233 | print "not " unless v200 eq eval "v200"; |
| 234 | print "ok 36\n"; |
| 235 | |
| 236 | print "not " unless v200 eq eval "+v200"; |
| 237 | print "ok 37\n"; |
| 238 | |