From b08409884e72dc4879942a23c56c10167cf5695f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 Feb 2008 18:03:01 -0600 Subject: [PATCH 1/2] Add try-everything for Ed --- core/vocabs/loader/loader-docs.factor | 5 ---- core/vocabs/loader/loader.factor | 34 +++++++++------------------ extra/tools/browser/browser.factor | 14 ++++++++--- extra/tools/test/test-docs.factor | 2 +- extra/tools/test/test.factor | 6 ++--- 5 files changed, 26 insertions(+), 35 deletions(-) diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index f8626f3370..379b300eaa 100755 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -124,11 +124,6 @@ HELP: refresh { $values { "prefix" string } } { $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ; -HELP: require-all-error -{ $values { "vocabs" "a sequence of vocabularies" } } -{ $description "Throws a " { $link require-all-error } "." } -{ $error-description "Thrown by " { $link require-all } " if one or more vocabulary failed to load." } ; - HELP: refresh-all { $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 352ef9fe02..4fcb74df66 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -160,37 +160,25 @@ SYMBOL: load-help? drop ; ! third "Traceback" swap write-object ; -TUPLE: require-all-error vocabs ; +: load-failures. ( failures -- ) + [ load-error. nl ] each ; -: require-all-error ( vocabs -- ) - [ vocab-name ] map - \ require-all-error construct-boa throw ; - -M: require-all-error summary - drop "The require-all operation failed" ; - -: require-all ( vocabs -- ) - dup length 1 = [ first require ] [ +: require-all ( vocabs -- failures ) + [ [ [ - [ - [ require ] - [ error-continuation get 3array , ] - recover - ] each - ] { } make - dup empty? [ drop ] [ - dup [ load-error. nl ] each - keys require-all-error - ] if - ] with-compiler-errors - ] if ; + [ require ] + [ error-continuation get 3array , ] + recover + ] each + ] { } make + ] with-compiler-errors ; : do-refresh ( modified-sources modified-docs -- ) 2dup [ f swap set-vocab-docs-loaded? ] each [ f swap set-vocab-source-loaded? ] each - append prune require-all ; + append prune require-all drop ; : refresh ( prefix -- ) to-refresh do-refresh ; diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index 48de69b025..87b4ba9939 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -132,11 +132,17 @@ MEMO: all-vocabs-seq ( -- seq ) { [ t ] [ f ] } } cond nip ; -: load-everything ( -- ) +: filter-dangerous ( seq -- seq' ) + [ vocab-name dangerous? not ] subset ; + +: try-everything ( -- failures ) all-vocabs-seq - [ vocab-name dangerous? not ] subset + filter-dangerous require-all ; +: load-everything ( -- ) + try-everything drop ; + : unrooted-child-vocabs ( prefix -- seq ) dup empty? [ CHAR: . add ] unless vocabs @@ -155,7 +161,9 @@ MEMO: all-vocabs-seq ( -- seq ) : load-children ( prefix -- ) all-child-vocabs values concat - require-all ; + filter-dangerous + require-all + drop ; : vocab-status-string ( vocab -- string ) { diff --git a/extra/tools/test/test-docs.factor b/extra/tools/test/test-docs.factor index c027073398..b756f9279e 100755 --- a/extra/tools/test/test-docs.factor +++ b/extra/tools/test/test-docs.factor @@ -29,7 +29,7 @@ $nl { $subsection run-tests } { $subsection run-all-tests } "The following word prints failures:" -{ $subsection failures. } ; +{ $subsection test-failures. } ; ARTICLE: "tools.test" "Unit testing" "A unit test is a piece of code which starts with known input values, then compares the output of a word with an expected output, where the expected output is defined by the word's contract." diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index 0b1a495e90..192a248161 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -80,7 +80,7 @@ M: expected-error summary dup first print-error "Traceback" swap third write-object ; -: failures. ( assoc -- ) +: test-failures. ( assoc -- ) dup [ nl dup empty? [ @@ -104,10 +104,10 @@ M: expected-error summary ] if ; : test ( prefix -- ) - run-tests failures. ; + run-tests test-failures. ; : run-all-tests ( prefix -- failures ) "" run-tests ; : test-all ( -- ) - run-all-tests failures. ; + run-all-tests test-failures. ; From 6bbbd3f9043a4162ce70e11acf3a3afc88bda7c9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 Feb 2008 18:06:53 -0600 Subject: [PATCH 2/2] Forgot to call load-failures. --- core/vocabs/loader/loader.factor | 2 +- extra/tools/browser/browser.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 4fcb74df66..a1276341b3 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -178,7 +178,7 @@ SYMBOL: load-help? 2dup [ f swap set-vocab-docs-loaded? ] each [ f swap set-vocab-source-loaded? ] each - append prune require-all drop ; + append prune require-all load-failures. ; : refresh ( prefix -- ) to-refresh do-refresh ; diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index 87b4ba9939..ae1901ff66 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -163,7 +163,7 @@ MEMO: all-vocabs-seq ( -- seq ) all-child-vocabs values concat filter-dangerous require-all - drop ; + load-failures. ; : vocab-status-string ( vocab -- string ) {