t/op/ver.t

   1 #!./perl
   2
   3 BEGIN {
   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
  13 use Config;
  14
  15 plan( tests => 52 );
  16
  17 eval 'use v5.5.640';
  18 is( $@, '', "use v5.5.640; $@");
  19
  20 require_ok('v5.5.640');
  21
  22 # printing characters should work
  23 if ($::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 }
  30 else { # 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
  39 sub v77 { "ok" }
  40 $x = v77;
  41 is('ok',$x,'poetry optimization');
  42
  43 # but not when dots are involved
  44 if ($::IS_ASCII) { # ASCII
  45     $x = v77.78.79;
  46 }
  47 else {
  48     $x = v212.213.214;
  49 }
  50 is($x, 'MNO','poetry optimization with dots');
  51
  52 is(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"
  56 eval 'use 5.5.640';
  57 is( $@, '', "use 5.5.640; $@");
  58
  59 require_ok('5.5.640');
  60
  61 # hash keys too
  62 if ($::IS_ASCII) { # ASCII
  63     $h{111.107.32} = "ok";
  64 }
  65 else {
  66     $h{150.146.64} = "ok";
  67 }
  68 is('ok',$h{ok },'hash keys w/o v');
  69
  70 if ($::IS_ASCII) { # ASCII
  71     $x = 77.78.79;
  72 }
  73 else {
  74     $x = 212.213.214;
  75 }
  76 is($x, 'MNO','poetry optimization with dots w/o v');
  77
  78 is(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
  81 if ($::IS_ASCII) { # ASCII
  82     is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")');
  83 }
  84 else {
  85     is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")');
  86 }
  87
  88 is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)');
  89
  90 if ($::IS_ASCII) { # ASCII
  91     is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")');
  92 }
  93 else {
  94     is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")');
  95 }
  96
  97 is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)');
  98
  99 if ($::IS_ASCII) { # ASCII
 100     is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")');
 101 }
 102 else {
 103     is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")');
 104 }
 105
 106 is(sprintf("%*vb", "##", v1.22.333.4444),
 107     '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)');
 108
 109 is(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
 176 my $vs = v1.20.300.4000;
 177 is($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}");
 178 is($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()");
 179 is('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
 184 eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) };
 185 if ($@) {
 186     # No - so do not test insane fails.
 187     $@ =~ s/\n/\n# /g;
 188 }
 189 SKIP: {
 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
 198 ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0");
 199
 200 # part of 20000323.059 (#2644)
 201 is(v200, chr(200),      "v200 eq chr(200)"      );
 202 is(v200, +v200,         "v200 eq +v200"         );
 203 is(v200, eval( "v200"), 'v200 eq "v200"'        );
 204 is(v200, eval("+v200"), 'v200 eq eval("+v200")' );
 205
 206 # Tests for string/numeric value of $] itself
 207 my ($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
 212 print "# revision   = '$revision'\n";
 213 print "# version    = '$version'\n";
 214 print "# subversion = '$subversion'\n";
 215
 216 my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion);
 217
 218 print "# v = '$v'\n";
 219 print "# ] = '$]'\n";
 220
 221 is( $v, "$]", qq{\$^V eq "\$]"});
 222
 223 $v = $revision + $version/1000 + $subversion/1000000;
 224
 225 ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
 226
 227 # Tests for magic v-strings
 228
 229 $v = 1.2.3;
 230 is( ref(\$v), 'VSTRING', 'v-string objects' );
 231
 232 $v = v1.2_3;
 233 is( ref(\$v), 'VSTRING', 'v-string objects with v' );
 234 is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' );
 235
 236 # [perl #16010]
 237 %h = (v65 => 42);
 238 ok( exists $h{v65}, "v-stringness is not engaged for vX" );
 239 %h = (v65.66 => 42);
 240 ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" );
 241 %h = (65.66.67 => 42);
 242 ok( 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/;
 253 is 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/;
 256 is ref \$a, 'SCALAR', 'y/// flattens vstrings';
 257
 258 sub { $_[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;
 268 is( (readline v3), "This is what we expect to see!\n", "v-strings even work in Mordor" );
 269
 270 __DATA__
 271 This is what we expect to see!