diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor index 79d5d4ed8b..501507bc56 100644 --- a/basis/compiler/tree/cleanup/cleanup.factor +++ b/basis/compiler/tree/cleanup/cleanup.factor @@ -69,7 +69,7 @@ GENERIC: cleanup* ( node -- node/nodes ) : small-shift? ( #call -- ? ) node-input-infos second interval>> - 0 cell-bits tag-bits get - [a,b] interval-subset? ; + cell-bits tag-bits get - [ neg ] keep [a,b] interval-subset? ; : remove-overflow-check? ( #call -- ? ) { diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index 338f397f66..e8d2b29027 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -120,7 +120,7 @@ IN: compiler.tree.dead-code.tests : call-recursive-dce-1 ( a -- b ) [ call-recursive-dce-1 drop ] [ call-recursive-dce-1 ] bi ; inline recursive -[ [ "WRAP" [ dup >r "REC" drop r> "REC" ] label ] ] [ +[ [ drop "WRAP" [ "REC" drop "REC" ] label ] ] [ [ call-recursive-dce-1 ] optimize-quot squish ] unit-test @@ -134,7 +134,7 @@ IN: compiler.tree.dead-code.tests [ f call-recursive-dce-2 drop ] optimize-quot squish ] unit-test -[ [ "WRAP" [ produce-a-value dup . drop "REC" ] label ] ] [ +[ [ "WRAP" [ produce-a-value . "REC" ] label ] ] [ [ f call-recursive-dce-2 ] optimize-quot squish ] unit-test @@ -152,7 +152,7 @@ IN: compiler.tree.dead-code.tests : call-recursive-dce-4 ( a -- b ) call-recursive-dce-4 ; inline recursive -[ [ "WRAP" [ "REC" ] label ] ] [ +[ [ drop "WRAP" [ "REC" ] label ] ] [ [ call-recursive-dce-4 ] optimize-quot squish ] unit-test diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor index 9267df93ed..0b7db5b36a 100644 --- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -7,7 +7,7 @@ compiler.tree.combinators compiler.tree sequences math math.private kernel tools.test accessors slots.private quotations.private prettyprint classes.tuple.private classes classes.tuple compiler.tree.intrinsics namespaces compiler.tree.propagation.info -stack-checker.errors ; +stack-checker.errors kernel.private ; \ escape-analysis must-infer @@ -316,3 +316,7 @@ C: ro-box [ \ too-many->r boa f f \ inference-error boa ] count-unboxed-allocations ] unit-test + +[ 0 ] [ + [ { null } declare [ 1 ] [ 2 ] if ] count-unboxed-allocations +] unit-test diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 4528eb3edc..0ba3b93730 100755 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -3,7 +3,7 @@ USING: accessors alien.c-types arrays cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2 cpu.x86.allot cpu.architecture kernel kernel.private math -namespaces sequences compiler.generator.registers +namespaces sequences compiler.generator compiler.generator.registers compiler.generator.fixup system layouts alien alien.accessors alien.structs slots splitting assocs ; IN: cpu.x86.64 diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index e5f3ac8394..dd9ca267d2 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -317,3 +317,14 @@ M: xref-tuple-2 xref-test (xref-test) ; [ t ] [ \ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and ] unit-test + +GENERIC: wide-predicate-bug ( obj -- n ) + +PREDICATE: b-predicate < object { { } } member? ; + +M: b-predicate wide-predicate-bug drop 0 ; + +M: array wide-predicate-bug drop 1 ; + +[ 0 ] [ { } wide-predicate-bug ] unit-test +[ 1 ] [ { 1 } wide-predicate-bug ] unit-test diff --git a/extra/html/templates/chloe/syntax/syntax.factor b/extra/html/templates/chloe/syntax/syntax.factor index 9412fde423..82309a49b2 100644 --- a/extra/html/templates/chloe/syntax/syntax.factor +++ b/extra/html/templates/chloe/syntax/syntax.factor @@ -23,7 +23,7 @@ tags global [ H{ } clone or ] change-at MEMO: chloe-name ( string -- name ) name new - swap >>tag + swap >>main chloe-ns >>url ; : required-attr ( tag name -- value ) @@ -45,7 +45,7 @@ MEMO: chloe-name ( string -- name ) : attrs>slots ( tag tuple -- ) [ attrs>> ] [ ] bi* '[ - swap tag>> dup "name" = + swap main>> dup "name" = [ 2drop ] [ , set-at ] if ] assoc-each ; diff --git a/extra/inverse/inverse-tests.factor b/extra/inverse/inverse-tests.factor index 0df41cf53f..3206636ea9 100644 --- a/extra/inverse/inverse-tests.factor +++ b/extra/inverse/inverse-tests.factor @@ -62,10 +62,10 @@ C: nil [ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test : empty-cons ( -- cons ) cons new ; -: cons* ( cdr car -- cons ) { set-cons-cdr set-cons-car } cons construct ; +: cons* ( cdr car -- cons ) cons boa ; [ ] [ T{ cons f f f } [ empty-cons ] undo ] unit-test -[ 1 2 ] [ 2 1 [ cons* ] undo ] unit-test +[ 1 2 ] [ 1 2 [ cons* ] undo ] unit-test [ t ] [ pi [ pi ] matches? ] unit-test [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test diff --git a/extra/io/files/unique/unique-tests.factor b/extra/io/files/unique/unique-tests.factor index 7007f593b6..c29a94f395 100644 --- a/extra/io/files/unique/unique-tests.factor +++ b/extra/io/files/unique/unique-tests.factor @@ -1,3 +1,5 @@ +USING: io.encodings.ascii sequences strings io io.files accessors +tools.test kernel io.files.unique ; IN: io.files.unique.tests [ 123 ] [