Permalink
Browse files

Perlito5 - another 42 standard tests pass

  • Loading branch information...
1 parent 0bc2e7a commit a9955f198538f4e3a012dfc7624ad803ace0e753 @fglock committed Nov 29, 2012
Showing with 154 additions and 154 deletions.
  1. +154 −154 t5/op/index.t
View
@@ -7,7 +7,7 @@ BEGIN {
}
use strict;
-plan( tests => 36 );
+plan( tests => 78 );
sub run_tests {
@@ -70,159 +70,159 @@ is(index($a, "bar", ), 5);
is(rindex($a, "\x{1234}"), 4);
is(rindex($a, "foo", ), 0);
-#{
-# my $needle = "\x{1230}\x{1270}";
-# my @needles = split ( //, $needle );
-# my $haystack = "\x{1228}\x{1228}\x{1230}\x{1270}";
-# foreach ( @needles ) {
-# my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
-# my $b = index ( $haystack, $_ );
-# is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
-# }
-# $needle = "\x{1270}\x{1230}"; # Transpose them.
-# @needles = split ( //, $needle );
-# foreach ( @needles ) {
-# my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
-# my $b = index ( $haystack, $_ );
-# is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
-# }
-#}
-
-#{
-# my $search;
-# my $text;
-# $search = latin1_to_native("foo \xc9 bar");
-# $text = latin1_to_native("a\xa3\xa3a $search $search quux");
-#
-# my $text_utf8 = $text;
-# utf8::upgrade($text_utf8);
-# my $search_utf8 = $search;
-# utf8::upgrade($search_utf8);
-#
-# is (index($text, $search), 5);
-# is (rindex($text, $search), 18);
-# is (index($text, $search_utf8), 5);
-# is (rindex($text, $search_utf8), 18);
-# is (index($text_utf8, $search), 5);
-# is (rindex($text_utf8, $search), 18);
-# is (index($text_utf8, $search_utf8), 5);
-# is (rindex($text_utf8, $search_utf8), 18);
-#
-# my $text_octets = $text_utf8;
-# utf8::encode ($text_octets);
-# my $search_octets = $search_utf8;
-# utf8::encode ($search_octets);
-#
-# is (index($text_octets, $search_octets), 7, "index octets, octets")
-# or _diag ($text_octets, $search_octets);
-# is (rindex($text_octets, $search_octets), 21, "rindex octets, octets");
-# is (index($text_octets, $search_utf8), -1);
-# is (rindex($text_octets, $search_utf8), -1);
-# is (index($text_utf8, $search_octets), -1);
-# is (rindex($text_utf8, $search_octets), -1);
-#
-# is (index($text_octets, $search), -1);
-# is (rindex($text_octets, $search), -1);
-# is (index($text, $search_octets), -1);
-# is (rindex($text, $search_octets), -1);
-#}
-#
-#foreach my $utf8 ('', ', utf-8') {
-# foreach my $arraybase (0, 1, -1, -2) {
-# my $expect_pos = 2 + $arraybase;
-#
-# my $prog = "no warnings 'deprecated';\n";
-# $prog .= "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; ";
-# $prog .= '$big .= chr 256; chop $big; ' if $utf8;
-# $prog .= 'print rindex $big, "N", 2 + $[';
-#
-# fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8");
-# }
-#}
-#
-#SKIP: {
-# skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if ord("A") == 193;
-#
-# my $a = "\x{80000000}";
-# my $s = $a.'defxyz';
-# is(index($s, 'def'), 1, "0x80000000 is a single character");
-#
-# my $b = "\x{fffffffd}";
-# my $t = $b.'pqrxyz';
-# is(index($t, 'pqr'), 1, "0xfffffffd is a single character");
-#
-# local ${^UTF8CACHE} = -1;
-# is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
-#}
-#
-#
-## Tests for NUL characters.
-#{
-# my @tests = (
-# ["", -1, -1, -1],
-# ["foo", -1, -1, -1],
-# ["\0", 0, -1, -1],
-# ["\0\0", 0, 0, -1],
-# ["\0\0\0", 0, 0, 0],
-# ["foo\0", 3, -1, -1],
-# ["foo\0foo\0\0", 3, 7, -1],
-# );
-# foreach my $l (1 .. 3) {
-# my $q = "\0" x $l;
-# my $i = 0;
-# foreach my $test (@tests) {
-# $i ++;
-# my $str = $$test [0];
-# my $res = $$test [$l];
-#
-# {
-# is (index ($str, $q), $res, "Find NUL character(s)");
-# }
-#
-# #
-# # Bug #53746 shows a difference between variables and literals,
-# # so test literals as well.
-# #
-# my $test_str = qq {is (index ("$str", "$q"), $res, } .
-# qq {"Find NUL character(s)")};
-# $test_str =~ s/\0/\\0/g;
-#
-# eval $test_str;
-# die $@ if $@;
-# }
-# }
-#}
-#
-#{
-# # RT#75898
-# is(eval { utf8::upgrade($_ = " "); index $_, " ", 72 }, -1,
-# 'UTF-8 cache handles offset beyond the end of the string');
-# $_ = "\x{100}BC";
-# is(index($_, "C", 4), -1,
-# 'UTF-8 cache handles offset beyond the end of the string');
-#}
-#
-## RT #89218
-#use constant {PVBM => 'galumphing', PVBM2 => 'bang'};
-#
-#sub index_it {
-# is(index('galumphing', PVBM), 0,
-# "index isn't confused by format compilation");
-#}
-#
-#index_it();
-#is($^A, '', '$^A is empty');
-#formline PVBM;
-#is($^A, 'galumphing', "formline isn't confused by index compilation");
-#index_it();
-#
-#$^A = '';
-## must not do index here before formline.
-#is($^A, '', '$^A is empty');
-#formline PVBM2;
-#is($^A, 'bang', "formline isn't confused by index compilation");
-#is(index('bang', PVBM2), 0, "index isn't confused by format compilation");
-#
+# {
+# my $needle = "\x{1230}\x{1270}";
+# my @needles = split ( //, $needle );
+# my $haystack = "\x{1228}\x{1228}\x{1230}\x{1270}";
+# foreach ( @needles ) {
+# my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
+# my $b = index ( $haystack, $_ );
+# is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
+# }
+# $needle = "\x{1270}\x{1230}"; # Transpose them.
+# @needles = split ( //, $needle );
+# foreach ( @needles ) {
+# my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
+# my $b = index ( $haystack, $_ );
+# is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
+# }
+# }
+#
+# {
+# my $search;
+# my $text;
+# $search = latin1_to_native("foo \xc9 bar");
+# $text = latin1_to_native("a\xa3\xa3a $search $search quux");
+#
+# my $text_utf8 = $text;
+# utf8::upgrade($text_utf8);
+# my $search_utf8 = $search;
+# utf8::upgrade($search_utf8);
+#
+# is (index($text, $search), 5);
+# is (rindex($text, $search), 18);
+# is (index($text, $search_utf8), 5);
+# is (rindex($text, $search_utf8), 18);
+# is (index($text_utf8, $search), 5);
+# is (rindex($text_utf8, $search), 18);
+# is (index($text_utf8, $search_utf8), 5);
+# is (rindex($text_utf8, $search_utf8), 18);
+#
+# my $text_octets = $text_utf8;
+# utf8::encode ($text_octets);
+# my $search_octets = $search_utf8;
+# utf8::encode ($search_octets);
+#
+# is (index($text_octets, $search_octets), 7, "index octets, octets")
+# or _diag ($text_octets, $search_octets);
+# is (rindex($text_octets, $search_octets), 21, "rindex octets, octets");
+# is (index($text_octets, $search_utf8), -1);
+# is (rindex($text_octets, $search_utf8), -1);
+# is (index($text_utf8, $search_octets), -1);
+# is (rindex($text_utf8, $search_octets), -1);
+#
+# is (index($text_octets, $search), -1);
+# is (rindex($text_octets, $search), -1);
+# is (index($text, $search_octets), -1);
+# is (rindex($text, $search_octets), -1);
+# }
+#
+# foreach my $utf8 ('', ', utf-8') {
+# foreach my $arraybase (0, 1, -1, -2) {
+# my $expect_pos = 2 + $arraybase;
+#
+# my $prog = "no warnings 'deprecated';\n";
+# $prog .= "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; ";
+# $prog .= '$big .= chr 256; chop $big; ' if $utf8;
+# $prog .= 'print rindex $big, "N", 2 + $[';
+#
+# fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8");
+# }
+# }
+#
+# SKIP: {
+# skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if ord("A") == 193;
+#
+# my $a = "\x{80000000}";
+# my $s = $a.'defxyz';
+# is(index($s, 'def'), 1, "0x80000000 is a single character");
+#
+# my $b = "\x{fffffffd}";
+# my $t = $b.'pqrxyz';
+# is(index($t, 'pqr'), 1, "0xfffffffd is a single character");
+#
+# local ${^UTF8CACHE} = -1;
+# is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
+# }
+#
+#
+# Tests for NUL characters.
+{
+ my @tests = (
+ ["", -1, -1, -1],
+ ["foo", -1, -1, -1],
+ ["\0", 0, -1, -1],
+ ["\0\0", 0, 0, -1],
+ ["\0\0\0", 0, 0, 0],
+ ["foo\0", 3, -1, -1],
+ ["foo\0foo\0\0", 3, 7, -1],
+ );
+ foreach my $l (1 .. 3) {
+ my $q = "\0" x $l;
+ my $i = 0;
+ foreach my $test (@tests) {
+ $i ++;
+ my $str = $$test [0];
+ my $res = $$test [$l];
+
+ {
+ is (index ($str, $q), $res, "Find NUL character(s)");
+ }
+
+ #
+ # Bug #53746 shows a difference between variables and literals,
+ # so test literals as well.
+ #
+ my $test_str = qq {is (index ("$str", "$q"), $res, } .
+ qq {"Find NUL character(s)")};
+ $test_str =~ s/\0/\\0/g;
+
+ eval $test_str;
+ die $@ if $@;
+ }
+ }
+}
+#
+# {
+# # RT#75898
+# is(eval { utf8::upgrade($_ = " "); index $_, " ", 72 }, -1,
+# 'UTF-8 cache handles offset beyond the end of the string');
+# $_ = "\x{100}BC";
+# is(index($_, "C", 4), -1,
+# 'UTF-8 cache handles offset beyond the end of the string');
+# }
+#
+# # RT #89218
+# use constant {PVBM => 'galumphing', PVBM2 => 'bang'};
+#
+# sub index_it {
+# is(index('galumphing', PVBM), 0,
+# "index isn't confused by format compilation");
+# }
+#
+# index_it();
+# is($^A, '', '$^A is empty');
+# formline PVBM;
+# is($^A, 'galumphing', "formline isn't confused by index compilation");
+# index_it();
+#
+# $^A = '';
+# # must not do index here before formline.
+# is($^A, '', '$^A is empty');
+# formline PVBM2;
+# is($^A, 'bang', "formline isn't confused by index compilation");
+# is(index('bang', PVBM2), 0, "index isn't confused by format compilation");
+
}
run_tests() unless 0;

0 comments on commit a9955f1

Please sign in to comment.