eliot@cs.qmw.ac.uk (Eliot Miranda) (03/21/91)
Yet more Smalltalk-80 v2.0 through v2.3 Multiple Inheritance Bug Fixes. This fixes hierarchy printing. In the standard code when a non-dynamic super- class prints its instance variable names it prints ** all ** its instance variable names, possibly duplicating names already printed by dynamic superclasses. !Behavior methodsFor: 'printing' shallowCopy! printHierarchy "Answer a description containing the names and instance variable names of all of the subclasses and superclasses of the receiver." | aStream index supers | index _ 0. aStream _ WriteStream on: (String new: 16). self allDynamicSuperclasses reverseDo: [:aClass | aStream crtab: index. index _ index + 1. aStream nextPutAll: aClass name. aStream space. aStream print: aClass instVarNames. supers _ aClass superclasses. supers size > 1 ifTrue: [ | instVars | instVars _ aClass superclass allInstVarNames. aStream nextPutAll: ' [also'. (supers copyFrom: 2 to: supers size) do: [:s | aStream space; nextPutAll: s name; nextPutAll: ' ('. s allInstVarNames do: [:n| (instVars includes: n) ifFalse: [aStream print: n; space]]. aStream nextPut: $)]. aStream nextPut: $] ]]. aStream cr. self printSubclassesOn: aStream callingSuperclass: self dynamicSuperclass level: index. ^aStream contents! ! !Behavior methodsFor: 'As yet unclassified' shallowCopy! printSubclassesOn: aStream callingSuperclass: whichSuper level: level "As part of the algorithm for printing a description of the receiver, print the subclass on the file stream, aStream, indenting level times." | subs supers | aStream crtab: level. aStream nextPutAll: self name. aStream space; print: self instVarNames. supers _ self superclasses. supers size > 1 ifTrue: [ | instVars | instVars _ superclass allInstVarNames. aStream nextPutAll: ' [also'. (supers copyWithout: whichSuper) do: [:s | aStream space; nextPutAll: s name; nextPutAll: ' ('. s allInstVarNames do: [:n| (instVars includes: n) ifFalse: [ aStream print: n; space. instVars addLast: n]]. aStream nextPut: $)]. aStream nextPut: $] ]. subs _ self subclasses. self == Class ifTrue: [aStream crtab: level+1; nextPutAll: '... all the Metaclasses ...'. subs _ subs reject: [:sub | sub isMeta]]. "Print subclasses in alphabetical order" (subs asSortedCollection: [:x :y | x name < y name]) do: [:sub | sub printSubclassesOn: aStream callingSuperclass: self level: level + 1]! ! -- Eliot Miranda email: eliot@cs.qmw.ac.uk Dept of Computer Science Tel: 071 975 5229 (+44 71 975 5229) Queen Mary Westfield College ARPA: eliot%cs.qmw.ac.uk@nsf.ac.uk Mile End Road UUCP: eliot@qmw-cs.uucp LONDON E1 4NS