BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
+ @INC = qw(. ../lib);
+ $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
+ require "test.pl";
}
-print "1..28\n";
+$DOWARN = 1; # enable run-time warnings now
-my $test = 1;
+use Config;
-use v5.5.640;
-require v5.5.640;
-print "ok $test\n"; ++$test;
+plan( tests => 58 );
+
+eval 'use v5.5.640';
+is( $@, '', "use v5.5.640; $@");
+
+require_ok('v5.5.640');
# printing characters should work
if (ord("\t") == 9) { # ASCII
- print v111;
- print v107.32;
- print "$test\n"; ++$test;
+ is('ok ',v111.107.32,'ASCII printing characters');
# hash keys too
$h{v111.107} = "ok";
- print "$h{ok} $test\n"; ++$test;
+ is('ok',$h{v111.107},'ASCII hash keys');
}
else { # EBCDIC
- print v150;
- print v146.64;
- print "$test\n"; ++$test;
+ is('ok ',v150.146.64,'EBCDIC printing characters');
# hash keys too
$h{v150.146} = "ok";
- print "$h{ok} $test\n"; ++$test;
+ is('ok',$h{v150.146},'EBCDIC hash keys');
}
# poetry optimization should also
sub v77 { "ok" }
$x = v77;
-print "$x $test\n"; ++$test;
+is('ok',$x,'poetry optimization');
# but not when dots are involved
if (ord("\t") == 9) { # ASCII
else {
$x = v212.213.214;
}
-print "not " unless $x eq "MNO";
-print "ok $test\n"; ++$test;
+is($x, 'MNO','poetry optimization with dots');
-print "not " unless v1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}";
-print "ok $test\n"; ++$test;
+is(v1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string');
#
# now do the same without the "v"
-use 5.5.640;
-require 5.5.640;
-print "ok $test\n"; ++$test;
+eval 'use 5.5.640';
+is( $@, '', "use 5.5.640; $@");
+
+require_ok('5.5.640');
# hash keys too
if (ord("\t") == 9) { # ASCII
else {
$h{150.146.64} = "ok";
}
-print "$h{ok } $test\n"; ++$test;
+is('ok',$h{ok },'hash keys w/o v');
if (ord("\t") == 9) { # ASCII
$x = 77.78.79;
else {
$x = 212.213.214;
}
-print "not " unless $x eq "MNO";
-print "ok $test\n"; ++$test;
+is($x, 'MNO','poetry optimization with dots w/o v');
-print "not " unless 1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}";
-print "ok $test\n"; ++$test;
+is(1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string w/o v');
# test sprintf("%vd"...) etc
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+ is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl")');
}
else {
- print "not " unless sprintf("%vd", "Perl") eq '215.133.153.147';
+ is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl")');
}
-print "ok $test\n"; ++$test;
-print "not " unless sprintf("%vd", v1.22.333.4444) eq '1.22.333.4444';
-print "ok $test\n"; ++$test;
+is(sprintf("%vd", v1.22.333.4444), '1.22.333.4444', 'sprintf("%vd", v1.22.333.4444)');
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+ is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")');
}
else {
- print "not " unless sprintf("%vx", "Perl") eq 'd7.85.99.93';
+ is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")');
}
-print "ok $test\n"; ++$test;
-print "not " unless sprintf("%vX", 1.22.333.4444) eq '1.16.14D.115C';
-print "ok $test\n"; ++$test;
+is(sprintf("%vX", 1.22.333.4444), '1.16.14D.115C','ASCII sprintf("%vX", 1.22.333.4444)');
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%#*vo", ":", "Perl") eq '0120:0145:0162:0154';
+ is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%vo", "Perl")');
}
else {
- print "not " unless sprintf("%#*vo", ":", "Perl") eq '0327:0205:0231:0223';
+ is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%vo", "Perl")');
}
-print "ok $test\n"; ++$test;
-print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
- eq '1##10110##101001101##1000101011100';
-print "ok $test\n"; ++$test;
+is(sprintf("%*vb", "##", v1.22.333.4444),
+ '1##10110##101001101##1000101011100', 'sprintf("%vb", 1.22.333.4444)');
-print "not " unless sprintf("%vd", join("", map { chr }
- unpack 'U*', pack('U*',2001,2002,2003)))
- eq '2001.2002.2003';
-print "ok $test\n"; ++$test;
+is(sprintf("%vd", join("", map { chr }
+ unpack 'U*', pack('U*',2001,2002,2003))),
+ '2001.2002.2003','unpack/pack U*');
{
use bytes;
+
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+ is(sprintf("%vd", "Perl"), '80.101.114.108', 'ASCII sprintf("%vd", "Perl") w/use bytes');
}
else {
- print "not " unless sprintf("%vd", "Perl") eq '215.133.153.147';
+ is(sprintf("%vd", "Perl"), '215.133.153.147', 'EBCDIC sprintf("%vd", "Perl") w/use bytes');
}
- print "ok $test\n"; ++$test;
if (ord("\t") == 9) { # ASCII
- print "not " unless
- sprintf("%vd", 1.22.333.4444) eq '1.22.197.141.225.133.156';
+ is(sprintf("%vd", 1.22.333.4444), '1.22.197.141.225.133.156', 'ASCII sprintf("%vd", v1.22.333.4444 w/use bytes');
}
else {
- print "not " unless
- sprintf("%vd", 1.22.333.4444) eq '1.22.142.84.187.81.112';
+ is(sprintf("%vd", 1.22.333.4444), '1.22.142.84.187.81.112', 'EBCDIC sprintf("%vd", v1.22.333.4444 w/use bytes');
}
- print "ok $test\n"; ++$test;
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+ is(sprintf("%vx", "Perl"), '50.65.72.6c', 'ASCII sprintf("%vx", "Perl")');
}
else {
- print "not " unless sprintf("%vx", "Perl") eq 'd7.85.99.93';
+ is(sprintf("%vx", "Perl"), 'd7.85.99.93', 'EBCDIC sprintf("%vx", "Perl")');
}
- print "ok $test\n"; ++$test;
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.C5.8D.E1.85.9C';
+ is(sprintf("%vX", v1.22.333.4444), '1.16.C5.8D.E1.85.9C', 'ASCII sprintf("%vX", v1.22.333.4444)');
}
else {
- print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.8E.54.BB.51.70';
+ is(sprintf("%vX", v1.22.333.4444), '1.16.8E.54.BB.51.70', 'EBCDIC sprintf("%vX", v1.22.333.4444)');
}
- print "ok $test\n"; ++$test;
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%#*vo", ":", "Perl") eq '0120:0145:0162:0154';
+ is(sprintf("%#*vo", ":", "Perl"), '0120:0145:0162:0154', 'ASCII sprintf("%#*vo", ":", "Perl")');
}
else {
- print "not " unless sprintf("%#*vo", ":", "Perl") eq '0327:0205:0231:0223';
+ is(sprintf("%#*vo", ":", "Perl"), '0327:0205:0231:0223', 'EBCDIC sprintf("%#*vo", ":", "Perl")');
}
- print "ok $test\n"; ++$test;
if (ord("\t") == 9) { # ASCII
- print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
- eq '1##10110##11000101##10001101##11100001##10000101##10011100';
+ is(sprintf("%*vb", "##", v1.22.333.4444),
+ '1##10110##11000101##10001101##11100001##10000101##10011100',
+ 'ASCII sprintf("%*vb", "##", v1.22.333.4444)');
}
else {
- print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
- eq '1##10110##10001110##1010100##10111011##1010001##1110000';
+ is(sprintf("%*vb", "##", v1.22.333.4444),
+ '1##10110##10001110##1010100##10111011##1010001##1110000',
+ 'EBCDIC sprintf("%*vb", "##", v1.22.333.4444)');
}
- print "ok $test\n"; ++$test;
}
{
# bug id 20000323.056
- print "not " unless "\x{41}" eq +v65;
- print "ok $test\n";
- $test++;
+ is( "\x{41}", +v65, 'bug id 20000323.056');
+ is( "\x41", +v65, 'bug id 20000323.056');
+ is( "\x{c8}", +v200, 'bug id 20000323.056');
+ is( "\xc8", +v200, 'bug id 20000323.056');
+ is( "\x{221b}", +v8731, 'bug id 20000323.056');
+}
+
+# See if the things Camel-III says are true: 29..33
+
+# Chapter 2 pp67/68
+my $vs = v1.20.300.4000;
+is($vs,"\x{1}\x{14}\x{12c}\x{fa0}","v-string ne \\x{}");
+is($vs,chr(1).chr(20).chr(300).chr(4000),"v-string ne chr()");
+is('foo',((chr(193) eq 'A') ? v134.150.150 : v102.111.111),"v-string ne ''");
+
+# Chapter 15, pp403
+
+# See if sane addr and gethostbyaddr() work
+eval { require Socket; gethostbyaddr(v127.0.0.1, &Socket::AF_INET) };
+if ($@) {
+ # No - so do not test insane fails.
+ $@ =~ s/\n/\n# /g;
+}
+SKIP: {
+ skip("No Socket::AF_INET # $@") if $@;
+ my $ip = v2004.148.0.1;
+ my $host;
+ eval { $host = gethostbyaddr($ip,&Socket::AF_INET) };
+ like($@, qr/Wide character/, "Non-bytes leak to gethostbyaddr");
+}
+
+# Chapter 28, pp671
+ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0");
+
+# part of 20000323.059
+is(v200, chr(200), "v200 eq chr(200)" );
+is(v200, +v200, "v200 eq +v200" );
+is(v200, eval( "v200"), 'v200 eq "v200"' );
+is(v200, eval("+v200"), 'v200 eq eval("+v200")' );
+
+# Tests for string/numeric value of $] itself
+my ($revision,$version,$subversion) = split /\./, sprintf("%vd",$^V);
+
+# $^V always displays the leading 'v' but we don't want that here
+$revision =~ s/^v//;
+
+print "# revision = '$revision'\n";
+print "# version = '$version'\n";
+print "# subversion = '$subversion'\n";
+
+my $v = sprintf("%d.%.3d%.3d",$revision,$version,$subversion);
- print "not " unless "\x41" eq +v65;
- print "ok $test\n";
- $test++;
+print "# v = '$v'\n";
+print "# ] = '$]'\n";
- print "not " unless "\x{c8}" eq +v200;
- print "ok $test\n";
- $test++;
+is( $v, "$]", qq{\$^V eq "\$]"});
- print "not " unless "\xc8" eq +v200;
- print "ok $test\n";
- $test++;
+$v = $revision + $version/1000 + $subversion/1000000;
- print "not " unless "\x{221b}" eq v8731;
- print "ok $test\n";
- $test++;
+ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
+
+SKIP: {
+ skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
+ if ord "A" == 193;
+
+ # [ID 20010902.001] check if v-strings handle full UV range or not
+ if ( $Config{'uvsize'} >= 4 ) {
+ is( sprintf("%vd", eval 'v2147483647.2147483648'), '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
+ is( sprintf("%vd", eval 'v3141592653'), '3141592653', 'IV_MAX < v-string < UV_MAX[32-bit]');
+ is( sprintf("%vd", eval 'v4294967295'), '4294967295', 'v-string == UV_MAX[32-bit] - 1');
+ }
+
+ SKIP: {
+ skip("No quads", 3) if $Config{uvsize} < 8;
+
+ if ( $Config{'uvsize'} >= 8 ) {
+ is( sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'), '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' );
+ is( sprintf("%vd", eval 'v17446744073709551615'), '17446744073709551615', 'IV_MAX < v-string < UV_MAX[64-bit]');
+ is( sprintf("%vd", eval 'v18446744073709551615'), '18446744073709551615', 'v-string == UV_MAX[64-bit] - 1');
+ }
+ }
}
+
+# Tests for magic v-strings
+
+$v = 1.2.3;
+is( ref(\$v), 'VSTRING', 'v-string objects' );
+
+$v = v1.2_3;
+is( ref(\$v), 'VSTRING', 'v-string objects with v' );
+is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' );
+
+# [perl #16010]
+%h = (v65 => 42);
+ok( exists $h{v65}, "v-stringness is not engaged for vX" );
+%h = (v65.66 => 42);
+ok( exists $h{chr(65).chr(66)}, "v-stringness is engaged for vX.Y" );
+%h = (65.66.67 => 42);
+ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
+
+{
+ local $|;
+ $| = v0;
+ $| = 1;
+ --$|; --$|;
+ is $|, 1, 'clobbering vstrings does not clobber all magic';
+}
+
+$a = v102; $a =~ s/f/f/;
+is ref \$a, 'SCALAR',
+ 's/// flattens vstrings even when the subst results in the same value';
+$a = v102; $a =~ y/f/g/;
+is ref \$a, 'SCALAR', 'y/// flattens vstrings';
+
+sub { $_[0] = v3;
+ is ref \$h{nonexistent}, 'VSTRING', 'defelems can pass vstrings' }
+->($h{nonexistent});
+
+# The following tests whether v-strings are correctly
+# interpreted by the tokeniser when it's in a XTERMORDORDOR
+# state (fittingly, the only tokeniser state to contain the
+# word MORDOR).
+
+*{"\3"} = *DATA;
+is( (readline v3), "This is what we expect to see!\n", "v-strings even work in Mordor" );
+
+__DATA__
+This is what we expect to see!
https://perl5.git.perl.org / perl5.git / blobdiff