]> gitweb.factorcode.org Git - factor.git/commitdiff
tools.scaffold: Add a word to scaffold tests.
authorDoug Coleman <doug.coleman@gmail.com>
Mon, 8 Aug 2022 06:28:57 +0000 (01:28 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 8 Aug 2022 06:29:47 +0000 (01:29 -0500)
Depends on sequences.extras loop>array but this may be forbidden (?)

basis/tools/scaffold/scaffold.factor

index 2abe6d60c74ff0d547ca566dacfec3fb7c9b6d52..0d73e7a2d512ee1fe279aecef0d6e7e7002fe9e7 100644 (file)
@@ -1,14 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! 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
 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
 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
-timers unicode urls vocabs vocabs.loader vocabs.metadata words
-words.symbol ;
+quotations sequences sequences.extras sets sorting splitting
+strings system timers unicode urls vocabs vocabs.loader
+vocabs.metadata words words.symbol ;
 IN: tools.scaffold
 
 SYMBOL: developer-name
 IN: tools.scaffold
 
 SYMBOL: developer-name
@@ -393,6 +392,25 @@ ${example-indent}}
 : scaffold-factor-roots ( -- )
     ".factor-roots" scaffold-rc ;
 
 : scaffold-factor-roots ( -- )
     ".factor-roots" scaffold-rc ;
 
+: make-unit-test ( answer code -- str )
+   [
+        prepend-lines-with-spaces
+        "{\n" "\n}" surround
+    ] [
+        prepend-lines-with-spaces
+        "[\n" "\n] unit-test\n" surround
+    ] bi* " " glue ;
+
+: scaffold-unit-test ( -- str/f )
+    read-contents dup "" = [
+        drop f
+    ] [
+        [ eval( -- x ) unparse ] keep make-unit-test
+    ] if ;
+
+: scaffold-unit-tests ( -- str )
+    [ scaffold-unit-test ] loop>array "\n\n" join ;
+
 HOOK: scaffold-emacs os ( -- )
 
 M: unix scaffold-emacs ".emacs" scaffold-rc ;
 HOOK: scaffold-emacs os ( -- )
 
 M: unix scaffold-emacs ".emacs" scaffold-rc ;