From 262e9d3443ec9a6f00c6d82f2fd24e5e131917ce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 10 Feb 2008 23:03:54 -0600 Subject: [PATCH] Clean up vocabs.loader and add littledan's unit test feature --- core/bootstrap/stage1.factor | 2 +- .../curry-tests.factor => curry.factor} | 0 core/compiler/test/curry/curry.factor | 0 .../float-tests.factor => float.factor} | 0 core/compiler/test/float/float.factor | 0 ...rinsics-tests.factor => intrinsics.factor} | 0 .../test/intrinsics/intrinsics.factor | 0 .../test/redefine/redefine-tests.factor | 287 ------------------ core/compiler/test/redefine/redefine.factor | 0 .../simple-tests.factor => simple.factor} | 0 core/compiler/test/simple/simple.factor | 0 ...-trace-tests.factor => stack-trace.factor} | 0 .../test/stack-trace/stack-trace.factor | 0 ...ly-tests.factor => templates-early.factor} | 0 .../templates-early/templates-early.factor | 0 ...emplates-tests.factor => templates.factor} | 0 core/compiler/test/templates/templates.factor | 0 .../tuples-tests.factor => tuples.factor} | 0 core/compiler/test/tuples/tuples.factor | 0 core/io/files/files.factor | 3 + core/optimizer/optimizer.factor | 3 - core/parser/parser.factor | 2 +- core/source-files/source-files.factor | 2 +- core/vocabs/loader/loader.factor | 116 ++++--- core/vocabs/vocabs.factor | 12 +- extra/furnace/furnace.factor | 2 +- extra/tools/browser/browser.factor | 17 +- extra/tools/test/test-docs.factor | 7 +- extra/tools/test/test.factor | 18 +- 29 files changed, 90 insertions(+), 381 deletions(-) rename core/compiler/test/{curry/curry-tests.factor => curry.factor} (100%) delete mode 100644 core/compiler/test/curry/curry.factor rename core/compiler/test/{float/float-tests.factor => float.factor} (100%) delete mode 100644 core/compiler/test/float/float.factor rename core/compiler/test/{intrinsics/intrinsics-tests.factor => intrinsics.factor} (100%) delete mode 100644 core/compiler/test/intrinsics/intrinsics.factor delete mode 100755 core/compiler/test/redefine/redefine-tests.factor delete mode 100644 core/compiler/test/redefine/redefine.factor rename core/compiler/test/{simple/simple-tests.factor => simple.factor} (100%) delete mode 100644 core/compiler/test/simple/simple.factor rename core/compiler/test/{stack-trace/stack-trace-tests.factor => stack-trace.factor} (100%) delete mode 100644 core/compiler/test/stack-trace/stack-trace.factor rename core/compiler/test/{templates-early/templates-early-tests.factor => templates-early.factor} (100%) delete mode 100644 core/compiler/test/templates-early/templates-early.factor rename core/compiler/test/{templates/templates-tests.factor => templates.factor} (100%) delete mode 100644 core/compiler/test/templates/templates.factor rename core/compiler/test/{tuples/tuples-tests.factor => tuples.factor} (100%) delete mode 100644 core/compiler/test/tuples/tuples.factor mode change 100644 => 100755 extra/furnace/furnace.factor diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index cc328e9760..4f5bf6d69e 100755 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -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 diff --git a/core/compiler/test/curry/curry-tests.factor b/core/compiler/test/curry.factor similarity index 100% rename from core/compiler/test/curry/curry-tests.factor rename to core/compiler/test/curry.factor diff --git a/core/compiler/test/curry/curry.factor b/core/compiler/test/curry/curry.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/float/float-tests.factor b/core/compiler/test/float.factor similarity index 100% rename from core/compiler/test/float/float-tests.factor rename to core/compiler/test/float.factor diff --git a/core/compiler/test/float/float.factor b/core/compiler/test/float/float.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/intrinsics/intrinsics-tests.factor b/core/compiler/test/intrinsics.factor similarity index 100% rename from core/compiler/test/intrinsics/intrinsics-tests.factor rename to core/compiler/test/intrinsics.factor diff --git a/core/compiler/test/intrinsics/intrinsics.factor b/core/compiler/test/intrinsics/intrinsics.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/redefine/redefine-tests.factor b/core/compiler/test/redefine/redefine-tests.factor deleted file mode 100755 index 9eaf2d1263..0000000000 --- a/core/compiler/test/redefine/redefine-tests.factor +++ /dev/null @@ -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 ) >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 diff --git a/core/compiler/test/redefine/redefine.factor b/core/compiler/test/redefine/redefine.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/simple/simple-tests.factor b/core/compiler/test/simple.factor similarity index 100% rename from core/compiler/test/simple/simple-tests.factor rename to core/compiler/test/simple.factor diff --git a/core/compiler/test/simple/simple.factor b/core/compiler/test/simple/simple.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/stack-trace/stack-trace-tests.factor b/core/compiler/test/stack-trace.factor similarity index 100% rename from core/compiler/test/stack-trace/stack-trace-tests.factor rename to core/compiler/test/stack-trace.factor diff --git a/core/compiler/test/stack-trace/stack-trace.factor b/core/compiler/test/stack-trace/stack-trace.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/templates-early/templates-early-tests.factor b/core/compiler/test/templates-early.factor similarity index 100% rename from core/compiler/test/templates-early/templates-early-tests.factor rename to core/compiler/test/templates-early.factor diff --git a/core/compiler/test/templates-early/templates-early.factor b/core/compiler/test/templates-early/templates-early.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/templates/templates-tests.factor b/core/compiler/test/templates.factor similarity index 100% rename from core/compiler/test/templates/templates-tests.factor rename to core/compiler/test/templates.factor diff --git a/core/compiler/test/templates/templates.factor b/core/compiler/test/templates/templates.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/compiler/test/tuples/tuples-tests.factor b/core/compiler/test/tuples.factor similarity index 100% rename from core/compiler/test/tuples/tuples-tests.factor rename to core/compiler/test/tuples.factor diff --git a/core/compiler/test/tuples/tuples.factor b/core/compiler/test/tuples/tuples.factor deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 79b59cc364..aa9f8686ce 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -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 "." = ] [ ] } diff --git a/core/optimizer/optimizer.factor b/core/optimizer/optimizer.factor index 1674ecd782..1debf6c8cc 100755 --- a/core/optimizer/optimizer.factor +++ b/core/optimizer/optimizer.factor @@ -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 diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 486c589134..7dee5e2212 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -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 ; diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 7ddf6f02c0..c7539ad3eb 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -26,7 +26,7 @@ uses definitions ; rot source-file-checksum (source-modified?) ] [ - ?resource-path exists? + resource-exists? ] ?if ; : record-modified ( source-file -- ) diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index a1276341b3..ea3023a4f8 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -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 ; diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 8db65e2eac..0717a6729c 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -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 ] 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* + ] if ; UNION: vocab-spec vocab vocab-link ; diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor old mode 100644 new mode 100755 index 80419e9c8d..9b7a8a8aa5 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -189,7 +189,7 @@ SYMBOL: model swap [ render-template ] with-slots ; : browse-webapp-source ( vocab -- ) - vocab-link browser-link-href =href a> + "Browse source" write ; diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index ae1901ff66..b91a6177b8 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -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 ; diff --git a/extra/tools/test/test-docs.factor b/extra/tools/test/test-docs.factor index b756f9279e..ac561100f8 100755 --- a/extra/tools/test/test-docs.factor +++ b/extra/tools/test/test-docs.factor @@ -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" } diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index 5673e41c62..62a4dab1eb 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -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 )