csv: more permission parsing.

diff --git a/basis/csv/csv-tests.factor b/basis/csv/csv-tests.factor
index 829637b4aa18b2e916ac4e6f9aed77d954ffdf4c..020f7e19445d372c52e60936099822f3873ecb92 100644 (file)
--- a/basis/csv/csv-tests.factor
+++ b/basis/csv/csv-tests.factor
@@ -47,7 +47,7 @@ IN: csv.tests
 
 
 ! !!!!!!!!  other tests
-   
+
 [ { { "Phil Dawes" } } ] 
 [ "\"Phil Dawes\"" <string-reader> csv ] unit-test
 
@@ -90,3 +90,12 @@ IN: csv.tests
 ] unit-test
 
 [ { { "hello" "" "" "" "goodbye" "" } } ] [ "hello,,\"\",,goodbye," <string-reader> csv ] unit-test
+
+{ { { "asd\"f\"" "asdf" } } } [ "asd\"f\",asdf" string>csv ] unit-test
+{ { { "a\"sdf" "asdf" } } } [ "a\"sdf,asdf" string>csv ] unit-test
+{ { { "as\"df" "asdf" } } } [ "    as\"df,asdf" string>csv ] unit-test
+{ { { "asd" "f" "asdf" } } } [ "\"as\"d,f,asdf" string>csv ] unit-test
+{ { { "as,df" "asdf" } } } [ "\"as,\"df,asdf" string>csv ] unit-test
+! FIXME: { { { "as,df" "asdf" } } } [ "\"as,\"df  ,asdf" string>csv ] unit-test
+! FIXME: { { { "asd\"f\"" "asdf" } } } [ "\"asd\"\"\"f\",asdf" string>csv ] unit-test
+{ { { "as,d\"f" "asdf" } } } [ "\"as,\"d\"\"\"\"f,asdf" string>csv ] unit-test

diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor
index 76adab87f2c34f9a19ea0e36ec19c9c063d56cf2..edd13a1c2affd708b566e422dc5f8898a4391a4c 100644 (file)
--- a/basis/csv/csv.factor
+++ b/basis/csv/csv.factor
@@ -16,38 +16,39 @@ CHAR: , delimiter set-global
 MEMO: (field-end) ( delimiter -- delimiter' )
     "\n" swap suffix ; inline
 
-: skip-to-field-end ( -- endchar )
-    delimiter> (field-end) read-until nip ; inline
+: field-end ( -- str sep )
+    delimiter> (field-end) read-until ; inline
 
 DEFER: quoted-field
 
 MEMO: (quoted-field) ( delimiter -- delimiter' )
     "\"\n" swap suffix ; inline
 
-: maybe-escaped-quote ( -- endchar )
+: maybe-escaped-quote ( quoted? -- endchar )
     read1 dup {
-        { CHAR: "    [ , quoted-field ] }
+        { CHAR: "    [ over [ , ] [ drop ] if quoted-field ] }
         { delimiter> [ ] }
-        { CHAR: \n   [ ] }
-        [ 2drop skip-to-field-end ]
-    } case ;
+        { CHAR: \n   [ ] } ! Error: newline inside string?
+        [ [ , f maybe-escaped-quote ] when ]
+    } case nip ;
 
 : quoted-field ( -- endchar )
     "\"" read-until
-    drop % maybe-escaped-quote ;
+    drop % t maybe-escaped-quote ;
+
+: ?trim ( string -- string' )
+    dup { [ first blank? ] [ last blank? ] } 1||
+    [ [ blank? ] trim ] when ;
 
 : field ( -- sep string )
     delimiter> (quoted-field) read-until
     dup CHAR: " = [
-        2drop [ quoted-field ] "" make
+        over empty?
+        [ 2drop [ quoted-field ] "" make ]
+        [ drop field-end [ "\"" glue ] dip swap ?trim ]
+        if
     ] [
-        swap [ "" ] [
-            dup {
-                [ first blank? ]
-                [ last blank? ]
-            } 1||
-            [ [ blank? ] trim ] when
-        ] if-empty
+        swap [ "" ] [ ?trim ] if-empty
     ] if ;
 
 : (row) ( -- sep )