diff --git a/basis/bootstrap/compiler/timing/tags.txt b/basis/bootstrap/compiler/timing/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/bootstrap/compiler/timing/tags.txt +++ b/basis/bootstrap/compiler/timing/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/compiler/tests/redefine23.factor b/basis/compiler/tests/redefine23.factor index e6061937b6..dafdc2d1af 100644 --- a/basis/compiler/tests/redefine23.factor +++ b/basis/compiler/tests/redefine23.factor @@ -1,6 +1,7 @@ IN: compiler.tests.redefine23 USING: classes.struct specialized-arrays alien.c-types sequences compiler.units vocabs tools.test ; +FROM: specialized-arrays.private => specialized-array-vocab ; STRUCT: my-struct { x int } ; SPECIALIZED-ARRAY: my-struct @@ -8,6 +9,6 @@ SPECIALIZED-ARRAY: my-struct [ ] [ [ - "specialized-arrays.instances.compiler.tests.redefine23" forget-vocab + my-struct specialized-array-vocab forget-vocab ] with-compilation-unit ] unit-test diff --git a/basis/cpu/ppc/linux/tags.txt b/basis/cpu/ppc/linux/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/cpu/ppc/linux/tags.txt +++ b/basis/cpu/ppc/linux/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/cpu/ppc/macosx/tags.txt b/basis/cpu/ppc/macosx/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/cpu/ppc/macosx/tags.txt +++ b/basis/cpu/ppc/macosx/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/cpu/ppc/tags.txt b/basis/cpu/ppc/tags.txt index 6c8f59c757..f5bb856b53 100644 --- a/basis/cpu/ppc/tags.txt +++ b/basis/cpu/ppc/tags.txt @@ -1,2 +1,2 @@ compiler -untested +not loaded diff --git a/basis/cpu/x86/32/tags.txt b/basis/cpu/x86/32/tags.txt index 50dfc5156e..44629a5876 100644 --- a/basis/cpu/x86/32/tags.txt +++ b/basis/cpu/x86/32/tags.txt @@ -1,2 +1,2 @@ -untested +not loaded compiler diff --git a/basis/cpu/x86/64/tags.txt b/basis/cpu/x86/64/tags.txt index 50dfc5156e..44629a5876 100644 --- a/basis/cpu/x86/64/tags.txt +++ b/basis/cpu/x86/64/tags.txt @@ -1,2 +1,2 @@ -untested +not loaded compiler diff --git a/basis/cpu/x86/64/unix/tags.txt b/basis/cpu/x86/64/unix/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/cpu/x86/64/unix/tags.txt +++ b/basis/cpu/x86/64/unix/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/cpu/x86/64/winnt/tags.txt b/basis/cpu/x86/64/winnt/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/cpu/x86/64/winnt/tags.txt +++ b/basis/cpu/x86/64/winnt/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/cpu/x86/features/tags.txt b/basis/cpu/x86/features/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/cpu/x86/features/tags.txt +++ b/basis/cpu/x86/features/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/cpu/x86/tags.txt b/basis/cpu/x86/tags.txt index 50dfc5156e..44629a5876 100644 --- a/basis/cpu/x86/tags.txt +++ b/basis/cpu/x86/tags.txt @@ -1,2 +1,2 @@ -untested +not loaded compiler diff --git a/basis/editors/editpadlite/tags.txt b/basis/editors/editpadlite/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/editpadlite/tags.txt +++ b/basis/editors/editpadlite/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/editpadpro/tags.txt b/basis/editors/editpadpro/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/editpadpro/tags.txt +++ b/basis/editors/editpadpro/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/editplus/tags.txt b/basis/editors/editplus/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/editplus/tags.txt +++ b/basis/editors/editplus/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/emacs/tags.txt b/basis/editors/emacs/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/emacs/tags.txt +++ b/basis/editors/emacs/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/emacs/windows/tags.txt b/basis/editors/emacs/windows/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/emacs/windows/tags.txt +++ b/basis/editors/emacs/windows/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/emeditor/tags.txt b/basis/editors/emeditor/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/emeditor/tags.txt +++ b/basis/editors/emeditor/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/etexteditor/tags.txt b/basis/editors/etexteditor/tags.txt index 5d77766703..ebb74b4d5f 100755 --- a/basis/editors/etexteditor/tags.txt +++ b/basis/editors/etexteditor/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/gedit/tags.txt b/basis/editors/gedit/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/gedit/tags.txt +++ b/basis/editors/gedit/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/gvim/tags.txt b/basis/editors/gvim/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/gvim/tags.txt +++ b/basis/editors/gvim/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/gvim/unix/tags.txt b/basis/editors/gvim/unix/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/gvim/unix/tags.txt +++ b/basis/editors/gvim/unix/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/gvim/windows/tags.txt b/basis/editors/gvim/windows/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/gvim/windows/tags.txt +++ b/basis/editors/gvim/windows/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/jedit/tags.txt b/basis/editors/jedit/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/jedit/tags.txt +++ b/basis/editors/jedit/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/macvim/tags.txt b/basis/editors/macvim/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/macvim/tags.txt +++ b/basis/editors/macvim/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/notepad/tags.txt b/basis/editors/notepad/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/notepad/tags.txt +++ b/basis/editors/notepad/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/notepad2/tags.txt b/basis/editors/notepad2/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/notepad2/tags.txt +++ b/basis/editors/notepad2/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/notepadpp/tags.txt b/basis/editors/notepadpp/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/notepadpp/tags.txt +++ b/basis/editors/notepadpp/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/scite/tags.txt b/basis/editors/scite/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/scite/tags.txt +++ b/basis/editors/scite/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/ted-notepad/tags.txt b/basis/editors/ted-notepad/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/ted-notepad/tags.txt +++ b/basis/editors/ted-notepad/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/textedit/tags.txt b/basis/editors/textedit/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/textedit/tags.txt +++ b/basis/editors/textedit/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/textmate/tags.txt b/basis/editors/textmate/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/textmate/tags.txt +++ b/basis/editors/textmate/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/textpad/tags.txt b/basis/editors/textpad/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/textpad/tags.txt +++ b/basis/editors/textpad/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/textwrangler/tags.txt b/basis/editors/textwrangler/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/textwrangler/tags.txt +++ b/basis/editors/textwrangler/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/ultraedit/tags.txt b/basis/editors/ultraedit/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/ultraedit/tags.txt +++ b/basis/editors/ultraedit/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/vim/generate-syntax/tags.txt b/basis/editors/vim/generate-syntax/tags.txt deleted file mode 100644 index 5d77766703..0000000000 --- a/basis/editors/vim/generate-syntax/tags.txt +++ /dev/null @@ -1 +0,0 @@ -untested diff --git a/basis/editors/vim/tags.txt b/basis/editors/vim/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/vim/tags.txt +++ b/basis/editors/vim/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/editors/wordpad/tags.txt b/basis/editors/wordpad/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/editors/wordpad/tags.txt +++ b/basis/editors/wordpad/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/furnace/recaptcha/tags.txt b/basis/furnace/recaptcha/tags.txt index c0772185a0..2b49742460 100644 --- a/basis/furnace/recaptcha/tags.txt +++ b/basis/furnace/recaptcha/tags.txt @@ -1 +1,2 @@ web +web services diff --git a/basis/math/floats/env/ppc/tags.txt b/basis/math/floats/env/ppc/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/math/floats/env/ppc/tags.txt +++ b/basis/math/floats/env/ppc/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/math/floats/env/x86/32/tags.txt b/basis/math/floats/env/x86/32/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/math/floats/env/x86/32/tags.txt +++ b/basis/math/floats/env/x86/32/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/math/floats/env/x86/64/tags.txt b/basis/math/floats/env/x86/64/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/math/floats/env/x86/64/tags.txt +++ b/basis/math/floats/env/x86/64/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/math/floats/env/x86/tags.txt b/basis/math/floats/env/x86/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/math/floats/env/x86/tags.txt +++ b/basis/math/floats/env/x86/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 6f8d503c05..77e983eefb 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: arrays effects fry vectors sequences assocs math math.order accessors kernel combinators quotations namespaces grouping locals stack-checker.state stack-checker.backend stack-checker.errors stack-checker.visitor stack-checker.values stack-checker.recursive-state ; +FROM: sequences.private => dispatch ; IN: stack-checker.branches : balanced? ( pairs -- ? ) @@ -43,10 +44,9 @@ SYMBOLS: +bottom+ +top+ ; : phi-outputs ( phi-in -- stack ) flip [ unify-values ] map ; -SYMBOL: quotations +SYMBOLS: combinator quotations ; -: simple-unbalanced-branches-error ( branches quots -- * ) - [ \ if ] 2dip swap +: simple-unbalanced-branches-error ( word quots branches -- * ) [ length [ (( ..a -- ..b )) ] replicate ] [ [ length [ "x" ] bi@ ] { } assoc>map ] bi unbalanced-branches-error ; @@ -54,9 +54,10 @@ SYMBOL: quotations : unify-branches ( ins stacks -- in phi-in phi-out ) zip [ 0 { } { } ] [ [ keys supremum ] [ ] [ balanced? ] tri - [ dupd phi-inputs dup phi-outputs ] - [ quotations get simple-unbalanced-branches-error ] - if + [ dupd phi-inputs dup phi-outputs ] [ + [ combinator get quotations get ] dip + simple-unbalanced-branches-error + ] if ] if-empty ; : branch-variable ( seq symbol -- seq ) @@ -125,13 +126,13 @@ M: curried curried/composed? drop t ; M: composed curried/composed? drop t ; M: declared-effect curried/composed? known>> curried/composed? ; -:: declare-if-effects ( -- ) - H{ } clone :> variables - V{ } clone :> branches - \ if (( ..a -- ..b )) variables branches 0 declare-effect-d - \ if (( ..a -- ..b )) variables branches 1 declare-effect-d ; +: declare-if-effects ( -- ) + H{ } clone V{ } clone + [ [ \ if (( ..a -- ..b )) ] 2dip 0 declare-effect-d ] + [ [ \ if (( ..a -- ..b )) ] 2dip 1 declare-effect-d ] 2bi ; : infer-if ( -- ) + \ if combinator set 2 literals-available? [ (infer-if) ] [ @@ -148,5 +149,6 @@ M: declared-effect curried/composed? known>> curried/composed? ; ] if ; : infer-dispatch ( -- ) + \ dispatch combinator set pop-literal nip infer-branches [ #dispatch, ] dip compute-phi-function ; diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor index 1b8bd8faed..ad4f92ced4 100644 --- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor +++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor @@ -24,7 +24,7 @@ IN: stack-checker.row-polymorphism [ with-inner-d ] 2dip (effect-here) ; inline : (diff-variable) ( diff variable vars -- diff' ) - [ at* nip ] [ '[ _ _ at - ] ] [ '[ _ _ set-at 0 ] ] 2tri if ; + [ key? ] [ '[ _ _ at - ] ] [ '[ _ _ set-at 0 ] ] 2tri if ; : (check-variable) ( actual-count declared-count variable vars -- diff ? ) [ - ] 2dip dupd '[ _ _ (diff-variable) t ] [ dup 0 <= ] if ; @@ -63,4 +63,3 @@ IN: stack-checker.row-polymorphism [ >>actual ] keep 2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables [ 2drop ] [ drop combinator-unbalanced-branches-error ] if ; - diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index ce2c03264b..351cf5cde0 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -252,6 +252,11 @@ DEFER: blah4 ! A typo { 1 0 } [ { [ ] } dispatch ] must-infer-as +! Make sure the error is correct +[ + [ { [ drop ] [ dup ] } dispatch ] infer +] [ word>> \ dispatch eq? ] must-fail-with + DEFER: inline-recursive-2 : inline-recursive-1 ( -- ) inline-recursive-2 ; : inline-recursive-2 ( -- ) inline-recursive-1 ; diff --git a/basis/tools/disassembler/gdb/tags.txt b/basis/tools/disassembler/gdb/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/tools/disassembler/gdb/tags.txt +++ b/basis/tools/disassembler/gdb/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/tools/disassembler/udis/tags.txt b/basis/tools/disassembler/udis/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/tools/disassembler/udis/tags.txt +++ b/basis/tools/disassembler/udis/tags.txt @@ -1 +1 @@ -untested +not loaded 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/ui/backend/x11/tags.txt b/basis/ui/backend/x11/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/ui/backend/x11/tags.txt +++ b/basis/ui/backend/x11/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 34a5221307..eaa947b2d6 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -66,8 +66,8 @@ M: source-file-renderer filled-column drop 1 ; [ invoke-primary-operation ] >>action COLOR: dark-gray >>column-line-color 6 >>gap - 5 >>min-rows - 5 >>max-rows + 4 >>min-rows + 4 >>max-rows 60 >>min-cols 60 >>max-cols t >>selection-required? @@ -115,8 +115,8 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ; [ invoke-primary-operation ] >>action COLOR: dark-gray >>column-line-color 6 >>gap - 5 >>min-rows - 5 >>max-rows + 4 >>min-rows + 4 >>max-rows 60 >>min-cols 60 >>max-cols t >>selection-required? diff --git a/basis/unix/stat/linux/32/tags.txt b/basis/unix/stat/linux/32/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/stat/linux/32/tags.txt +++ b/basis/unix/stat/linux/32/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/unix/stat/linux/64/tags.txt b/basis/unix/stat/linux/64/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/stat/linux/64/tags.txt +++ b/basis/unix/stat/linux/64/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/unix/stat/netbsd/32/tags.txt b/basis/unix/stat/netbsd/32/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/stat/netbsd/32/tags.txt +++ b/basis/unix/stat/netbsd/32/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/unix/stat/netbsd/64/tags.txt b/basis/unix/stat/netbsd/64/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/stat/netbsd/64/tags.txt +++ b/basis/unix/stat/netbsd/64/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/unix/types/netbsd/32/tags.txt b/basis/unix/types/netbsd/32/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/types/netbsd/32/tags.txt +++ b/basis/unix/types/netbsd/32/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/basis/unix/types/netbsd/64/tags.txt b/basis/unix/types/netbsd/64/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/basis/unix/types/netbsd/64/tags.txt +++ b/basis/unix/types/netbsd/64/tags.txt @@ -1 +1 @@ -untested +not loaded 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 ) : (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 -- ) diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor index b4bf9a1aef..3ca2cce93c 100644 --- a/core/hash-sets/hash-sets.factor +++ b/core/hash-sets/hash-sets.factor @@ -16,13 +16,22 @@ M: hash-set in? table>> key? ; inline M: hash-set adjoin table>> dupd set-at ; inline M: hash-set delete table>> delete-at ; inline M: hash-set members table>> keys ; inline -M: hash-set set-like - drop dup hash-set? [ members ] unless ; -M: hash-set clone - table>> clone hash-set boa ; +M: hash-set set-like drop dup hash-set? [ members ] unless ; +M: hash-set clone table>> clone hash-set boa ; M: sequence fast-set ; M: f fast-set drop H{ } clone hash-set boa ; M: sequence duplicates f fast-set [ [ in? ] [ adjoin ] 2bi ] curry filter ; + + + +M: sequence all-unique? + dup length hash-set boa + [ (all-unique?) ] curry all? ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 5db1822d9e..a308b9f0c3 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -3,7 +3,9 @@ debugger.threads destructors generic.single io io.directories io.encodings.8-bit.latin1 io.encodings.ascii io.encodings.binary io.encodings.string io.files io.files.private io.files.temp io.files.unique kernel make math -sequences specialized-arrays system threads tools.test ; +sequences specialized-arrays system threads tools.test vocabs +compiler.units ; +FROM: specialized-arrays.private => specialized-array-vocab ; SPECIALIZED-ARRAY: int IN: io.files.tests @@ -119,6 +121,12 @@ CONSTANT: pt-array-1 pt-array-1 rest-slice sequence= ] unit-test +[ ] [ + [ + pt specialized-array-vocab forget-vocab + ] with-compilation-unit +] unit-test + ! Writing strings to binary streams should fail [ "test.txt" temp-file binary [ diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 3f441f9239..d279f036d4 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -92,9 +92,6 @@ M: sequence set-like M: sequence members [ pruned ] keep like ; -M: sequence all-unique? - dup pruned sequence= ; - : combine ( sets -- set ) [ f ] [ [ [ members ] map concat ] [ first ] bi set-like ] diff --git a/core/vocabs/loader/test/a/tags.txt b/core/vocabs/loader/test/a/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/a/tags.txt +++ b/core/vocabs/loader/test/a/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/b/tags.txt b/core/vocabs/loader/test/b/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/b/tags.txt +++ b/core/vocabs/loader/test/b/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/c/tags.txt b/core/vocabs/loader/test/c/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/c/tags.txt +++ b/core/vocabs/loader/test/c/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/d/tags.txt b/core/vocabs/loader/test/d/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/d/tags.txt +++ b/core/vocabs/loader/test/d/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/e/tags.txt b/core/vocabs/loader/test/e/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/e/tags.txt +++ b/core/vocabs/loader/test/e/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/f/tags.txt b/core/vocabs/loader/test/f/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/f/tags.txt +++ b/core/vocabs/loader/test/f/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/g/tags.txt b/core/vocabs/loader/test/g/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/g/tags.txt +++ b/core/vocabs/loader/test/g/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/h/tags.txt b/core/vocabs/loader/test/h/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/h/tags.txt +++ b/core/vocabs/loader/test/h/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/i/tags.txt b/core/vocabs/loader/test/i/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/i/tags.txt +++ b/core/vocabs/loader/test/i/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/j/tags.txt b/core/vocabs/loader/test/j/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/j/tags.txt +++ b/core/vocabs/loader/test/j/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/k/tags.txt b/core/vocabs/loader/test/k/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/k/tags.txt +++ b/core/vocabs/loader/test/k/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/l/tags.txt b/core/vocabs/loader/test/l/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/l/tags.txt +++ b/core/vocabs/loader/test/l/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/m/tags.txt b/core/vocabs/loader/test/m/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/m/tags.txt +++ b/core/vocabs/loader/test/m/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/n/tags.txt b/core/vocabs/loader/test/n/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/n/tags.txt +++ b/core/vocabs/loader/test/n/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/core/vocabs/loader/test/o/tags.txt b/core/vocabs/loader/test/o/tags.txt index 5d77766703..ebb74b4d5f 100644 --- a/core/vocabs/loader/test/o/tags.txt +++ b/core/vocabs/loader/test/o/tags.txt @@ -1 +1 @@ -untested +not loaded diff --git a/extra/bit/ly/ly.factor b/extra/bit/ly/ly.factor index 32d40786f7..0220fba264 100644 --- a/extra/bit/ly/ly.factor +++ b/extra/bit/ly/ly.factor @@ -7,6 +7,8 @@ SYMBOLS: login api-key ; url login get "login" set-query-param @@ -14,8 +16,16 @@ SYMBOLS: login api-key ; "json" "format" set-query-param swap "longUrl" set-query-param ; +ERROR: bad-response json status ; + +: check-response ( json -- json ) + dup "status_code" of 200 = [ + dup "status_txt" of + bad-response + ] unless ; + : parse-response ( response data -- short-url ) - nip json> "data" swap at "url" swap at ; + nip json> check-response "data" of "url" of ; PRIVATE> diff --git a/extra/classes/struct/vectored/vectored-tests.factor b/extra/classes/struct/vectored/vectored-tests.factor index 1b3aa86eff..4d083faa5d 100644 --- a/extra/classes/struct/vectored/vectored-tests.factor +++ b/extra/classes/struct/vectored/vectored-tests.factor @@ -1,6 +1,7 @@ ! (c)2009 Joe Groff bsd license USING: accessors alien.c-types classes.struct classes.struct.vectored -kernel sequences specialized-arrays tools.test ; +kernel sequences specialized-arrays tools.test vocabs compiler.units ; +FROM: specialized-arrays.private => specialized-array-vocab ; SPECIALIZED-ARRAYS: int ushort float ; IN: classes.struct.vectored.tests @@ -71,3 +72,9 @@ VECTORED-STRUCT: foo { w ushort-array{ 15 25 35 45 } } } third vectored-element> ] unit-test + +[ ] [ + [ + foo specialized-array-vocab forget-vocab + ] with-compilation-unit +] unit-test diff --git a/extra/couchdb/tags.txt b/extra/couchdb/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/couchdb/tags.txt +++ b/extra/couchdb/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/cuda/authors.txt b/extra/cuda/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/cuda/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/cuda/cuda-tests.factor b/extra/cuda/cuda-tests.factor new file mode 100644 index 0000000000..28fe222dff --- /dev/null +++ b/extra/cuda/cuda-tests.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: cuda kernel tools.test ; +IN: cuda.tests + +! [ ] [ [ 0 0 [ drop ] with-cuda-context ] with-cuda ] unit-test +! [ ] [ 100 cuda-malloc cuda-free ] unit-test diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor new file mode 100644 index 0000000000..887740d542 --- /dev/null +++ b/extra/cuda/cuda.factor @@ -0,0 +1,77 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types alien.data assocs classes.struct +combinators continuations cuda.ffi fry io.backend kernel +sequences ; +IN: cuda + +ERROR: throw-cuda-error n ; + +: cuda-error ( n -- ) + { + { CUDA_SUCCESS [ ] } + [ throw-cuda-error ] + } case ; + +: cuda-version ( -- n ) + int [ cuDriverGetVersion cuda-error ] keep *int ; + +: init-cuda ( -- ) + 0 cuInit cuda-error ; + +: with-cuda ( quot -- ) + init-cuda [ ] [ ] cleanup ; inline + + [ cuDeviceGetCount cuda-error ] keep *int ; + +: n>cuda-device ( n -- device ) + [ CUdevice ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ; + +: enumerate-cuda-devices ( -- devices ) + #cuda-devices iota [ n>cuda-device ] map ; + +: cuda-device>properties ( device -- properties ) + [ CUdevprop ] dip + [ cuDeviceGetProperties cuda-error ] 2keep drop + CUdevprop memory>struct ; + +: cuda-device-properties ( -- properties ) + enumerate-cuda-devices [ cuda-device>properties ] map ; + +PRIVATE> + +: cuda-devices ( -- assoc ) + enumerate-cuda-devices [ dup cuda-device>properties ] { } map>assoc ; + +: with-cuda-context ( flags device quot -- ) + [ + [ CUcontext ] 2dip + [ cuCtxCreate cuda-error ] 3keep 2drop *void* + ] dip + [ '[ _ @ ] ] + [ drop '[ _ cuCtxDestroy cuda-error ] ] 2bi + [ ] cleanup ; inline + +: with-cuda-module ( path quot -- ) + [ + normalize-path + [ CUmodule ] dip + [ cuModuleLoad cuda-error ] 2keep drop *void* + ] dip + [ '[ _ @ ] ] + [ drop '[ _ cuModuleUnload cuda-error ] ] 2bi + [ ] cleanup ; inline + +: get-cuda-function ( module string -- function ) + [ CUfunction ] 2dip + [ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ; + +: cuda-malloc ( n -- ptr ) + [ CUdeviceptr ] dip + [ cuMemAlloc cuda-error ] 2keep drop *int ; + +: cuda-free ( ptr -- ) + cuMemFree cuda-error ; diff --git a/extra/cuda/ffi/ffi.factor b/extra/cuda/ffi/ffi.factor index ce6f8cb8b8..3d41f1e4c5 100644 --- a/extra/cuda/ffi/ffi.factor +++ b/extra/cuda/ffi/ffi.factor @@ -307,12 +307,12 @@ FUNCTION: CUresult cuCtxPopCurrent ( CUcontext* pctx ) ; FUNCTION: CUresult cuCtxGetDevice ( CUdevice* device ) ; FUNCTION: CUresult cuCtxSynchronize ( ) ; -FUNCTION: CUresult cuModuleLoad ( CUmodule* module, char* fname ) ; +FUNCTION: CUresult cuModuleLoad ( CUmodule* module, c-string fname ) ; FUNCTION: CUresult cuModuleLoadData ( CUmodule* module, void* image ) ; FUNCTION: CUresult cuModuleLoadDataEx ( CUmodule* module, void* image, uint numOptions, CUjit_option* options, void** optionValues ) ; FUNCTION: CUresult cuModuleLoadFatBinary ( CUmodule* module, void* fatCubin ) ; FUNCTION: CUresult cuModuleUnload ( CUmodule hmod ) ; -FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, char* name ) ; +FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, c-string name ) ; FUNCTION: CUresult cuModuleGetGlobal ( CUdeviceptr* dptr, uint* bytes, CUmodule hmod, char* name ) ; FUNCTION: CUresult cuModuleGetTexRef ( CUtexref* pTexRef, CUmodule hmod, char* name ) ; diff --git a/extra/cuda/ffi/tags.txt b/extra/cuda/ffi/tags.txt new file mode 100644 index 0000000000..700f0dc9a5 --- /dev/null +++ b/extra/cuda/ffi/tags.txt @@ -0,0 +1 @@ +not tested diff --git a/extra/cuda/tags.txt b/extra/cuda/tags.txt new file mode 100644 index 0000000000..700f0dc9a5 --- /dev/null +++ b/extra/cuda/tags.txt @@ -0,0 +1 @@ +not tested diff --git a/extra/ecdsa/tags.txt b/extra/ecdsa/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/ecdsa/tags.txt +++ b/extra/ecdsa/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/core/core.factor b/extra/llvm/core/core.factor index 0ab43c6ab6..5778a00ffb 100644 --- a/extra/llvm/core/core.factor +++ b/extra/llvm/core/core.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.libraries alien.syntax system sequences combinators kernel alien.c-types ; +USING: alien alien.libraries alien.syntax system sequences combinators kernel alien.c-types ; IN: llvm.core diff --git a/extra/llvm/core/tags.txt b/extra/llvm/core/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/core/tags.txt +++ b/extra/llvm/core/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/engine/engine.factor b/extra/llvm/engine/engine.factor index 95e425c425..bb39f86f73 100644 --- a/extra/llvm/engine/engine.factor +++ b/extra/llvm/engine/engine.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.libraries alien.syntax llvm.core ; +USING: alien.c-types alien.libraries alien.syntax llvm.core ; IN: llvm.engine << diff --git a/extra/llvm/engine/tags.txt b/extra/llvm/engine/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/engine/tags.txt +++ b/extra/llvm/engine/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/invoker/invoker.factor b/extra/llvm/invoker/invoker.factor index cc3480fe49..27fdeeb618 100644 --- a/extra/llvm/invoker/invoker.factor +++ b/extra/llvm/invoker/invoker.factor @@ -45,7 +45,7 @@ TUPLE: function name alien return params ; ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ; : install-module ( name -- ) - thejit get mps>> at [ + current-jit mps>> at [ module>> functions [ install-function ] each ] [ "no such module" throw ] if* ; diff --git a/extra/llvm/invoker/tags.txt b/extra/llvm/invoker/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/invoker/tags.txt +++ b/extra/llvm/invoker/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/jit/jit.factor b/extra/llvm/jit/jit.factor index f58851fe6f..fc755fd00f 100644 --- a/extra/llvm/jit/jit.factor +++ b/extra/llvm/jit/jit.factor @@ -5,8 +5,6 @@ kernel llvm.core llvm.engine llvm.wrappers namespaces ; IN: llvm.jit -SYMBOL: thejit - TUPLE: jit ee mps ; : empty-engine ( -- engine ) @@ -15,8 +13,11 @@ TUPLE: jit ee mps ; : ( -- jit ) jit new empty-engine >>ee H{ } clone >>mps ; +: current-jit ( -- jit ) + \ current-jit global [ drop ] cache ; + : (remove-functions) ( function -- ) - thejit get ee>> value>> over LLVMFreeMachineCodeForFunction + current-jit ee>> value>> over LLVMFreeMachineCodeForFunction LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ; : remove-functions ( module -- ) @@ -24,26 +25,24 @@ TUPLE: jit ee mps ; LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ; : remove-provider ( provider -- ) - thejit get ee>> value>> swap value>> f f + current-jit ee>> value>> swap value>> f f [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when* *void* module new swap >>value [ value>> remove-functions ] with-disposal ; : remove-module ( name -- ) - dup thejit get mps>> at [ + dup current-jit mps>> at [ remove-provider - thejit get mps>> delete-at + current-jit mps>> delete-at ] [ drop ] if* ; : add-module ( module name -- ) [ ] dip [ remove-module ] keep - thejit get ee>> value>> pick + current-jit ee>> value>> pick [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal - thejit get mps>> set-at ; + current-jit mps>> set-at ; : function-pointer ( name -- alien ) - thejit get ee>> value>> dup + current-jit ee>> value>> dup rot f [ LLVMFindFunction drop ] keep - *void* LLVMGetPointerToGlobal ; - -thejit [ ] initialize \ No newline at end of file + *void* LLVMGetPointerToGlobal ; \ No newline at end of file diff --git a/extra/llvm/jit/tags.txt b/extra/llvm/jit/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/jit/tags.txt +++ b/extra/llvm/jit/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/reader/tags.txt b/extra/llvm/reader/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/reader/tags.txt +++ b/extra/llvm/reader/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/tags.txt b/extra/llvm/tags.txt index a9d28becd8..ba3ee02ae4 100644 --- a/extra/llvm/tags.txt +++ b/extra/llvm/tags.txt @@ -1,2 +1,2 @@ bindings -untested +not tested diff --git a/extra/llvm/types/tags.txt b/extra/llvm/types/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/types/tags.txt +++ b/extra/llvm/types/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/llvm/types/types.factor b/extra/llvm/types/types.factor index e93cf7a44b..c312e7a173 100644 --- a/extra/llvm/types/types.factor +++ b/extra/llvm/types/types.factor @@ -229,7 +229,7 @@ NoFunctionParams = "(" WhiteSpace ")" => [[ drop { } ]] VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]] ParamListContinued = "," (Type | VarArgs):t => [[ t ]] ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]] -Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts delete ] when t ts >array rot ]] +Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts remove! drop ] when t ts >array rot ]] PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t ]] UpReference = "\\" Number:n => [[ n ]] Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]] diff --git a/extra/llvm/wrappers/tags.txt b/extra/llvm/wrappers/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/llvm/wrappers/tags.txt +++ b/extra/llvm/wrappers/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/mason/email/email-tests.factor b/extra/mason/email/email-tests.factor index 5f48ff0d4f..77f651feb9 100644 --- a/extra/mason/email/email-tests.factor +++ b/extra/mason/email/email-tests.factor @@ -6,6 +6,6 @@ USING: mason.email mason.common mason.config namespaces tools.test ; "linux" target-os set "x86.64" target-cpu set "12345" current-git-id set - status-error subject prefix-subject + status-error report-subject ] with-scope ] unit-test diff --git a/extra/mason/email/email.factor b/extra/mason/email/email.factor index 302df599b4..1389a2e27c 100644 --- a/extra/mason/email/email.factor +++ b/extra/mason/email/email.factor @@ -1,35 +1,42 @@ -! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces accessors combinators make smtp debugger prettyprint sequences io io.streams.string io.encodings.utf8 io.files io.sockets mason.common mason.platform mason.config ; IN: mason.email -: prefix-subject ( str -- str' ) - [ "mason on " % platform % ": " % % ] "" make ; - -: email-status ( body content-type subject -- ) +: mason-email ( body content-type subject -- ) builder-from get >>from builder-recipients get >>to - swap prefix-subject >>subject + swap >>subject swap >>content-type swap >>body send-email ; -: subject ( status -- str ) - [ current-git-id get 7 short head " -- " ] dip { - { status-clean [ "clean" ] } - { status-dirty [ "dirty" ] } - { status-error [ "error" ] } - } case 3append ; +: subject-prefix ( -- string ) + "mason on " platform ": " 3append ; + +: report-subject ( status -- string ) + [ + subject-prefix % + current-git-id get 7 short head % + " -- " % + { + { status-clean [ "clean" ] } + { status-dirty [ "dirty" ] } + { status-error [ "error" ] } + } case % + ] "" make ; : email-report ( report status -- ) - [ "text/html" ] dip subject email-status ; + [ "text/html" ] dip report-subject mason-email ; : email-error ( error callstack -- ) [ "Fatal error on " write host-name print nl [ error. ] [ callstack. ] bi* - ] with-string-writer "text/plain" "fatal error" - email-status ; + ] with-string-writer + "text/plain" + subject-prefix "fatal error" append + mason-email ; diff --git a/extra/mason/mason.factor b/extra/mason/mason.factor index 42f3737e11..9732c03dfa 100755 --- a/extra/mason/mason.factor +++ b/extra/mason/mason.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors calendar continuations debugger io io.directories io.files kernel mason.common -mason.email mason.updates namespaces threads ; +mason.email mason.updates mason.notify namespaces threads ; FROM: mason.build => build ; IN: mason @@ -15,6 +15,7 @@ IN: mason error. flush ; : build-loop ( -- ) + notify-heartbeat ?prepare-build-machine [ [ diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index 122c8a47cd..d7319c0f20 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays accessors io io.sockets io.encodings.utf8 io.files io.launcher kernel make mason.config mason.common mason.email @@ -22,6 +22,9 @@ IN: mason.notify ] retry ] [ 2drop ] if ; +: notify-heartbeat ( -- ) + f { "heartbeat" } status-notify ; + : notify-begin-build ( git-id -- ) [ "Starting build of GIT ID " write print flush ] [ f swap "git-id" swap 2array status-notify ] diff --git a/extra/mason/server/notify/notify.factor b/extra/mason/server/notify/notify.factor index 2c04a43016..bfa1027d92 100644 --- a/extra/mason/server/notify/notify.factor +++ b/extra/mason/server/notify/notify.factor @@ -25,8 +25,9 @@ SYMBOLS: host-name target-os target-cpu message message-arg ; target-cpu get >>cpu dup select-tuple [ ] [ dup insert-tuple ] ?if ; -: git-id ( builder id -- ) - >>current-git-id +starting+ >>status drop ; +: heartbeat ( builder -- ) now >>heartbeat-timestamp drop ; + +: git-id ( builder id -- ) >>current-git-id +starting+ >>status drop ; : make-vm ( builder -- ) +make-vm+ >>status drop ; @@ -51,6 +52,7 @@ SYMBOLS: host-name target-os target-cpu message message-arg ; : update-builder ( builder -- ) message get { + { "heartbeat" [ heartbeat ] } { "git-id" [ message-arg get git-id ] } { "make-vm" [ make-vm ] } { "boot" [ boot ] } diff --git a/extra/mason/server/release/authors.txt b/extra/mason/server/release/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/extra/mason/server/release/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/extra/mason/server/release/release.factor b/extra/mason/server/release/release.factor deleted file mode 100644 index 04ca2955a7..0000000000 --- a/extra/mason/server/release/release.factor +++ /dev/null @@ -1,82 +0,0 @@ -! Copyright (C) 2010 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors calendar db db.tuples db.types grouping io -io.encodings.ascii io.launcher kernel locals make -mason.release.archive mason.config mason.platform mason.server -namespaces sequences ; -IN: mason.server.release - -: platform ( builder -- string ) - [ os>> ] [ cpu>> ] bi (platform) ; - -: package-name ( builder -- string ) - [ platform ] [ last-release>> ] bi "/" glue ; - -: release-name ( version builder -- string ) - [ - "releases/" % - over % "/" % - [ "factor-" % platform % "-" % % ] - [ os>> extension % ] - bi - ] "" make ; - -: release-command ( version builder -- command ) - [ - "cp " % - [ nip package-name % " " % ] [ release-name % ] 2bi - ] "" make ; - -TUPLE: release -host-name os cpu -last-release release-git-id ; - -release "RELEASES" { - { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } - { "os" "OS" TEXT +user-assigned-id+ } - { "cpu" "CPU" TEXT +user-assigned-id+ } - { "last-release" "LAST_RELEASE" TEXT } - { "release-git-id" "RELEASE_GIT_ID" TEXT } -} define-persistent - -:: ( version builder -- release ) - release new - builder host-name>> >>host-name - builder os>> >>os - builder cpu>> >>cpu - builder release-git-id>> >>release-git-id - version builder release-name >>last-release ; - -: execute-on-server ( string -- ) - [ "ssh" , upload-host get , "-l" , upload-username get , ] { } make - - swap >>command - 5 minutes >>timeout - ascii [ write ] with-process-writer ; - -: release-script ( version builders -- string ) - [ upload-directory get "cd " "\n" surround ] 2dip - [ release-command ] with map "\n" join - append ; - -: create-releases ( version builders -- ) - release-script execute-on-server ; - -: update-releases ( version builders -- ) - [ - release new delete-tuples - [ insert-tuple ] with each - ] with-transaction ; - -: check-releases ( builders -- ) - [ release-git-id>> ] map all-equal? - [ "Not all builders are up to date" throw ] unless ; - -: do-release ( version -- ) - [ - builder new select-tuples - [ nip check-releases ] - [ create-releases ] - [ update-releases ] - 2tri - ] with-mason-db ; diff --git a/extra/mason/server/server.factor b/extra/mason/server/server.factor index d0fe29b917..26be4df57c 100644 --- a/extra/mason/server/server.factor +++ b/extra/mason/server/server.factor @@ -17,7 +17,8 @@ clean-git-id clean-timestamp last-release release-git-id last-git-id last-timestamp last-report current-git-id current-timestamp -status ; +status +heartbeat-timestamp ; builder "BUILDERS" { { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } @@ -38,6 +39,8 @@ builder "BUILDERS" { ! Can't name it CURRENT_TIMESTAMP because of bug in db library { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP } { "status" "STATUS" TEXT } + + { "heartbeat-timestamp" "HEARTBEAT_TIMESTAMP" TIMESTAMP } } define-persistent : mason-db ( -- db ) "resource:mason.db" ; diff --git a/extra/mason/source/authors.txt b/extra/mason/source/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/extra/mason/source/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor deleted file mode 100644 index 72c63660e3..0000000000 --- a/extra/mason/source/source.factor +++ /dev/null @@ -1,49 +0,0 @@ -! Copyright (C) 2010 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image bootstrap.image.download io io.directories -io.directories.hierarchy io.files.unique io.launcher -io.pathnames kernel sequences namespaces mason.common mason.config ; -IN: mason.source - -: clone-factor ( -- ) - { "git" "clone" } home "factor" append-path suffix try-process ; - -: save-git-id ( -- ) - git-id "git-id" to-file ; - -: delete-git-tree ( -- ) - ".git" delete-tree ; - -: download-images ( -- ) - images [ download-image ] each ; - -: prepare-source ( -- ) - "factor" [ save-git-id delete-git-tree download-images ] with-directory ; - -: package-name ( version -- string ) - "factor-src-" ".zip" surround ; - -: make-tarball ( version -- path ) - [ { "zip" "-qr9" } ] dip package-name - [ suffix "factor" suffix try-process ] keep ; - -: make-package ( version -- path ) - unique-directory - [ - clone-factor prepare-source make-tarball - "Package created: " write absolute-path dup print - ] with-directory ; - -: remote-location ( version -- dest ) - [ upload-directory get "/releases/" ] dip 3append ; - -: remote-archive-name ( version -- dest ) - [ remote-location ] [ package-name ] bi "/" glue ; - -: upload-package ( package version -- ) - [ upload-username get upload-host get ] dip - remote-archive-name - upload-safely ; - -: release-source-package ( version -- ) - [ make-package ] [ upload-package ] bi ; diff --git a/extra/mason/version/authors.txt b/extra/mason/version/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/binary/authors.txt b/extra/mason/version/binary/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/binary/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/binary/binary.factor b/extra/mason/version/binary/binary.factor new file mode 100644 index 0000000000..5273b644ee --- /dev/null +++ b/extra/mason/version/binary/binary.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel make mason.version.common mason.version.files +sequences ; +IN: mason.version.binary + +: binary-release-command ( version builder -- command ) + [ + "cp " % + [ nip binary-package-name % " " % ] + [ remote-binary-release-name % ] + 2bi + ] "" make ; + +: binary-release-script ( version builders -- string ) + [ binary-release-command ] with map "\n" join ; + +: do-binary-release ( version builders -- ) + "Copying binary releases to release directory..." print flush + binary-release-script execute-on-server ; diff --git a/extra/mason/version/common/authors.txt b/extra/mason/version/common/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/common/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/common/common.factor b/extra/mason/version/common/common.factor new file mode 100644 index 0000000000..65d01c3f71 --- /dev/null +++ b/extra/mason/version/common/common.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar io io.encodings.ascii io.launcher +kernel make mason.config namespaces ; +IN: mason.version.common + +: execute-on-server ( string -- ) + [ "ssh" , upload-host get , "-l" , upload-username get , ] { } make + + swap >>command + 5 minutes >>timeout + ascii [ write ] with-process-writer ; diff --git a/extra/mason/version/data/authors.txt b/extra/mason/version/data/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/data/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/data/data.factor b/extra/mason/version/data/data.factor new file mode 100644 index 0000000000..eb735c918c --- /dev/null +++ b/extra/mason/version/data/data.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar db db.tuples db.types kernel locals +mason.version.files sequences ; +IN: mason.version.data + +TUPLE: release +host-name os cpu +last-release release-git-id ; + +release "RELEASES" { + { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } + { "os" "OS" TEXT +user-assigned-id+ } + { "cpu" "CPU" TEXT +user-assigned-id+ } + { "last-release" "LAST_RELEASE" TEXT } + { "release-git-id" "RELEASE_GIT_ID" TEXT } +} define-persistent + +:: ( version builder -- release ) + release new + builder host-name>> >>host-name + builder os>> >>os + builder cpu>> >>cpu + builder release-git-id>> >>release-git-id + version builder binary-release-name >>last-release ; + +: update-binary-releases ( version builders -- ) + [ + release new delete-tuples + [ insert-tuple ] with each + ] with-transaction ; + +TUPLE: version +id version git-id timestamp source-path announcement-url ; + +version "VERSIONS" { + { "id" "ID" INTEGER +db-assigned-id+ } + { "version" "VERSION" TEXT } + { "git-id" "GIT_ID" TEXT } + { "timestamp" "TIMESTAMP" TIMESTAMP } + { "source-path" "SOURCE_PATH" TEXT } + { "announcement-url" "ANNOUNCEMENT_URL" TEXT } +} define-persistent + +: update-version ( version git-id announcement-url -- ) + version new + swap >>announcement-url + swap >>git-id + swap [ >>version ] [ source-release-name >>source-path ] bi + now >>timestamp + insert-tuple ; + +: latest-version ( -- version ) + version new select-tuples last ; diff --git a/extra/mason/version/files/authors.txt b/extra/mason/version/files/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/files/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/files/files.factor b/extra/mason/version/files/files.factor new file mode 100644 index 0000000000..1335885c3d --- /dev/null +++ b/extra/mason/version/files/files.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors fry kernel make mason.config mason.platform +mason.release.archive namespaces sequences ; +IN: mason.version.files + +: release-directory ( string version -- string ) + [ "releases/" % % "/" % % ] "" make ; + +: remote-directory ( string -- string' ) + [ upload-directory get ] dip "/" glue ; + +: remote ( string version -- string ) + remote-directory swap "/" glue ; + +: platform ( builder -- string ) + [ os>> ] [ cpu>> ] bi (platform) ; + +: binary-package-name ( builder -- string ) + [ [ platform % "/" % ] [ last-release>> % ] bi ] "" make + remote-directory ; + +: binary-release-name ( version builder -- string ) + [ + [ + [ "factor-" % platform % "-" % % ] + [ os>> extension % ] + bi + ] "" make + ] [ drop ] 2bi release-directory ; + +: remote-binary-release-name ( version builder -- string ) + [ binary-release-name ] [ drop ] 2bi remote ; + +: source-release-name ( version -- string ) + [ "factor-src-" ".zip" surround ] keep release-directory ; + +: remote-source-release-name ( version -- string ) + [ source-release-name ] keep remote ; diff --git a/extra/mason/version/source/authors.txt b/extra/mason/version/source/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/source/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/source/source.factor b/extra/mason/version/source/source.factor new file mode 100644 index 0000000000..cc41ee3e6b --- /dev/null +++ b/extra/mason/version/source/source.factor @@ -0,0 +1,51 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: bootstrap.image bootstrap.image.download io +io.directories io.directories.hierarchy io.files.unique +io.launcher io.pathnames kernel mason.common mason.config +mason.version.files namespaces sequences ; +IN: mason.version.source + +: clone-factor ( -- ) + { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ; + +: git-reset ( git-id -- ) + { "git" "reset" "--hard" } swap suffix try-process ; + +: save-git-id ( git-id -- ) + "git-id" to-file ; + +: delete-git-tree ( -- ) + ".git" delete-tree + ".gitignore" delete-file ; + +: download-images ( -- ) + images [ download-image ] each ; + +: prepare-source ( git-id -- ) + "factor" [ + [ git-reset ] [ save-git-id ] bi + delete-git-tree + download-images + ] with-directory ; + +: (make-source-release) ( version -- path ) + [ { "zip" "-qr9" } ] dip source-release-name file-name + [ suffix "factor" suffix try-process ] keep ; + +: make-source-release ( version git-id -- path ) + "Creating source release..." print flush + unique-directory + [ + clone-factor prepare-source (make-source-release) + "Package created: " write absolute-path dup print + ] with-directory ; + +: upload-source-release ( package version -- ) + "Uploading source release..." print flush + [ upload-username get upload-host get ] dip + remote-source-release-name + upload-safely ; + +: do-source-release ( version git-id -- ) + [ make-source-release ] [ drop upload-source-release ] 2bi ; diff --git a/extra/mason/version/version.factor b/extra/mason/version/version.factor new file mode 100644 index 0000000000..a2093124f7 --- /dev/null +++ b/extra/mason/version/version.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors bit.ly combinators db.tuples debugger fry +grouping io io.streams.string kernel locals make mason.email +mason.server mason.twitter mason.version.binary +mason.version.common mason.version.data mason.version.files +mason.version.source sequences threads ; +IN: mason.version + +: check-releases ( builders -- ) + [ release-git-id>> ] map all-equal? + [ "Some builders are out of date" throw ] unless ; + +: make-release-directory ( version -- ) + "Creating release directory..." print flush + [ "mkdir -p " % "" release-directory % "\n" % ] "" make + execute-on-server ; + +: tweet-release ( version announcement-url -- ) + [ + "Factor " % + [ % " released -- " % ] [ shorten-url % ] bi* + ] "" make mason-tweet ; + +:: (do-release) ( version announcement-url -- ) + [ + builder new select-tuples :> builders + builders first release-git-id>> :> git-id + + builders check-releases + version make-release-directory + version builders do-binary-release + version builders update-binary-releases + version git-id do-source-release + version git-id announcement-url update-version + version announcement-url tweet-release + + "Done." print flush + ] with-mason-db ; + +: send-release-email ( string version -- ) + [ "text/plain" ] dip "Release output: " prepend mason-email ; + +:: do-release ( version announcement-url -- ) + [ + [ + [ + version announcement-url (do-release) + ] try + ] with-string-writer + version send-release-email + ] "Mason release" spawn drop ; diff --git a/extra/opencl/ffi/ffi.factor b/extra/opencl/ffi/ffi.factor index d3398f5c24..c3a053d6ae 100644 --- a/extra/opencl/ffi/ffi.factor +++ b/extra/opencl/ffi/ffi.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.libraries alien.syntax classes.struct -combinators system alien.accessors byte-arrays kernel ; +USING: alien alien.c-types alien.libraries alien.syntax +classes.struct combinators system alien.accessors byte-arrays +kernel ; IN: opencl.ffi << "opencl" { diff --git a/extra/opencl/ffi/tags.txt b/extra/opencl/ffi/tags.txt index a9d28becd8..ba3ee02ae4 100644 --- a/extra/opencl/ffi/tags.txt +++ b/extra/opencl/ffi/tags.txt @@ -1,2 +1,2 @@ bindings -untested +not tested diff --git a/extra/opencl/syntax/tags.txt b/extra/opencl/syntax/tags.txt index 5d77766703..700f0dc9a5 100644 --- a/extra/opencl/syntax/tags.txt +++ b/extra/opencl/syntax/tags.txt @@ -1 +1 @@ -untested +not tested diff --git a/extra/opencl/tags.txt b/extra/opencl/tags.txt index a9d28becd8..ba3ee02ae4 100644 --- a/extra/opencl/tags.txt +++ b/extra/opencl/tags.txt @@ -1,2 +1,2 @@ bindings -untested +not tested diff --git a/extra/webapps/mason/download-package.xml b/extra/webapps/mason/download-package.xml index 7e50f958cd..cff9dbe789 100644 --- a/extra/webapps/mason/download-package.xml +++ b/extra/webapps/mason/download-package.xml @@ -28,6 +28,7 @@ + diff --git a/extra/webapps/mason/downloads.xml b/extra/webapps/mason/downloads.xml new file mode 100644 index 0000000000..82d6572579 --- /dev/null +++ b/extra/webapps/mason/downloads.xml @@ -0,0 +1,22 @@ + + + + + + +

Stable release:

+ +
Host name:
Last heartbeat:
Current status:
Last build:
Last clean build:
+ +
+ +

Source code:

+ +

Development release

+ + + +
+ + diff --git a/extra/webapps/mason/downloads/authors.txt b/extra/webapps/mason/downloads/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/webapps/mason/downloads/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/webapps/mason/downloads/downloads.factor b/extra/webapps/mason/downloads/downloads.factor new file mode 100644 index 0000000000..7ff9e64f6b --- /dev/null +++ b/extra/webapps/mason/downloads/downloads.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors furnace.actions html.components html.forms +kernel mason.server mason.version.data webapps.mason.grids +webapps.mason.utils ; +IN: webapps.mason.downloads + +: stable-release ( version -- link ) + [ version>> ] [ announcement-url>> ] bi ; + +: source-release ( version -- link ) + [ version>> ] [ source-path>> download-url ] bi ; + +: ( -- action ) + + [ + [ + package-grid "package-grid" set-value + release-grid "release-grid" set-value + + latest-version + [ stable-release "stable-release" set-value ] + [ source-release "source-release" set-value ] bi + ] with-mason-db + ] >>init ; diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor index 86d9ba38b3..d9d12ef745 100644 --- a/extra/webapps/mason/grids/grids.factor +++ b/extra/webapps/mason/grids/grids.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs db.tuples furnace.actions furnace.utilities http.server.responses kernel locals -mason.server mason.server.release sequences splitting urls +mason.server mason.version.data sequences splitting urls webapps.mason.utils xml.syntax xml.writer ; IN: webapps.mason.grids @@ -19,7 +19,6 @@ CONSTANT: oses { "macosx" "Mac OS X" } { "linux" "Linux" } { "freebsd" "FreeBSD" } - { "netbsd" "NetBSD" } { "openbsd" "OpenBSD" } } @@ -36,7 +35,7 @@ CONSTANT: cpus :: render-grid-row ( cpu quot -- xml ) cpu second oses keys [| os | cpu os quot render-grid-cell ] map [XML <-><-> XML] ; - + :: render-grid ( quot -- xml ) render-grid-header cpus [ quot render-grid-row ] map diff --git a/extra/webapps/mason/make-release.xml b/extra/webapps/mason/make-release.xml index f12ba014f2..7143d819ab 100644 --- a/extra/webapps/mason/make-release.xml +++ b/extra/webapps/mason/make-release.xml @@ -11,8 +11,12 @@ - Version: - + + + +
Version:
Announcement URL:
+ +

diff --git a/extra/webapps/mason/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor index 4cc3873d91..c90aaad297 100644 --- a/extra/webapps/mason/make-release/make-release.factor +++ b/extra/webapps/mason/make-release/make-release.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors furnace.actions html.forms -http.server.responses mason.server mason.server.release -validators ; +http.server.responses mason.server mason.version validators ; IN: webapps.mason.make-release : ( -- action ) @@ -10,7 +9,7 @@ IN: webapps.mason.make-release [ { { "version" [ v-one-line ] } } validate-params ] >>validate [ [ - "version" value do-release + "version" value "announcement-url" value do-release "OK" "text/html" ] with-mason-db ] >>submit ; diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index e134778fc7..ecb1348532 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -3,7 +3,8 @@ USING: accessors furnace.auth furnace.db http.server.dispatchers mason.server webapps.mason.grids webapps.mason.make-release webapps.mason.package -webapps.mason.release webapps.mason.report ; +webapps.mason.release webapps.mason.report +webapps.mason.downloads ; IN: webapps.mason TUPLE: mason-app < dispatcher ; @@ -21,19 +22,16 @@ can-make-releases? define-capability { mason-app "download-package" } >>template "package" add-responder - - "packages" add-responder - { mason-app "download-release" } >>template "release" add-responder - - "releases" add-responder + + { mason-app "downloads" } >>template + "downloads" add-responder { mason-app "make-release" } >>template - "make releases" >>description { can-make-releases? } >>capabilities diff --git a/extra/webapps/mason/package/package.factor b/extra/webapps/mason/package/package.factor index d1ed03cbf4..5c36a7f23a 100644 --- a/extra/webapps/mason/package/package.factor +++ b/extra/webapps/mason/package/package.factor @@ -2,8 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators furnace.actions html.forms kernel mason.platform mason.report mason.server present -sequences webapps.mason webapps.mason.report -webapps.mason.utils xml.syntax ; +sequences webapps.mason webapps.mason.report webapps.mason.utils +xml.syntax ; +FROM: mason.version.files => platform ; IN: webapps.mason.package : building ( builder string -- xml ) @@ -31,7 +32,7 @@ IN: webapps.mason.package over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ; : packages-url ( builder -- url ) - [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ; + platform download-url ; : package-link ( builder -- xml ) [ packages-url ] [ last-release>> ] bi [ "/" glue ] keep link ; @@ -40,7 +41,7 @@ IN: webapps.mason.package packages-url dup link ; : clean-image-url ( builder -- url ) - [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ; + platform "http://factorcode.org/images/clean/" prepend ; : clean-image-link ( builder -- link ) clean-image-url dup link ; @@ -65,6 +66,7 @@ IN: webapps.mason.package [ current-status "status" set-value ] [ last-build-status "last-build" set-value ] [ clean-build-status "last-clean-build" set-value ] + [ heartbeat-timestamp>> "heartbeat-timestamp" set-value ] [ packages-link "binaries" set-value ] [ clean-image-link "clean-images" set-value ] [ report-link "last-report" set-value ] diff --git a/extra/webapps/mason/release/release.factor b/extra/webapps/mason/release/release.factor index a7c0f71154..98fa42b68c 100644 --- a/extra/webapps/mason/release/release.factor +++ b/extra/webapps/mason/release/release.factor @@ -6,8 +6,7 @@ webapps.mason.utils io.pathnames ; IN: webapps.mason.release : release-link ( builder -- xml ) - [ "http://downloads.factorcode.org/" ] dip - last-release>> [ "/" glue ] [ file-name ] bi link ; + last-release>> [ download-url ] [ file-name ] bi link ; : ( -- action ) diff --git a/extra/webapps/mason/utils/utils.factor b/extra/webapps/mason/utils/utils.factor index 8197cce820..ad56737bc1 100644 --- a/extra/webapps/mason/utils/utils.factor +++ b/extra/webapps/mason/utils/utils.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs db.tuples furnace.actions -html.forms kernel mason.server mason.server.release sequences +html.forms kernel mason.server mason.version.data sequences validators xml.syntax ; IN: webapps.mason.utils @@ -38,3 +38,6 @@ IN: webapps.mason.utils ] [ drop f ] if ] bi 2array sift [ [XML
  • <->
    • XML] ] map [XML
      <->
    XML] ; + +: download-url ( string -- string' ) + "http://downloads.factorcode.org/" prepend ;