Commits

Felix Geller committed b401a37

Ported remaining tests of pattern matching facilities from NS2 code.

Comments (0)

Files changed (1)

PatternMatchingTests.ns3

 "Tests for Newspeaks pattern matching facilities."|
 	private TestContext = minitest TestContext.
 	private MessageNotUnderstood = platform MessageNotUnderstood.
+	
+	private patternMatching = platform NSPatternMatching NSPatternMatching usingPlatform: platform.
+	private Binding = patternMatching Binding.
+	
+	private Product = SimplificationTests new Product.
+	private Num = SimplificationTests new Num.
+	private Container = KeywordPatternTests new Container.
 |)
 (
+class BasicAPI = TestContext (|
+|)
+('as yet unclassified'
+testCombinatorAlternation = (
+| a |
+	assert: (case: <23> | <_> => [ true ] otherwise: [ false ])
+)
+testCombinatorAlternationExtended = (
+| a |
+	assert: (case:	  ( <23> => [ false ] )
+					| ( <_> => [ true ] )
+  			 otherwise: [ false ])
+)
+testCombinatorAlternationTerminationUponSuccess = (
+| a |
+	assert: (case:	  ( <23> => [ false ] )
+					| ( <_> => [ true ] )
+					| ( <46> => [ false ] )
+  			 otherwise: [ false ])
+)
+testCombinatorApplication = (
+| a |
+	assert: (case: <_> => [ true ] otherwise: [ false ])
+)
+testCombinatorApplicationBindingAccess = (
+| a |
+	assert: ((Container of: true)
+				case: <_> => [ :b | b val ] 
+				otherwise: [ false ])
+)
+testCombinatorApplicationOptionalBindingArgument = (
+| a |
+	assert: (case: <_> => [ true ] otherwise: [ false ])
+)
+testCombinatorConjunction = (
+| a |
+	assert: ((Container of: 23) 
+				case: <contains: 23> & <contains: _> => [ true ]
+				otherwise: [ false ])
+)
+testCombinatorNegation = (
+| a |
+	assert: ((Container of: 23) 
+				case: <contains: 46> not => [ true ]
+				otherwise: [ false ])
+)
+testCombinatorSequence = (
+| a |
+	assert: ((Container of: 23) 
+				case: <_> >> <contains: 23> => [ true ]
+				otherwise: [ false ])
+)
+testLiteralCharacter = (
+	assert: (<$b> doesMatch: $b else: [ false ]) isBound
+)
+testLiteralNumber = (
+	assert: (<23> doesMatch: 23 else: [ false ]) isBound
+)
+testLiteralString = (
+	assert: (<'abc'> doesMatch: 'abc' else: [ false ]) isBound
+)
+testLiteralSymbol = (
+	assert: (<#abc> doesMatch: #abc else: [ false ]) isBound
+)
+testWildcard = (
+	"N.B.: The receiver of case:witherwise: is implicit self, therefore a descendant of NewspeakObject, which defines case:otherwise:."
+	assert: (case: <_> => [ true ] otherwise: [ false ])
+)) : ('as yet unclassified'
+TEST_CONTEXT = (
+	
+))
+class BindingTests = TestContext (|
+|)
+('as yet unclassified'
+testBindingIllegalAccess = (
+| failed |
+	[ Binding new unverstaendlich ]
+	on: MessageNotUnderstood do: [ failed: true ].
+	assert: failed.
+
+	failed: false.
+	[ case: <_> => [ :b | b unverstaendlich ]]
+	on: MessageNotUnderstood do: [ failed: true ].
+	assert: failed.
+)
+testBindingMatchFailure = (
+	assert: Pattern new MatchFailure isBinding.
+	deny: Pattern new MatchFailure isBound.
+)
+testBindingMatchFailureCached = (
+| pattern = Pattern new. |
+	assert: pattern cachedMatchFailure isNil.
+	assert: pattern MatchFailure hash = pattern MatchFailure hash.
+)) : ('as yet unclassified'
+TEST_CONTEXT = (
+	
+))
+class KeywordPatternTests = TestContext (|
+|)
+(
+class Container of: v = (|
+	val = v.
+|)
+('as yet unclassified'
+match: p = (
+	^ p contains: val.
+))'as yet unclassified'
+testKeywordPattern = (
+|	l = Num of: 1.
+	r = Num of: 2.	
+	prod = Product of: l and: r.
+	a |
+	a:: prod case: <multiply:with:> => [ :b | b multiply ] otherwise: [ false ].
+	assert: a == l.
+)
+testKeywordPatternFailure = (
+|	l = Num of: 1.
+	r = Num of: 2.	
+	prod = Product of: l and: r.
+	a | "different pattern: multiply:with: vs. multiply:by:"
+	a:: prod case: <multiply:by:> => [ :b | b multiply ] otherwise: [ true ].
+	assert: a.
+)
+testKeywordPatternNested = (
+|	l = Num of: 3.
+	r = Num of: 2.	
+	prod1 = Product of: l and: r.
+	prod2 = Product of: l and: prod1.
+	a |
+	a:: prod2 case: <multiply: with: <multiply:with:>> => [ :b | b multiply ] otherwise: [ false ].
+	assert: a == l.
+)
+testKeywordPatternNestedLiteralValue = (
+|	prod = Product of: 1 and: 2.
+	a |
+	a:: prod case: <multiply: 1 with: 2> => [ :b | b multiply ] otherwise: [ false ].
+	assert: a = 1.
+)
+testKeywordPatternNestedNested = (
+|	l = Num of: 1.
+	r = Num of: 2.	
+	prod1 = Product of: l and: r.
+	prod2 = Product of: prod1 and: prod1.
+	a |
+	a:: prod2 case: <multiply: <multiply:with: <num:>> with: <multiply: <num:>with:>> => [ :b | b with multiply num ] otherwise: [ false ].
+	assert: a = 1.
+)
+testKeywordPatternNestedNumberLiteral = (
+|	v = 23.
+	c = Container of: v.
+	a |
+	a:: c case: <contains: 23 > => [ :b | b contains ] otherwise: [ false ].
+	assert: a = v.
+)
+testKeywordPatternNestedStringLiteral = (
+|	v = 'hans'.
+	c = Container of: v.
+	a |
+	a:: c case: <contains: 'hans' > => [ :b | b contains ] otherwise: [ false ].
+	assert: a = v.
+)
+testKeywordPatternNestedVariables = (
+|	l = Num of: 3.
+	r = Num of: 2.	
+	prod = Product of: l and: r.
+	a |
+	a:: prod
+		case: <multiply: <num: ?x> with: <num: ?y>> => [ :b | b x * b y ] 
+		otherwise: [ false ].
+	assert: a = 6.
+)
+testKeywordPatternVariables = (
+|	l = Num of: 3.
+	r = Num of: 2.	
+	prod = Product of: l and: r.
+	a |
+	a:: prod
+		case: <multiply: ?x with: ?y > => [ :b | b x val * b y val ] 
+		otherwise: [ false ].
+	assert: a = 6.
+)
+testKeywordPatternWildcard = (
+|	l = Num of: 1.
+	r = Num of: 2.	
+	prod = Product of: l and: r.
+	a |
+	a:: prod case: <multiply: _ with: _ > => [ :b | b multiply ] otherwise: [ false ].
+	assert: a == l.
+)) : ('as yet unclassified'
+TEST_CONTEXT = (
+	
+))
 class LexicalScopingTests = TestContext (
 "If a pattern defines a pattern variable (e.g., ?x) and one uses the application combinator on such a pattern, then the pattern variable should only be accessible in closures (that are parameters to the application combinator) that are defined in the same context as the pattern that defines the pattern variable.
 
 setPattern = (
 	patternSlot: pattern.
 )
+testAccessingKeywordPatternBindingWithoutBindingArgument = (
+|	ts = TestSubject new. 
+	a |
+	a:: ts case: <testSubject: ?x> => [ testSubject ] otherwise: [ false ].
+	assert: a == ts.
+)
+testAccessingPatternVariableWithoutBindingArgument = (
+|	ts = TestSubject new. 
+	a |
+	a:: ts case: <testSubject: ?x> => [ x ] otherwise: [ false ].
+	assert: a == ts.
+)
 testLexicalScopeAccessClosureThroughMethod = (
 |	a |
 	setPattern.