From 531961f3526e5351894e6844ddc74c35a1910d5a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 13 Apr 2010 18:43:33 -0700
Subject: [PATCH] load-all now skips vocabs tagged 'not loaded', and test-all
 skips vocabs tagged 'not tested'

---
 basis/tools/test/test.factor            | 20 +++++++++++---------
 basis/vocabs/hierarchy/hierarchy.factor |  5 +----
 basis/vocabs/metadata/metadata.factor   | 13 +++++++++++--
 3 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor
index f3f53e43b7..95f1ad8e2c 100644
--- a/basis/tools/test/test.factor
+++ b/basis/tools/test/test.factor
@@ -2,11 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators compiler.units
 continuations debugger effects fry generalizations io io.files
-io.styles kernel lexer locals macros math.parser namespaces parser
-vocabs.parser prettyprint quotations sequences source-files splitting
-stack-checker summary unicode.case vectors vocabs vocabs.loader
-vocabs.files words tools.errors source-files.errors io.streams.string
-make compiler.errors ;
+io.styles kernel lexer locals macros math.parser namespaces
+parser vocabs.parser prettyprint quotations sequences
+source-files splitting stack-checker summary unicode.case
+vectors vocabs vocabs.loader vocabs.files vocabs.metadata words
+tools.errors source-files.errors io.streams.string make
+compiler.errors ;
 IN: tools.test
 
 TUPLE: test-failure < source-file-error continuation ;
@@ -126,7 +127,7 @@ SYMBOL: forget-tests?
     forget-tests? get
     [ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
 
-: run-vocab-tests ( vocab -- )
+: test-vocab ( vocab -- )
     vocab dup [
         dup source-loaded?>> [
             vocab-tests
@@ -136,6 +137,8 @@ SYMBOL: forget-tests?
         ] [ drop ] if
     ] [ drop ] if ;
 
+: test-vocabs ( vocabs -- ) [ test-vocab ] each ;
+
 PRIVATE>
 
 TEST: unit-test
@@ -154,7 +157,6 @@ M: test-failure error. ( error -- )
 
 : :test-failures ( -- ) test-failures get errors. ;
 
-: test ( prefix -- )
-    child-vocabs [ run-vocab-tests ] each ;
+: test ( prefix -- ) child-vocabs test-vocabs ;
 
-: test-all ( -- ) "" test ;
+: test-all ( -- ) vocabs filter-don't-test test-vocabs ;
diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor
index 986091a543..609d485f0c 100644
--- a/basis/vocabs/hierarchy/hierarchy.factor
+++ b/basis/vocabs/hierarchy/hierarchy.factor
@@ -97,9 +97,6 @@ MEMO: all-vocabs-recursive ( -- assoc )
 
 <PRIVATE
 
-: filter-unportable ( seq -- seq' )
-    [ vocab-name unportable? not ] filter ;
-
 : collect-vocabs ( quot -- seq )
     [ all-vocabs-recursive no-roots no-prefixes ] dip
     gather natural-sort ; inline
@@ -109,7 +106,7 @@ PRIVATE>
 : (load) ( prefix -- failures )
     [ child-vocabs-recursive no-roots no-prefixes ]
     [ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi
-    filter-unportable
+    filter-don't-load
     require-all ;
 
 : load ( prefix -- )
diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor
index 5048b0edd0..bb14581f0d 100644
--- a/basis/vocabs/metadata/metadata.factor
+++ b/basis/vocabs/metadata/metadata.factor
@@ -103,12 +103,21 @@ ERROR: bad-platform name ;
 : supported-platform? ( platforms -- ? )
     [ t ] [ [ os swap class<= ] any? ] if-empty ;
 
-: unportable? ( vocab -- ? )
+: don't-load? ( vocab -- ? )
     {
-        [ vocab-tags "untested" swap member? ]
+        [ vocab-tags "not loaded" swap member? ]
         [ vocab-platforms supported-platform? not ]
     } 1|| ;
 
+: filter-don't-load ( vocabs -- vocabs' )
+    [ vocab-name don't-load? not ] filter ;
+
+: don't-test? ( vocab -- ? )
+    vocab-tags "not tested" swap member? ;
+
+: filter-don't-test ( vocabs -- vocabs' )
+    [ don't-test? not ] filter ;
+
 TUPLE: unsupported-platform vocab requires ;
 
 : unsupported-platform ( vocab requires -- )