strings.parser: fix "string"length bug when parsing strings.

It really shouldn't have worked, but it did, now it doesn't.

diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor
index f7fcef1a291ca613daa48c9d67c9e6091728a2b6..474542852a0d99237b15b4bfb91004bd2dca97f0 100644 (file)
--- a/core/strings/parser/parser-tests.factor
+++ b/core/strings/parser/parser-tests.factor
@@ -18,6 +18,8 @@ USING: accessors kernel eval strings.parser tools.test ;
 [ "\"abc" eval( -- string ) ] [ error>> "Unterminated string" = ] must-fail-with
 [ "\"abc\n\n" eval( -- string ) ] [ error>> "Unterminated string" = ] must-fail-with
 
+[ "\"hello\"length" eval( -- string ) ] [ error>> "Invalid string" = ] must-fail-with
+
 { "\"\\" } [ "\"\\" ] unit-test
 
 { "\e" } [ "\u00001b" ] unit-test

diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor
index 056d6527c41069a78cdc67e795161e88abb901f6..73dd42485a7b9f343f97e948961fdd42150a9f82 100644 (file)
--- a/core/strings/parser/parser.factor
+++ b/core/strings/parser/parser.factor
@@ -106,22 +106,27 @@ PRIVATE>
 : find-next-token ( lexer -- i elt )
     { lexer } declare
     [ column>> ] [ line-text>> ] bi
-    [ "\"\\" member? ] find-from ;
+    [ "\"\\" member-eq? ] find-from ;
 
 DEFER: (parse-string)
 
 : parse-found-token ( accum lexer i elt -- )
     { sbuf lexer fixnum fixnum } declare
     [ over lexer-subseq pick push-all ] dip
-    CHAR: \ = [
+    CHAR: \ eq? [
         dup dup [ next-char ] bi@
         [ [ pick push ] bi@ ]
         [ drop 2dup next-line% ] if*
         (parse-string)
     ] [
-        advance-char drop
+        dup advance-char
+        dup current-char forbid-tab {
+            { CHAR: \s [ advance-char ] }
+            { f [ drop ] }
+            [ "Invalid string" throw ]
+        } case drop
     ] if ;
-
+ 
 : (parse-string) ( accum lexer -- )
     { sbuf lexer } declare
     dup still-parsing? [
@@ -136,18 +141,9 @@ DEFER: (parse-string)
         "Unterminated string" throw
     ] if ;
 
-: rewind-lexer-on-error ( quot -- )
-    lexer get [ line>> ] [ line-text>> ] [ column>> ] tri
-    [
-        lexer get [ column<< ] [ line-text<< ] [ line<< ] tri
-        rethrow
-    ] 3curry recover ; inline
-
 PRIVATE>
 
 : parse-string ( -- str )
-    [
-        SBUF" " clone [
-            lexer get (parse-string)
-        ] keep unescape-string
-    ] rewind-lexer-on-error ;
+    SBUF" " clone [
+        lexer get (parse-string)
+    ] keep unescape-string ;