Changeset 22899 for src

Timestamp:

11/06/08 17:25:00 (2 months ago)

Author:

lwall

Message:

[Cursor] plug some syntax errors misdiagnosed by new LTM
[tryfile] restore ability to report failures via exit status

Location:

src/perl6

Files:

• Cursor.pmc (modified) (11 diffs)
• tryfile (modified) (2 diffs)

src/perl6/Cursor.pmc

@@ -364 +364 @@
                         }
                     }
+                    elsif ($1 eq 'p') {
+                        if ($p =~ s/^(\w{1,2})//) {
+                            $f .= $1;
+                        }
+                        elsif ($p =~ s/^(\{\w+\})//) {
+                            $f .= $1;
+                        }
+                    }
+                    elsif ($1 eq 'b') {
+                        return 1;
+                    }
                     return 1 if $p =~ s/^[*?]//;
                     return 0 unless $c =~ /^$f/;
@@ -412 +423 @@
     my $p = shift;
     my $len = 0;
-    while ($p ne '' and $p ne '.?') {
+    while ($p ne '') {
         return -1 if $p =~ /^[*+?(|]/;
         return -1 if $p =~ /^\{[\d,]+\}/;
@@ -422 +433 @@
             $len++, next if $p =~ s/^\d+//;
             $len++, next if $p =~ s/^x[\da-fA-F]{1,4}//;
+            $len++, next if $p =~ s/^p[a-zA-Z]{1,2}//;
             return -1;
         }
@@ -613 +625 @@
             @pats = grep { canmatch($_, $ch2) } @{
                 $lexer->{FASTPATS} //= [
-                    map { my $x = $_; $x =~ s/\(\?#::\)//g; $x =~ s/\t/.?\t/; $x } @{$lexer->{PATS}}
+                    map { my $x = $_; $x =~ s/\(\?#::\)//g; $x } @{$lexer->{PATS}}
                 ]
             };
@@ -679 +691 @@
             for my $i (0..@$fates-1) {
                 $self->deb("\t", $i, ': ', $fates->[$i][3]) if $DEBUG & DEBUG::autolexer;
-            }
-            for my $pat (@pats) {
-                $pat =~ s/\.\?$//;      # ltm backoff doesn't need tre workaround
-                $pat =~ s/\\>/\\b/g;    # perl regex doesn't use \>
             }
 
@@ -735 +743 @@
                                 if ($l == -1) {
                                     my $p = $pats[$px];
+                                    $self->deb("Trying $p at $P\n") if $DEBUG & DEBUG::fixed_length;
                                     pos($::ORIG) = $P;
-                                    if (($::ORIG =~ m/\G$p/gc)) {
+                                    if (($::ORIG =~ m/\G($p)/msgc)) {
+                                        $self->deb("Got $1\n") if $DEBUG & DEBUG::fixed_length;
                                         $$rxlens[$px] = $l = pos($::ORIG) - $P;
                                         if ($l == $$trylen) {
@@ -1635 +1645 @@
     my $P = $self->{_pos};
     my $char = substr($::ORIG, $P, 1);
-    if ($char =~ /^[[:alpha:]_]$/) {
+    if ($char =~ /^[_[:alpha:]\pL]$/) {
         my $r = $self->cursor($P+1);
         return $r->retm();
@@ -1652 +1662 @@
     }
     my $char = substr($::ORIG, $from, 1);
-    if ($char =~ /^[_[:alpha:]]$/) {
+    if ($char =~ /^[_[:alpha:]\pL]$/) {
         my $r = $self->cursor_rev($from);
         return $r->retm();
@@ -2084 +2094 @@
             ::qm($fixed);
         }
-        $fixed =~ s/([[:alpha:]])/'[' . $1 . chr(ord($1)^32) . ']'/eg if $self->{i};
+        $fixed =~ s/([a-zA-Z])/'[' . $1 . chr(ord($1)^32) . ']'/eg if $self->{i};
         $fixed;
     }
@@ -2120 +2130 @@
             }
             elsif ($_ eq '»' or $_ eq '>>') {
-                return '\>';
+                return '\b';
             }
             elsif ($_ eq '«' or $_ eq '<<') {
-                return '\<';
+                return '\b';
             }
             elsif ($_ eq '::' or $_ eq ':::' or $_ eq '.*?') {
@@ -2156 +2166 @@
                 Encode::_utf8_on($sym);
                 my $text = ::qm($sym);
-                $text =~ s/([[:alpha:]])/'[' . lc($1) . uc($1) . ']'/eg if $self->{i};
+                $text =~ s/(\pL)/'[' . lc($1) . uc($1) . ']'/eg if $self->{i};
                 return $text;
             }
             elsif ($_ eq 'alpha') {
                 $fakepos++;
-                return '[_[:alpha:]]';  # XXX not unicodey
+                return '[_[:alpha:]\pL]';
             }
             my $lexer;

src/perl6/tryfile

@@ -5 +5 @@
 use YAML::XS;
 use Encode;
+
+my $failures = 0;
 
 if (not @ARGV) {
@@ -16 +18 @@
         STD->parsefile($file);
     };
-    warn $@ if $@;
+    if ($@) {
+        warn $@;
+        $failures++;
+    }
 }
+
+exit $failures;