tests/PPScriptingTest.st
author sr
Wed, 04 Jul 2018 15:30:19 +0200
changeset 611 38338f2de417
parent 574 64e031cdc1a1
permissions -rw-r--r--
build order was wrong
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
574
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/petitparser/tests' }"
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: Smalltalk }"
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
PPAbstractParserTest subclass:#PPScriptingTest
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'PetitTests-Tests'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
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'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
!PPScriptingTest methodsFor:'examples'!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
expressionInterpreter
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
        "Same as #expressionInterpreter but with semantic actions."
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
        
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
        | mul prim add dec |
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
        add := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
        mul := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
        prim := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
        dec := ($0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ].
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
        add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
                / mul.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
        mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
                / prim.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
        prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
                / dec.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
        ^ add end
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
expressionParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
        "Simple demo of scripting an expression parser."
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
        
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
        | mul prim add dec |
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
        add := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
        mul := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
        prim := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
        dec := ($0 to: $9) asParser.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
        add def: (mul , $+ asParser , add)
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
                / mul.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
        mul def: (prim , $* asParser , mul)
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
                / prim.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
        prim def: ($( asParser , add , $) asParser)
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
                / dec.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
        ^ add end
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
straightLineParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
        | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
        goal := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
        stmList := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
        stm := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
        exp := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
        expList := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
        mulExp := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
        primExp := PPUnresolvedParser new.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
        
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
        lower := ($a to: $z) asParser.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
        upper := ($A to: $Z) asParser.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
        char := lower / upper.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
        nonzero := ($1 to: $9) asParser.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
        dec := ($0 to: $9) asParser.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
        id := char, ( char / dec ) star.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
        num := $0 asParser / ( nonzero, dec star).
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
        goal def: stmList end.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
        stmList def: stm , ( $; asParser, stm ) star.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
        stm def: ( id, ':=' asParser, exp )
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
                / ( 'print' asParser, $( asParser, expList, $) asParser ). 
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
        exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
        expList def: exp, ( $, asParser, exp ) star.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
        mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        primExp def: id
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
                / num
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
                / ( $( asParser, stmList, $, asParser, exp, $) asParser ).
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
        ^ goal
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
! !
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
!PPScriptingTest methodsFor:'tests'!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
testExpressionInterpreter
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
	self 
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
		assert: self expressionInterpreter
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
		parse: '2*(3+4)'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
		to: 14
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
testExpressionParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
	self
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
		assert: self expressionParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
		parse: '2*(3+4)'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
		to: #($2 $* ($( ($3 $+ $4) $)))
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
testSLassign
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
	
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
	self assert: self straightLineParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
		parse: 'abc:=1'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
testSLprint
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
	self 
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
		assert: self straightLineParser
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
		parse: 'print(3,4)'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
! !
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
!PPScriptingTest class methodsFor:'documentation'!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
version
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    ^ '$Header$'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
!
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
version_CVS
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    ^ '$Header$'
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
! !
64e031cdc1a1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122