Skip to content

Commit

Permalink
50225
Browse files Browse the repository at this point in the history
16167 remove useless methods
	https://pharo.fogbugz.com/f/cases/16167

16170 Add Manifests for the bootstrap (part 1)
	https://pharo.fogbugz.com/f/cases/16170

16172 Kernel and Ring should not depend on Nautilus
	https://pharo.fogbugz.com/f/cases/16172

http://files.pharo.org/image/50/50225.zip
  • Loading branch information
Jenkins Build Server authored and ci committed Aug 13, 2015
1 parent d8f4de7 commit 79c4410
Show file tree
Hide file tree
Showing 120 changed files with 393 additions and 130 deletions.
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#Transcript #Reflectivity #'System-Support' #'Collections-Abstract' #'System-Localization')
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Abstract' #Traits)
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestAnnouncementsCore
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Announcements-Core'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Graphics-Primitives' #'Collections-Arithmetic' #Traits #'System-Localization')
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Streams')
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Streams')
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'System-Support' #'Collections-Support' #Traits)
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#UIManager #'Text-Core' #Transcript #Traits #'Tool-Transcript' #'System-Support' #'Collections-Abstract' #Jobs)
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'AST-Core' #'OpalCompiler-Core' #'Multilingual-OtherLanguages' #Traits #'System-Support')
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Streams')
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'System-Support' #'Collections-Streams')
1 change: 1 addition & 0 deletions Compression.package/ManifestCompression.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#Jobs #Transcript #'Tool-Base' #'Tool-FileList' #'System-Changes' #'System-Support' #'System-Localization' #Traits)
5 changes: 5 additions & 0 deletions Compression.package/ManifestCompression.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestCompression
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Compression'
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'FileSystem-Disk' #'Regex-Core' #'System-Platforms' #'AST-Core' #'System-Support' #'Collections-Streams' #Traits)
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestFileSystemCore
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileSystem-Core'
1 change: 1 addition & 0 deletions Files.package/ManifestFiles.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#Traits #'System-Sources' #Compression #'Graphics-Primitives' #'System-Changes' #'System-Support' #'Collections-Abstract' #'System-Localization')
5 changes: 5 additions & 0 deletions Files.package/ManifestFiles.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestFiles
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Files'
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Graphics-Fonts' #'AST-Core' #Traits #'Graphics-Canvas')
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestGraphicsPrimitives
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-Primitives'
1 change: 1 addition & 0 deletions Jobs.package/ManifestJobs.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'System-Support' #'Morphic-Base' #'Collections-Abstract')
5 changes: 5 additions & 0 deletions Jobs.package/ManifestJobs.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestJobs
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Jobs'
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
basicCheckClass: aClass
"Every class that implements veryDeepInner: or veryDeepCopyWith: must copy all its inst vars.
The danger is that a user will add a new instance variable and forget to copy it.
This method will check those conditions on a class and return a collection of methods that looked suspicious.
If you get a non-empty collection, an implementation of veryDeepCopyWith: or veryDeepInner: needs to be updated (check inside the collection).
The idea is to catch a change while it is still in the system of the programmer who made it.
This is an old method. We do not know why it is checking for the size of the method > 20, or the inclusion of the selector in the literals.
May require a further refactor."
| warnings |
warnings := Set new.

(aClass includesSelector: #veryDeepInner:) ifTrue: [ | veryDeepInnerMethod |
veryDeepInnerMethod := aClass >> #veryDeepInner:.
((self doesMethod: #veryDeepInner: writeAllInstanceVariablesOfClass: aClass)) ifFalse: [
warnings add: veryDeepInnerMethod ]].

(aClass includesSelector: #veryDeepCopyWith:) ifTrue: [ | veryDeepCopyWithMethod |
veryDeepCopyWithMethod := aClass >> #veryDeepCopyWith:.
(veryDeepCopyWithMethod size > 20) & (veryDeepCopyWithMethod literals includes: #veryDeepCopyWith:) not ifTrue: [
(self doesMethod: #veryDeepCopyWith: writeAllInstanceVariablesOfClass: aClass) ifFalse: [
warnings add: veryDeepCopyWithMethod]]].

^ warnings
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
checkAllClasses

| warnings |
self checkBasicClasses.

warnings := ((self systemNavigation allClassesImplementing: #veryDeepInner:),
(self systemNavigation allClassesImplementing: #veryDeepCopyWith:)) flatCollect: [ :aClass |
self basicCheckClass: aClass ].

self raiseWarningsIfAny: warnings
Original file line number Diff line number Diff line change
@@ -1,10 +1,6 @@
checkBasicClasses
"Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it.
DeepCopier new checkVariables "

| str objCls morphCls |
str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'.
Object instSize = 0 ifFalse: [self error:
'Many implementers of veryDeepCopyWith: are out of date'].
DeepCopier new checkAllClasses"
Object instSize = 0 ifFalse: [ self error: 'Many implementers of veryDeepCopyWith: are out of date' ].


10 changes: 10 additions & 0 deletions Kernel.package/DeepCopier.class/instance/checking/checkClass_.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
checkClass: aClass

| warnings |
self checkBasicClasses.
warnings := self basicCheckClass: aClass.
warnings ifNotEmpty: [
Warning new
messageText: 'VeryDeepCopy out of sync in some classes. Some classes contain veryDeepCopyWith: or veryDeepInner: methods that are not in sync with their instance variables. Check the exception #tag for a list of them';
tag: warnings;
signal ]
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
doesMethod: aSelector writeAllInstanceVariablesOfClass: aClass

"This method returns true if the method of the given selector writes all instance variables of the given class.
As an optimization, this method only checks that the last instance variable is written, assuming that all the rest are being written if the last one is."

| lastFieldIndex method hasNoInstanceVariables |
hasNoInstanceVariables := aClass instSize = 0.

lastFieldIndex := aClass instSize.
method := aClass compiledMethodAt: aSelector.
^ hasNoInstanceVariables or: [ method writesField: lastFieldIndex ]
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
raiseWarningsIfAny: warnings

warnings ifNotEmpty: [
Warning new
messageText: 'VeryDeepCopy out of sync in some classes. Some classes contain veryDeepCopyWith: or veryDeepInner: methods that are not in sync with their instance variables. Check the exception #tag for a list of them';
tag: warnings;
signal ]

This file was deleted.

This file was deleted.

This file was deleted.

Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'System-Sources' #'NativeBoost-Core' #'System-Platforms' #Transcript #'Spec-Debugger' #'System-VMEvents' #'Tool-Base' #'Regex-Core' #'Multilingual-TextConversion' #'System-Settings' #'System-Changes' #'AST-Core' #Nautilus)
1 change: 1 addition & 0 deletions Monticello.package/ManifestMonticello.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'FileSystem-Disk' #'Multilingual-TextConversion' #'System-Sources' #'Ring-Monticello' #'Ring-Core-Kernel' #'OpalCompiler-Core' #'System-Localization' #Jobs)
5 changes: 5 additions & 0 deletions Monticello.package/ManifestMonticello.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestMonticello
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Monticello'
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#Traits #'Multilingual-TextConversion' #'Text-Scanning' #'AST-Core' #'Collections-Streams' #'Collections-Abstract' #'Unicode-Initialization')
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestMultilingualEncodings
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Multilingual-Encodings'
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#Traits #'Collections-Abstract' #'Collections-Streams')
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestMultilingualTextConversion
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Multilingual-TextConversion'
1 change: 1 addition & 0 deletions Network-UUID.package/ManifestNetworkUUID.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'System-Support' #'AST-Core' #'Collections-Abstract')
5 changes: 5 additions & 0 deletions Network-UUID.package/ManifestNetworkUUID.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestNetworkUUID
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Network-UUID'
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Streams')
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestNewValueHolder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NewValueHolder'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Morphic-Base' #'System-Announcements')
1 change: 1 addition & 0 deletions RPackage-Core.package/ManifestRPackageCore.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Ring-Core-Kernel' #'System-Sources')
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestRPackageCore
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'RPackage-Core'

This file was deleted.

This file was deleted.

1 change: 1 addition & 0 deletions Regex-Core.package/ManifestRegexCore.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
manuallyResolvedDependencies
^ #(#'Collections-Abstract')
5 changes: 5 additions & 0 deletions Regex-Core.package/ManifestRegexCore.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
PackageManifest subclass: #ManifestRegexCore
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Regex-Core'
Loading

0 comments on commit 79c4410

Please sign in to comment.