use radix literals

[factor.git] / extra / smalltalk / parser / parser-tests.factor

diff --git a/extra/smalltalk/parser/parser-tests.factor b/extra/smalltalk/parser/parser-tests.factor
index aa440f581e848d8bc09094024bb2f4fd18524ba6..932fda7810be8028081d03d7044d4d004d907ed4 100644 (file)
--- a/extra/smalltalk/parser/parser-tests.factor
+++ b/extra/smalltalk/parser/parser-tests.factor
@@ -1,5 +1,6 @@
 IN: smalltalk.parser.tests
-USING: smalltalk.parser smalltalk.ast peg.ebnf tools.test accessors
+USING: smalltalk.parser smalltalk.ast
+peg.ebnf tools.test accessors
 io.files io.encodings.ascii kernel ;
 
 EBNF: test-Character
@@ -32,7 +33,7 @@ test         = <foreign parse-smalltalk Literal>
 
 [ nil ] [ "nil" test-Literal ] unit-test
 [ 123 ] [ "123" test-Literal ] unit-test
-[ HEX: deadbeef ] [ "16rdeadbeef" test-Literal ] unit-test
+[ 0xdeadbeef ] [ "16rdeadbeef" test-Literal ] unit-test
 [ -123 ] [ "-123" test-Literal ] unit-test
 [ 1.2 ] [ "1.2" test-Literal ] unit-test
 [ -1.24 ] [ "-1.24" test-Literal ] unit-test
@@ -49,9 +50,9 @@ test         = <foreign parse-smalltalk Literal>
 [ B{ 1 2 3 4 } ] [ "#[1 2 3 4]" test-Literal ] unit-test
 [ { nil t f } ] [ "#(nil true false)" test-Literal ] unit-test
 [ { nil { t f } } ] [ "#(nil (true false))" test-Literal ] unit-test
-[ T{ ast-block f { } { } } ] [ "[]" test-Literal ] unit-test
-[ T{ ast-block f { "x" } { T{ ast-return f T{ ast-name f "x" } } } } ] [ "[ :x|^x]" test-Literal ] unit-test
-[ T{ ast-block f { } { T{ ast-return f self } } } ] [ "[^self]" test-Literal ] unit-test
+[ T{ ast-block f { } { } { } } ] [ "[]" test-Literal ] unit-test
+[ T{ ast-block f { "x" } { } { T{ ast-return f T{ ast-name f "x" } } } } ] [ "[ :x|^x]" test-Literal ] unit-test
+[ T{ ast-block f { } { } { T{ ast-return f self } } } ] [ "[^self]" test-Literal ] unit-test
 
 [
     T{ ast-block
@@ -164,6 +165,54 @@ test         = <foreign parse-smalltalk Expression>
 ]
 [ "((1 < 10) ifTrue: [ 'HI' ] ifFalse: [ 'BYE' ]) print" test-Expression ] unit-test
 
+[
+    T{ ast-cascade
+       { receiver 12 }
+       { messages
+         {
+           T{ ast-message f "sqrt" }
+           T{ ast-message f "+" { 2 } }
+         }
+       }
+    }
+]
+[ "12 sqrt; + 2" test-Expression ] unit-test
+
+[
+    T{ ast-cascade
+       { receiver T{ ast-message-send f 12 "sqrt" } }
+       { messages
+         {
+           T{ ast-message f "+" { 1 } }
+           T{ ast-message f "+" { 2 } }
+         }
+       }
+    }
+]
+[ "12 sqrt + 1; + 2" test-Expression ] unit-test
+
+[
+    T{ ast-cascade
+       { receiver T{ ast-message-send f 12 "squared" } }
+       { messages
+         {
+           T{ ast-message f "to:" { 100 } }
+           T{ ast-message f "sqrt" }
+         }
+       }
+    }
+]
+[ "12 squared to: 100; sqrt" test-Expression ] unit-test
+
+[
+    T{ ast-message-send f
+        T{ ast-message-send f 1 "+" { 2 } }
+        "*"
+        { 3 }
+    }
+]
+[ "1+2*3" test-Expression ] unit-test
+
 [
     T{ ast-message-send
        { receiver
@@ -193,12 +242,8 @@ test         = <foreign parse-smalltalk LocalVariableDeclarationList>
 [ T{ ast-local-variables f { "i" "j" } } ] [ " |  i j   |" test-LocalVariableDeclarationList ] unit-test
 
 
-EBNF: test-KeywordMessageSend
-test         = <foreign parse-smalltalk KeywordMessageSend>
-;EBNF
-
 [ T{ ast-message-send f T{ ast-name f "x" } "foo:bar:" { 1 2 } } ]
-[ "x foo:1 bar:2" test-KeywordMessageSend ] unit-test
+[ "x foo:1 bar:2" test-Expression ] unit-test
 
 [
     T{ ast-message-send
@@ -212,17 +257,44 @@ test         = <foreign parse-smalltalk KeywordMessageSend>
         { 10 100 }
     }
 ]
-[ "3 factorial + 4 factorial between: 10 and: 100" test-KeywordMessageSend ] unit-test
+[ "3 factorial + 4 factorial between: 10 and: 100" test-Expression ] unit-test
 
-[ { 1 2 } ] [ "1. 2" parse-smalltalk ] unit-test
+[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
+
+[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2." parse-smalltalk ] unit-test
 
 [
-    T{ ast-class
-       { name "Test" }
-       { superclass "Object" }
-       { ivars { "a" } }
+    T{ ast-sequence f { }
+        {
+            T{ ast-class
+               { name "Test" }
+               { superclass "Object" }
+               { ivars { "a" } }
+            }
+        }
     }
 ]
 [ "class Test [|a|]" parse-smalltalk ] unit-test
 
-[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
+[
+    T{ ast-sequence f { }
+        {
+            T{ ast-class
+               { name "Test1" }
+               { superclass "Object" }
+               { ivars { "a" } }
+            }
+
+            T{ ast-class
+               { name "Test2" }
+               { superclass "Test1" }
+               { ivars { "b" } }
+            }
+        }
+    }
+]
+[ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
+
+[ ] [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test
+
+[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
\ No newline at end of file