source: trunk/third/perl/t/op/ver.t @ 20075

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