]> gitweb.factorcode.org Git - factor.git/commitdiff
fix compilation of cond; fix other regressions
authorSlava Pestov <slava@factorcode.org>
Sat, 3 Sep 2005 06:19:11 +0000 (06:19 +0000)
committerSlava Pestov <slava@factorcode.org>
Sat, 3 Sep 2005 06:19:11 +0000 (06:19 +0000)
library/inference/known-words.factor
library/test/compiler/ifte.factor
library/test/files.factor
library/test/httpd/html.factor
library/test/io/io.factor
library/test/parsing-word.factor
library/test/prettyprint.factor
library/test/redefine.factor
library/test/test.factor
library/ui/hierarchy.factor

index 0d74a0b5379bf572069ab11ccc28aabd1285a918..cbddc25e02bebb838cc1cf0ebfb405742f3a8dfe 100644 (file)
@@ -26,7 +26,7 @@ memory parser sequences strings vectors words prettyprint ;
 \ cond [ [ object ] [ ] ] "infer-effect" set-word-prop
 
 \ cond [
-    pop-literal [ first2 cons ] map
+    pop-literal [ first2 cons ] map reverse-slice
     [ no-cond ] swap alist>quot infer-quot-value
 ] "infer" set-word-prop
 
index 59624a1513f9ffdd56f0ae510c65fae836f9b818..1768eb4a8c7c88339860787a22ac1c1f39af2df9 100644 (file)
@@ -124,3 +124,12 @@ DEFER: countdown-b
         } cond
     ] compile-1
 ] unit-test
+
+[ 3 ] [
+    [
+        3 {
+            { [ dup fixnum? ] [ ] }
+            { [ t ] [ drop t ] }
+        } cond
+    ] compile-1
+] unit-test
index 60ef9eddda2d319c59ddbf790742eccc0e923aee..d147de9b708731a7fcad636ffd172bb547d550f4 100644 (file)
@@ -9,10 +9,3 @@ USE: test
 [ "txt" ] [ "foo.bar.txt" file-extension ] unit-test
 [ "text/plain" ] [ "foo.bar.txt" mime-type ] unit-test
 [ "text/html" ] [ "index.html" mime-type ] unit-test
-
-! Some tests to ensure these words simply work, since we can't
-! really test them
-
-[ t ] [ cwd directory list? ] unit-test
-
-cwd directory.
index 6e06a44053901bf6f7f5dd8a7c7f20c019cf4e0e..703d6d05ee36ff8b4d9f41a8c4a8985b9d3578f7 100644 (file)
@@ -13,15 +13,6 @@ USING: html io kernel namespaces styles test ;
     ] with-scope
 ] unit-test
 
-[ "<img src='/responder/resource/library/icons/File.png'>" ]
-[
-    [
-        ""
-        [ [[ icon "library/icons/File.png" ]] ]
-        [ drop ] icon-tag
-    ] string-out
-] unit-test
-
 [ "" ]
 [
     [
index 0f97c3578a06ed36963a753309f48dcb7a21244a..122d01dbb7ea69e970f16e694f684ab9430e466c 100644 (file)
@@ -48,7 +48,7 @@ USING: io kernel math parser strings test ;
 
 [ "" ] [ 0 read ] unit-test
 
-[ ] [ "123" write 9000 CHAR: x fill write flush ] unit-test
+[ ] [ "123" write 9000 CHAR: x fill write flush ] unit-test
 
 [ "line 1" CHAR: l ]
 [
index dd708331f1a59358223fb6b49113520b9357c5a7..d0f3b126ca90b2a1c30e56cfc402cf8006f6fd8b 100644 (file)
@@ -1,13 +1,13 @@
-IN: temporary
 USING: kernel parser sequences test words ;
+IN: temporary
 
 DEFER: foo
 
-": foo 2 2 + . ; parsing" eval
+"IN: temporary : foo 2 2 + . ; parsing" eval
 
 [ [ ] ] [ "USE: temporary foo" parse ] unit-test
 
-": foo 2 2 + . ;" eval
+"IN: temporary : foo 2 2 + . ;" eval
 
 [ [ POSTPONE: foo ] ] [ "USE: temporary foo" parse ] unit-test
 
index a8572a22c75c18a2f66b3080a62eaf808f4a2fdc..c669e3a897fcea629bd38953435f9f8409abaf61 100644 (file)
@@ -1,6 +1,6 @@
-IN: temporary
 USING: alien io kernel lists math prettyprint sequences
 test words inference namespaces vectors ;
+IN: temporary
 
 [ "4" ] [ 4 unparse ] unit-test
 [ "1.0" ] [ 1.0 unparse ] unit-test
index 8cad84c75970687e9bab90c8af68f8ffe12e927f..f2dc4c74f6ad772ab3033eeba5e6c76b5615e6b5 100644 (file)
@@ -1,5 +1,5 @@
-IN: temporary
 USING: compiler inference math generic parser test ;
+IN: temporary
 
 : foo 1 2 ;
 : bar foo foo ; compiled
index 4f732c67aad29542fffe04001211513448aec994..6e007af2ed639b1d5ac0d61bfedda93cac92f120 100644 (file)
@@ -52,7 +52,9 @@ SYMBOL: failures
 : test ( name -- ? )
     [
         "=====> " write dup write "..." print
-        test-path [ [ run-resource ] keep ] assert-depth drop
+        test-path [
+            [ [ run-resource ] with-scope ] keep
+        ] assert-depth drop
     ] test-handler ;
 
 : prepare-tests ( -- )
index ff8c221e2f29a7c255e5328c707fdf2e00e7c634..71d42be963adb9d1b9af18fda9b6e4d5cc279d66 100644 (file)
@@ -15,9 +15,8 @@ sequences vectors ;
     ] when* ;
 
 : (clear-gadget) ( gadget -- )
-    gadget-children [
-        dup [ f swap set-gadget-parent ] each 0 swap set-length
-    ] when* ;
+    dup gadget-children [ f swap set-gadget-parent ] each
+    f swap set-gadget-children ;
 
 : clear-gadget ( gadget -- )
     dup (clear-gadget) relayout ;