tools.scaffold: Support unit tests with more than one output with run-string helper...

[factor.git] / basis / tools / scaffold / scaffold.factor

diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor
index 1d3fe34f4abc87319e5ff94f94df1c34a1d64122..845f2324e279c8163d72578cc973823bba4fe56e 100644 (file)
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: accessors alien arrays assocs byte-arrays calendar
 classes classes.error combinators combinators.short-circuit
-continuations hashtables help.markup interpolate io
+continuations eval hashtables help.markup interpolate io
 io.directories io.encodings.utf8 io.files io.pathnames
 io.streams.string kernel math math.parser namespaces prettyprint
 quotations sequences sets sorting splitting strings system
@@ -127,6 +126,11 @@ ERROR: vocab-must-not-exist string ;
         { "vocab-root" "a vocabulary root string" }
         { "c-ptr" c-ptr }
         { "sequence" sequence }
+        { "slice" slice }
+        { "from" integer }
+        { "to" integer }
+        { "i" integer }
+        { "n" integer }
         { "seq" sequence }
         { "exemplar" object }
         { "assoc" assoc }
@@ -157,8 +161,8 @@ M: object add-using
                 [ unparse write bl ]
                 [ [ pprint ] [ add-using ] bi ] bi*
             ] [
-                drop unparse write bl null pprint
-                null add-using
+                drop unparse write bl object pprint
+                object add-using
             ] if
             " }" write
         ] interleave
@@ -252,6 +256,7 @@ M: object add-using
     [ HS{ } clone using ] dip with-variable ; inline
 
 : link-vocab ( vocab -- )
+    ".private" ?tail drop
     check-vocab
     "Edit documentation: " write
     "-docs.factor" vocab/suffix>path <pathname> . ;
@@ -341,7 +346,7 @@ PRIVATE>
 SYMBOL: nested-examples
 
 : example-using ( using -- )
-    unwords "example-using" [
+    join-words "example-using" [
         nested-examples get 4 0 ? CHAR: \s <string> "example-indent" [
             "${example-indent}\"Example:\"
 ${example-indent}{ $example \"USING: ${example-using} ;\"
@@ -373,7 +378,7 @@ ${example-indent}}
     [ "Click to edit: " write <pathname> . ] bi ;
 
 : scaffold-rc ( path -- )
-    [ home ] dip append-path scaffold-file ;
+    home prepend-path scaffold-file ;
 
 : scaffold-factor-boot-rc ( -- )
     ".factor-boot-rc" scaffold-rc ;
@@ -387,6 +392,25 @@ ${example-indent}}
 : scaffold-factor-roots ( -- )
     ".factor-roots" scaffold-rc ;
 
+: make-unit-test ( answer code -- str )
+    split-lines [ "    " prepend ] map "\n" join
+    "[\n" "\n] unit-test\n" surround
+    " " glue ;
+
+: run-string ( string -- datastack )
+    parse-string V{ } clone swap with-datastack ; inline
+
+: scaffold-unit-test ( -- str/f )
+    read-contents dup "" = [
+        drop f
+    ] [
+        [ run-string unparse ] keep
+        make-unit-test
+    ] if ;
+
+: scaffold-unit-tests ( -- str )
+    [ scaffold-unit-test dup ] [ ] produce nip "\n\n" join ;
+
 HOOK: scaffold-emacs os ( -- )
 
 M: unix scaffold-emacs ".emacs" scaffold-rc ;