diff options
| author | Jarkko Hietaniemi <jhi@iki.fi> | 2006-07-14 02:10:27 +0300 |
|---|---|---|
| committer | Steve Peters <steve@fisharerojo.org> | 2006-07-13 20:18:59 +0000 |
| commit | cf0d1c66a0d97cdcc6938d91401fa36b9b5a67ac (patch) | |
| tree | 65674c4cd5d583a2c89833405ac421a19c1387be /ext/Data | |
| parent | 2f3efc978ada94e3718bd6f3a25b06cd1d13b6f8 (diff) | |
| download | perl-cf0d1c66a0d97cdcc6938d91401fa36b9b5a67ac.tar.gz | |
z/OS: CPAN-ized ext/ and lib/
Message-ID: <44B6A8B3.5070605@iki.fi>
p4raw-id: //depot/perl@28568
Diffstat (limited to 'ext/Data')
| -rw-r--r-- | ext/Data/Dumper/Dumper.xs | 13 | ||||
| -rwxr-xr-x | ext/Data/Dumper/t/dumper.t | 43 |
2 files changed, 45 insertions, 11 deletions
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs index 255a6d99eb..0c62250c54 100644 --- a/ext/Data/Dumper/Dumper.xs +++ b/ext/Data/Dumper/Dumper.xs @@ -138,7 +138,11 @@ esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen) for (s = src; s < send; s += UTF8SKIP(s)) { const UV k = utf8_to_uvchr((U8*)s, NULL); - if (k > 127) { +#ifdef EBCDIC + if (!isprint(k) || k > 256) { +#else + if (k > 127) { +#endif /* 4: \x{} then count the number of hex digits. */ grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 : #if UVSIZE == 4 @@ -172,7 +176,12 @@ esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen) *r++ = '\\'; *r++ = (char)k; } - else if (k < 0x80) + else +#ifdef EBCDIC + if (isprint(k) && k < 256) +#else + if (k < 0x80) +#endif *r++ = (char)k; else { /* The return value of sprintf() is unportable. diff --git a/ext/Data/Dumper/t/dumper.t b/ext/Data/Dumper/t/dumper.t index 8ab5f1ddcc..05e51a45c2 100755 --- a/ext/Data/Dumper/t/dumper.t +++ b/ext/Data/Dumper/t/dumper.t @@ -48,7 +48,15 @@ sub TEST { : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n"); ++$TNUM; - eval "$t"; + if ($Is_ebcdic) { # EBCDIC. + if ($TNUM == 311 || $TNUM == 314) { + eval $string; + } else { + eval $t; + } + } else { + eval "$t"; + } print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n"; $t = eval $string; @@ -1285,20 +1293,37 @@ EOT #XXX} { - $b = "Bad. XS didn't escape dollar sign"; + 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"; ############# 322 - $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc + $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc #\$VAR1 = '\$b\"\@\\\\\xA3'; EOT - $a = "\$b\"\@\\\xA3\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 + $a = "\$b\"\@\\\xA3\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}"; EOT - TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$"; + 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\\\")] ############# 328 |