t/op/oct.t: Add descriptions to tests lacking them.

[perl5.git] / t / op / oct.t

diff --git a/t/op/oct.t b/t/op/oct.t
old mode 100755 (executable)
new mode 100644 (file)
index 7890643..d8caecd
--- a/t/op/oct.t
+++ b/t/op/oct.t
@@ -1,12 +1,141 @@
 #!./perl
 
-# $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
+# Tests 51 onwards are intentionally not all-warnings-clean
 
-print "1..6\n";
+require './test.pl';
+use strict;
 
-print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
-print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
-print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 3\n";
-print +(oct('20000000000') == 020000000000) ? "ok" : "not ok", " 4\n";
-print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
-print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
+plan(tests => 77);
+
+foreach(['0b1_0101', 0b101_01],
+       ['0b10_101', 0_2_5],
+       ['0b101_01', 2_1],
+       ['0b1010_1', 0x1_5],
+       ['b1_0101', 0b10101],
+       ['b10_101', 025],
+       ['b101_01', 21],
+       ['b1010_1', 0x15],
+       ['01_234', 0b10_1001_1100],
+       ['012_34', 01234],
+       ['0123_4', 668],
+       ['01234', 0x29c],
+       ['0x1_234', 0b10010_00110100],
+       ['0x12_34', 01_1064],
+       ['0x123_4', 4660],
+       ['0x1234', 0x12_34],
+       ['x1_234', 0b100100011010_0],
+       ['x12_34', 0_11064],
+       ['x123_4', 4660],
+       ['x1234', 0x_1234],
+       ['0b1111_1111_1111_1111_1111_1111_1111_1111', 4294967295],
+       ['037_777_777_777', 4294967295],
+       ['0xffff_ffff', 4294967295],
+       ['0b'.(  '0'x10).'1_0101', 0b101_01],
+       ['0b'.( '0'x100).'1_0101', 0b101_01],
+       ['0b'.('0'x1000).'1_0101', 0b101_01],
+       # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
+       ["b00b0101", 0],
+       ["bb0101", 0],
+       ["0bb0101", 0],
+       ["0x0x3A", 0],
+       ["0xx3A", 0],
+       ["x0x3A", 0],
+       ["xx3A", 0],
+       ["0x3A", 0x3A],
+       ["x3A", 0x3A],
+       ["0x0x4", 0],
+       ["0xx4", 0],
+       ["x0x4", 0],
+       ["xx4", 0],
+       ["0x4", 4],
+       ["x4", 4],
+       # Allow uppercase base markers (#76296)
+       ["0XCAFE", 0xCAFE],
+       ["XCAFE", 0xCAFE],
+       ["0B101001", 0b101001],
+       ["B101001", 0b101001],
+       ) {
+    my ($string, $value) = @$_;
+    my $result = oct $string;
+
+    my $desc = ($^O ne 'VMS' || length $string <= 256) && "oct \"$string\"";
+
+    unless (cmp_ok($value, '==', $result, $desc)) {
+       my $format = ($string =~ /([bx])/i) ? "0\L$1%\U$1": '0%o';
+       diag(sprintf "oct '%s' gives '%s' ($format), not %s ($format)",
+            $string, $result, $result, $value, $value);
+    }
+}
+
+foreach(['01_234', 0b_1001000110100],
+       ['012_34', 011064],
+       ['0123_4', 4660],
+       ['01234_', 0x1234],
+       ['0x_1234', 0b1001000110100],
+       ['0x1_234', 011064],
+       ['0x12_34', 4660],
+       ['0x1234_', 0x1234],
+       ['x_1234', 0b1001000110100],
+       ['x12_34', 011064],
+       ['x123_4', 4660],
+       ['x1234_', 0x1234],
+       ['0xff_ff_ff_ff', 4294967295],
+       [(  '0'x10).'01234', 0x1234],
+       [( '0'x100).'01234', 0x1234],
+       [('0'x1000).'01234', 0x1234],
+       # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
+       ["0x3A", 0x3A],
+       ["x3A", 0x3A],
+       ["0x4",4],
+       ["x4", 4],
+       # Allow uppercase base markers (#76296)
+       ["0XCAFE",   0xCAFE],
+       ["XCAFE",    0xCAFE],
+       ) {
+    my ($string, $value) = @$_;
+    my $result = hex $string;
+
+    my $desc = ($^O ne 'VMS' || length $string <= 256) && "hex \"$string\"";
+
+    unless (cmp_ok($value, '==', $result, $desc)) {
+       diag(sprintf "hex '%s' gives '%s' (0x%X), not %s (0x%X)",
+            $string, $result, $result, $value, $value);
+    }
+}
+
+
+$_ = "\0_7_7";
+is(length, 5,
+    "length() correctly calculated string with nul character in octal");
+is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
+chop, chop, chop, chop;
+is($_, "\0", "repeated chop() eliminated all but nul character");
+if (ord("\t") != 9) {
+    is("\157_", "?_",
+        "question mark is 111 in 1047, 037, && POSIX-BC");
+}
+else {
+    is("\077_", "?_",
+        "question mark is 077 in other than 1047, 037, && POSIX-BC");
+}
+
+$_ = "\x_7_7";
+is(length, 5,
+    "length() correctly calculated string with nul character in hex");
+is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
+chop, chop, chop, chop;
+is($_, "\0", "repeated chop() eliminated all but nul character");
+if (ord("\t") != 9) {
+    is("\x61_", "/_",
+        "/ is 97 in 1047, 037, && POSIX-BC");
+}
+else {
+    is("\x2F_", "/_",
+        "/ is 79 in other than 1047, 037, && POSIX-BC");
+}
+
+eval '$a = oct "10\x{100}"';
+like($@, qr/Wide character/, "wide character - oct");
+
+eval '$a = hex "ab\x{100}"';
+like($@, qr/Wide character/, "wide character - hex");