SystemOrganization addCategory: #'Cutie-LanguageBoxes'! SystemOrganization addCategory: #'Cutie-LanguageBoxes-Skins'! SystemOrganization addCategory: #'Cutie-LanguageBoxes-SQL'! !QQTestCase class methodsFor: '*cutie-languageboxes' stamp: 'lr 6/23/2009 11:52'! languageBoxesHighlight ^ nil! ! !QQTestCase class methodsFor: '*cutie-languageboxes' stamp: 'lr 6/23/2009 11:53'! languageBoxesParser ^ nil! ! CUCompositeParser subclass: #LBFactoryParser instanceVariableNames: 'primary message' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! !LBFactoryParser class methodsFor: 'accessing' stamp: 'lr 4/8/2009 15:06'! concern ^ nil! ! !LBFactoryParser class methodsFor: 'accessing' stamp: 'lr 4/8/2009 15:05'! identifier ^ nil! ! !LBFactoryParser class methodsFor: 'instance creation' stamp: 'lr 5/7/2009 13:18'! primary: aPrimaryParser message: aMessageParser ^ self basicNew initializePrimary: aPrimaryParser message: aMessageParser! ! !LBFactoryParser methodsFor: 'initialization' stamp: 'lr 5/7/2009 13:18'! initializePrimary: aPrimaryParser message: aMessageParser primary := aPrimaryParser. message := aMessageParser. self initialize! ! LBFactoryParser subclass: #LBLispFactoryParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! LBLispFactoryParser subclass: #LBLispFactoryCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! !LBLispFactoryCompiler class methodsFor: 'accessing' stamp: 'lr 4/8/2009 15:17'! concern ^ #compile:! ! !LBLispFactoryCompiler methodsFor: 'grammar' stamp: 'lr 4/8/2009 15:38'! send super send ==> [ :nodes | | resultNodes messageNode | resultNodes := OrderedCollection new. messageNode := RBMessageNode receiver: ``(stack last) selectorParts: nodes second first arguments: nodes second second. nodes third isEmpty ifTrue: [ resultNodes add: messageNode ] ifFalse: [ resultNodes add: ``(stack addLast: `,messageNode); addAll: nodes third flatten; add: ``(stack removeLast) ]. resultNodes ]! ! !LBLispFactoryCompiler methodsFor: 'grammar' stamp: 'lr 4/8/2009 15:38'! start super start ==> [ :nodes | RBSequenceNode new addTemporaryNamed: 'stack'; addNode: ``(stack := OrderedCollection with: `,(nodes second)); addNodes: (nodes third flatten); addNode: ``(stack last); yourself ]! ! !LBLispFactoryParser class methodsFor: 'accessing' stamp: 'lr 4/8/2009 15:41'! concern ^ #highlight:! ! !LBLispFactoryParser class methodsFor: 'accessing' stamp: 'lr 4/9/2009 10:55'! identifier ^ 'builder-parens:'! ! !LBLispFactoryParser methodsFor: 'token' stamp: 'lr 5/5/2009 14:31'! close $) token! ! !LBLispFactoryParser methodsFor: 'token' stamp: 'lr 5/5/2009 14:31'! open $( token! ! !LBLispFactoryParser methodsFor: 'grammar' stamp: 'lr 4/8/2009 15:06'! send open , message , send star , close! ! !LBLispFactoryParser methodsFor: 'grammar' stamp: 'lr 4/8/2009 15:07'! start open , primary , send star , close! ! LBFactoryParser subclass: #LBPythonFactoryParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! LBPythonFactoryParser subclass: #LBPythonFactoryCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! !LBPythonFactoryCompiler class methodsFor: 'accessing' stamp: 'lr 4/8/2009 15:41'! concern ^ #compile:! ! !LBPythonFactoryCompiler methodsFor: 'grammar' stamp: 'lr 4/9/2009 11:00'! send super start ==> [ :nodes | self halt. OrderedCollection new add: nodes first size - nodes second; addAll: nodes flatten; yourself ]! ! !LBPythonFactoryCompiler methodsFor: 'grammar' stamp: 'lr 4/8/2009 15:45'! start super start ==> [ :nodes | self halt ]! ! !LBPythonFactoryParser class methodsFor: 'accessing' stamp: 'lr 5/7/2009 12:07'! concern ^ #highlight:! ! !LBPythonFactoryParser class methodsFor: 'accessing' stamp: 'lr 4/9/2009 10:55'! identifier ^ 'builder-indent:'! ! !LBPythonFactoryParser methodsFor: 'token' stamp: 'lr 5/5/2009 15:19'! indent #tab star! ! !LBPythonFactoryParser methodsFor: 'token' stamp: 'lr 5/5/2009 14:31'! newline #cr token! ! !LBPythonFactoryParser methodsFor: 'grammar' stamp: 'lr 4/8/2009 10:36'! send indent , message , newline optional! ! !LBPythonFactoryParser methodsFor: 'grammar' stamp: 'lr 4/8/2009 10:36'! start indent , primary , send star! ! CUCompositeParser subclass: #LBRomanGrammar instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBRomanGrammar methodsFor: 'productions' stamp: 'lr 10/2/2009 11:27'! romanCharacter $I / $V / $X / $L / $C / $D / $M! ! !LBRomanGrammar methodsFor: 'productions' stamp: 'lr 10/2/2009 14:49'! romanNumber (romanCharacter plus , #word not) token ==> [ :token | token value romanToArabic isNil ifTrue: [ PPFailure reason: 'Roman number expected' ] ifFalse: [ token ] ]! ! !LBRomanGrammar methodsFor: 'accessing' stamp: 'lr 10/2/2009 11:25'! start romanNumber! ! LBLanguageBox subclass: #LBFactoryBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! !LBFactoryBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:43'! change: aGrammar ^ LBChange new fragment: (self factoriesFor: aGrammar); before: (aGrammar productionAt: #cascadeExpression)! ! !LBFactoryBox methodsFor: 'hooks' stamp: 'lr 5/7/2009 13:21'! compile: aNode ^ aNode third! ! !LBFactoryBox methodsFor: 'parsing' stamp: 'lr 6/23/2009 12:06'! factoriesFor: aParser ^ (LBFactoryParser withAllSubclasses select: [ :class | aParser class concern = class concern ]) inject: PPChoiceParser new into: [ :parser :class | parser / ('<<' asParser token , class identifier asParser token , (class primary: (aParser productionAt: #cascadeExpression) message: (aParser productionAt: #message)) , '>>' asParser token) ]! ! !LBFactoryBox methodsFor: 'hooks' stamp: 'lr 5/7/2009 13:40'! highlight: aNode ^ CHHighlighter mark: aNode with: Color orange! ! LBLanguageBox subclass: #LBPathBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBPathBox class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'! initialize self default recompile! ! !LBPathBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:43'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #cascadeExpression); fragment: (aGrammar productionAt: #primary) , ('::' asParser token , (aGrammar productionAt: #unaryToken) , ('()' asParser token / (aGrammar productionAt: #block) optional)) plus! ! !LBPathBox methodsFor: 'hooks' stamp: 'lr 2/6/2009 11:59'! compile: aCollection ^ (aCollection second collect: [ :each | each flatten ]) inject: aCollection first into: [ :receiver :array | | result | result := ``(`,(receiver) gather: `,(array second value asSymbol)). array third isNil ifFalse: [ result := ``(`,result select: `,(array third)) ]. result ]! ! !LBPathBox methodsFor: 'hooks' stamp: 'lr 4/2/2009 15:32'! highlight: aCollection ^ CHHighlighter mark: aCollection with: TextEmphasis italic! ! LBLanguageBox subclass: #LBPositionalBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBPositionalBox class methodsFor: 'initialization' stamp: 'lr 5/18/2009 11:17'! initialize self default recompile! ! !LBPositionalBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:43'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #unaryMessage); fragment: (aGrammar productionAt: #unary) token , $( asParser token , ((aGrammar productionAt: #primary) separatedBy: $, asParser token) optional , $) asParser token! ! !LBPositionalBox methodsFor: 'hooks' stamp: 'lr 5/18/2009 12:09'! compile: aCollection | selectors arguments | selectors := OrderedCollection with: aCollection first. arguments := OrderedCollection new. aCollection third do: [ :argument | (argument isKindOf: PPToken) ifFalse: [ (selectors size = 1 and: [ selectors last value last ~= $: ]) ifTrue: [ selectors add: (PPToken on: selectors removeFirst value , ':') ] ifFalse: [ selectors add: (PPToken on: 'with:') ]. arguments add: argument ] ]. ^ Array with: selectors asArray with: arguments asArray! ! !LBPositionalBox methodsFor: 'hooks' stamp: 'lr 5/18/2009 12:07'! highlight: aCollection ^ CHHighlighter mark: aCollection with: TextEmphasis underlined! ! !LBPositionalBox methodsFor: 'hooks' stamp: 'lr 5/18/2009 12:06'! transform: aCollection ^ Array with: aCollection first with: aCollection second with: (aCollection third ifNil: [ #() ]) with: aCollection fourth! ! LBLanguageBox subclass: #LBQuoteBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! LBQuoteBox subclass: #LBPrimaryQuoteBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBPrimaryQuoteBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:44'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #primary); fragment: self metaParser token , (aGrammar productionAt: #primary)! ! !LBQuoteBox methodsFor: 'hooks' stamp: 'lr 2/3/2009 19:08'! compile: aCollection ^ (self findMetaClass: aCollection first value) value: aCollection second! ! !LBQuoteBox methodsFor: 'private' stamp: 'lr 2/3/2009 19:08'! findMetaClass: aString ^ QQMetaNode subclasses detect: [ :each | aString last = each prefix ] ifNone: [ self error: 'Unknown meta node ' , aString printString ]! ! !LBQuoteBox methodsFor: 'hooks' stamp: 'lr 2/3/2009 19:08'! highlight: aCollection ^ (self findMetaClass: aCollection first value) highlight: aCollection! ! !LBQuoteBox methodsFor: 'testing' stamp: 'lr 6/23/2009 11:44'! includesSelector: aSelector in: aClass "The quoting operators should be available everywhere." ^ self class name ~= #LBQuoteBox! ! !LBQuoteBox methodsFor: 'private' stamp: 'lr 5/7/2009 11:51'! metaParser ^ QQMetaNode subclasses inject: PPChoiceParser new into: [ :parser :class | parser / (String with: $` with: class prefix) asParser ]! ! LBQuoteBox subclass: #LBVariableQuoteBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBVariableQuoteBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:44'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #variable); fragment: self metaParser token , (aGrammar productionAt: #variable)! ! LBLanguageBox subclass: #LBRegexpBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBRegexpBox class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'! initialize self default recompile! ! !LBRegexpBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:44'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #primary); fragment: ($/ asParser , $/ asParser negate star , $/ asParser) token! ! !LBRegexpBox methodsFor: 'hooks' stamp: 'lr 8/27/2009 16:04'! compile: aToken ^ ``(`,(aToken value copyFrom: 2 to: aToken size - 1) asRegex)! ! !LBRegexpBox methodsFor: 'hooks' stamp: 'lr 1/19/2009 09:49'! highlight: aToken ^ aToken -> Color orange! ! LBLanguageBox subclass: #LBRomanBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBRomanBox methodsFor: 'hooks' stamp: 'lr 10/2/2009 11:32'! change: aGrammar ^ LBChange new before: (aGrammar productionAt: #numberLiteral); fragment: LBRomanGrammar new! ! !LBRomanBox methodsFor: 'hooks' stamp: 'lr 10/2/2009 11:33'! compile: aToken ^ aToken value romanToArabic lift: aToken! ! !LBRomanBox methodsFor: 'hooks' stamp: 'lr 9/29/2009 11:24'! highlight: aToken ^ aToken -> Color darkGray! ! LBLanguageBox subclass: #LBSqlBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes-SQL'! !LBSqlBox class methodsFor: 'executing' stamp: 'lr 10/2/2009 11:15'! execute: aString "This is a fake database connection, it always responds a single row with a single column containing the same string. The SQL query doesn't actually matter." ^ #( #('info@planet-sl.org') )! ! !LBSqlBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 15:09'! change: aSmalltalkGrammar ^ LBChange new fragment: (self sqlGrammarFor: aSmalltalkGrammar); before: (aSmalltalkGrammar productionAt: #cascadeExpression)! ! !LBSqlBox methodsFor: 'hooks' stamp: 'lr 10/2/2009 12:02'! compile: aCollection | expressions | expressions := OrderedCollection new. aCollection flatten do: [ :each | each class = PPToken ifTrue: [ (each value = '@(' or: [ each value = ')' ]) ifFalse: [ (expressions notEmpty and: [ expressions last class = RBLiteralNode ]) ifTrue: [ expressions last token instVarNamed: 'stop' put: each stop. expressions last value: expressions last token value ] ifFalse: [ expressions addLast: (RBLiteralNode literalToken: each value: each value) ] ] ] ifFalse: [ each isNil ifFalse: [ expressions addLast: ``(`,each asString) ] ] ]. ^ ``(LBSqlBox execute: `,(expressions fold: [ :a :b | ``(`,a , `,b) ]))! ! !LBSqlBox methodsFor: 'private' stamp: 'lr 8/31/2009 00:29'! sqlGrammarFor: aSmalltalkGrammar | grammarClass grammar | grammarClass := LBSqlGrammar allSubclasses detect: [ :each | each concern = aSmalltalkGrammar class concern ] ifNone: [ self error: 'Unsupported language concern: ' , aSmalltalkGrammar class concern ]. grammar := grammarClass new. LBChange new after: (grammar productionAt: #expression); fragment: ('@(' asParser token , (aSmalltalkGrammar productionAt: #cascadeExpression) , $) asParser token); modify: grammar with: nil. ^ grammar! ! !RxMatcher methodsFor: '*cutie-languageboxes' stamp: 'lr 8/31/2009 00:46'! matches: aString at: anInteger ^ (self matches: aString) ifTrue: [ self subexpression: anInteger ]! ! !ProtoObject methodsFor: '*cutie-languageboxes' stamp: 'lr 6/23/2009 11:54'! languageBoxesHighlight ^ LBSmalltalkGrammar compileUseLanguageBoxes ifTrue: [ LBHighlightAction new ]! ! !ProtoObject methodsFor: '*cutie-languageboxes' stamp: 'lr 6/23/2009 11:54'! languageBoxesParser ^ LBSmalltalkGrammar compileUseLanguageBoxes ifTrue: [ LBParseAction new ]! ! !String methodsFor: '*cutie-languageboxes' stamp: 'lr 5/7/2009 12:17'! =~ aRegexp ^ aRegexp matches: self! ! !String methodsFor: '*cutie-languageboxes' stamp: 'lr 10/2/2009 11:33'! romanToArabic ^ CURomanExample romanToArabic: self! ! TestCase subclass: #LBTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! LBTestCase subclass: #LBCrosscuttingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBCrosscuttingTest class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:45'! languageBoxes ^ Array with: LBPathBox with: LBRegexpBox! ! !LBCrosscuttingTest methodsFor: 'testing' stamp: 'lr 6/23/2009 11:45'! testModular | input output | input := #(('aaaa') ('aaab' 'aaba' 'abaa' 'baaa') ('aabb' 'abba' 'bbaa' 'abab' 'baba' 'baab') ('abbb' 'babb' 'bbab' 'bbba') ('bbbb')). output := input::yourself[ :each | each =~ /a*b*/ ]. self assert: output = #('aaaa' 'aaab' 'aabb' 'abbb' 'bbbb')! ! LBTestCase subclass: #LBFactoryTest instanceVariableNames: '' classVariableNames: 'LALispFactory' poolDictionaries: '' category: 'Cutie-LanguageBoxes-Skins'! !LBFactoryTest class methodsFor: 'accessing' stamp: 'lr 6/23/2009 12:05'! languageBoxes ^ Array with: LBFactoryBox! ! !LBFactoryTest methodsFor: 'testing-lisp' stamp: 'lr 6/23/2009 12:06'! testLispFactoryMorph | morph | morph := <>. self assert: (morph isKindOf: WatchMorph). self assert: (morph color = Color white). morph submorphs do: [ :each | self assert: each color = Color black ]! ! !LBFactoryTest methodsFor: 'testing-lisp' stamp: 'lr 6/23/2009 12:06'! testLispFactoryOrderedCollection | collection | collection := <>. self assert: collection size = 4. self assert: collection first = 1. self assert: collection second = 2. self assert: collection third size = 1. self assert: collection third first = 3. self assert: collection fourth size = 2. self assert: collection fourth first = 4. self assert: collection fourth second = 5! ! LBTestCase subclass: #LBPathBoxTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBPathBoxTest class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:45'! languageBoxes ^ Array with: LBPathBox! ! !LBPathBoxTest methodsFor: 'testing' stamp: 'lr 6/30/2009 13:58'! testSimpleFilter | input output | input := #((1 2 3) (4 5) (6)). output := input::yourself[ :each | each odd ]. self assert: output = #(1 3 5)! ! !LBPathBoxTest methodsFor: 'testing' stamp: 'lr 6/23/2009 11:46'! testSimplePath | input output | input := #((1 2 3) (4 5) (6)). output := input::yourself. self assert: output = #(1 2 3 4 5 6)! ! LBTestCase subclass: #LBPositionalBoxTest instanceVariableNames: 'seen' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBPositionalBoxTest class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:45'! languageBoxes ^ Array with: LBPositionalBox! ! !LBPositionalBoxTest methodsFor: 'running' stamp: 'lr 5/18/2009 11:47'! assertSeen: anArray self assert: seen asArray = anArray description: anArray printString , ' expected, but got ' , seen asArray printString. seen := OrderedCollection new! ! !LBPositionalBoxTest methodsFor: 'utilities' stamp: 'lr 5/18/2009 14:30'! empty! ! !LBPositionalBoxTest methodsFor: 'utilities' stamp: 'lr 5/18/2009 11:47'! foo seen add: #foo! ! !LBPositionalBoxTest methodsFor: 'utilities' stamp: 'lr 5/18/2009 11:48'! foo: aFirstObject seen add: #foo:; add: aFirstObject! ! !LBPositionalBoxTest methodsFor: 'utilities' stamp: 'lr 5/18/2009 11:48'! foo: aFirstObject with: aSecondObject seen add: #foo:with:; add: aFirstObject; add: aSecondObject! ! !LBPositionalBoxTest methodsFor: 'utilities' stamp: 'lr 5/18/2009 11:48'! foo: aFirstObject with: aSecondObject with: aThirdObject seen add: #foo:with:with:; add: aFirstObject; add: aSecondObject; add: aThirdObject! ! !LBPositionalBoxTest methodsFor: 'running' stamp: 'lr 6/23/2009 11:47'! setUp super setUp. seen := OrderedCollection new! ! !LBPositionalBoxTest methodsFor: 'testing-chaining' stamp: 'lr 5/18/2009 14:43'! testChainAtBegin self foo(1) empty. self assertSeen: #(foo: 1). self foo(1, 2) empty empty. self assertSeen: #(foo:with: 1 2)! ! !LBPositionalBoxTest methodsFor: 'testing-chaining' stamp: 'lr 5/18/2009 14:31'! testChainAtEnd self empty foo(1). self assertSeen: #(foo: 1). self empty empty foo(1, 2). self assertSeen: #(foo:with: 1 2)! ! !LBPositionalBoxTest methodsFor: 'testing-chaining' stamp: 'lr 5/18/2009 14:43'! testChainInbetween self empty foo(1) empty. self assertSeen: #(foo: 1). self empty empty foo(1, 2) empty empty. self assertSeen: #(foo:with: 1 2)! ! !LBPositionalBoxTest methodsFor: 'testing-chaining' stamp: 'lr 6/30/2009 13:58'! testMultipleChained self foo() foo(2) foo(3, 4) foo(4, 5, 6). self assertSeen: #(foo foo: 2 foo:with: 3 4 foo:with:with: 4 5 6)! ! !LBPositionalBoxTest methodsFor: 'testing-nested' stamp: 'lr 5/18/2009 14:47'! testNestedCalling self foo(1, (self foo(2, (self foo(3))))). self assertSeen: #(foo: 3 foo:with: 2) , (Array with: self) , #(foo:with: 1) , (Array with: self)! ! !LBPositionalBoxTest methodsFor: 'testing-nested' stamp: 'lr 5/18/2009 14:44'! testNestedExpression self foo(('a' , 'b'), (1 + 2)). self assertSeen: #(foo:with: 'ab' 3)! ! !LBPositionalBoxTest methodsFor: 'testing-arguments' stamp: 'lr 5/18/2009 14:27'! testOneArgument self foo('abc'). self assertSeen: #(foo: 'abc')! ! !LBPositionalBoxTest methodsFor: 'testing-arguments' stamp: 'lr 5/18/2009 14:28'! testTreeArguments self foo(true, false, nil). self assertSeen: #(foo:with:with: true false nil)! ! !LBPositionalBoxTest methodsFor: 'testing-arguments' stamp: 'lr 5/18/2009 14:28'! testTwoArguments self foo($a, 'b'). self assertSeen: #(foo:with: $a 'b')! ! !LBPositionalBoxTest methodsFor: 'testing-arguments' stamp: 'lr 5/18/2009 14:27'! testZeroArguments self foo(). self assertSeen: #(foo)! ! LBTestCase subclass: #LBQuoteBoxTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBQuoteBoxTest class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:45'! languageBoxes ^ Array with: LBQuoteBox! ! !LBQuoteBoxTest methodsFor: 'testing-splice' stamp: 'lr 5/7/2009 13:04'! testParseSplice1 self assert: `@(10 factorial) = 3628800! ! !LBQuoteBoxTest methodsFor: 'testing-splice' stamp: 'lr 5/7/2009 13:04'! testParseSplice2 self assert: `@(DateAndTime now) < DateAndTime now! ! !LBQuoteBoxTest methodsFor: 'testing-quote' stamp: 'lr 5/7/2009 13:04'! testQuote1 | ast | ast := ``(1 + 2). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! !LBQuoteBoxTest methodsFor: 'testing-quote' stamp: 'lr 5/7/2009 13:04'! testQuote2 | ast | ast := ``{ 1 }. self assert: (ast isKindOf: RBArrayNode). self assert: ast formattedCode = '{ 1 }'! ! !LBQuoteBoxTest methodsFor: 'testing-quote' stamp: 'lr 6/30/2009 13:58'! testQuote3 | ast | ast := ``[ ]. self assert: (ast isKindOf: RBBlockNode). self assert: ast formattedCode = '[ ]'! ! !LBQuoteBoxTest methodsFor: 'testing-quote' stamp: 'lr 5/7/2009 13:04'! testQuote4 | ast | ast := ``123. self assert: (ast isKindOf: RBLiteralNode). self assert: ast formattedCode = '123'! ! !LBQuoteBoxTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote5 | ast | ast := ``x. self assert: (ast isKindOf: RBVariableNode). self assert: ast formattedCode = 'x'! ! !LBQuoteBoxTest methodsFor: 'testing-unquote' stamp: 'lr 4/3/2009 11:48'! testUnquote1 | one two ast | one := ``1. two := ``2. ast := ``(`,one + `,two). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! !LBQuoteBoxTest methodsFor: 'testing-unquote' stamp: 'lr 4/3/2009 11:48'! testUnquote2 | ast | ast := ``b. ast := ``(`,ast := 12). self assert: ast isAssignment. self assert: ast variable isVariable. self assert: ast variable name = 'b'. self assert: ast value isLiteral. self assert: ast value value = 12! ! LBTestCase subclass: #LBRegexpBoxTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBRegexpBoxTest class methodsFor: 'accessing' stamp: 'lr 8/27/2009 16:05'! languageBoxes ^ Array with: LBRegexpBox! ! !LBRegexpBoxTest methodsFor: 'accessing' stamp: 'lr 8/27/2009 16:05'! testPaper self assert: ('Nena - 99 Luftballons' =~ /.*\d+.*/)! ! !LBRegexpBoxTest methodsFor: 'accessing' stamp: 'lr 8/27/2009 16:05'! testRegexp self assert: ('10010100' =~ /[01]+/). self assert: ('aaaaab' =~ /a*b/). self assert: ('abbbbbbc' =~ /ab+c/). self assert: ('abbb' =~ /ab*/)! ! LBTestCase subclass: #LBRomanBoxTest instanceVariableNames: '' classVariableNames: 'III II' poolDictionaries: '' category: 'Cutie-LanguageBoxes'! !LBRomanBoxTest class methodsFor: 'accessing' stamp: 'lr 9/29/2009 11:25'! languageBoxes ^ Array with: LBRomanBox! ! !LBRomanBoxTest methodsFor: 'testing' stamp: 'lr 10/2/2009 14:49'! testRomanNumbers self assert: IV + VII = XI! ! LBTestCase subclass: #LBSqlBoxTest instanceVariableNames: '' classVariableNames: 'SELECT FROM SQLSession' poolDictionaries: '' category: 'Cutie-LanguageBoxes-SQL'! !LBSqlBoxTest class methodsFor: 'accessing' stamp: 'lr 7/8/2009 15:51'! languageBoxes ^ Array with: LBSqlBox with: LBRegexpBox ! ! !LBSqlBoxTest methodsFor: 'querying' stamp: 'lr 10/2/2009 12:02'! findEmail: aString "Retrieve the e-mail for the given username aString." | rows | rows := SELECT email FROM users WHERE username = @(/\s*(\w+)\s*/ matches: aString at: 2). rows isEmpty ifTrue: [ self error: 'User not found' ]. ^ rows first first! ! !LBSqlBoxTest methodsFor: 'testing' stamp: 'lr 10/2/2009 11:14'! testUser | email | self halt. email := self findEmail: 'sle'. self assert: email = 'info@planet-sl.org'! ! !LBTestCase class methodsFor: 'private' stamp: 'lr 6/23/2009 12:09'! compile: aString classified: aSymbol notifying: anObject trailer: anArray ifFail: aBlock "Before compiling the methods of the receiver make sure that the language boxes are added." self languageBoxes do: [ :box | (box default environments noneSatisfy: [ :env | env includesClass: self ]) ifTrue: [ box default addClass: self ] ]. ^ super compile: aString classified: aSymbol notifying: anObject trailer: anArray ifFail: aBlock! ! !LBTestCase class methodsFor: 'testing' stamp: 'lr 10/2/2009 11:09'! isAbstract ^ self name = #LBTestCase! ! !LBTestCase class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:44'! languageBoxes ^ #()! ! LBPathBox initialize! LBPositionalBox initialize! LBRegexpBox initialize!