t/op/ver.t

   1 #!./perl
   2
   3 BEGIN {
   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
  11 use Config;
  12
  13 require "test.pl";
  14 plan( tests => 53 );
  15
  16 eval 'use v5.5.640';
  17 is( $@, '', "use v5.5.640; $@");
  18
  19 require_ok('v5.5.640');
  20
  21 # printing characters should work
  22 if (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 }
  29 else { # 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
  38 sub v77 { "ok" }
  39 $x = v77;
  40 is('ok',$x,'poetry optimization');
  41
  42 # but not when dots are involved
  43 if (ord("\t") == 9) { # ASCII
  44     $x = v77.78.79;
  45 }
  46 else {
  47     $x = v212.213.214;
  48 }
  49 is($x, 'MNO','poetry optimization with dots');
  50
  51 is(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"
  55 eval 'use 5.5.640';
  56 is( $@, '', "use 5.5.640; $@");
  57
  58 require_ok('5.5.640');
  59
  60 # hash keys too
  61 if (ord("\t") == 9) { # ASCII
  62     $h{111.107.32} = "ok";
  63 }
  64 else {
  65     $h{150.146.64} = "ok";
  66 }
  67 is('ok',$h{ok },'hash keys w/o v');
  68
  69 if (ord("\t") == 9) { # ASCII
  70     $x = 77.78.79;
  71 }
  72 else {
  73     $x = 212.213.214;
  74 }
  75 is($x, 'MNO','poetry optimization with dots w/o v');
  76
  77 is(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
  80 if (ord("\t") == 9) { # ASCII
  81     is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")');
  82 }
  83 else {
  84     is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")');
  85 }
  86
  87 is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)');
  88
  89 if (ord("\t") == 9) { # ASCII
  90     is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")');
  91 }
  92 else {
  93     is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")');
  94 }
  95
  96 is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)');
  97
  98 if (ord("\t") == 9) { # ASCII
  99     is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")');
 100 }
 101 else {
 102     is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")');
 103 }
 104
 105 is(sprintf("%*vb", "##", v1.22.333.4444),
 106     '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)');
 107
 108 is(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
 175 my $vs = v1.20.300.4000;
 176 is($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}");
 177 is($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()");
 178 is('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
 183 eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) };
 184 if ($@) {
 185     # No - so do not test insane fails.
 186     $@ =~ s/\n/\n# /g;
 187 }
 188 SKIP: {
 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
 197 ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0");
 198
 199 # part of 20000323.059
 200 is(v200, chr(200),      "v200 eq chr(200)"      );
 201 is(v200, +v200,         "v200 eq +v200"         );
 202 is(v200, eval( "v200"), 'v200 eq "v200"'        );
 203 is(v200, eval("+v200"), 'v200 eq eval("+v200")' );
 204
 205 # Tests for string/numeric value of $] itself
 206 my ($revision,$version,$subversion) = split '\.', sprintf("%vd",$^V);
 207
 208 # $^V always displays the leading 'v' but we don't want that here
 209 $revision =~ s/^v//;
 210
 211 print "# revision   = '$revision'\n";
 212 print "# version    = '$version'\n";
 213 print "# subversion = '$subversion'\n";
 214
 215 my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion);
 216
 217 print "# v = '$v'\n";
 218 print "# ] = '$]'\n";
 219
 220 $v =~ s/000$// if $subversion == 0;
 221
 222 print "# v = '$v'\n";
 223
 224 ok( $v eq "$]", qq{\$^V eq "\$]"});
 225
 226 $v = $revision + $version/1000 + $subversion/1000000;
 227
 228 ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
 229
 230 SKIP: {
 231   skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
 232     if ord "A" == 193;
 233
 234   # [ID 20010902.001] check if v-strings handle full UV range or not
 235   if ( $Config{'uvsize'} >= 4 ) {
 236     is(  sprintf("%vd", eval 'v2147483647.2147483648'),   '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
 237     is(  sprintf("%vd", eval 'v3141592653'),              '3141592653',            'IV_MAX < v-string < UV_MAX[32-bit]');
 238     is(  sprintf("%vd", eval 'v4294967295'),              '4294967295',            'v-string == UV_MAX[32-bit] - 1');
 239   }
 240
 241   SKIP: {
 242     skip("No quads", 3) if $Config{uvsize} < 8;
 243
 244     if ( $Config{'uvsize'} >= 8 ) {
 245       is(  sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'),   '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' );
 246       is(  sprintf("%vd", eval 'v17446744073709551615'),                      '17446744073709551615',                    'IV_MAX < v-string < UV_MAX[64-bit]');
 247       is(  sprintf("%vd", eval 'v18446744073709551615'),                      '18446744073709551615',                    'v-string == UV_MAX[64-bit] - 1');
 248     }
 249   }
 250 }
 251
 252 # Tests for magic v-strings
 253
 254 $v = 1.2.3;
 255 is( ref(\$v), 'VSTRING', 'v-string objects' );
 256
 257 $v = v1.2_3;
 258 is( ref(\$v), 'VSTRING', 'v-string objects with v' );
 259 is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' );
 260
 261 # [perl #16010]
 262 %h = (v65 => 42);
 263 ok( exists $h{v65}, "v-stringness is not engaged for vX" );
 264 %h = (v65.66 => 42);
 265 ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" );
 266 %h = (65.66.67 => 42);
 267 ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
 268
 269