modern: Fix : ; and add unit tests.

extra/modern/modern-tests.factor

@@ -33,6 +33,30 @@ IN: modern.tests
     { "1" ":>" "one" }
 } [ "1 :> one" string>literals >strings ] unit-test
 
+{
+    { { ":" { "foo" } ";" } }
+} [ ": foo ;" string>literals >strings ] unit-test
+
+{
+    {
+        { "FOO:" { "a" } }
+        { "BAR:" { "b" } }
+    }
+} [ "FOO: a BAR: b" string>literals >strings ] unit-test
+
+{
+    {
+        { "FOO:" { "a" } ";" }
+    }
+} [ "FOO: a ;" string>literals >strings ] unit-test
+
+{
+    {
+        { "FOO:" { "a" } "FOO;" }
+    }
+} [ "FOO: a FOO;" string>literals >strings ] unit-test
+
+
 ! Acute
 {
     { { "<A" { } "A>" } }
@@ -91,3 +115,17 @@ IN: modern.tests
 { { "\\[[" } } [ "\\[[" string>literals >strings ] unit-test
 { { "\\[=[" } } [ "\\[=[" string>literals >strings ] unit-test
 { { "\\[==[" } } [ "\\[==[" string>literals >strings ] unit-test
+
+
+{ t } [ "FOO:" strict-upper? ] unit-test
+{ t } [ ":" strict-upper? ] unit-test
+{ f } [ "<FOO" strict-upper? ] unit-test
+{ f } [ "<FOO:" strict-upper? ] unit-test
+{ f } [ "->" strict-upper? ] unit-test
+{ f } [ "FOO>" strict-upper? ] unit-test
+{ f } [ ";FOO>" strict-upper? ] unit-test
+
+{ f } [ "FOO" section-open? ] unit-test
+{ f } [ "FOO:" section-open? ] unit-test
+{ f } [ ";FOO" section-close? ] unit-test
+{ f } [ "FOO" section-close? ] unit-test

extra/modern/modern.factor

@@ -133,7 +133,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
     dup '[ but-last ";" append ";" 2array lex-colon-until ] dip
     swap
     ! Remove the ; from the paylaod if present
-    dup ?last ";" sequence= [
+    dup ?last ";" tail? [
         unclip-last 3array
     ] [
         2array
@@ -162,7 +162,7 @@ ERROR: unexpected-terminator n string slice ;
         dup terminator? [ unexpected-terminator ] when
     ] dip swap 2array ;
 
-: strict-upper? ( string -- ? )
+: (strict-upper?) ( string -- ? )
     {
         [
             [
@@ -172,6 +172,9 @@ ERROR: unexpected-terminator n string slice ;
         [ [ char: A char: Z between? ] any? ]
     } 1&& ;
 
+: strict-upper? ( string -- ? )
+    { [ ":" sequence= ] [ (strict-upper?) ] } 1|| ;
+
 ! <a <a: but not <a>
 : section-open? ( string -- ? )
     {