OhmSmalltalk Grammar Test Script

counter := 0.
results := OrderedCollection new.
classesToTest := Smalltalk allClasses.
'Compiling code for every method of every class.'
	displayProgressFrom: 1
	to: classesToTest size
	during: [:classBar |
		classesToTest doWithIndex: [:class :classIndex |
			| methodsToTest |
			methodsToTest := class methodDict values.
			('Checking ' , class printString , ' for compile errors.')
				displayProgressFrom: 1
				to: methodsToTest size
				during: [:methodBar |
					methodsToTest doWithIndex: [:method :methodIndex |
						| source newSource errorType matchResult syntaxError |
						errorType := #none.
						syntaxError := nil.
						source := method getSource asString.
						matchResult := OhmSmalltalk match: source startingFrom: #MethodDeclaration.
						matchResult failed ifTrue: [errorType := #rewriter].
						errorType == #none ifTrue: [
							| rewriter |
							rewriter := OhmSmalltalk synthesizedAttribute: OhmSourceRewriter new.
							newSource := rewriter value: matchResult.
							[Compiler new parse: newSource in: class notifying: nil]
								on: Error
								do: [:ex |
									syntaxError := ex.
									errorType := #compiler]].
						errorType ~= #none ifTrue: [
							results add: { class . method . errorType . syntaxError }].
						counter := counter + 1.
						methodBar value: methodIndex]].
			classBar value: classIndex]].

sortedResults := results sorted: [:a :b | | comparison |
					comparison := (a at: 1) printString compare: (b at: 1) printString.
					comparison = 2
						ifTrue: [(a at: 2) selector <= (b at: 2) selector]
						ifFalse: [comparison = 1]].

sortedResults := results sorted: [:a :b | (a at: 2) getSource asString size 
										<= (b at: 2) getSource asString size].

longStream := (FileDirectory uri: 'fileouts') newFileNamed: 'long.md'.
sortedResults do: [:result |
	| class method errorType syntaxError selector source |
	class := result at: 1.
	method := result at: 2.
	errorType := result at: 3.
	syntaxError := result at: 4.
	selector := method selector.
	source :=  method getSource asString withInternetLineEndings.

	longStream
		nextPutAll: '#### `';
		nextPutAll: class printString;
		nextPutAll: ' >> ';
		nextPutAll: selector;
		nextPut: $`; crlf;
		nextPutAll: '```smalltalk';  crlf;
		nextPutAll: source; crlf;
		nextPutAll: '```'; crlf.
							
	errorType == #compiler ifTrue: [
		longStream
			nextPutAll: '##### Syntax Error `';
			nextPutAll: syntaxError errorMessage;
			nextPutAll: '` ['; 
			nextPutAll: syntaxError location printString;
			nextPut: $]; crlf;
		 	nextPutAll: '```smalltalk'; crlf;
			nextPutAll: syntaxError errorCode asString withInternetLineEndings; crlf;
			nextPutAll: '```'; crlf].

	longStream
		crlf; nextPutAll: '---'; crlf; crlf].
longStream close.

compilerErrorCount := sortedResults count: [:each | (each at: 3) == #compiler].
rewriterErrorCount := sortedResults count: [:each | (each at: 3) == #rewriter].
errorCount := sortedResults size.

shortStream := (FileDirectory uri: 'fileouts') newFileNamed: 'short.md'.
shortStream 
	nextPutAll: 'Total Number of Methods ';
	nextPutAll: counter printString; crlf;
	nextPutAll: 'Total Number of Errors ';
	nextPutAll: errorCount printString; crlf;
	nextPutAll: 'Rewriter Errors ';
	nextPutAll: rewriterErrorCount printString; crlf;
	nextPutAll: 'Compiler Errors ';
	nextPutAll: compilerErrorCount printString; crlf;
	nextPutAll: 'Percentage of rewritable methods ';
	nextPutAll: (1 - (errorCount / counter)) asFloat printString; crlf; crlf;
	nextPutAll: '```'; crlf.

sortedResults do: [:result |
	| class method errorType selector |
	class := result at: 1.
	method := result at: 2.
	errorType := result at: 3.
	selector := method selector.

	errorType == #compiler
		ifTrue: [shortStream nextPutAll: '[C] ']
		ifFalse: [shortStream nextPutAll: '[·] '].

	shortStream
		nextPutAll: class printString;
		nextPutAll: ' >> ';
		nextPutAll: selector; crlf].
shortStream nextPutAll: '```'.
shortStream close.