xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/op/oct.t (revision 0:68f95e015346) 
1#!./perl
2
3# tests 51 onwards aren't all warnings clean. (intentionally)
4
5print "1..71\n";
6
7my $test = 1;
8
9sub test ($$$) {
10  my ($act, $string, $value) = @_;
11  my $result;
12  if ($act eq 'oct') {
13    $result = oct $string;
14  } elsif ($act eq 'hex') {
15    $result = hex $string;
16  } else {
17    die "Unknown action 'act'";
18  }
19  if ($value == $result) {
20    if ($^O eq 'VMS' && length $string > 256) {
21      $string = '';
22    } else {
23      $string = "\"$string\"";
24    }
25    print "ok $test # $act $string\n";
26  } else {
27    my ($valstr, $resstr);
28    if ($act eq 'hex' or $string =~ /x/) {
29      $valstr = sprintf "0x%X", $value;
30      $resstr = sprintf "0x%X", $result;
31    } elsif ($string =~ /b/) {
32      $valstr = sprintf "0b%b", $value;
33      $resstr = sprintf "0b%b", $result;
34    } else {
35      $valstr = sprintf "0%o", $value;
36      $resstr = sprintf "0%o", $result;
37    }
38    print "not ok $test # $act \"$string\" gives \"$result\" ($resstr), not $value ($valstr)\n";
39  }
40  $test++;
41}
42
43test ('oct', '0b1_0101', 0b101_01);
44test ('oct', '0b10_101', 0_2_5);
45test ('oct', '0b101_01', 2_1);
46test ('oct', '0b1010_1', 0x1_5);
47
48test ('oct', 'b1_0101', 0b10101);
49test ('oct', 'b10_101', 025);
50test ('oct', 'b101_01', 21);
51test ('oct', 'b1010_1', 0x15);
52
53test ('oct', '01_234', 0b10_1001_1100);
54test ('oct', '012_34', 01234);
55test ('oct', '0123_4', 668);
56test ('oct', '01234', 0x29c);
57
58test ('oct', '0x1_234', 0b10010_00110100);
59test ('oct', '0x12_34', 01_1064);
60test ('oct', '0x123_4', 4660);
61test ('oct', '0x1234', 0x12_34);
62
63test ('oct', 'x1_234', 0b100100011010_0);
64test ('oct', 'x12_34', 0_11064);
65test ('oct', 'x123_4', 4660);
66test ('oct', 'x1234', 0x_1234);
67
68test ('hex', '01_234', 0b_1001000110100);
69test ('hex', '012_34', 011064);
70test ('hex', '0123_4', 4660);
71test ('hex', '01234_', 0x1234);
72
73test ('hex', '0x_1234', 0b1001000110100);
74test ('hex', '0x1_234', 011064);
75test ('hex', '0x12_34', 4660);
76test ('hex', '0x1234_', 0x1234);
77
78test ('hex', 'x_1234', 0b1001000110100);
79test ('hex', 'x12_34', 011064);
80test ('hex', 'x123_4', 4660);
81test ('hex', 'x1234_', 0x1234);
82
83test ('oct', '0b1111_1111_1111_1111_1111_1111_1111_1111', 4294967295);
84test ('oct', '037_777_777_777', 4294967295);
85test ('oct', '0xffff_ffff', 4294967295);
86test ('hex', '0xff_ff_ff_ff', 4294967295);
87
88$_ = "\0_7_7";
89print length eq 5                      ? "ok" : "not ok", " 37\n";
90print $_ eq "\0"."_"."7"."_"."7"       ? "ok" : "not ok", " 38\n";
91chop, chop, chop, chop;
92print $_ eq "\0"                       ? "ok" : "not ok", " 39\n";
93if (ord("\t") != 9) {
94    # question mark is 111 in 1047, 037, && POSIX-BC
95    print "\157_" eq "?_"                  ? "ok" : "not ok", " 40\n";
96}
97else {
98    print "\077_" eq "?_"                  ? "ok" : "not ok", " 40\n";
99}
100
101$_ = "\x_7_7";
102print length eq 5                      ? "ok" : "not ok", " 41\n";
103print $_ eq "\0"."_"."7"."_"."7"       ? "ok" : "not ok", " 42\n";
104chop, chop, chop, chop;
105print $_ eq "\0"                       ? "ok" : "not ok", " 43\n";
106if (ord("\t") != 9) {
107    # / is 97 in 1047, 037, && POSIX-BC
108    print "\x61_" eq "/_"                  ? "ok" : "not ok", " 44\n";
109}
110else {
111    print "\x2F_" eq "/_"                  ? "ok" : "not ok", " 44\n";
112}
113
114$test = 45;
115test ('oct', '0b'.(  '0'x10).'1_0101', 0b101_01);
116test ('oct', '0b'.( '0'x100).'1_0101', 0b101_01);
117test ('oct', '0b'.('0'x1000).'1_0101', 0b101_01);
118
119test ('hex', (  '0'x10).'01234', 0x1234);
120test ('hex', ( '0'x100).'01234', 0x1234);
121test ('hex', ('0'x1000).'01234', 0x1234);
122
123# Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
124test ('oct', "b00b0101", 0);
125test ('oct', "bb0101",	 0);
126test ('oct', "0bb0101",	 0);
127
128test ('oct', "0x0x3A",	 0);
129test ('oct', "0xx3A",	 0);
130test ('oct', "x0x3A",	 0);
131test ('oct', "xx3A",	 0);
132test ('oct', "0x3A",	 0x3A);
133test ('oct', "x3A",	 0x3A);
134
135test ('oct', "0x0x4",	 0);
136test ('oct', "0xx4",	 0);
137test ('oct', "x0x4",	 0);
138test ('oct', "xx4",	 0);
139test ('oct', "0x4",	 4);
140test ('oct', "x4",	 4);
141
142test ('hex', "0x3A",	 0x3A);
143test ('hex', "x3A",	 0x3A);
144
145test ('hex', "0x4",	 4);
146test ('hex', "x4",	 4);
147
148eval '$a = oct "10\x{100}"';
149print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++;
150
151eval '$a = hex "ab\x{100}"';
152print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++;
153