Fixing bugs

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 -- ? )
     {

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
 

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> 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

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

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

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>> ] [ <mirror> ] bi*
     '[
-        swap tag>> dup "name" =
+        swap main>> dup "name" =
         [ 2drop ] [ , set-at ] if
     ] assoc-each ;
 

extra/inverse/inverse-tests.factor

@@ -62,10 +62,10 @@ C: <nil> 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> [ cons* ] undo ] unit-test
+[ 1 2 ] [ 1 2 <cons> [ cons* ] undo ] unit-test
 
 [ t ] [ pi [ pi ] matches? ] unit-test
 [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test

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 ] [