Mercurial Mercurial > hg > stx-goodies-petitparser / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
compiler/tests/PPCNodeCompilingTest.st
changeset 438 20598d7ce9fa
parent 422 116d2b2af905 
--- a/compiler/tests/PPCNodeCompilingTest.st	Tue Apr 21 17:20:11 2015 +0100
+++ b/compiler/tests/PPCNodeCompilingTest.st	Thu Apr 30 23:43:14 2015 +0200
@@ -23,343 +23,32 @@
 !
 
 compileTree: root 
-	^ self compileTree: root params: #()
-!
-
-compileTree: root params: params
-	| compiler mock |
-	compiler := PPCCompiler new.
-	compiler profile: true.
-	mock := nil asParser.
-	^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new.
-! !
-
-!PPCNodeCompilingTest methodsFor:'tests - compiling'!
-
-testCompileAction
-	tree := PPCActionNode new
-		block: [ :res | res collect: [:each | each asUppercase ]];
-		child: #letter asParser plus asCompilerTree;
-		yourself.
-	parser := self compileTree: tree.
-			
-	self assert: parser parse: 'foo' to: { $F . $O . $O}.
-	self assert: parser parse: 'bar' to: { $B . $A . $R}.
-	self assert: parser fail: ''.
-!
-
-testCompileAnd
-	tree := PPCAndNode new
-		child: #digit asParser asCompilerNode;
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: '1' to: $1 end: 0.
-	self assert: parser fail: 'a'.
-	self assert: parser fail: ''.
-!
-
-testCompileAny
-	tree := PPCAnyNode new.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'a' to: $a.
-	self assert: parser parse: '_' to: $_.
-	self assert: parser parse: '
-' to: Character cr.
-!
-
-testCompileCharSetPredicate
-	tree := PPCCharSetPredicateNode new 
-		predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'a'  to: $a.
-	self assert: parser fail: 'b'.
-!
-
-testCompileCharacter
-	tree := PPCCharacterNode new character: $a; yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'a'  to: $a.
-	self assert: parser fail: 'b'.
-
-	parser := self compileTree: (PPCCharacterNode new character: $#; yourself).
-	self assert: parser parse: '#'.
-
-	parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself).
-	self assert: parser parse: String lf.
-!
-
-testCompileChoice
-	tree := PPCChoiceNode new
-		children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };
-		yourself.
-		
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 4.
-	
-	self assert: parser parse: '1' to: $1.
-	self assert: parser parse: 'a' to: $a.
-	self assert: parser fail: '_'.
-!
-
-testCompileLiteral
-	tree := PPCLiteralNode new
-		literal: 'foo';
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'foo'  to: 'foo'.
-	self assert: parser parse: 'foobar'  to: 'foo' end: 3.
-	self assert: parser fail: 'boo'.
-!
-
-testCompileLiteral2
-	|  |
-	
-	tree := PPCLiteralNode new
-		literal: '''''';
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: ''''''  to: ''''''.
-!
-
-testCompileNil
-	tree := PPCNilNode new.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'a' to: nil end: 0.
-	self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNot
-	tree := PPCNotNode new
-		child: #digit asParser asCompilerNode;
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'a' to: nil end: 0.
-	self assert: parser fail: '1'.
-	self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNotCharSetPredicate
-	tree := PPCNotCharSetPredicateNode new
-		predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'b' to: nil end: 0.
-	self assert: context invocationCount = 2.
-		
-	self assert: parser fail: 'a'.
-	self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNotLiteral
-	tree := PPCNotLiteralNode new
-		literal: 'foo';
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'bar' to: nil end: 0.
-	self assert: context invocationCount = 2.
-		
-	self assert: parser fail: 'foo'.
-	self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNotMessagePredicate
-	tree := PPCNotMessagePredicateNode new
-		message: #isDigit;
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'a' to: nil end: 0.
-	self assert: context invocationCount = 2.
-		
-	self assert: parser fail: '1'.
-	self assert: parser parse: '' to: nil end: 0.
+	^ self compileTree: root arguments: PPCArguments default
 !
 
-testCompileOptional
-	tree := PPCOptionalNode new
-		child: ($a asParser asCompilerNode);
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'b' to: nil end: 0.
-	self assert: parser parse: 'a' to: $a.
-	self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompilePluggable
-	tree := PPCPluggableNode new
-		block: [:ctx | ctx next ];
-		yourself.
-	parser := self compileTree: tree.
-		
-	self assert: parser parse: 'foo' to: $f end: 1.
-	self assert: parser parse: 'bar' to: $b end: 1.
-	self assert: parser parse: '' to: nil.
-!
-
-testCompilePlus
-	tree := PPCPlusNode new
-		child: ($a asParser asCompilerNode);
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
-	self assert: parser parse: 'ab' to: #( $a ) end: 1.
-	self assert: parser fail: 'b'.
-!
-
-testCompileSequence
-	tree := PPCSequenceNode new
-		children: {  $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode  }
-		yourself.
-	parser := self compileTree: tree.
+compileTree: root arguments: arguments
+	|  configuration |
+	arguments profile: true.
 	
-	self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
-	self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3.
-	self assert: parser fail: 'ab'.
-!
-
-testCompileStar
-	tree := PPCStarNode new
-		child: ($a asParser asCompilerNode);
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
-	self assert: parser parse: 'ab' to: #( $a ) end: 1.
-	self assert: parser parse: 'b' to: #( ) end: 0.
-!
+	configuration := PPCPluggableConfiguration on: [ :_self | 
+		_self specialize.
+		_self specialize.
+		_self tokenize.
+		_self inline.
+		_self merge.
+		_self generate.
+	].
 
-testCompileStarAny
-	tree := PPCStarAnyNode new child: PPCNilNode new; yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'abc' to: #($a $b $c).
-	self assert: parser parse: 'a' to: #($a).
-	self assert: parser parse: '' to: #().
-!
-
-testCompileStarCharSetPredicate
-	tree := PPCStarCharSetPredicateNode new
-		predicate: (PPCharSetPredicate on: [:e | e = $a ]);
-		"I have to put something here"
-		child: PPCNilNode new;
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.
-	self assert: context invocationCount = 2.
-	self assert: parser parse: 'bba' to: #() end: 0.
-	self assert: context invocationCount = 2.
-	
+	^ configuration compile: root arguments: arguments.
 !
 
-testCompileStarMessagePredicate
-	tree := PPCStarMessagePredicateNode new
-		message: #isLetter;
-		"I have to add something here"
-		child: PPCNilNode new;
-		yourself.
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.
-	self assert: context invocationCount = 2.
-	
-	self assert: parser parse: '123a' to: #() end: 0.
-	self assert: context invocationCount = 2.
-	
-!
-
-testCompileSymbolAction
-	tree := PPCSymbolActionNode new
-		block: #second;
-		child: #letter asParser plus asCompilerTree;
-		yourself.
-	parser := self compileTree: tree.
-		
-	self assert: parser parse: 'foo' to: $o.
-	self assert: parser parse: 'bar' to: $a.
-	self assert: parser fail: ''.
-!
-
-testCompileToken
-	tree := PPCTokenNode new
-		child: #letter asParser plus asCompilerTree;
-		tokenClass: PPToken;
-		yourself.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: 'abc'.
-	self assert: result class = PPToken.
-	self assert: result inputValue = 'abc'.
-
-	self assert: parser fail: '1a'.
-!
+tearDown
+	| class |
 
-testCompileTokenSequence
-	tree := PPCTokenSequenceNode new.
-	tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }.
-
-	parser := self compileTree: tree.
-	
-	self assert: parser parse: '1a' to: parser.
-	self assert: context rememberCount = 0.
-	self assert: context lwRememberCount = 1.
-	self assert: context restoreCount = 0.
-	self assert: context lwRestoreCount = 0.
-	
-	self assert: parser parse: '1ab' to: parser end: 2.
-	self assert: context lwRememberCount = 1.
-	self assert: context lwRestoreCount = 0.
-
-	self assert: parser fail: 'a1'. 	
-	self assert: context lwRememberCount = 1.
-	self assert: context lwRestoreCount = 0.
-
-	self assert: parser fail: 'aa'. 	
-	self assert: context lwRememberCount = 1.
-	self assert: context lwRestoreCount = 0.
-
-	self assert: parser fail: '11'. 	
-	self assert: context lwRememberCount = 1.
-	self assert: context lwRestoreCount = 1.
-	
-!
-
-testCompileTokenStarMessagePredicate
-	
-	tree := PPCTokenStarMessagePredicateNode new message: #isLetter; child: PPCNilNode new; yourself.
-	parser := self compileTree: tree params: {#guards -> false}.
-	
-	self assert: parser class methodDictionary size = 2.
-	
-	self assert: parser parse: 'foo' to: parser.
-	self assert: context invocationCount = 2.
-	self assert: context lwRememberCount  = 0.
-	self assert: context lwRestoreCount  = 0.
-	self assert: context rememberCount = 0.
-	
-	self assert: parser parse: 'foo123' to: parser end: 3.
+	class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+	class notNil ifTrue:[ 
+		class removeFromSystem
+	].
 ! !
 
 !PPCNodeCompilingTest methodsFor:'tests - guard'!
@@ -411,89 +100,6 @@
 	self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
 ! !
 
-!PPCNodeCompilingTest methodsFor:'tests - inlining'!
-
-testInlineAny
-	tree := PPCSequenceNode new
-		children: { PPCInlineAnyNode new. $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: '.a' to: #($. $a).
-!
-
-testInlineCharSetPredicate
-	tree := PPCPlusNode new
-		child: (PPCInlineCharSetPredicateNode new 
-			predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
-			yourself);
-		yourself.
-	
-	parser := self compileTree: tree.
-
-	self assert: parser class methodDictionary size = 2.
-	self assert: parser parse: 'a'  to: #($a).
-	self assert: parser fail: 'b'.
-!
-
-testInlineCharacter
-	tree := PPCSequenceNode new
-		children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: 'ba' to: #($b $a).
-!
-
-testInlineLiteral
-	tree := PPCSequenceNode new
-		children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: 'fooa' to: #('foo' $a).
-!
-
-testInlineNil
-	tree := PPCSequenceNode new
-		children: { PPCInlineNilNode new . $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: 'a' to: #(nil $a).
-!
-
-testInlineNotLiteral
-	tree := PPCSequenceNode new
-		children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: 'a' to: #(nil $a).
-!
-
-testInlinePluggable
-   "Sadly, on Smalltalk/X blocks cannot be inlined because
-	 the VM does not provide enough information to map
-	 it back to source code. Very bad indeed!!"          
-	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
-	    self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'.
-	].
-
-	tree := PPCSequenceNode new
-		children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }.
-	
-	parser := self compileTree: tree.
-	
-	self assert: parser class methodDictionary size = 3.
-	self assert: parser parse: 'ba' to: #($b $a).
-! !
-
 !PPCNodeCompilingTest class methodsFor:'documentation'!
 
 version_HG
hg/stx-goodies-petitparser