This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/Data-Dumper/t/dumper.t: Simplify EBCDIC
[perl5.git] / dist / Data-Dumper / t / dumper.t
index 35f3fd9..78ff7ec 100644 (file)
@@ -108,7 +108,7 @@ sub SKIP_TEST {
   ++$TNUM; print "ok $TNUM # skip $reason\n";
 }
 
-$TMAX = 438;
+$TMAX = 450;
 
 # Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
 # it direct. Out here it lets us knobble the next if to test that the perl
@@ -1413,40 +1413,25 @@ EOT
   }
 }
 
-#XXX}
 {
-    if ($Is_ebcdic) {
-       $b = "Bad. XS didn't escape dollar sign";
-############# 322
-       $WANT = <<"EOT"; # Careful. This is '' string written inside "" here doc
-#\$VAR1 = '\$b\"\@\\\\\xB1';
-EOT
-        $a = "\$b\"\@\\\xB1\x{100}";
-       chop $a;
-       TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
-       if ($XS) {
-           $WANT = <<'EOT'; # While this is "" string written inside "" here doc
-#$VAR1 = "\$b\"\@\\\x{b1}";
-EOT
-            TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
-       }
-    } else {
        $b = "Bad. XS didn't escape dollar sign";
 #############
+    # B6 is chosen because it is UTF-8 variant on ASCII and all 3 EBCDIC
+    # platforms that Perl currently purports to work on.  It also is the only
+    # such code point that has the same meaning on all 4, the paragraph sign.
        $WANT = <<"EOT"; # Careful. This is '' string written inside "" here doc
-#\$VAR1 = '\$b\"\@\\\\\xA3';
+#\$VAR1 = '\$b\"\@\\\\\xB6';
 EOT
 
-        $a = "\$b\"\@\\\xA3\x{100}";
+        $a = "\$b\"\@\\\xB6\x{100}";
        chop $a;
        TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
        if ($XS) {
            $WANT = <<'EOT'; # While this is "" string written inside "" here doc
-#$VAR1 = "\$b\"\@\\\x{a3}";
+#$VAR1 = "\$b\"\@\\\x{b6}";
 EOT
             TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
        }
-  }
   # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
 #############
   $WANT = <<'EOT';
@@ -1722,3 +1707,36 @@ EOW
     if $XS;
 }
 #############
+
+{
+    if($] lt 5.007_003) {
+        SKIP_TEST "Test is only problematic for EBCDIC, which only works for >= 5.8";
+        SKIP_TEST "Test is only problematic for EBCDIC, which only works for >= 5.8";
+    }
+    else {
+        # There is special code to handle the single control that in EBCDIC is
+        # not in the block with all the other controls, when it is UTF-8 and
+        # there are no variants in it (All controls in EBCDIC are invariant.)
+        # This tests that.  There is no harm in testing this works on ASCII,
+        # and is better to not have split code paths.
+        my $outlier = chr utf8::unicode_to_native(0x9F);
+        my $outlier_hex = sprintf "%x", ord $outlier;
+        $WANT = <<EOT;
+#\$VAR1 = \"\\x{$outlier_hex}\";
+EOT
+        $foo = "$outlier\x{100}";
+        chop $foo;
+        local $Data::Dumper::Useqq = 1;
+        TEST (q(Dumper($foo)), 'EBCDIC outlier control');
+        TEST (q(Data::Dumper::DumperX($foo)), 'EBCDIC outlier control: DumperX') if $XS;
+    }
+}
+############# [perl #124091]
+{
+        $WANT = <<'EOT';
+#$VAR1 = "\n";
+EOT
+        local $Data::Dumper::Useqq = 1;
+        TEST (qq(Dumper("\n")), '\n alone');
+        TEST (qq(Data::Dumper::DumperX("\n")), '\n alone') if $XS;
+}