modern.html: Fix a bug in parsing factor's wikipedia history

diff --git a/extra/modern/html/html-tests.factor b/extra/modern/html/html-tests.factor
index 9114b16492db5685bd72d09f10c234d060098cb0..b82b11d976e12035059440089def9fbaa37b6acb 100644 (file)
--- a/extra/modern/html/html-tests.factor
+++ b/extra/modern/html/html-tests.factor
@@ -74,4 +74,115 @@ IN: modern.html.tests
 
 {
     V{ T{ comment { open "<!--" } { payload " comment " } { close "-->" } } }
-} [ [[ <!-- comment --> ]] string>html ] unit-test
\ No newline at end of file
+} [ [[ <!-- comment --> ]] string>html ] unit-test
+
+! From wikipedia factor article
+! https://en.wikipedia.org/w/index.php?title=Factor_(programming_language)&offset=&limit=500&action=history"
+{
+    V{
+        T{ doctype
+            { open "<!DOCTYPE" }
+            { close ">" }
+            { values V{ "html" } }
+        }
+        T{ open-tag
+            { open "<" }
+            { name "html" }
+            { props
+                V{
+                    {
+                        "class"
+                        T{ dquote { payload "client-nojs" } }
+                    }
+                    { "lang" T{ dquote { payload "en" } } }
+                    { "dir" T{ dquote { payload "ltr" } } }
+                }
+            }
+            { close ">" }
+            { children
+                V{
+                    T{ open-tag
+                        { open "<" }
+                        { name "head" }
+                        { props V{ } }
+                        { close ">" }
+                        { children
+                            V{
+                                T{ open-tag
+                                    { open "<" }
+                                    { name "title" }
+                                    { props V{ } }
+                                    { close ">" }
+                                    { children V{ "omg" } }
+                                    { close-tag
+                                        T{ close-tag
+                                            { name "title" }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                        { close-tag T{ close-tag { name "head" } } }
+                    }
+                    T{ open-tag
+                        { open "<" }
+                        { name "body" }
+                        { props V{ } }
+                        { close ">" }
+                        { children
+                            V{
+                                T{ open-tag
+                                    { open "<" }
+                                    { name "div" }
+                                    { props
+                                        V{
+                                            {
+                                                "id"
+                                                T{ squote
+                                                    { payload
+                                                        "ooui-php-6"
+                                                    }
+                                                }
+                                            }
+                                            {
+                                                "data-ooui"
+                                                T{ squote
+                                                    { payload
+                                                        "{\"_\":\"mw.htmlform.FieldLayout\",\"fieldWidget\":{\"tag\":\"tagfilter\"},\"align\":\"top\",\"helpInline\":true,\"$overlay\":true,\"label\":{\"html\":\"&lt;a href=\\\"\\/wiki\\/Special:Tags\\\" title=\\\"Special:Tags\\\"&gt;Tag&lt;\\/a&gt; filter:\"},\"classes\":[\"mw-htmlform-field-HTMLTagFilter\",\"mw-htmlform-autoinfuse\"]}"
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                    { close ">" }
+                                    { children V{ } }
+                                    { close-tag
+                                        T{ close-tag
+                                            { name "div" }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                        { close-tag T{ close-tag { name "body" } } }
+                    }
+                }
+            }
+            { close-tag T{ close-tag { name "html" } } }
+        }
+    }
+} [
+    [[
+    <!DOCTYPE html>
+    <html class="client-nojs" lang="en" dir="ltr">
+
+    <head> <title>omg</title></head>
+    <body>
+    <div id='ooui-php-6'
+    data-ooui='{"_":"mw.htmlform.FieldLayout","fieldWidget":{"tag":"tagfilter"},"align":"top","helpInline":true,"$overlay":true,"label":{"html":"&lt;a href=\"\/wiki\/Special:Tags\" title=\"Special:Tags\"&gt;Tag&lt;\/a&gt; filter:"},"classes":["mw-htmlform-field-HTMLTagFilter","mw-htmlform-autoinfuse"]}'
+    >
+    </div>
+    </body>
+    </html>
+    ]] string>html
+] unit-test

diff --git a/extra/modern/html/html.factor b/extra/modern/html/html.factor
index 25a6bda20e811dc105b7e0cb40b6692fd7b8ea38..7c90db4384e34237d96f5b5f115bddd991601875 100644 (file)
--- a/extra/modern/html/html.factor
+++ b/extra/modern/html/html.factor
@@ -57,23 +57,12 @@ C: <squote> squote
 TUPLE: dquote payload ;
 C: <dquote> dquote
 
-: read-squote-string-payload ( n string -- n' string )
+: read-squote-payload ( n string -- n' string )
     over [
         { CHAR: \\ CHAR: ' } slice-til-separator-inclusive {
             { f [ drop ] }
             { CHAR: ' [ drop ] }
-            { CHAR: \\ [ drop next-char-from drop read-string-payload ] }
-        } case
-    ] [
-        string-expected-got-eof
-    ] if ;
-
-: read-dquote-string-payload ( n string -- n' string )
-    over [
-        { CHAR: \\ CHAR: \" } slice-til-separator-inclusive {
-            { f [ drop ] }
-            { CHAR: \" [ drop ] }
-            { CHAR: \\ [ drop next-char-from drop read-string-payload ] }
+            { CHAR: \\ [ drop next-char-from drop read-squote-payload ] }
         } case
     ] [
         string-expected-got-eof
@@ -81,8 +70,8 @@ C: <dquote> dquote
 
 :: read-string ( $n $string $char -- n' string payload )
     $n $string $char CHAR: ' =
-    [ read-squote-string-payload ]
-    [ read-dquote-string-payload ] if drop :> $n'
+    [ read-squote-payload ]
+    [ read-dquote-payload ] if drop :> $n'
     $n' $string
     $n' [ $n $string string-expected-got-eof ] unless
     $n $n' 1 - $string <slice> ;

diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor
index 407937d0702dbd63904a39ada9587140f4123193..04f9dbe199a83df86dbb1013f31694ad4d099253 100644 (file)
--- a/extra/modern/modern.factor
+++ b/extra/modern/modern.factor
@@ -109,19 +109,19 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
 : read-bracket ( n string slice -- n' string slice' ) CHAR: [ read-matched ;
 : read-brace ( n string slice -- n' string slice' ) CHAR: { read-matched ;
 : read-paren ( n string slice -- n' string slice' ) CHAR: ( read-matched ;
-: read-string-payload ( n string -- n' string )
+: read-dquote-payload ( n string -- n' string )
     over [
         { CHAR: \\ CHAR: \" } slice-til-separator-inclusive {
             { f [ drop ] }
             { CHAR: \" [ drop ] }
-            { CHAR: \\ [ drop next-char-from drop read-string-payload ] }
+            { CHAR: \\ [ drop next-char-from drop read-dquote-payload ] }
         } case
     ] [
         string-expected-got-eof
     ] if ;
 
 :: read-string ( n string tag -- n' string seq )
-    n string read-string-payload drop :> n'
+    n string read-dquote-payload drop :> n'
     n' string
     n' [ n string string-expected-got-eof ] unless
     n n' 1 - string <slice>