modern: Fix :> and :: ::: etc

modern-harvey3
Doug Coleman 2019-10-24 18:38:23 -05:00
parent ff594f4313
commit 11b0bfc038
2 changed files with 7 additions and 1 deletions

View File

@ -146,6 +146,8 @@ IN: modern.tests
{ t } [ "FOO:" strict-upper? ] unit-test
{ t } [ ":" strict-upper? ] unit-test
{ t } [ "::" 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
@ -157,6 +159,9 @@ IN: modern.tests
{ f } [ ";FOO" section-close? ] unit-test
{ f } [ "FOO" section-close? ] unit-test
{ f } [ ":>" section-close? ] unit-test
{ f } [ ":::>" section-close? ] unit-test
! Strings
{

View File

@ -179,7 +179,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
} 1&& ;
: strict-upper? ( string -- ? )
{ [ ":" sequence= ] [ (strict-upper?) ] } 1|| ;
{ [ [ char: \: = ] all? ] [ (strict-upper?) ] } 1|| ;
! <A <A: but not <A>
: section-open? ( string -- ? )
@ -254,6 +254,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
[ length 2 >= ]
[ "\\" head? not ] ! XXX: good?
[ ">" tail? ]
[ but-last [ char: \: = ] all? not ] ! :> ::> :::> not section-close
[
{
[ but-last strict-upper? ]