use radix literals

[factor.git] / basis / prettyprint / prettyprint-tests.factor

diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor
index b3897960f0fa09b659eb81c68bfd2b9abecaa28c..2eed7b47d26b0ea0d65331e8dc9f3f5b1afcfd87 100644 (file)
--- a/basis/prettyprint/prettyprint-tests.factor
+++ b/basis/prettyprint/prettyprint-tests.factor
@@ -1,14 +1,23 @@
-USING: arrays definitions io.streams.string io.streams.duplex
-kernel math namespaces parser prettyprint prettyprint.config
-prettyprint.sections sequences tools.test vectors words
-effects splitting generic.standard prettyprint.private
-continuations generic compiler.units tools.continuations
-tools.continuations.private eval accessors make vocabs.parser see
-listener ;
+USING: accessors arrays classes.intersection classes.maybe
+classes.union compiler.units continuations definitions effects
+eval generic generic.standard hashtables io io.streams.duplex
+io.streams.string kernel listener make math namespaces parser
+prettyprint prettyprint.config prettyprint.private
+prettyprint.sections see sequences splitting
+strings tools.continuations tools.continuations.private
+tools.test vectors vocabs.parser words ;
 IN: prettyprint.tests
 
 [ "4" ] [ 4 unparse ] unit-test
+[ "4096" ] [ 4096 unparse ] unit-test
+[ "0b1000000000000" ] [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "0o10000" ] [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "0x1000" ] [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
 [ "1.0" ] [ 1.0 unparse ] unit-test
+[ "8.0" ] [ 8.0 unparse ] unit-test
+[ "8.0" ] [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "8.0" ] [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "0x1.0p3" ] [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
 
 [ "+" ] [ \ + unparse ] unit-test
@@ -95,7 +104,7 @@ unit-test
         [
             [ parse-fresh drop ] with-compilation-unit
             [
-                "prettyprint.tests" lookup see
+                "prettyprint.tests" lookup-word see
             ] with-string-writer "\n" split but-last
         ] keep =
     ] with-interactive-vocabs ;
@@ -188,7 +197,7 @@ DEFER: parse-error-file
         "    {"
         "        { [ dup continuation? ] [ append ] }"
         "        { [ dup not ] [ drop reverse ] }"
-        "        { [ dup pair? ] [ [ delete ] keep ] }"
+        "        { [ dup pair? ] [ [ remove! drop ] keep ] }"
         "    } cond ;"
     } ;
 
@@ -253,7 +262,7 @@ M: class-see-layout class-see-layout ;
 [ t ] [
     "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
     dup eval( -- )
-    "generic-decl-test" "prettyprint.tests" lookup
+    "generic-decl-test" "prettyprint.tests" lookup-word
     [ see ] with-string-writer =
 ] unit-test
 
@@ -354,3 +363,95 @@ TUPLE: tuple-with-initial-declared-slot { x integer initial: 123 } ;
 ] [
     [ \ tuple-with-initial-declared-slot see ] with-string-writer "\n" split
 ] unit-test
+
+TUPLE: final-tuple ; final
+
+[
+    {
+        "IN: prettyprint.tests"
+        "TUPLE: final-tuple ; final"
+        ""
+    }
+] [
+    [ \ final-tuple see ] with-string-writer "\n" split
+] unit-test
+
+[ "H{ { 1 2 } }\n" ] [ [ H{ { 1 2 } } short. ] with-string-writer ] unit-test
+
+[ "H{ { 1 ~array~ } }\n" ] [ [ H{ { 1 { 2 } } } short. ] with-string-writer ] unit-test
+
+[ "{ ~array~ }\n" ] [ [ { { 1 2 } } short. ] with-string-writer ] unit-test
+
+[ "H{ { 1 { 2 3 } } }\n" ] [
+    f nesting-limit [
+        [ H{ { 1 { 2 3 } } } . ] with-string-writer
+    ] with-variable
+] unit-test
+
+[ "maybe: integer\n" ] [ [  maybe: integer . ] with-string-writer ] unit-test
+TUPLE: bob a b ;
+[ "maybe: bob\n" ] [ [  maybe: bob . ] with-string-writer ] unit-test
+[ "maybe: word\n" ] [ [  maybe: word . ] with-string-writer ] unit-test
+
+TUPLE: har a ;
+GENERIC: harhar ( obj -- obj )
+M: maybe: har harhar ;
+M: integer harhar M\ integer harhar drop ;
+[
+"""USING: prettyprint.tests ;
+M: maybe: har harhar ;
+
+USING: kernel math prettyprint.tests ;
+M: integer harhar M\\ integer harhar drop ;\n"""
+] [
+    [ \ harhar see-methods ] with-string-writer
+] unit-test
+
+TUPLE: mo { a union{ float integer } } ;
+TUPLE: fo { a intersection{ fixnum integer } } ;
+
+[
+"""USING: math ;
+IN: prettyprint.tests
+TUPLE: mo { a union{ float integer } initial: 0 } ;
+"""
+] [
+    [ \ mo see ] with-string-writer
+] unit-test
+
+[
+"""USING: math ;
+IN: prettyprint.tests
+TUPLE: fo { a intersection{ fixnum integer } initial: 0 } ;
+"""
+] [
+    [ \ fo see ] with-string-writer
+] unit-test
+
+[
+"""union{
+    union{ float integer }
+    intersection{ string hashtable }
+}
+"""
+] [ [ union{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
+
+[
+"""intersection{
+    union{ float integer }
+    intersection{ string hashtable }
+}
+"""
+] [ [ intersection{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
+
+[
+"""maybe: union{ float integer }\n"""
+] [
+    [ maybe: union{ float integer } . ] with-string-writer
+] unit-test
+
+[
+"""maybe: maybe: integer\n"""
+] [
+    [ maybe: maybe: integer . ] with-string-writer
+] unit-test