From 6fe38fde00c228d9543b0a7be51fa75bedc2bd35 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 30 Sep 2017 09:21:09 -0500
Subject: [PATCH] modern: Fix case for "<PRIVATE FOO: foo PRIVATE>"

At the end of a file the length of the string is f, so this needs to be
fixed up for calculations.
---
 extra/modern/modern-tests.factor | 13 +++++++++++++
 extra/modern/modern.factor       | 13 ++++++++++++-
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor
index c50ebea43c..10432d6949 100644
--- a/extra/modern/modern-tests.factor
+++ b/extra/modern/modern-tests.factor
@@ -164,3 +164,16 @@ IN: modern.tests
     }
 } [ "\"abc\"[ 0 ]" string>literals >strings ] unit-test
 ]]
+
+
+{
+    {
+        { "<FOO" { { "BAR:" { "bar" } } } "FOO>" }
+    }
+} [ "<FOO BAR: bar FOO>" string>literals >strings ] unit-test
+
+{
+    {
+        { "<FOO:" { "foo" { "BAR:" { "bar" } } } ";FOO>" }
+    }
+} [ "<FOO: foo BAR: bar ;FOO>" string>literals >strings ] unit-test
diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor
index 4304f45cfd..1091ac5c2e 100644
--- a/extra/modern/modern.factor
+++ b/extra/modern/modern.factor
@@ -171,8 +171,13 @@ ERROR: unexpected-terminator n string slice ;
 : section-close? ( string -- ? )
     {
         [ length 2 >= ]
-        [ but-last strict-upper? ]
         [ ">" tail? ]
+        [
+            {
+                [ but-last strict-upper? ]
+                [ { [ ";" head? ] [ rest but-last strict-upper? ] } 1&& ]
+            } 1||
+        ]
     } 1&& ;
 
 : read-til-semicolon ( n string slice -- n' string semi )
@@ -219,6 +224,11 @@ ERROR: no-backslash-payload n string slice ;
 ERROR: mismatched-terminator n string slice ;
 : read-terminator ( n string slice -- n' string slice ) ;
 
+! If we are at the end of the string, we need to be at position len instead of f
+! after a read. Especially for "<FOO BAR: baz FOO>"
+: ?length-and-string ( length/f string -- length string )
+    over [ nip [ length ] [ ] bi ] unless ; inline
+
 : (lex-factor) ( n/f string slice/f ch/f -- n'/f string literal )
     {
         { char: \" [ read-string ] }
@@ -253,6 +263,7 @@ ERROR: mismatched-terminator n string slice ;
             [ slice-til-whitespace drop ] dip span-slices
             dup section-close? [
                 strict-upper get [
+                    [ ?length-and-string ] dip
                     length swap [ - ] dip f strict-upper off
                 ] when
             ] when