From 472e707bb37ad04a8a1b3cec1625d01694fb3a7c Mon Sep 17 00:00:00 2001 From: Dmitry Dorofeev Date: Sun, 20 Sep 2026 20:34:06 +0300 Subject: [PATCH] Add SQL-aware duplication cleaning and standard browser preset --- docs/mooseide-integration.md | 11 ++ .../FmxSQLReplicationCleanerTest.class.st | 60 +++++++++ .../FmxSQLReplicationCleaner.class.st | 123 ++++++++++++++++++ 3 files changed, 194 insertions(+) create mode 100644 src/FamixNGSQL-MooseIDE-Tests/FmxSQLReplicationCleanerTest.class.st create mode 100644 src/FamixNGSQL-MooseIDE/FmxSQLReplicationCleaner.class.st diff --git a/docs/mooseide-integration.md b/docs/mooseide-integration.md index 84917fe..aa4d073 100644 --- a/docs/mooseide-integration.md +++ b/docs/mooseide-integration.md @@ -22,3 +22,14 @@ fork-first v3 development work, not a published v3 release. GitHub CI loads these optional tests in the ready-made Moose image. The plain Pharo job continues to test Core without GUI dependencies. + +## SQL duplication analysis + +Choose **PostgreSQL** as the source cleaner in the standard Duplication Browser settings, or open it with the preset: + +```smalltalk +FmxSQLReplicationCleaner openOn: (model entities select: [ :entity | + entity hasSourceAnchor and: [ entity sourceAnchor hasSourceText ] ]). +``` + +The cleaner preserves SQL literals, quoted identifiers and dollar-quoted bodies; removes line and nested block comments; and keeps original line numbers. Whitespace inside literals stays significant. It assumes PostgreSQL `standard_conforming_strings = on`; explicit `E` strings support escaped quotes. Unterminated lexical input raises an error instead of silently changing its meaning. Dollar-quoted bodies are compared verbatim, without recursively interpreting their language. This is lexical clone detection, not semantic SQL equivalence. Thresholds remain configurable in the standard browser. diff --git a/src/FamixNGSQL-MooseIDE-Tests/FmxSQLReplicationCleanerTest.class.st b/src/FamixNGSQL-MooseIDE-Tests/FmxSQLReplicationCleanerTest.class.st new file mode 100644 index 0000000..06702cd --- /dev/null +++ b/src/FamixNGSQL-MooseIDE-Tests/FmxSQLReplicationCleanerTest.class.st @@ -0,0 +1,60 @@ +Class { + #name : #FmxSQLReplicationCleanerTest, + #superclass : #TestCase, + #category : #'FamixNGSQL-MooseIDE-Tests' +} +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testCommentsAndTokenBoundaries [ + self assert: (FmxSQLReplicationCleaner new cleanedTextLines: + '-- heading', String lf, 'SELECT/* a /* nested */ b */x -- end') asArray + equals: { 2 -> 'SELECT x' } +] +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testQuotesAndDollarBodiesAreVerbatim [ + | text | + text := 'SELECT ''https://x -- /* y */'', "a""--b", $tag$ /* -- */ $tag$, ''it''''s ok'''. + self assert: (FmxSQLReplicationCleaner new cleanedTextLines: text) first value equals: text. + self deny: (FmxSQLReplicationCleaner new cleanedTextLines: 'SELECT ''a b''') + equals: (FmxSQLReplicationCleaner new cleanedTextLines: 'SELECT ''ab''') +] +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testEscapedQuoteAndMultilineLiteral [ + | text lines | + text := 'SELECT E''a\''-- b'', $$', String lf, ' -- body ', String lf, '$$;', String lf, + '/* comment', String lf, '*/', String lf, 'SELECT 2'. + lines := FmxSQLReplicationCleaner new cleanedTextLines: text. + self assert: lines second equals: 2 -> ' -- body '. + self assert: lines last equals: 6 -> 'SELECT 2'. + self assert: lines first value equals: 'SELECT E''a\''-- b'', $$' +] +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testRejectsUnterminatedLexemes [ + { '/* missing'. 'SELECT ''missing'. 'SELECT $a$missing' } do: [ :text | + self should: [ FmxSQLReplicationCleaner new cleanedTextLines: text ] raise: Error ] +] +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testStandardDetectorOnSQLSourceAnchors [ + | entities configuration manager | + entities := (1 to: 2) collect: [ :i | | owner query | + owner := FmxSQLView new name: 'view', i asString; source: 'SELECT 1', String lf, 'FROM items'; yourself. + query := FmxSQLSelectQuery new. + query sourceAnchor: (FmxSQLEntitySourceAnchor new entity: owner; start: 1; end: owner source size; yourself). + query ]. + configuration := FamixRepConfiguration sourcesCleaner: FmxSQLReplicationCleaner new + minimumNumberOfReplicas: 2 ofLines: 2 ofCharacters: 1. + manager := FamixRepDetector new configuration: configuration; runOn: entities. + self assert: manager replicatedFragments notEmpty. + self assert: manager replicatedFragments anyOne replicas anyOne codeText equals: entities first sourceText +] + +{ #category : #tests } +FmxSQLReplicationCleanerTest >> testStandardBrowserUsesSQLCleaner [ + | owner query browser | + owner := FmxSQLView new source: 'SELECT 1'; yourself. + query := FmxSQLSelectQuery new. + query sourceAnchor: (FmxSQLEntitySourceAnchor new entity: owner; start: 1; end: 8; yourself). + browser := FmxSQLReplicationCleaner openOn: { query }. + [ self assert: browser specModel currentConfiguration sourcesCleaner class equals: FmxSQLReplicationCleaner. + self assert: (MiDuplicationBrowserModel availableSourcesCleaners anySatisfy: [ :cleaner | + cleaner class = FmxSQLReplicationCleaner ]) ] ensure: [ browser window close ] +] diff --git a/src/FamixNGSQL-MooseIDE/FmxSQLReplicationCleaner.class.st b/src/FamixNGSQL-MooseIDE/FmxSQLReplicationCleaner.class.st new file mode 100644 index 0000000..c057a0c --- /dev/null +++ b/src/FamixNGSQL-MooseIDE/FmxSQLReplicationCleaner.class.st @@ -0,0 +1,123 @@ +"PostgreSQL lexical cleaner. Preserves quoted text and line positions; assumes standard_conforming_strings = on." +Class { + #name : #FmxSQLReplicationCleaner, + #superclass : #FamixRepSourcesCleaner, + #instVars : [ 'source', 'index', 'output', 'state', 'depth', 'delimiter', 'escaped', 'pendingSpace', 'lineHasCode' ], + #category : #'FamixNGSQL-MooseIDE' +} + +{ #category : #accessing } +FmxSQLReplicationCleaner class >> description [ + ^ 'PostgreSQL comments and quoting (standard_conforming_strings=on)' +] + +{ #category : #printing } +FmxSQLReplicationCleaner class >> displayStringOn: stream [ + stream nextPutAll: 'PostgreSQL' +] + +{ #category : #opening } +FmxSQLReplicationCleaner class >> openOn: entities [ + | browser configuration | + (entities notEmpty and: [ entities allSatisfy: [ :entity | + (entity isKindOf: FmxSQLEntity) and: [ entity hasSourceAnchor ] ] ]) + ifFalse: [ self error: 'Select SQL entities with source anchors' ]. + browser := MiDuplicationBrowser new. + browser followEntity: entities asMooseGroup. + configuration := browser specModel currentConfiguration. + configuration sourcesCleaner: self new. + browser specModel updateFromConfiguration: configuration. + browser open. + ^ browser +] + +{ #category : #cleaning } +FmxSQLReplicationCleaner >> cleanedTextLines: text [ + | lines | + source := text. + index := 1. + output := String new writeStream. + state := #normal. + depth := 0. + pendingSpace := false. + lineHasCode := false. + [ index <= source size ] whileTrue: [ self scanNext ]. + (#(normal lineComment) includes: state) ifFalse: [ self error: 'Unterminated SQL quoted text or comment' ]. + lines := OrderedCollection new. + output contents lines doWithIndex: [ :line :lineNumber | + line ifNotEmpty: [ lines add: lineNumber -> line ] ]. + ^ lines +] + +{ #category : #private } +FmxSQLReplicationCleaner >> matches: text [ + ^ index + text size - 1 <= source size and: [ + (source copyFrom: index to: index + text size - 1) = text ] +] + +{ #category : #private } +FmxSQLReplicationCleaner >> putCode: character [ + (pendingSpace and: [ lineHasCode ]) ifTrue: [ output space ]. + pendingSpace := false. + output nextPut: character. + lineHasCode := true +] + +{ #category : #private } +FmxSQLReplicationCleaner >> dollarDelimiter [ + | end tag | + end := source indexOf: $$ startingAt: index + 1 ifAbsent: [ 0 ]. + end = 0 ifTrue: [ ^ nil ]. + tag := source copyFrom: index + 1 to: end - 1. + (tag notEmpty and: [ (tag first isLetter or: [ tag first = $_ ]) not + or: [ (tag allSatisfy: [ :c | c isAlphaNumeric or: [ c = $_ ] ]) not ] ]) ifTrue: [ ^ nil ]. + (index > 1 and: [ (source at: index - 1) isAlphaNumeric or: [ (source at: index - 1) = $_ ] ]) ifTrue: [ ^ nil ]. + ^ source copyFrom: index to: end +] + +{ #category : #private } +FmxSQLReplicationCleaner >> scanNext [ + | c quote | + c := source at: index. + state = #dollar ifTrue: [ + (self matches: delimiter) + ifTrue: [ output nextPutAll: delimiter. index := index + delimiter size. state := #normal ] + ifFalse: [ output nextPut: c. index := index + 1 ]. + ^ self ]. + state = #quoted ifTrue: [ + output nextPut: c. + index := index + 1. + (escaped and: [ c = $\ and: [ index <= source size ] ]) ifTrue: [ + output nextPut: (source at: index). index := index + 1. ^ self ]. + c = delimiter ifTrue: [ + (index <= source size and: [ (source at: index) = delimiter ]) + ifTrue: [ output nextPut: delimiter. index := index + 1 ] + ifFalse: [ state := #normal ] ]. + ^ self ]. + (c = Character cr or: [ c = Character lf ]) ifTrue: [ + output nextPut: c. pendingSpace := false. lineHasCode := false. + state = #lineComment ifTrue: [ state := #normal ]. + index := index + 1. ^ self ]. + state = #lineComment ifTrue: [ index := index + 1. ^ self ]. + state = #blockComment ifTrue: [ + (self matches: '/*') ifTrue: [ depth := depth + 1. index := index + 2. ^ self ]. + (self matches: '*/') ifTrue: [ depth := depth - 1. index := index + 2. + depth = 0 ifTrue: [ state := #normal ]. ^ self ]. + index := index + 1. ^ self ]. + c isSeparator ifTrue: [ pendingSpace := true. index := index + 1. ^ self ]. + (self matches: '--') ifTrue: [ state := #lineComment. index := index + 2. ^ self ]. + (self matches: '/*') ifTrue: [ state := #blockComment. depth := 1. + pendingSpace := true. index := index + 2. ^ self ]. + quote := c = $' or: [ c = $" ]. + quote ifTrue: [ + escaped := c = $' and: [ index > 1 and: [ + (source at: index - 1) asLowercase = $e and: [ index = 2 or: [ + ((source at: index - 2) isAlphaNumeric or: [ '_$' includes: (source at: index - 2) ]) not ] ] ] ]. + delimiter := c. state := #quoted ]. + (c = $$ and: [ (delimiter := self dollarDelimiter) notNil ]) ifTrue: [ + self putCode: c. + output nextPutAll: delimiter allButFirst. + index := index + delimiter size. state := #dollar. ^ self ]. + self putCode: c. + index := index + 1 +]