Clean up vocabs.loader and add littledan's unit test feature
Slava Pestov
parent
637600011c
commit
262e9d3443
|
|
@ -38,7 +38,7 @@ vocabs.loader system ;
|
|||
|
||||
[
|
||||
"resource:core/bootstrap/stage2.factor"
|
||||
dup ?resource-path exists? [
|
||||
dup resource-exists? [
|
||||
run-file
|
||||
] [
|
||||
"Cannot find " write write "." print
|
||||
|
|
|
|||
|
|
@ -1,287 +0,0 @@
|
|||
USING: compiler definitions generic assocs inference math
|
||||
namespaces parser tools.test words kernel sequences arrays io
|
||||
effects tools.test compiler.units inference.state ;
|
||||
IN: temporary
|
||||
|
||||
DEFER: x-1
|
||||
DEFER: x-2
|
||||
|
||||
[ [ f ] { } map>assoc modify-code-heap ] recompile-hook [
|
||||
"IN: temporary USE: math GENERIC: x-1 ( x -- y ) M: integer x-1 ;" eval
|
||||
"IN: temporary : x-2 3 x-1 ;" eval
|
||||
|
||||
[ t ] [
|
||||
{ x-2 } compile
|
||||
|
||||
\ x-2 word-xt
|
||||
|
||||
{ x-1 } compile
|
||||
|
||||
\ x-2 word-xt =
|
||||
] unit-test
|
||||
] with-variable
|
||||
|
||||
DEFER: b
|
||||
DEFER: c
|
||||
|
||||
[ ] [ "IN: temporary : a 1 2 ; : b a a ;" eval ] unit-test
|
||||
|
||||
[ 1 2 1 2 ] [ "USE: temporary b" eval ] unit-test
|
||||
|
||||
{ 0 4 } [ b ] must-infer-as
|
||||
|
||||
[ ] [ "IN: temporary : a 1 2 3 ;" eval ] unit-test
|
||||
|
||||
[ 1 2 3 1 2 3 ] [ "USE: temporary b" eval ] unit-test
|
||||
|
||||
{ 0 6 } [ b ] must-infer-as
|
||||
|
||||
\ b word-xt "b-xt" set
|
||||
|
||||
[ ] [ "IN: temporary : c b ;" eval ] unit-test
|
||||
|
||||
[ t ] [ "b-xt" get \ b word-xt = ] unit-test
|
||||
|
||||
\ c word-xt "c-xt" set
|
||||
|
||||
[ ] [ "IN: temporary : a 1 2 4 ;" eval ] unit-test
|
||||
|
||||
[ t ] [ "c-xt" get \ c word-xt = ] unit-test
|
||||
|
||||
[ 1 2 4 1 2 4 ] [ "USE: temporary c" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : a 1 2 ;" eval ] unit-test
|
||||
|
||||
{ 0 4 } [ c ] must-infer-as
|
||||
|
||||
[ f ] [ "c-xt" get \ c word-xt = ] unit-test
|
||||
|
||||
[ 1 2 1 2 ] [ "USE: temporary c" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : d 3 ; inline" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : e d d ;" eval ] unit-test
|
||||
|
||||
[ 3 3 ] [ "USE: temporary e" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : d 4 ; inline" eval ] unit-test
|
||||
|
||||
[ 4 4 ] [ "USE: temporary e" eval ] unit-test
|
||||
|
||||
DEFER: x-3
|
||||
|
||||
[ ] [ "IN: temporary : x-3 3 ;" eval ] unit-test
|
||||
|
||||
DEFER: x-4
|
||||
|
||||
[ ] [ "IN: temporary : x-4 x-3 ;" eval ] unit-test
|
||||
|
||||
[ t ] [ \ x-4 compiled? ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: sequences : x-3 { } [ ] each ;" eval ] unit-test
|
||||
|
||||
[ f ] [ \ x-3 compiled? ] unit-test
|
||||
|
||||
[ f ] [ \ x-4 compiled? ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USING: kernel sequences ; : x-3 { } [ drop ] each ;" eval ] unit-test
|
||||
|
||||
[ t ] [ \ x-3 compiled? ] unit-test
|
||||
|
||||
[ t ] [ \ x-4 compiled? ] unit-test
|
||||
|
||||
[ t ] [ \ x-3 "compiled-uses" word-prop >boolean ] unit-test
|
||||
|
||||
DEFER: g-test-1
|
||||
|
||||
DEFER: g-test-3
|
||||
|
||||
[ ] [ "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 sq ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : g-test-2 ( -- y ) 3 g-test-1 ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : g-test-3 ( -- y ) g-test-2 ;" eval ] unit-test
|
||||
|
||||
[ 25 ] [ 5 g-test-1 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 ;" eval ] unit-test
|
||||
|
||||
[ 5 ] [ 5 g-test-1 ] unit-test
|
||||
|
||||
[ t ] [
|
||||
\ g-test-3 word-xt
|
||||
|
||||
"IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 3 + ;" eval
|
||||
|
||||
\ g-test-3 word-xt =
|
||||
] unit-test
|
||||
|
||||
DEFER: g-test-5
|
||||
|
||||
[ ] [ "IN: temporary : g-test-4 ( -- y ) 3 g-test-1 ; inline" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : g-test-5 ( -- y ) g-test-4 ;" eval ] unit-test
|
||||
|
||||
[ 6 ] [ g-test-5 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 10 + ;" eval ] unit-test
|
||||
|
||||
[ 13 ] [ g-test-5 ] unit-test
|
||||
|
||||
DEFER: g-test-6
|
||||
|
||||
[ ] [ "IN: temporary USING: arrays kernel ; GENERIC: g-test-6 ( x -- y ) M: array g-test-6 drop 123 g-test-1 ;" eval ] unit-test
|
||||
|
||||
DEFER: g-test-7
|
||||
|
||||
[ ] [ "IN: temporary : g-test-7 { } g-test-6 ;" eval ] unit-test
|
||||
|
||||
[ 133 ] [ g-test-7 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 15 + ;" eval ] unit-test
|
||||
|
||||
[ 138 ] [ g-test-7 ] unit-test
|
||||
|
||||
USE: macros
|
||||
|
||||
DEFER: macro-test-3
|
||||
|
||||
[ ] [ "IN: temporary USING: macros math ; : macro-test-1 sq ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USING: macros arrays quotations ; MACRO: macro-test-2 ( n word -- quot ) <array> >quotation ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : macro-test-3 2 \\ macro-test-1 macro-test-2 ;" eval ] unit-test
|
||||
|
||||
[ 625 ] [ 5 macro-test-3 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USING: macros arrays quotations kernel math ; MACRO: macro-test-2 ( n word -- quot ) 2drop [ 3 + ] ;" eval ] unit-test
|
||||
|
||||
[ 8 ] [ 5 macro-test-3 ] unit-test
|
||||
|
||||
USE: hints
|
||||
|
||||
DEFER: hints-test-2
|
||||
|
||||
[ ] [ "IN: temporary USING: math hints ; : hints-test-1 3 + ; HINTS: hints-test-1 fixnum ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : hints-test-2 5 hints-test-1 ;" eval ] unit-test
|
||||
|
||||
[ 8 ] [ hints-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math : hints-test-1 5 + ;" eval ] unit-test
|
||||
|
||||
[ 10 ] [ hints-test-2 ] unit-test
|
||||
|
||||
DEFER: inline-then-not-inline-test-1
|
||||
DEFER: inline-then-not-inline-test-2
|
||||
|
||||
[ ] [ "IN: temporary : inline-then-not-inline-test-1 1 2 3 ; inline" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : inline-then-not-inline-test-2 inline-then-not-inline-test-1 ;" eval ] unit-test
|
||||
|
||||
[ 1 2 3 ] [ inline-then-not-inline-test-2 ] unit-test
|
||||
|
||||
\ inline-then-not-inline-test-2 word-xt "a" set
|
||||
|
||||
[ ] [ "IN: temporary : inline-then-not-inline-test-1 6 6 9 ;" eval ] unit-test
|
||||
|
||||
[ f ] [ \ inline-then-not-inline-test-2 word-xt "a" get = ] unit-test
|
||||
|
||||
[ 6 6 9 ] [ inline-then-not-inline-test-2 ] unit-test
|
||||
|
||||
DEFER: generic-then-not-generic-test-1
|
||||
DEFER: generic-then-not-generic-test-2
|
||||
|
||||
[ ] [ "IN: temporary GENERIC: generic-then-not-generic-test-1 ( a -- b )" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math M: integer generic-then-not-generic-test-1 sq ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : generic-then-not-generic-test-2 3 generic-then-not-generic-test-1 ;" eval ] unit-test
|
||||
|
||||
[ 9 ] [ generic-then-not-generic-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math : generic-then-not-generic-test-1 1 + ;" eval ] unit-test
|
||||
|
||||
[ 4 ] [ generic-then-not-generic-test-2 ] unit-test
|
||||
|
||||
DEFER: foldable-test-1
|
||||
DEFER: foldable-test-2
|
||||
|
||||
[ ] [ "IN: temporary : foldable-test-1 3 ; foldable" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : foldable-test-2 foldable-test-1 ;" eval ] unit-test
|
||||
|
||||
[ +inlined+ ] [ \ foldable-test-2 \ foldable-test-1 compiled-usage at ] unit-test
|
||||
|
||||
[ 3 ] [ foldable-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : foldable-test-1 4 ; foldable" eval ] unit-test
|
||||
|
||||
[ 4 ] [ foldable-test-2 ] unit-test
|
||||
|
||||
DEFER: flushable-test-2
|
||||
|
||||
[ ] [ "IN: temporary USE: kernel : flushable-test-1 drop 3 ; flushable" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: kernel : flushable-test-2 V{ } dup flushable-test-1 drop ;" eval ] unit-test
|
||||
|
||||
[ V{ } ] [ flushable-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USING: kernel sequences ; : flushable-test-1 3 over push ;" eval ] unit-test
|
||||
|
||||
[ V{ 3 } ] [ flushable-test-2 ] unit-test
|
||||
|
||||
: ax ;
|
||||
: bx ax ;
|
||||
[ \ bx forget ] with-compilation-unit
|
||||
|
||||
[ f ] [ \ bx \ ax compiled-usage key? ] unit-test
|
||||
|
||||
DEFER: defer-redefine-test-2
|
||||
|
||||
[ ] [ "IN: temporary DEFER: defer-redefine-test-1" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test
|
||||
|
||||
[ defer-redefine-test-2 ] must-fail
|
||||
|
||||
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
|
||||
|
||||
[ 2 1 ] [ defer-redefine-test-2 ] unit-test
|
||||
|
||||
! Cross-referencing issue
|
||||
: compiled-xref-a ;
|
||||
|
||||
: compiled-xref-c ; inline
|
||||
|
||||
GENERIC: compiled-xref-b ( a -- b )
|
||||
|
||||
TUPLE: c-1 ;
|
||||
|
||||
M: c-1 compiled-xref-b compiled-xref-a compiled-xref-c ;
|
||||
|
||||
TUPLE: c-2 ;
|
||||
|
||||
M: c-2 compiled-xref-b drop 3 ;
|
||||
|
||||
[ t ] [
|
||||
\ compiled-xref-a compiled-crossref get key?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
\ compiled-xref-a forget
|
||||
] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
\ compiled-xref-a compiled-crossref get key?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: temporary : compiled-xref-c ; FORGET: { c-2 compiled-xref-b }" eval
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
\ compiled-xref-a compiled-crossref get key?
|
||||
] unit-test
|
||||
|
|
@ -96,6 +96,9 @@ TUPLE: no-parent-directory path ;
|
|||
: ?resource-path ( path -- newpath )
|
||||
"resource:" ?head [ resource-path ] when ;
|
||||
|
||||
: resource-exists? ( path -- ? )
|
||||
?resource-path exists? ;
|
||||
|
||||
: make-directories ( path -- )
|
||||
normalize-pathname right-trim-separators {
|
||||
{ [ dup "." = ] [ ] }
|
||||
|
|
|
|||
|
|
@ -4,11 +4,8 @@ USING: kernel namespaces optimizer.backend optimizer.def-use
|
|||
optimizer.known-words optimizer.math inference.class ;
|
||||
IN: optimizer
|
||||
|
||||
SYMBOL: optimize-count
|
||||
|
||||
: optimize-1 ( node -- newnode ? )
|
||||
[
|
||||
global [ optimize-count inc ] bind
|
||||
H{ } clone class-substitutions set
|
||||
H{ } clone literal-substitutions set
|
||||
H{ } clone value-substitutions set
|
||||
|
|
|
|||
|
|
@ -479,7 +479,7 @@ SYMBOL: interactive-vocabs
|
|||
[ [ parse-file call ] keep ] assert-depth drop ;
|
||||
|
||||
: ?run-file ( path -- )
|
||||
dup ?resource-path exists? [ run-file ] [ drop ] if ;
|
||||
dup resource-exists? [ run-file ] [ drop ] if ;
|
||||
|
||||
: bootstrap-file ( path -- )
|
||||
[ parse-file % ] [ run-file ] if-bootstrapping ;
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ uses definitions ;
|
|||
rot source-file-checksum
|
||||
(source-modified?)
|
||||
] [
|
||||
?resource-path exists?
|
||||
resource-exists?
|
||||
] ?if ;
|
||||
|
||||
: record-modified ( source-file -- )
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Eduardo Cavazos, Slava Pestov.
|
||||
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces splitting sequences io.files kernel assocs
|
||||
words vocabs definitions parser continuations inspector debugger
|
||||
|
|
@ -15,45 +15,59 @@ V{
|
|||
"resource:work"
|
||||
} clone vocab-roots set-global
|
||||
|
||||
! No such thing as current directory on Windows CE
|
||||
wince? [ "." vocab-roots get push ] unless
|
||||
: vocab-dir ( vocab -- dir )
|
||||
vocab-name "." split "/" join ;
|
||||
|
||||
: vocab-dir+ ( vocab str/f -- path )
|
||||
>r vocab-name "." split r>
|
||||
[ >r dup peek r> append add ] when*
|
||||
"/" join ;
|
||||
|
||||
: vocab-dir ( vocab -- dir )
|
||||
f vocab-dir+ ;
|
||||
: vocab-path+ ( vocab path -- newpath )
|
||||
swap vocab-root dup [ swap path+ ] [ 2drop f ] if ;
|
||||
|
||||
: vocab-source ( vocab -- path )
|
||||
".factor" vocab-dir+ ;
|
||||
: vocab-source-path ( vocab -- path/f )
|
||||
dup ".factor" vocab-dir+ vocab-path+ ;
|
||||
|
||||
: vocab-docs ( vocab -- path )
|
||||
"-docs.factor" vocab-dir+ ;
|
||||
: vocab-docs-path ( vocab -- path/f )
|
||||
dup "-docs.factor" vocab-dir+ vocab-path+ ;
|
||||
|
||||
: vocab-tests ( vocab -- path )
|
||||
"-tests.factor" vocab-dir+ ;
|
||||
: vocab-dir? ( root name -- ? )
|
||||
over [
|
||||
".factor" vocab-dir+ path+ resource-exists?
|
||||
] [
|
||||
2drop f
|
||||
] if ;
|
||||
|
||||
: find-vocab-root ( vocab -- path/f )
|
||||
vocab-dir vocab-roots get
|
||||
swap [ path+ ?resource-path exists? ] curry find nip ;
|
||||
vocab-roots get swap [ vocab-dir? ] curry find nip ;
|
||||
|
||||
M: string vocab-root
|
||||
dup vocab [ vocab-root ] [ find-vocab-root ] ?if ;
|
||||
|
||||
M: vocab-link vocab-root
|
||||
dup vocab-link-root [ ] [ vocab-link-name vocab-root ] ?if ;
|
||||
vocab-link-root ;
|
||||
|
||||
: vocab-tests ( vocab -- tests )
|
||||
dup vocab-root [
|
||||
[
|
||||
f >vocab-link dup
|
||||
|
||||
dup "-tests.factor" vocab-dir+ vocab-path+
|
||||
dup resource-exists? [ , ] [ drop ] if
|
||||
|
||||
dup vocab-dir "test" path+ vocab-path+ dup
|
||||
?resource-path directory keys [ ".factor" tail? ] subset
|
||||
[ path+ , ] with each
|
||||
] { } make
|
||||
] [ drop f ] if ;
|
||||
|
||||
: vocab-files ( vocab -- seq )
|
||||
[
|
||||
dup vocab-root dup [
|
||||
swap
|
||||
2dup vocab-source path+ ,
|
||||
2dup vocab-docs path+ ,
|
||||
2dup vocab-tests path+ ,
|
||||
] when 2drop
|
||||
] { } make [ ?resource-path exists? ] subset ;
|
||||
f >vocab-link [
|
||||
dup vocab-source-path [ , ] when*
|
||||
dup vocab-docs-path [ , ] when*
|
||||
vocab-tests %
|
||||
] { } make ;
|
||||
|
||||
TUPLE: no-vocab name ;
|
||||
|
||||
|
|
@ -67,42 +81,36 @@ SYMBOL: load-help?
|
|||
|
||||
: source-wasn't-loaded f swap set-vocab-source-loaded? ;
|
||||
|
||||
: load-source ( root name -- )
|
||||
: load-source ( vocab-link -- )
|
||||
[ source-wasn't-loaded ] keep
|
||||
[ vocab-source path+ bootstrap-file ] keep
|
||||
[ vocab-source-path bootstrap-file ] keep
|
||||
source-was-loaded ;
|
||||
|
||||
: docs-were-loaded t swap set-vocab-docs-loaded? ;
|
||||
|
||||
: docs-weren't-loaded f swap set-vocab-docs-loaded? ;
|
||||
|
||||
: load-docs ( root name -- )
|
||||
: load-docs ( vocab-link -- )
|
||||
load-help? get [
|
||||
[ docs-weren't-loaded ] keep
|
||||
[ vocab-docs path+ ?run-file ] keep
|
||||
[ vocab-docs-path ?run-file ] keep
|
||||
docs-were-loaded
|
||||
] [ 2drop ] if ;
|
||||
] [ drop ] if ;
|
||||
|
||||
: amend-vocab-from-root ( root name -- vocab )
|
||||
dup vocab-source-loaded? [ 2dup load-source ] unless
|
||||
dup vocab-docs-loaded? [ 2dup load-docs ] unless
|
||||
nip vocab ;
|
||||
|
||||
: load-vocab-from-root ( root name -- )
|
||||
2dup vocab-source path+ ?resource-path exists? [
|
||||
2dup create-vocab set-vocab-root
|
||||
2dup load-source load-docs
|
||||
] [
|
||||
nip no-vocab
|
||||
] if ;
|
||||
: create-vocab-with-root ( vocab-link -- vocab )
|
||||
dup vocab-name create-vocab
|
||||
swap vocab-root over set-vocab-root ;
|
||||
|
||||
: reload ( name -- )
|
||||
[
|
||||
dup find-vocab-root dup [
|
||||
swap load-vocab-from-root
|
||||
] [
|
||||
drop no-vocab
|
||||
] if
|
||||
f >vocab-link
|
||||
dup vocab-root [
|
||||
dup vocab-source-path resource-exists? [
|
||||
create-vocab-with-root
|
||||
dup load-source
|
||||
load-docs
|
||||
] [ no-vocab ] if
|
||||
] [ no-vocab ] if
|
||||
] with-compiler-errors ;
|
||||
|
||||
: require ( vocab -- )
|
||||
|
|
@ -122,18 +130,6 @@ SYMBOL: load-help?
|
|||
[ nip ] assoc-subset
|
||||
[ nip source-modified? ] assoc-subset keys ; inline
|
||||
|
||||
: vocab-path+ ( vocab path -- newpath )
|
||||
swap vocab-root dup [ swap path+ ] [ 2drop f ] if ;
|
||||
|
||||
: vocab-source-path ( vocab -- path/f )
|
||||
dup vocab-source vocab-path+ ;
|
||||
|
||||
: vocab-tests-path ( vocab -- path/f )
|
||||
dup vocab-tests vocab-path+ ;
|
||||
|
||||
: vocab-docs-path ( vocab -- path/f )
|
||||
dup vocab-docs vocab-path+ ;
|
||||
|
||||
: modified-sources ( vocabs -- seq )
|
||||
[ vocab-source-path ] modified ;
|
||||
|
||||
|
|
@ -151,7 +147,7 @@ SYMBOL: load-help?
|
|||
: vocab-heading. ( vocab -- )
|
||||
nl
|
||||
"==== " write
|
||||
dup vocab-name swap f >vocab-link write-object ":" print
|
||||
dup vocab-name swap vocab write-object ":" print
|
||||
nl ;
|
||||
|
||||
: load-error. ( triple -- )
|
||||
|
|
@ -187,8 +183,10 @@ SYMBOL: load-help?
|
|||
GENERIC: (load-vocab) ( name -- vocab )
|
||||
|
||||
M: vocab (load-vocab)
|
||||
dup vocab-root
|
||||
[ swap vocab-name amend-vocab-from-root ] when* ;
|
||||
dup vocab-root [
|
||||
dup vocab-source-loaded? [ dup load-source ] unless
|
||||
dup vocab-docs-loaded? [ dup load-docs ] unless
|
||||
] when ;
|
||||
|
||||
M: string (load-vocab)
|
||||
[ ".private" ?tail drop reload ] keep vocab ;
|
||||
|
|
|
|||
|
|
@ -96,8 +96,16 @@ M: vocab-link hashcode*
|
|||
|
||||
M: vocab-link vocab-name vocab-link-name ;
|
||||
|
||||
: >vocab-link ( name root -- vocab )
|
||||
over vocab dup [ 2nip ] [ drop <vocab-link> ] if ;
|
||||
GENERIC# >vocab-link 1 ( name root -- vocab )
|
||||
|
||||
M: vocab >vocab-link drop ;
|
||||
|
||||
M: vocab-link >vocab-link drop ;
|
||||
|
||||
M: string >vocab-link
|
||||
over vocab dup [ 2nip ] [
|
||||
drop [ dup vocab-root ] unless* <vocab-link>
|
||||
] if ;
|
||||
|
||||
UNION: vocab-spec vocab vocab-link ;
|
||||
|
||||
|
|
|
|||
|
|
@ -189,7 +189,7 @@ SYMBOL: model
|
|||
swap [ render-template ] with-slots ;
|
||||
|
||||
: browse-webapp-source ( vocab -- )
|
||||
<a f >vocab-link browser-link-href =href a>
|
||||
<a vocab browser-link-href =href a>
|
||||
"Browse source" write
|
||||
</a> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -72,13 +72,6 @@ M: vocab-link summary vocab-summary ;
|
|||
: set-vocab-authors ( authors vocab -- )
|
||||
dup vocab-authors-path set-vocab-file-contents ;
|
||||
|
||||
: vocab-dir? ( root name -- ? )
|
||||
over [
|
||||
vocab-source path+ ?resource-path exists?
|
||||
] [
|
||||
2drop f
|
||||
] if ;
|
||||
|
||||
: subdirs ( dir -- dirs )
|
||||
directory [ second ] subset keys natural-sort ;
|
||||
|
||||
|
|
@ -96,10 +89,8 @@ M: vocab-link summary vocab-summary ;
|
|||
vocabs-in-dir
|
||||
] with each ;
|
||||
|
||||
: sane-vocab-roots "." vocab-roots get remove ;
|
||||
|
||||
: all-vocabs ( -- assoc )
|
||||
sane-vocab-roots [
|
||||
vocab-roots get [
|
||||
dup [ "" vocabs-in-dir ] { } make
|
||||
] { } map>assoc ;
|
||||
|
||||
|
|
@ -153,9 +144,9 @@ MEMO: all-vocabs-seq ( -- seq )
|
|||
[ vocab ] map ;
|
||||
|
||||
: all-child-vocabs ( prefix -- assoc )
|
||||
sane-vocab-roots [
|
||||
dup pick dupd (all-child-vocabs)
|
||||
[ swap >vocab-link ] with map
|
||||
vocab-roots get [
|
||||
over dupd dupd (all-child-vocabs)
|
||||
swap [ >vocab-link ] curry map
|
||||
] { } map>assoc
|
||||
f rot unrooted-child-vocabs 2array add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -36,7 +36,12 @@ ARTICLE: "tools.test" "Unit testing"
|
|||
$nl
|
||||
"For example, if you were developing a word for computing symbolic derivatives, your unit tests would apply the word to certain input functions, comparing the results against the correct values. While the passing of these tests would not guarantee the algorithm is correct, it would at least ensure that what used to work keeps working, in that as soon as something breaks due to a change in another part of your program, failing tests will let you know."
|
||||
$nl
|
||||
"Unit tests for a vocabulary are placed in test files, named " { $snippet { $emphasis "vocab" } "-tests.factor" } " alongside " { $snippet { $emphasis "vocab" } ".factor" } "; see " { $link "vocabs.loader" } " for details."
|
||||
"Unit tests for a vocabulary are placed in test files in the same directory as the vocabulary source file (see " { $link "vocabs.loader" } "). Two possibilities are supported:"
|
||||
{ $list
|
||||
{ "Tests can be placed in a file named " { $snippet { $emphasis "vocab" } "-tests.factor" } "." }
|
||||
{ "Tests can be placed in files in the " { $snippet "test" } " subdirectory." }
|
||||
}
|
||||
"The latter is used for vocabularies with more extensive test suites."
|
||||
$nl
|
||||
"If the test harness needs to define words, they should be placed in the " { $snippet "temporary" } " vocabulary so that they can be forgotten after the tests have been run."
|
||||
{ $subsection "tools.test.write" }
|
||||
|
|
|
|||
|
|
@ -53,18 +53,12 @@ SYMBOL: this-test
|
|||
|
||||
: (run-test) ( vocab -- )
|
||||
dup vocab-source-loaded? [
|
||||
vocab-tests-path dup [
|
||||
dup ?resource-path exists? [
|
||||
[
|
||||
"temporary" forget-vocab
|
||||
] with-compilation-unit
|
||||
dup run-file
|
||||
[
|
||||
dup forget-source
|
||||
"temporary" forget-vocab
|
||||
] with-compilation-unit
|
||||
] when
|
||||
] when
|
||||
[ "temporary" forget-vocab ] with-compilation-unit
|
||||
vocab-tests dup [ run-file ] each
|
||||
[
|
||||
dup [ forget-source ] each
|
||||
"temporary" forget-vocab
|
||||
] with-compilation-unit
|
||||
] when drop ;
|
||||
|
||||
: run-test ( vocab -- failures )
|
||||
|
|
|
|||
Loading…
Reference in New Issue