Merge branch 'master' of git://factorcode.org/git/factor
Joe Groff
commit
6816adfeb3
|
|
@ -413,5 +413,35 @@ M: object bad-dispatch-position-test* ;
|
|||
] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
[ 16 ] [
|
||||
[
|
||||
0 2
|
||||
[
|
||||
nip
|
||||
[
|
||||
1 + {
|
||||
[ 16 ]
|
||||
[ 16 ]
|
||||
[ 16 ]
|
||||
} dispatch
|
||||
] [
|
||||
{
|
||||
[ ]
|
||||
[ ]
|
||||
[ ]
|
||||
} dispatch
|
||||
] bi
|
||||
] each-integer
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
: dispatch-branch-problem ( a b c -- d )
|
||||
dup 0 < [ "boo" throw ] when
|
||||
1 + { [ + ] [ - ] [ * ] } dispatch ;
|
||||
|
||||
[ 3 4 -1 dispatch-branch-problem ] [ "boo" = ] must-fail-with
|
||||
[ -1 ] [ 3 4 0 dispatch-branch-problem ] unit-test
|
||||
[ 12 ] [ 3 4 1 dispatch-branch-problem ] unit-test
|
||||
|
||||
! Not sure if I want to fix this...
|
||||
! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry kernel sequences assocs accessors namespaces
|
||||
math.intervals arrays classes.algebra combinators columns
|
||||
stack-checker.branches locals
|
||||
stack-checker.branches locals math
|
||||
compiler.utilities
|
||||
compiler.tree
|
||||
compiler.tree.combinators
|
||||
|
|
@ -21,6 +21,9 @@ M: #if child-constraints
|
|||
M: #dispatch child-constraints
|
||||
children>> length f <repetition> ;
|
||||
|
||||
! There is an important invariant here, either no flags are set
|
||||
! in live-branches, exactly one is set, or all are set.
|
||||
|
||||
GENERIC: live-branches ( #branch -- indices )
|
||||
|
||||
M: #if live-branches
|
||||
|
|
@ -32,8 +35,12 @@ M: #if live-branches
|
|||
} cond nip ;
|
||||
|
||||
M: #dispatch live-branches
|
||||
[ children>> length ] [ in-d>> first value-info interval>> ] bi
|
||||
'[ _ interval-contains? ] map ;
|
||||
[ children>> ] [ in-d>> first value-info ] bi {
|
||||
{ [ dup class>> null-class? ] [ drop length f <array> ] }
|
||||
{ [ dup literal>> integer? not ] [ drop length t <array> ] }
|
||||
{ [ 2dup literal>> swap bounds-check? not ] [ drop length t <array> ] }
|
||||
[ literal>> swap length f <array> [ [ t ] 2dip set-nth ] keep ]
|
||||
} cond ;
|
||||
|
||||
: live-children ( #branch -- children )
|
||||
[ children>> ] [ live-branches>> ] bi select-children ;
|
||||
|
|
|
|||
|
|
@ -1,11 +1,14 @@
|
|||
USING: definitions help help.markup kernel sequences tools.test
|
||||
words parser namespaces assocs generic io.streams.string accessors
|
||||
strings math ;
|
||||
USING: accessors assocs definitions fry generic help
|
||||
help.markup io.streams.string kernel math namespaces parser
|
||||
sequences strings tools.test words ;
|
||||
IN: help.markup.tests
|
||||
|
||||
: with-markup-test ( quot -- )
|
||||
'[ f last-element set _ with-string-writer ] with-scope ; inline
|
||||
|
||||
TUPLE: blahblah quux ;
|
||||
|
||||
[ "int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
|
||||
[ "int" ] [ [ { "int" } $instance ] with-markup-test ] unit-test
|
||||
|
||||
[ ] [ \ quux>> print-topic ] unit-test
|
||||
[ ] [ \ >>quux print-topic ] unit-test
|
||||
|
|
@ -18,54 +21,54 @@ TUPLE: blahblah quux ;
|
|||
[ ] [ gensym print-topic ] unit-test
|
||||
|
||||
[ "a string" ]
|
||||
[ [ { $or string } print-element ] with-string-writer ] unit-test
|
||||
[ [ { $or string } print-element ] with-markup-test ] unit-test
|
||||
|
||||
[ "a string or an integer" ]
|
||||
[ [ { $or string integer } print-element ] with-string-writer ] unit-test
|
||||
[ [ { $or string integer } print-element ] with-markup-test ] unit-test
|
||||
|
||||
[ "a string, a fixnum, or an integer" ]
|
||||
[ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test
|
||||
[ [ { $or string fixnum integer } print-element ] with-markup-test ] unit-test
|
||||
|
||||
! Layout
|
||||
|
||||
[ "span" ]
|
||||
[ [ { "span" } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span" } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span1span2" ]
|
||||
[ [ { "span1" "span2" } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span1" "span2" } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span1\n\nspan2" ]
|
||||
[ [ { "span1" { $nl } "span2" } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span1" { $nl } "span2" } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "\nspan" ]
|
||||
[ [ { { $nl } "span" } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $nl } "span" } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "2 2 +\nspan" ]
|
||||
[ [ { { $code "2 2 +" } "span" } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $code "2 2 +" } "span" } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "2 2 +" ]
|
||||
[ [ { { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span\n2 2 +" ]
|
||||
[ [ { "span" { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span" { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "\n2 2 +" ]
|
||||
[ [ { { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $nl } { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span\n\n2 2 +" ]
|
||||
[ [ { "span" { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span" { $nl } { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "Heading" ]
|
||||
[ [ { { $heading "Heading" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $heading "Heading" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "Heading1\n\nHeading2" ]
|
||||
[ [ { { $heading "Heading1" } { $heading "Heading2" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $heading "Heading1" } { $heading "Heading2" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span\n\nHeading" ]
|
||||
[ [ { "span" { $heading "Heading" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span" { $heading "Heading" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "\nHeading" ]
|
||||
[ [ { { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { { $nl } { $heading "Heading" } } print-content ] with-markup-test ] unit-test
|
||||
|
||||
[ "span\n\nHeading" ]
|
||||
[ [ { "span" { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test
|
||||
[ [ { "span" { $nl } { $heading "Heading" } } print-content ] with-markup-test ] unit-test
|
||||
|
|
|
|||
Loading…
Reference in New Issue