In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f87af7115945fa6571c49bc43940a3cead44ed3c?hp=24fe90a14d91f512527a158a02ea19d502723856>
- Log ----------------------------------------------------------------- commit f87af7115945fa6571c49bc43940a3cead44ed3c Author: Karl Williamson <[email protected]> Date: Tue Mar 26 14:06:50 2013 -0600 op/index.t: Fix tests for EBCDIC Commit 8a38a836 erroneously translates literals into the native encoding, causing a double translation, which is garbage. M t/op/index.t commit 43bf0d50d71d3932b34b930f2d756c08c25349fe Author: Karl Williamson <[email protected]> Date: Thu Jun 19 15:28:45 2014 -0600 regen/ebcdic.pl: Allow making tables in hex This allows the source to be easily edited to create ebcdic translations tables in hex which is easier to debug, but won't fit in an 80 column window. I suppose it could be controlled by an environment variable, but for now, it's just going to be hard-set to 1 or 0. M regen/ebcdic.pl commit 58c435ec0779a997b13944cc99e4f02af2c26734 Author: Karl Williamson <[email protected]> Date: Tue Oct 21 10:22:01 2014 -0600 t/re/regexp.t: Properly handle \c?[ in regex_sets t/re/regex_sets.t is actually handled by regexp.t, skipping all tests that don't have a [bracketed character class]. Prior to this commit, \[ and \c[ were thought to be such a class, when in fact they aren't. M t/re/regexp.t commit 37611e66dc90407e7e76c2b2d917ff2de6adcd43 Author: Yaroslav Kuzmin <[email protected]> Date: Fri Oct 24 12:01:33 2014 -0600 Makefile.SH: Fix so works in EBCDIC M Makefile.SH commit 9c9bd5858bb1ba0716ce72cfed56b41e34126686 Author: Karl Williamson <[email protected]> Date: Fri Oct 24 11:54:15 2014 -0600 t/uni/variables.t: Fix typo This caused failures only in EBCDIC. The variable $chr is what was intended, but due to a missing '$', we got the variable $_ which differs from $chr only on EBCDIC. M t/uni/variables.t commit 923a26c1246c21c9fda8ae111a717697640bc3eb Author: Karl Williamson <[email protected]> Date: Tue Oct 28 10:04:37 2014 -0600 regcomp.c: Comment fixes M regcomp.c ----------------------------------------------------------------------- Summary of changes: Makefile.SH | 2 +- regcomp.c | 7 ++++--- regen/ebcdic.pl | 15 +++++++++++++-- t/op/index.t | 10 +++++----- t/re/regexp.t | 8 ++++---- t/uni/variables.t | 2 +- 6 files changed, 28 insertions(+), 16 deletions(-) diff --git a/Makefile.SH b/Makefile.SH index 7043f3d..72b40be 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -930,7 +930,7 @@ lib/buildcustomize.pl: $& $(mini_obj) write_buildcustomize.pl $(PERL_EXE): $& perlmain$(OBJ_EXT) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT) write_buildcustomize.pl -@rm -f miniperl.xok - $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(LLIBPERL) $(static_ext) `cat ext.libs` $(libs) # Microperl. This is just a convenience thing if one happens to # build also the full Perl and therefore the real big Makefile: diff --git a/regcomp.c b/regcomp.c index 2e633e8..7ea5d89 100644 --- a/regcomp.c +++ b/regcomp.c @@ -9104,7 +9104,7 @@ Perl__add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) /* Add the range from 'start' to 'end' inclusive to the inversion list's * set. A pointer to the inversion list is returned. This may actually be * a new list, in which case the passed in one has been destroyed. The - * passed in inversion list can be NULL, in which case a new one is created + * passed-in inversion list can be NULL, in which case a new one is created * with just the one range in it */ SV* range_invlist; @@ -14462,8 +14462,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, continue; } - /* Here, we have a single value, and <prevvalue> is the beginning of - * the range, if any; or <value> if not */ + /* Here, we have a single value this time through the loop, and + * <prevvalue> is the beginning of the range, if any; or <value> if + * not. */ /* non-Latin1 code point implies unicode semantics. Must be set in * pass1 so is there for the whole of pass 2 */ diff --git a/regen/ebcdic.pl b/regen/ebcdic.pl index 0f66230..b726793 100644 --- a/regen/ebcdic.pl +++ b/regen/ebcdic.pl @@ -14,16 +14,27 @@ sub output_table ($$) { my $table_ref = shift; my $name = shift; + # Tables in hex easier to debug, but don't fit into 80 columns + my $print_in_hex = 0; + die "Requres 256 entries in table $name, got @$table_ref" if @$table_ref != 256; print $out_fh "EXTCONST U8 $name\[\] = {\n"; + print $out_fh "/* _0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _A _B _C _D _E _F */\n" if $print_in_hex; for my $i (0 .. 255) { - printf $out_fh "%4d", $table_ref->[$i]; - #printf $out_fh " 0x%02X", $table_ref->[$i]; + if ($print_in_hex) { + printf $out_fh "/* %X_ */ ", $i / 16 if $i % 16 == 0; + printf $out_fh " 0x%02X", $table_ref->[$i]; + } + else { + printf $out_fh "%4d", $table_ref->[$i]; + } + printf $out_fh " /* %X_ */", $i / 16 if $print_in_hex && $i % 16 == 15; print $out_fh ",", if $i < 255; print $out_fh "\n" if $i % 16 == 15; } + print $out_fh "/* _0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _A _B _C _D _E _F */\n" if $print_in_hex; print $out_fh "};\n\n"; } diff --git a/t/op/index.t b/t/op/index.t index 2bb6cd1..fd5a98f 100644 --- a/t/op/index.t +++ b/t/op/index.t @@ -93,8 +93,8 @@ is(rindex($a, "foo", ), 0); { my $search; my $text; - $search = latin1_to_native("foo \xc9 bar"); - $text = latin1_to_native("a\xa3\xa3a $search $search quux"); + $search = "foo " . latin1_to_native("\xc9") . " bar"; + $text = "a" . latin1_to_native("\xa3\xa3") . "a $search $search quux"; my $text_utf8 = $text; utf8::upgrade($text_utf8); @@ -130,13 +130,13 @@ is(rindex($a, "foo", ), 0); } SKIP: { - skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if ord("A") == 193; + skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if $::IS_EBCDIC; - my $a = "\x{80000000}"; + my $a = eval q{"\x{80000000}"}; my $s = $a.'defxyz'; is(index($s, 'def'), 1, "0x80000000 is a single character"); - my $b = "\x{fffffffd}"; + my $b = eval q{"\x{fffffffd}"}; my $t = $b.'pqrxyz'; is(index($t, 'pqr'), 1, "0xfffffffd is a single character"); diff --git a/t/re/regexp.t b/t/re/regexp.t index 8c51ea5..f27a027 100644 --- a/t/re/regexp.t +++ b/t/re/regexp.t @@ -179,10 +179,10 @@ foreach (@tests) { if (! $skip && $regex_sets) { # If testing regex sets, change the [bracketed] classes into - # (?[bracketed]). - - if ($pat !~ / \[ /x) { - + # (?[bracketed]). But note that '\[' and '\c[' don't introduce such a + # class. (We don't bother looking for an odd number of backslashes, + # as this hasn't been needed so far.) + if ($pat !~ / (?<!\\c) (?<!\\) \[ /x) { $skip++; $reason = "Pattern doesn't contain [brackets]"; } diff --git a/t/uni/variables.t b/t/uni/variables.t index 5ccf7e7..475196c 100644 --- a/t/uni/variables.t +++ b/t/uni/variables.t @@ -136,7 +136,7 @@ for ( 0x0 .. 0xff ) { "$name as a length-1 variable generates a syntax error"); $tests++; } - elsif ($ord < 32 || chr =~ /[[:punct:][:digit:]]/a) { + elsif ($ord < 32 || $chr =~ /[[:punct:][:digit:]]/a) { # Unlike other variables, we dare not try setting the length-1 # variables that are \cX (for all valid X) nor ASCII ones that are -- Perl5 Master Repository
