tests/PPScriptingTest.st
changeset 382 1825151d6455
parent 380 8fe3cb4e607f
child 385 44a36ed4e484
--- a/tests/PPScriptingTest.st	Sat Oct 04 21:26:15 2014 +0100
+++ b/tests/PPScriptingTest.st	Sun Oct 05 00:29:07 2014 +0100
@@ -1,130 +1,1 @@
-"{ Package: 'stx:goodies/petitparser/tests' }"
-
-PPAbstractParserTest subclass:#PPScriptingTest
-	instanceVariableNames:''
-	classVariableNames:''
-	poolDictionaries:''
-	category:'PetitTests-Tests'
-!
-
-PPScriptingTest comment:'These are some simple demo-scripts of parser combinators for the compiler construction course.
http://www.iam.unibe.ch/~scg/Teaching/CC/index.html'
-!
-
-
-!PPScriptingTest methodsFor:'examples'!
-
-expressionInterpreter
-        "Same as #expressionInterpreter but with semantic actions."
-        
-        | mul prim add dec |
-        add := PPUnresolvedParser new.
-        mul := PPUnresolvedParser new.
-        prim := PPUnresolvedParser new.
-        dec := (Interval from: $0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ].
-        add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
-                / mul.
-        mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
-                / prim.
-        prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
-                / dec.
-        ^ add end
-
-    "Modified: / 05-10-2014 / 00:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-expressionParser
-        "Simple demo of scripting an expression parser."
-        
-        | mul prim add dec |
-        add := PPUnresolvedParser new.
-        mul := PPUnresolvedParser new.
-        prim := PPUnresolvedParser new.
-        dec := (Interval from: $0 to: $9) asParser.
-        add def: (mul , $+ asParser , add)
-                / mul.
-        mul def: (prim , $* asParser , mul)
-                / prim.
-        prim def: ($( asParser , add , $) asParser)
-                / dec.
-        ^ add end
-
-    "Modified: / 05-10-2014 / 00:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-straightLineParser
-        | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
-        goal := PPUnresolvedParser new.
-        stmList := PPUnresolvedParser new.
-        stm := PPUnresolvedParser new.
-        exp := PPUnresolvedParser new.
-        expList := PPUnresolvedParser new.
-        mulExp := PPUnresolvedParser new.
-        primExp := PPUnresolvedParser new.
-        
-        lower := (Interval from: $a to: $z) asParser.
-        upper := (Interval from: $A to: $Z) asParser.
-        char := lower / upper.
-        nonzero := (Interval from: $1 to: $9) asParser.
-        dec := (Interval from: $0 to: $9) asParser.
-        id := char, ( char / dec ) star.
-        num := $0 asParser / ( nonzero, dec star).
-
-        goal def: stmList end.
-        stmList def: stm , ( $; asParser, stm ) star.
-        stm def: ( id, ':=' asParser, exp )
-                / ( 'print' asParser, $( asParser, expList, $) asParser ). 
-        exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
-        expList def: exp, ( $, asParser, exp ) star.
-        mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
-        primExp def: id
-                / num
-                / ( $( asParser, stmList, $, asParser, exp, $) asParser ).
-        ^ goal
-
-    "Modified: / 05-10-2014 / 00:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!PPScriptingTest methodsFor:'tests'!
-
-testExpressionInterpreter
-	self 
-		assert: self expressionInterpreter
-		parse: '2*(3+4)'
-		to: 14
-!
-
-testExpressionParser
-	self
-		assert: self expressionParser
-		parse: '2*(3+4)'
-		to: #($2 $* ($( ($3 $+ $4) $)))
-!
-
-testSLassign
-	
-	self assert: self straightLineParser
-		parse: 'abc:=1'
-		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
-!
-
-testSLprint
-	self 
-		assert: self straightLineParser
-		parse: 'print(3,4)'
-		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
-! !
-
-!PPScriptingTest class methodsFor:'documentation'!
-
-version
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
-!
-
-version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
-!
-
-version_SVN
-    ^ '$Id: PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
-! !
-
+"{ Package: 'stx:goodies/petitparser/tests' }"

PPAbstractParserTest subclass:#PPScriptingTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitTests-Tests'
!

PPScriptingTest comment:'These are some simple demo-scripts of parser combinators for the compiler construction course.
http://www.iam.unibe.ch/~scg/Teaching/CC/index.html'
!


!PPScriptingTest methodsFor:'examples'!

expressionInterpreter
        "Same as #expressionInterpreter but with semantic actions."
        
        | mul prim add dec |
        add := PPUnresolvedParser new.
        mul := PPUnresolvedParser new.
        prim := PPUnresolvedParser new.
        dec := (Interval from: $0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ].
        add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
                / mul.
        mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
                / prim.
        prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
                / dec.
        ^ add end

    "Modified: / 05-10-2014 / 00:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

expressionParser
        "Simple demo of scripting an expression parser."
        
        | mul prim add dec |
        add := PPUnresolvedParser new.
        mul := PPUnresolvedParser new.
        prim := PPUnresolvedParser new.
        dec := (Interval from: $0 to: $9) asParser.
        add def: (mul , $+ asParser , add)
                / mul.
        mul def: (prim , $* asParser , mul)
                / prim.
        prim def: ($( asParser , add , $) asParser)
                / dec.
        ^ add end

    "Modified: / 05-10-2014 / 00:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

straightLineParser
        | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
        goal := PPUnresolvedParser new.
        stmList := PPUnresolvedParser new.
        stm := PPUnresolvedParser new.
        exp := PPUnresolvedParser new.
        expList := PPUnresolvedParser new.
        mulExp := PPUnresolvedParser new.
        primExp := PPUnresolvedParser new.
        
        lower := (Interval from: $a to: $z) asParser.
        upper := (Interval from: $A to: $Z) asParser.
        char := lower / upper.
        nonzero := (Interval from: $1 to: $9) asParser.
        dec := (Interval from: $0 to: $9) asParser.
        id := char, ( char / dec ) star.
        num := $0 asParser / ( nonzero, dec star).

        goal def: stmList end.
        stmList def: stm , ( $; asParser, stm ) star.
        stm def: ( id, ':=' asParser, exp )
                / ( 'print' asParser, $( asParser, expList, $) asParser ). 
        exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
        expList def: exp, ( $, asParser, exp ) star.
        mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
        primExp def: id
                / num
                / ( $( asParser, stmList, $, asParser, exp, $) asParser ).
        ^ goal

    "Modified: / 05-10-2014 / 00:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPScriptingTest methodsFor:'tests'!

testExpressionInterpreter
	self 
		assert: self expressionInterpreter
		parse: '2*(3+4)'
		to: 14
!

testExpressionParser
	self
		assert: self expressionParser
		parse: '2*(3+4)'
		to: #($2 $* ($( ($3 $+ $4) $)))
!

testSLassign
	
	self assert: self straightLineParser
		parse: 'abc:=1'
		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
!

testSLprint
	self 
		assert: self straightLineParser
		parse: 'print(3,4)'
		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
! !

!PPScriptingTest class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '$Id: PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
! !
\ No newline at end of file