author | Jan Vrany <jan.vrany@labware.com> |
Fri, 01 Sep 2023 22:32:10 +0100 | |
branch | jv |
changeset 19646 | 235fea37201a |
parent 19600 | 4b1129981eb9 |
permissions | -rw-r--r-- |
14947 | 1 |
" |
2 |
COPYRIGHT (c) 2004 by eXept Software AG |
|
3 |
All Rights Reserved |
|
4 |
||
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
"{ Package: 'stx:libtool' }" |
|
13 |
||
14 |
"{ NameSpace: Tools }" |
|
15 |
||
16 |
Object subclass:#ClassChecker |
|
17 |
instanceVariableNames:'checkedClass badClasses badClassInfo badMethods badMethodInfo |
|
18 |
obsoleteWarners allObsoleteMethods checksPerformed' |
|
19 |
classVariableNames:'' |
|
20 |
poolDictionaries:'' |
|
21 |
category:'Interface-Browsers-New' |
|
22 |
! |
|
23 |
||
24 |
!ClassChecker class methodsFor:'documentation'! |
|
25 |
||
26 |
copyright |
|
27 |
" |
|
28 |
COPYRIGHT (c) 2004 by eXept Software AG |
|
29 |
All Rights Reserved |
|
30 |
||
31 |
This software is furnished under a license and may be used |
|
32 |
only in accordance with the terms of that license and with the |
|
33 |
inclusion of the above copyright notice. This software may not |
|
34 |
be provided or otherwise made available to, or used by, any |
|
35 |
other person. No title to or ownership of the software is |
|
36 |
hereby transferred. |
|
37 |
" |
|
38 |
! |
|
39 |
||
40 |
documentation |
|
41 |
" |
|
42 |
embeddable application displaying the class-categories. |
|
43 |
Provides an outputGenerator, which enumerates the classes in |
|
44 |
the selected categories. |
|
45 |
||
46 |
Attention: do not change the method categories 'checks-' into something else. |
|
47 |
The 'checks-' prefix is used to detect checks and these are listed in the browsers |
|
48 |
lint dialog. |
|
49 |
||
50 |
[author:] |
|
51 |
Claus Gittinger (cg@exept.de) |
|
52 |
" |
|
53 |
! ! |
|
54 |
||
55 |
!ClassChecker class methodsFor:'queries'! |
|
56 |
||
57 |
individualChecks |
|
58 |
"return a list of supported checks" |
|
59 |
||
60 |
|checks| |
|
61 |
||
62 |
checks := OrderedCollection new. |
|
63 |
self methodDictionary keysAndValuesDo:[:sel :mthd | |
|
64 |
(mthd category startsWith:'checks') ifTrue:[checks add:sel] |
|
65 |
]. |
|
66 |
checks sort. |
|
67 |
^ checks |
|
68 |
||
69 |
" |
|
70 |
self individualChecks |
|
71 |
" |
|
72 |
||
73 |
"Created: / 18.8.2000 / 22:30:46 / cg" |
|
74 |
"Modified: / 18.8.2000 / 22:31:02 / cg" |
|
75 |
! ! |
|
76 |
||
77 |
!ClassChecker methodsFor:'accessing'! |
|
78 |
||
79 |
badClassInfo |
|
80 |
^ badClassInfo |
|
81 |
! |
|
82 |
||
83 |
badMethodInfo |
|
84 |
^ badMethodInfo |
|
85 |
! |
|
86 |
||
87 |
checkedClass |
|
88 |
"return the value of the instance variable 'checkedClass' (automatically generated)" |
|
89 |
||
90 |
^ checkedClass |
|
91 |
! |
|
92 |
||
93 |
checkedClass:something |
|
94 |
"set the value of the instance variable 'checkedClass' (automatically generated)" |
|
95 |
||
96 |
checkedClass := something. |
|
97 |
checksPerformed := nil. |
|
98 |
! ! |
|
99 |
||
100 |
!ClassChecker methodsFor:'checking'! |
|
101 |
||
102 |
allChecks |
|
103 |
self errorChecks. |
|
104 |
self warningChecks. |
|
105 |
self styleChecks. |
|
106 |
! |
|
107 |
||
108 |
doCheck:whichCheck |
|
109 |
checksPerformed isNil ifTrue:[ |
|
110 |
checksPerformed := Set new. |
|
111 |
]. |
|
112 |
(checksPerformed includes:whichCheck) ifFalse:[ |
|
113 |
checksPerformed add:whichCheck. |
|
114 |
self perform:whichCheck |
|
115 |
] |
|
116 |
! |
|
117 |
||
118 |
errorChecks |
|
119 |
self doCheck:#subclassResponsibilityNotDefined. |
|
120 |
self doCheck:#sentNotImplemented. |
|
121 |
self doCheck:#definesEqualButNotHash. |
|
122 |
self doCheck:#instanceVariablesNeverWritten. |
|
123 |
! |
|
124 |
||
125 |
styleChecks |
|
126 |
self doCheck:#checkProtocols. |
|
127 |
self doCheck:#sendsObsoleteMethodWarningButNotTaggedAsObsoleteOrViceVersa. |
|
128 |
self doCheck:#unusedInstanceVariables. |
|
129 |
self doCheck:#unusedClassVariables. |
|
130 |
||
131 |
"/ self doCheck:#guardingClause. |
|
132 |
||
133 |
"Modified: / 18-05-2010 / 14:38:15 / cg" |
|
134 |
! |
|
135 |
||
136 |
warningChecks |
|
137 |
self doCheck:#messageNeverSentAndNotUsedAsSymbol. |
|
138 |
self doCheck:#sendsObsoleteMessages. |
|
139 |
self doCheck:#instanceVariablesNeverUsed. |
|
140 |
self doCheck:#instanceVariablesNeverWritten. |
|
141 |
self doCheck:#classVariablesNeverUsed. |
|
142 |
self doCheck:#classVariablesNeverWritten. |
|
143 |
self doCheck:#classInstanceVariablesNeverUsed. |
|
144 |
self doCheck:#classInstanceVariablesNeverWritten. |
|
145 |
self doCheck:#invalidKeyInImageResourceMethod |
|
146 |
! ! |
|
147 |
||
148 |
!ClassChecker methodsFor:'checks-individual'! |
|
149 |
||
150 |
checkProtocols |
|
151 |
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | |
|
152 |
self checkProtocolOf:method |
|
153 |
] |
|
154 |
! |
|
155 |
||
156 |
checkVariableNameConventions |
|
157 |
|badInstVars badClassVars| |
|
158 |
||
159 |
badInstVars := checkedClass instanceVariableNames select:[:varName | varName isUppercaseFirst]. |
|
160 |
badClassVars := checkedClass classVarNames select:[:varName | varName first isLowercase]. |
|
161 |
||
162 |
badInstVars notEmpty ifTrue:[ |
|
163 |
badInstVars := (badInstVars collect:[:v | '''' , v , '''']) asStringWith:$, . |
|
164 |
self |
|
165 |
rememberBadClass:checkedClass |
|
166 |
info:('instVars ' , badInstVars , ' should be lowercase (#checkNameConventions)'). |
|
167 |
]. |
|
168 |
badClassVars notEmpty ifTrue:[ |
|
169 |
badClassVars := (badClassVars collect:[:v | '''' , v , '''']) asStringWith:$, . |
|
170 |
self |
|
171 |
rememberBadClass:checkedClass |
|
172 |
info:('classVars ' , badClassVars , ' should be uppercase (#checkNameConventions)'). |
|
173 |
]. |
|
174 |
! |
|
175 |
||
176 |
classInstanceVariablesNeverUsed |
|
177 |
self instanceVariablesNeverUsedIn:checkedClass theMetaclass. |
|
178 |
! |
|
179 |
||
180 |
classInstanceVariablesNeverWritten |
|
181 |
self instanceVariablesNeverWrittenIn:checkedClass theMetaclass. |
|
182 |
! |
|
183 |
||
184 |
classVariablesNeverUsed |
|
185 |
|cls notUsedHere notUsedAnyWhere anySubclass| |
|
186 |
||
187 |
cls := checkedClass theNonMetaclass. |
|
188 |
notUsedHere := cls classVarNames asNewSet. |
|
189 |
notUsedHere isEmpty ifTrue:[^ self]. |
|
190 |
||
191 |
self removeUsedClassVariablesIn:cls from:notUsedHere. |
|
192 |
self removeUsedClassVariablesIn:cls class from:notUsedHere. |
|
193 |
||
194 |
notUsedHere notEmpty ifTrue:[ |
|
195 |
notUsedAnyWhere := notUsedHere copy. |
|
196 |
anySubclass := false. |
|
197 |
cls allSubclassesDo:[:eachSubclass | |
|
198 |
anySubclass := true. |
|
199 |
notUsedAnyWhere notEmpty ifTrue:[ |
|
200 |
self removeUsedClassVariablesIn:eachSubclass from:notUsedAnyWhere. |
|
201 |
self removeUsedClassVariablesIn:eachSubclass class from:notUsedAnyWhere. |
|
202 |
] |
|
203 |
]. |
|
204 |
||
205 |
notUsedHere do:[:eachVariable | |
|
206 |
|className| |
|
207 |
||
208 |
className := checkedClass name allBold. |
|
209 |
self |
|
210 |
rememberBadClass:cls |
|
211 |
info:('classVar ' , eachVariable allBold , ' is unused in ' , className , ' (#classVariablesNeverUsed)'). |
|
212 |
(notUsedAnyWhere includes:eachVariable) ifTrue:[ |
|
213 |
self |
|
214 |
rememberBadClass:cls |
|
215 |
info:('classVar ' , eachVariable allBold , ' is not even used in subclasses of ' , className , ' (#classVariablesNeverUsed)') |
|
216 |
] |
|
217 |
]. |
|
218 |
] |
|
219 |
! |
|
220 |
||
221 |
classVariablesNeverWritten |
|
222 |
|cls notWrittenHere notWrittenAnyWhere anySubclass| |
|
223 |
||
224 |
cls := checkedClass theNonMetaclass. |
|
225 |
notWrittenHere := cls classVarNames asNewSet. |
|
226 |
notWrittenHere isEmpty ifTrue:[^ self]. |
|
227 |
||
228 |
self removeWrittenClassVariablesIn:cls from:notWrittenHere. |
|
229 |
self removeWrittenClassVariablesIn:cls class from:notWrittenHere. |
|
230 |
||
231 |
notWrittenHere notEmpty ifTrue:[ |
|
232 |
notWrittenAnyWhere := notWrittenHere copy. |
|
233 |
anySubclass := false. |
|
234 |
cls allSubclassesDo:[:eachSubclass | |
|
235 |
anySubclass := true. |
|
236 |
notWrittenAnyWhere notEmpty ifTrue:[ |
|
237 |
self removeWrittenClassVariablesIn:eachSubclass from:notWrittenAnyWhere. |
|
238 |
self removeWrittenClassVariablesIn:eachSubclass class from:notWrittenAnyWhere. |
|
239 |
] |
|
240 |
]. |
|
241 |
||
242 |
notWrittenHere do:[:eachVariable | |
|
243 |
|className| |
|
244 |
||
245 |
className := cls name allBold. |
|
246 |
self |
|
247 |
rememberBadClass:cls |
|
248 |
info:('classVar ' , eachVariable allBold , ' is not set in ' , className , ' (#classVariablesNeverWritten)'). |
|
249 |
(notWrittenAnyWhere includes:eachVariable) ifTrue:[ |
|
250 |
self |
|
251 |
rememberBadClass:cls |
|
252 |
info:('classVar ' , eachVariable allBold , ' is not even set in subclasses of ' , className , ' (#classVariablesNeverWritten)') |
|
253 |
] |
|
254 |
]. |
|
255 |
] |
|
256 |
! |
|
257 |
||
258 |
definesEqualButNotHash |
|
259 |
(checkedClass includesSelector:#=) ifTrue:[ |
|
260 |
(checkedClass includesSelector:#hash) ifFalse:[ |
|
261 |
self |
|
262 |
rememberBadClass:checkedClass |
|
263 |
info:(checkedClass name allBold, ' redefines #=, but not #hash (#definesEqualButNotHash)'). |
|
264 |
] |
|
265 |
] |
|
266 |
! |
|
267 |
||
268 |
guardingClause |
|
269 |
|detector| |
|
270 |
||
271 |
detector := ParseTreeLintRule guardingClause. |
|
272 |
detector runOnEnvironment: (Array with:checkedClass). |
|
273 |
self breakPoint:#cg. |
|
274 |
! |
|
275 |
||
276 |
instanceVariablesNeverUsed |
|
277 |
self instanceVariablesNeverUsedIn:checkedClass theNonMetaclass. |
|
278 |
! |
|
279 |
||
280 |
instanceVariablesNeverWritten |
|
281 |
self instanceVariablesNeverWrittenIn:checkedClass theNonMetaclass. |
|
282 |
! |
|
283 |
||
284 |
invalidKeyInImageResourceMethod |
|
285 |
Icon flushCachedIcons. |
|
286 |
checkedClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
|
287 |
|img key name mclass| |
|
288 |
||
289 |
(mthd hasImageResource) ifTrue:[ |
|
290 |
((mclass := mthd mclass) notNil and:[mclass isMeta]) ifTrue:[ |
|
291 |
img := mthd valueWithReceiver:(mclass theNonMetaclass) arguments:#(). |
|
292 |
key := (Icon classVarAt:#KnownIcons) keyAtIdentityValue:img. |
|
293 |
key notNil ifTrue:[ |
|
294 |
name := (mclass name , ' ', mthd selector). |
|
295 |
name ~= key ifTrue:[ |
|
296 |
name := (mclass theNonMetaclass name , ' ', mthd selector). |
|
297 |
name ~= key ifTrue:[ |
|
298 |
self |
|
299 |
rememberBadMethod:mthd |
|
300 |
key:#invalidKeyInImageResourceMethod |
|
301 |
info:('key in constantNamed: does not match the method name') |
|
302 |
] |
|
303 |
] |
|
304 |
] |
|
305 |
] |
|
306 |
] |
|
307 |
]. |
|
308 |
! |
|
309 |
||
310 |
messageNeverSent |
|
311 |
"/ old code: (slow) |
|
312 |
"/ checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | |
|
313 |
"/ (self anySendsOf:mSelector) ifFalse:[ |
|
314 |
"/ self |
|
315 |
"/ rememberBadMethod:method |
|
316 |
"/ info:('#' , mSelector , ' is nowhere sent (#messageNeverSent)') |
|
317 |
"/ ]. |
|
318 |
"/ ]. |
|
319 |
||
320 |
|selectorsOfInterest| |
|
321 |
||
322 |
selectorsOfInterest := IdentitySet new. |
|
323 |
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | selectorsOfInterest add:mSelector]. |
|
324 |
(self messagesNeverSentIn:selectorsOfInterest) do:[:eachNeverSent | |
|
325 |
self |
|
326 |
rememberBadMethod:(checkedClass compiledMethodAt:eachNeverSent) |
|
327 |
key:#messageNeverSent |
|
328 |
info:('#' , eachNeverSent allBold, ' is nowhere sent (#messageNeverSent)') |
|
329 |
]. |
|
330 |
||
331 |
"Modified: / 18.8.2000 / 22:54:45 / cg" |
|
332 |
! |
|
333 |
||
334 |
messageNeverSentAndNotUsedAsSymbol |
|
335 |
|selectorsOfInterest| |
|
336 |
||
337 |
selectorsOfInterest := IdentitySet new. |
|
338 |
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | selectorsOfInterest add:mSelector]. |
|
339 |
(self messagesNeverSentAndNotUsedAsSymbolIn:selectorsOfInterest) do:[:eachNeverSent | |
|
340 |
self |
|
341 |
rememberBadMethod:(checkedClass compiledMethodAt:eachNeverSent) |
|
342 |
key:#messageNeverSentAndNotUsedAsSymbol |
|
343 |
info:('#' , eachNeverSent allBold, ' is nowhere sent and selector-symbol not used in any method (#messageNeverSentAndNotUsedAsSymbol)') |
|
344 |
]. |
|
345 |
||
346 |
"Modified: / 18.8.2000 / 23:10:56 / cg" |
|
347 |
! |
|
348 |
||
349 |
parseMethod:method in:aClass withParserDo:aBlock onErrorDo:errorBlock |
|
350 |
|source parser| |
|
351 |
||
352 |
source := method source. |
|
353 |
parser := Parser |
|
354 |
parseMethod:source |
|
355 |
in:aClass |
|
356 |
ignoreErrors:true |
|
357 |
ignoreWarnings:true. |
|
358 |
||
359 |
(parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
360 |
aBlock value:parser |
|
361 |
] ifFalse:[ |
|
362 |
errorBlock value |
|
363 |
]. |
|
364 |
||
365 |
"Created: / 18-05-2010 / 15:17:19 / cg" |
|
366 |
! |
|
367 |
||
368 |
sendsObsoleteMessages |
|
369 |
obsoleteWarners isNil ifTrue:[ |
|
370 |
obsoleteWarners := Object selectors select:[:each | each startsWith:'obsoleteMethodWarning']. |
|
371 |
]. |
|
372 |
allObsoleteMethods isNil ifTrue:[ |
|
373 |
allObsoleteMethods := IdentitySet new. |
|
374 |
Method allSubInstancesDo:[:eachMethod | |lits selector| |
|
375 |
((lits := eachMethod literals) notNil |
|
376 |
and:[lits includesAny:obsoleteWarners]) ifTrue:[ |
|
377 |
(eachMethod messagesSent includesAny:obsoleteWarners) ifTrue:[ |
|
378 |
selector := eachMethod selector. |
|
379 |
selector notNil ifTrue:[ |
|
380 |
allObsoleteMethods add:selector. |
|
381 |
] |
|
382 |
]. |
|
383 |
]. |
|
384 |
]. |
|
385 |
||
386 |
"/ manually patchup; there are some which should not be considered as bad ... |
|
387 |
allObsoleteMethods removeAllFoundIn:#( #',' #'at:' #'at:put:' #'raise'). |
|
388 |
allObsoleteMethods removeAllFoundIn:#( #'asText'). |
|
389 |
allObsoleteMethods removeAllFoundIn:obsoleteWarners. |
|
390 |
]. |
|
391 |
||
392 |
checkedClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
|
393 |
|lits sentMessages whichOnes pT searcher nodes| |
|
394 |
||
395 |
((lits := mthd literals) notNil |
|
396 |
and:[lits includesAny:allObsoleteMethods]) ifTrue:[ |
|
397 |
sentMessages := mthd messagesSent. |
|
398 |
(sentMessages includesAny:allObsoleteMethods) ifTrue:[ |
|
399 |
whichOnes := sentMessages select:[:each | allObsoleteMethods includes:each]. |
|
400 |
||
401 |
(RBParser notNil |
|
402 |
and:[RBParser isLoaded]) ifTrue:[ |
|
403 |
"/ lets look at this a bit more detailed; |
|
404 |
"/ parse it and see if we can filter out any messages |
|
405 |
"/ (i.e. look if we can figure out the receiver type) |
|
406 |
||
407 |
"/ pT := RBParser |
|
408 |
"/ parseMethod: (mthd source) |
|
409 |
"/ onError: [:aString :pos | nil]. |
|
410 |
"/ pT notNil ifTrue:[ |
|
411 |
"/ searcher := ParseTreeSearcher |
|
412 |
"/ allMessageSendsMatchingAny:whichOnes ignoreCase:false. |
|
413 |
"/ nodes := searcher executeTree:pT initialAnswer:(OrderedCollection new). |
|
414 |
"/ nodes := nodes |
|
415 |
"/ select: |
|
416 |
"/ [:aSendNode | |
|
417 |
"/ self halt. |
|
418 |
"/ ]. |
|
419 |
"/ whichOnes := nodes collect:[:aSendNode | aSendNode selector]. |
|
420 |
"/ ]. |
|
421 |
]. |
|
422 |
||
423 |
whichOnes asOrderedCollection sort do:[:eachObsoleteMessage | |
|
424 |
self |
|
425 |
rememberBadMethod:mthd |
|
426 |
key:#sendsObsoleteMessages |
|
427 |
info:('possibly sends an obsolete message: ' , eachObsoleteMessage , ' (#sendsObsoleteMessages)') |
|
428 |
]. |
|
429 |
]. |
|
430 |
] |
|
431 |
] |
|
432 |
! |
|
433 |
||
434 |
sendsObsoleteMethodWarningButNotTaggedAsObsoleteOrViceVersa |
|
435 |
|obsoleteWarners| |
|
436 |
||
437 |
obsoleteWarners := #( #'obsoleteMethodWarning' #'obsoleteMethodWarning:' ). |
|
438 |
||
439 |
checkedClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
|
440 |
|lits sentMessages whichOnes pT searcher nodes| |
|
441 |
||
442 |
((lits := mthd literals) notNil |
|
443 |
and:[lits includesAny:obsoleteWarners]) ifTrue:[ |
|
444 |
mthd isObsolete ifFalse:[ |
|
445 |
self |
|
446 |
rememberBadMethod:mthd |
|
447 |
key:#sendsObsoleteMethodWarningButNotTaggedAsObsoleteOrViceVersa |
|
448 |
info:('sends obsoleteMethodWarning but not tagged as obsolete') |
|
449 |
]. |
|
450 |
] ifFalse:[ |
|
451 |
mthd isObsolete ifTrue:[ |
|
452 |
self |
|
453 |
rememberBadMethod:mthd |
|
454 |
key:#sendsObsoleteMethodWarningButNotTaggedAsObsoleteOrViceVersa |
|
455 |
info:('tagged as obsolete but does not send an obsoleteMethodWarning') |
|
456 |
]. |
|
457 |
]. |
|
458 |
] |
|
459 |
! |
|
460 |
||
461 |
sentNotImplemented |
|
462 |
|alreadyChecked alreadyCheckedSelf alreadyCheckedSuper| |
|
463 |
||
464 |
alreadyChecked := IdentitySet new. |
|
465 |
alreadyCheckedSelf := IdentitySet new. |
|
466 |
alreadyCheckedSuper := IdentitySet new. |
|
467 |
||
468 |
checkedClass methodDictionary keysAndValuesDo:[:mSelector :method | |
|
469 |
|sentSelectors selfSelectors superSelectors selectorsNoWhereImplemented| |
|
470 |
||
471 |
selectorsNoWhereImplemented := IdentitySet new. |
|
472 |
sentSelectors := method messagesSent. |
|
473 |
sentSelectors do:[:eachSelector | |
|
474 |
(alreadyChecked includes:eachSelector) ifFalse:[ |
|
475 |
(self anyImplementationOf:eachSelector) ifTrue:[ |
|
476 |
alreadyChecked add:eachSelector |
|
477 |
] ifFalse:[ |
|
478 |
selectorsNoWhereImplemented add:eachSelector. |
|
479 |
self |
|
480 |
rememberBadMethod:method |
|
481 |
key:#sentNotImplemented |
|
482 |
info:('#' , eachSelector allBold, ' is nowhere implemented (#sentNotImplemented)') |
|
483 |
] |
|
484 |
] |
|
485 |
]. |
|
486 |
||
487 |
selfSelectors := method messagesSentToSelf. |
|
488 |
selfSelectors do:[:eachSelector | |
|
489 |
(selectorsNoWhereImplemented includes:eachSelector) ifFalse:[ |
|
490 |
(alreadyCheckedSelf includes:eachSelector) ifFalse:[ |
|
491 |
(self anyImplementationOf:eachSelector inOrAbove:checkedClass) ifTrue:[ |
|
492 |
alreadyCheckedSelf add:eachSelector |
|
493 |
] ifFalse:[ |
|
494 |
self |
|
495 |
rememberBadMethod:method |
|
496 |
key:#sentNotImplemented |
|
497 |
info:('#' , eachSelector allBold, ' is not implemented in the class (#sentNotImplemented)') |
|
498 |
] |
|
499 |
] |
|
500 |
] |
|
501 |
]. |
|
502 |
||
503 |
superSelectors := method messagesSentToSuper. |
|
504 |
superSelectors do:[:eachSelector | |
|
505 |
(selectorsNoWhereImplemented includes:eachSelector) ifFalse:[ |
|
506 |
(alreadyCheckedSuper includes:eachSelector) ifFalse:[ |
|
507 |
(self anyImplementationOf:eachSelector inOrAbove:(checkedClass superclass)) ifTrue:[ |
|
508 |
alreadyCheckedSuper add:eachSelector |
|
509 |
] ifFalse:[ |
|
510 |
self |
|
511 |
rememberBadMethod:method |
|
512 |
key:#sentNotImplemented |
|
513 |
info:('#' , eachSelector allBold, ' is not implemented in any superclass (#sentNotImplemented)') |
|
514 |
] |
|
515 |
] |
|
516 |
] |
|
517 |
]. |
|
518 |
]. |
|
519 |
! |
|
520 |
||
521 |
subclassResponsibilityNotDefined |
|
522 |
|classesInBetween| |
|
523 |
||
524 |
checkedClass allSuperclasses do:[:eachSuperClass | |
|
525 |
eachSuperClass methodDictionary keysAndValuesDo:[:mSelector :method | |
|
526 |
(method referencesLiteral:#subclassResponsibility) ifTrue:[ |
|
527 |
"/ parse it to see if it really does ... |
|
19600
4b1129981eb9
Replace `sends:` with `sendsSelector:` and `sendsAny:` with `sendsAnySelector:`
Jan Vrany <jan.vrany@labware.com>
parents:
15566
diff
changeset
|
528 |
(method sendsSelector:#subclassResponsibility) ifTrue:[ |
14947 | 529 |
"/ ok, got one; |
530 |
"/ now, see if it is defined below this superClass |
|
531 |
classesInBetween := checkedClass withAllSuperclasses copy. |
|
532 |
classesInBetween removeAll:(eachSuperClass withAllSuperclasses). |
|
533 |
(self anyImplementationOf:mSelector in:classesInBetween) ifFalse:[ |
|
534 |
(self methodShouldBeIgnoredInSubclassResponsibilityNotDefined:method) |
|
535 |
ifFalse:[ |
|
536 |
self |
|
537 |
rememberBadMethod:method |
|
538 |
key:#subclassResponsibilityNotDefined |
|
539 |
info:(checkedClass name allBold , ' should redefine the #' , mSelector allBold , ' method (#subclassResponsibilityNotDefined)'). |
|
540 |
]. |
|
541 |
]. |
|
542 |
] |
|
543 |
] |
|
544 |
] |
|
545 |
]. |
|
546 |
! |
|
547 |
||
548 |
unusedClassVariables |
|
549 |
|remainingVars| |
|
550 |
||
551 |
remainingVars := checkedClass theNonMetaclass classVarNames asNewSet. |
|
552 |
||
553 |
checkedClass theNonMetaclass withAllSubclassesDo:[:eachClassToCheck | |
|
554 |
eachClassToCheck instAndClassMethodsDo:[:method | |
|
555 |
self |
|
556 |
parseMethod:method in:method mclass |
|
557 |
withParserDo:[:parser | |
|
558 |
remainingVars removeAllFoundIn:(parser usedClassVars) |
|
559 |
] |
|
560 |
onErrorDo:[] |
|
561 |
]. |
|
562 |
]. |
|
563 |
||
564 |
remainingVars asSortedCollection do:[:eachVar | |
|
565 |
self rememberBadClass:checkedClass info:'Unused class variable: ',eachVar |
|
566 |
]. |
|
567 |
||
568 |
"Created: / 18-05-2010 / 14:37:42 / cg" |
|
569 |
! |
|
570 |
||
571 |
unusedInstanceVariables |
|
572 |
|remainingVars| |
|
573 |
||
574 |
remainingVars := checkedClass theNonMetaclass instVarNames asNewSet. |
|
575 |
||
576 |
checkedClass theNonMetaclass withAllSubclassesDo:[:eachClassToCheck | |
|
577 |
eachClassToCheck methodDictionary keysAndValuesDo:[:mSelector :method | |
|
578 |
self |
|
579 |
parseMethod:method in:eachClassToCheck |
|
580 |
withParserDo:[:parser | |
|
581 |
remainingVars removeAllFoundIn:(parser usedInstVars) |
|
582 |
] |
|
583 |
onErrorDo:[] |
|
584 |
]. |
|
585 |
]. |
|
586 |
||
587 |
remainingVars asSortedCollection do:[:eachVar | |
|
588 |
self rememberBadClass:checkedClass info:'Unused instance variable: ',eachVar |
|
589 |
]. |
|
590 |
||
591 |
"Created: / 18-05-2010 / 14:32:09 / cg" |
|
592 |
! ! |
|
593 |
||
594 |
!ClassChecker methodsFor:'helpers'! |
|
595 |
||
596 |
anyImplementationOf:aSelector |
|
597 |
Smalltalk allClassesDo:[:eachClass | |
|
598 |
(eachClass theNonMetaclass includesSelector:aSelector) ifTrue:[^ true]. |
|
599 |
(eachClass theMetaclass includesSelector:aSelector) ifTrue:[^ true]. |
|
600 |
]. |
|
601 |
^ false |
|
602 |
! |
|
603 |
||
604 |
anyImplementationOf:aSelector in:aCollectionOfClasses |
|
605 |
^ aCollectionOfClasses |
|
606 |
contains:[:aClass | (aClass includesSelector:aSelector) ]. |
|
607 |
! |
|
608 |
||
609 |
anyImplementationOf:aSelector inOrAbove:aClass |
|
610 |
aClass withAllSuperclassesDo:[:eachClass | |
|
611 |
(eachClass includesSelector:aSelector) ifTrue:[^ true]. |
|
612 |
]. |
|
613 |
^ false |
|
614 |
! |
|
615 |
||
616 |
anySendsOf:aSelector |
|
617 |
Smalltalk allMethodsDo:[:mthd | |
|
19600
4b1129981eb9
Replace `sends:` with `sendsSelector:` and `sendsAny:` with `sendsAnySelector:`
Jan Vrany <jan.vrany@labware.com>
parents:
15566
diff
changeset
|
618 |
(mthd sendsSelector:aSelector) ifTrue:[^ true]. |
14947 | 619 |
]. |
620 |
^ false |
|
621 |
! |
|
622 |
||
623 |
checkProtocolOf:aMethod |
|
624 |
|mClass mSelector protocol superClass implClass superProtocol| |
|
625 |
||
626 |
mClass := aMethod mclass. |
|
627 |
mSelector := aMethod selector. |
|
628 |
mClass isNil ifTrue:[^ true]. |
|
629 |
mSelector isNil ifTrue:[^ true]. |
|
630 |
||
631 |
protocol := aMethod category. |
|
632 |
protocol isNil ifTrue: [^true]. |
|
633 |
||
634 |
superClass := mClass superclass. |
|
635 |
superClass isNil ifTrue: [^true]. |
|
636 |
||
637 |
implClass := superClass whichClassIncludesSelector:mSelector. |
|
638 |
implClass isNil ifTrue: [^true]. |
|
639 |
||
640 |
superProtocol := (implClass compiledMethodAt:mSelector) category. |
|
641 |
superProtocol = protocol ifTrue: [^true]. |
|
642 |
superProtocol isNil ifTrue: [^true]. |
|
643 |
||
644 |
self |
|
645 |
rememberBadMethod:aMethod |
|
646 |
key:#checkProtocols |
|
647 |
info:('#' , mSelector allBold , ' is classified under "' , protocol allBold , '" in ' |
|
648 |
, mClass name , ' and under "' , superProtocol allBold , '" in ' , implClass name |
|
649 |
, ' (#checkProtocols)') |
|
650 |
||
651 |
"Modified: / 18.8.2000 / 23:13:53 / cg" |
|
652 |
! |
|
653 |
||
654 |
checkUnusedVariables:aMethod rememberReadInstVarsIn:readInstVars writtenInstVarsIn:writtenInstVars readClassVarsIn:readClassVars writtenClassVarsIn:writtenClassVars |
|
655 |
|p mClass sourceString| |
|
656 |
||
657 |
sourceString := aMethod source. |
|
658 |
||
659 |
mClass := aMethod mclass. |
|
660 |
||
661 |
p := Parser parseMethodSilent:sourceString in:mClass. |
|
662 |
readInstVars addAll:(p readInstVars). |
|
663 |
writtenInstVars addAll:(p modifiedInstVars). |
|
664 |
readClassVars addAll:(p readClassVars). |
|
665 |
writtenClassVars addAll:(p modifiedClassVars). |
|
666 |
! |
|
667 |
||
668 |
instanceVariablesNeverUsedIn:aClass |
|
669 |
|notUsedHere notUsedAnyWhere anySubclass| |
|
670 |
||
671 |
notUsedHere := aClass instVarNames asNewSet. |
|
672 |
notUsedHere isEmpty ifTrue:[^ self]. |
|
673 |
||
674 |
self removeUsedInstanceVariablesIn:aClass from:notUsedHere. |
|
675 |
||
676 |
notUsedHere notEmpty ifTrue:[ |
|
677 |
notUsedAnyWhere := notUsedHere copy. |
|
678 |
anySubclass := false. |
|
679 |
aClass allSubclassesDo:[:eachSubclass | |
|
680 |
anySubclass := true. |
|
681 |
notUsedAnyWhere notEmpty ifTrue:[ |
|
682 |
self removeUsedInstanceVariablesIn:eachSubclass from:notUsedAnyWhere. |
|
683 |
] |
|
684 |
]. |
|
685 |
||
686 |
notUsedHere do:[:eachVariable | |
|
687 |
|className| |
|
688 |
||
689 |
className := aClass name allBold. |
|
690 |
self |
|
691 |
rememberBadClass:aClass |
|
692 |
info:('instVar ' , eachVariable allBold , ' is unused in ' , className , ' (#instanceVariablesNeverUsed)'). |
|
693 |
||
694 |
anySubclass ifTrue:[ |
|
695 |
(notUsedAnyWhere includes:eachVariable) ifTrue:[ |
|
696 |
self |
|
697 |
rememberBadClass:aClass |
|
698 |
info:('instVar ' , eachVariable allBold , ' is not even used in subclasses of ' , className , ' (#instanceVariablesNeverUsed)') |
|
699 |
] |
|
700 |
] |
|
701 |
]. |
|
702 |
] |
|
703 |
! |
|
704 |
||
705 |
instanceVariablesNeverWrittenIn:aClass |
|
706 |
|notWrittenHere notWrittenAnyWhere anySubclass| |
|
707 |
||
708 |
notWrittenHere := aClass instVarNames asNewSet. |
|
709 |
notWrittenHere isEmpty ifTrue:[^ self]. |
|
710 |
||
711 |
self removeWrittenInstanceVariablesIn:aClass from:notWrittenHere. |
|
712 |
||
713 |
notWrittenHere notEmpty ifTrue:[ |
|
714 |
notWrittenAnyWhere := notWrittenHere copy. |
|
715 |
anySubclass := false. |
|
716 |
aClass allSubclassesDo:[:eachSubclass | |
|
717 |
anySubclass := true. |
|
718 |
notWrittenAnyWhere notEmpty ifTrue:[ |
|
719 |
self removeWrittenInstanceVariablesIn:eachSubclass from:notWrittenAnyWhere. |
|
720 |
] |
|
721 |
]. |
|
722 |
||
723 |
notWrittenHere do:[:eachVariable | |
|
724 |
|className| |
|
725 |
||
726 |
className := aClass name allBold. |
|
727 |
self |
|
728 |
rememberBadClass:aClass |
|
729 |
info:('instVar ' , eachVariable allBold , ' is nowhere set in ' , className , ' (#instanceVariablesNeverWritten)'). |
|
730 |
anySubclass ifTrue:[ |
|
731 |
(notWrittenAnyWhere includes:eachVariable) ifTrue:[ |
|
732 |
self |
|
733 |
rememberBadClass:aClass |
|
734 |
info:('instVar ' , eachVariable allBold , ' is not even set in subclasses of ' , className , ' (#instanceVariablesNeverWritten)') |
|
735 |
] |
|
736 |
] |
|
737 |
]. |
|
738 |
] |
|
739 |
! |
|
740 |
||
741 |
messagesNeverSentAndNotUsedAsSymbolIn:selectorsOfInterest |
|
742 |
|remaining toRemove checkBlock| |
|
743 |
||
744 |
remaining := selectorsOfInterest asNewIdentitySet. |
|
745 |
toRemove := IdentitySet new. |
|
746 |
||
747 |
checkBlock := [:eachClass | |
|
748 |
eachClass instAndClassSelectorsAndMethodsDo:[:mSel :mthd | |lits| |
|
749 |
lits := mthd literals. |
|
750 |
lits notNil ifTrue:[ |
|
751 |
lits traverse:[:eachLiteral | |
|
752 |
eachLiteral isSymbol ifTrue:[ |
|
753 |
remaining remove:eachLiteral ifAbsent:nil. |
|
754 |
] |
|
755 |
]. |
|
756 |
remaining isEmpty ifTrue:[^ remaining]. |
|
757 |
] |
|
758 |
]. |
|
759 |
]. |
|
760 |
||
761 |
"/ start searching in the checkedClass - chances are high, we find some here |
|
762 |
checkBlock value:checkedClass. |
|
763 |
checkedClass superclass notNil ifTrue:[checkBlock value:checkedClass superclass]. |
|
764 |
Smalltalk allClassesDo:checkBlock. |
|
765 |
||
766 |
^ remaining |
|
767 |
||
768 |
"Modified: / 18.8.2000 / 23:05:53 / cg" |
|
769 |
"Created: / 18.8.2000 / 23:06:55 / cg" |
|
770 |
! |
|
771 |
||
772 |
messagesNeverSentIn:selectorsOfInterest |
|
773 |
|remaining| |
|
774 |
||
775 |
remaining := selectorsOfInterest copy. |
|
776 |
Smalltalk allMethodsDo:[:mthd | |
|
777 |
|lits| |
|
778 |
||
779 |
lits := mthd literals. |
|
780 |
lits notNil ifTrue:[ |
|
781 |
(lits includesAny:remaining) ifTrue:[ |
|
782 |
remaining removeAllFoundIn:(mthd messagesSent). |
|
783 |
remaining isEmpty ifTrue:[^ remaining]. |
|
784 |
] |
|
785 |
] |
|
786 |
]. |
|
787 |
^ remaining |
|
788 |
||
789 |
"Created: / 18.8.2000 / 22:53:38 / cg" |
|
790 |
"Modified: / 18.8.2000 / 22:56:59 / cg" |
|
791 |
! |
|
792 |
||
793 |
methodShouldBeIgnoredInSubclassResponsibilityNotDefined:aMethod |
|
794 |
"a kludge for now - would like to have a pragma, resource or other |
|
795 |
way to mark such a method" |
|
796 |
||
797 |
aMethod == (Object compiledMethodAt:#implementedBySubclass) ifTrue:[^ true]. |
|
798 |
aMethod == (Object compiledMethodAt:#readBinaryContentsFromData:manager:) ifTrue:[^ true]. |
|
799 |
aMethod == (Object compiledMethodAt:#finalize) ifTrue:[^ true]. |
|
800 |
^ false. |
|
801 |
! |
|
802 |
||
803 |
rememberBadClass:class info:whatIsWrong |
|
804 |
|entry| |
|
805 |
||
806 |
badClasses isNil ifTrue:[ |
|
807 |
badClasses := IdentitySet new. |
|
808 |
]. |
|
809 |
badClasses add:class. |
|
810 |
||
811 |
badClassInfo isNil ifTrue:[ |
|
812 |
badClassInfo := IdentityDictionary new. |
|
813 |
]. |
|
814 |
entry := badClassInfo at:class ifAbsentPut:[ OrderedCollection new ]. |
|
815 |
entry add:whatIsWrong. |
|
816 |
! |
|
817 |
||
818 |
rememberBadMethod:method key:key info:whatIsWrong |
|
819 |
|entry| |
|
820 |
||
821 |
badMethods isNil ifTrue:[ |
|
822 |
badMethods := Set new. |
|
823 |
]. |
|
824 |
(badMethods includes:(method -> key)) ifTrue:[^ self]. |
|
825 |
||
826 |
badMethods add:(method -> key). |
|
827 |
||
828 |
badMethodInfo isNil ifTrue:[ |
|
829 |
badMethodInfo := IdentityDictionary new. |
|
830 |
]. |
|
831 |
entry := badMethodInfo at:method ifAbsentPut:[ OrderedCollection new ]. |
|
832 |
entry add:whatIsWrong. |
|
833 |
! |
|
834 |
||
835 |
rememberBadMethods:methods key:key info:whatIsWrong |
|
836 |
methods do:[:eachMethod | |
|
837 |
self rememberBadMethod:eachMethod key:key info:whatIsWrong |
|
838 |
]. |
|
839 |
! |
|
840 |
||
841 |
removeUsedClassVariablesIn:aClass from:aCollectionOfVariablenames |
|
842 |
aClass selectorsAndMethodsDo:[:mSelector :method | |
|
843 |
|src usedVars parser| |
|
844 |
||
845 |
src := method source. |
|
846 |
src notNil ifTrue:[ |
|
847 |
parser := Parser |
|
848 |
parseMethod:src |
|
849 |
in:aClass |
|
850 |
ignoreErrors:true |
|
851 |
ignoreWarnings:true. |
|
852 |
||
853 |
(parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
854 |
aCollectionOfVariablenames removeAllFoundIn:(parser usedClassVars). |
|
855 |
aCollectionOfVariablenames isEmpty ifTrue:[^ self]. |
|
856 |
] |
|
857 |
]. |
|
858 |
]. |
|
859 |
! |
|
860 |
||
861 |
removeUsedInstanceVariablesIn:aClass from:aCollectionOfVariablenames |
|
862 |
aClass selectorsAndMethodsDo:[:mSelector :method | |
|
863 |
|src usedVars parser| |
|
864 |
||
865 |
src := method source. |
|
866 |
src notNil ifTrue:[ |
|
867 |
parser := Parser |
|
868 |
parseMethod:src |
|
869 |
in:aClass |
|
870 |
ignoreErrors:true |
|
871 |
ignoreWarnings:true. |
|
872 |
||
873 |
(parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
874 |
aCollectionOfVariablenames removeAllFoundIn:(parser usedInstVars). |
|
875 |
aCollectionOfVariablenames isEmpty ifTrue:[^ self]. |
|
876 |
] |
|
877 |
]. |
|
878 |
]. |
|
879 |
! |
|
880 |
||
881 |
removeWrittenClassVariablesIn:aClass from:aCollectionOfVariablenames |
|
882 |
aClass selectorsAndMethodsDo:[:mSelector :method | |
|
883 |
|src usedVars parser| |
|
884 |
||
885 |
src := method source. |
|
886 |
src notNil ifTrue:[ |
|
887 |
parser := Parser |
|
888 |
parseMethod:src |
|
889 |
in:aClass |
|
890 |
ignoreErrors:true |
|
891 |
ignoreWarnings:true. |
|
892 |
||
893 |
(parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
894 |
aCollectionOfVariablenames removeAllFoundIn:(parser modifiedClassVars). |
|
895 |
aCollectionOfVariablenames isEmpty ifTrue:[^ self]. |
|
896 |
] |
|
897 |
]. |
|
898 |
]. |
|
899 |
! |
|
900 |
||
901 |
removeWrittenInstanceVariablesIn:aClass from:aCollectionOfVariablenames |
|
902 |
aClass selectorsAndMethodsDo:[:mSelector :method | |
|
903 |
|src usedVars parser| |
|
904 |
||
905 |
src := method source. |
|
906 |
src notNil ifTrue:[ |
|
907 |
parser := Parser |
|
908 |
parseMethod:src |
|
909 |
in:aClass |
|
910 |
ignoreErrors:true |
|
911 |
ignoreWarnings:true. |
|
912 |
||
913 |
(parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
914 |
aCollectionOfVariablenames removeAllFoundIn:(parser modifiedInstVars). |
|
915 |
aCollectionOfVariablenames isEmpty ifTrue:[^ self]. |
|
916 |
] |
|
917 |
]. |
|
918 |
]. |
|
919 |
! ! |
|
920 |
||
921 |
!ClassChecker class methodsFor:'documentation'! |
|
922 |
||
923 |
version |
|
924 |
^ '$Header: /cvs/stx/stx/libtool/Tools__ClassChecker.st,v 1.21 2014-11-28 16:09:23 cg Exp $' |
|
925 |
! |
|
926 |
||
927 |
version_CVS |
|
928 |
^ '$Header: /cvs/stx/stx/libtool/Tools__ClassChecker.st,v 1.21 2014-11-28 16:09:23 cg Exp $' |
|
929 |
! ! |
|
930 |