From e54a39412baabbae4ead588a392edbe8d5bf7359 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Aug 2022 01:28:57 -0500 Subject: [PATCH] tools.scaffold: Add a word to scaffold tests. Depends on sequences.extras loop>array but this may be forbidden (?) --- basis/tools/scaffold/scaffold.factor | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 2abe6d60c7..0d73e7a2d5 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -1,14 +1,13 @@ ! 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 -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 @@ -393,6 +392,25 @@ ${example-indent}} : 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 ; -- 2.34.1