Hi,
Here is a patch which adds a UnusedGlobals namespace, when a variable
binding
is removed from a namespace, it tests if the binding is used by a
compiled method
(could be changed), if yes the global is added to the UnusedGlobal
namespace
otherwise it's removed. The vm is changed a bit to bootstrap the new
class and
there is a simple test case.
Cheers,
Gwen
From 1c61e8ca080b1556270e4599b084ee78a8a2eead Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <[email protected]>
Date: Thu, 22 Sep 2011 19:59:34 +0200
Subject: add unused namespace
---
kernel/AbstNamespc.st | 38 +++++++++++++++++++++++++++++
kernel/Makefile.frag | 2 +-
kernel/Namespace.st | 2 +-
kernel/ObjMemory.st | 3 +-
kernel/RootNamespc.st | 9 ++++--
kernel/UnusedNamespace.st | 42 ++++++++++++++++++++++++++++++++
kernel/VarBinding.st | 8 ++++++
libgst/dict.c | 5 ++++
libgst/dict.h | 1 +
libgst/files.c | 1 +
packages.xml | 1 +
tests/Makefile.am | 2 +-
tests/testsuite.at | 1 +
tests/unusedNamespace.ok | 6 ++++
tests/unusedNamespace.st | 58 +++++++++++++++++++++++++++++++++++++++++++++
15 files changed, 172 insertions(+), 7 deletions(-)
create mode 100644 kernel/UnusedNamespace.st
create mode 100644 tests/unusedNamespace.ok
create mode 100644 tests/unusedNamespace.st
diff --git a/kernel/AbstNamespc.st b/kernel/AbstNamespc.st
index 9b1fd7b..daa5ad3 100644
--- a/kernel/AbstNamespc.st
+++ b/kernel/AbstNamespc.st
@@ -510,5 +510,43 @@ an instance of me; it is called their `environment''. '>
<category: 'testing'>
^false
]
+
+ bindingFor: aSymbol [
+ <category: 'accessing'>
+
+ ^ self bindingFor: aSymbol ifAbsent: [ SystemExceptions.NotFound signalOn: aSymbol what: 'key' ]
+ ]
+
+ bindingFor: aSymbol ifAbsent: aBlock [
+ <category: 'accessing'>
+
+ | index |
+ index := self findIndexOrNil: aSymbol.
+ index isNil ifTrue: [ ^ aBlock value ].
+ ^ self primAt: index.
+ ]
+
+ remove: anAssociation ifAbsent: aBlock [
+ <category: 'dictionary removing'>
+
+ | assoc |
+ assoc := super remove: anAssociation ifAbsent: aBlock.
+ (KernelInitialized and: [ assoc isUsed and: [ self ~= Undeclared ] ]) ifTrue: [ UnusedGlobals add: assoc ].
+ ^ assoc
+ ]
+
+ removeKey: key ifAbsent: aBlock [
+ <category: 'dictionary removing'>
+
+ | index assoc |
+ index := self findIndexOrNil: key.
+ index isNil ifTrue: [ ^ aBlock value ].
+ assoc := self primAt: index.
+ self primAt: index put: nil.
+ self decrementTally.
+ self rehashObjectsAfter: index.
+ (KernelInitialized and: [ assoc isUsed and: [ self ~= Undeclared ] ]) ifTrue: [ UnusedGlobals add: assoc ].
+ ^ assoc value
+ ]
]
diff --git a/kernel/Makefile.frag b/kernel/Makefile.frag
index 03e848d..e0d2795 100644
--- a/kernel/Makefile.frag
+++ b/kernel/Makefile.frag
@@ -1,3 +1,3 @@
$(srcdir)/kernel/stamp-classes: \
-kernel/Array.st kernel/CompildMeth.st kernel/LookupTable.st kernel/RunArray.st kernel/Iterable.st kernel/ArrayColl.st kernel/CompiledBlk.st kernel/Magnitude.st kernel/Semaphore.st kernel/DeferBinding.st kernel/Association.st kernel/HomedAssoc.st kernel/ContextPart.st kernel/MappedColl.st kernel/SeqCollect.st kernel/Autoload.st kernel/DLD.st kernel/Memory.st kernel/Set.st kernel/Bag.st kernel/Date.st kernel/Message.st kernel/SharedQueue.st kernel/Behavior.st kernel/Delay.st kernel/Metaclass.st kernel/SmallInt.st kernel/BlkClosure.st kernel/Continuation.st kernel/Generator.st kernel/Dictionary.st kernel/MethodDict.st kernel/SortCollect.st kernel/BlkContext.st kernel/DirMessage.st kernel/MethodInfo.st kernel/Stream.st kernel/Boolean.st kernel/Directory.st kernel/MthContext.st kernel/String.st kernel/UniString.st kernel/ExcHandling.st kernel/Namespace.st kernel/SymLink.st kernel/VFS.st kernel/VFSZip.st kernel/Builtins.st kernel/False.st kernel/Number.st kernel/Symbol.st kernel/ByteArray.st kernel/FilePath.st kernel/File.st kernel/SysDict.st kernel/ScaledDec.st kernel/FileSegment.st kernel/Object.st kernel/Time.st kernel/FileStream.st kernel/Security.st kernel/OrderColl.st kernel/CCallable.st kernel/CCallback.st kernel/CFuncs.st kernel/Float.st kernel/PkgLoader.st kernel/Transcript.st kernel/CObject.st kernel/Fraction.st kernel/Point.st kernel/True.st kernel/CStruct.st kernel/IdentDict.st kernel/PosStream.st kernel/UndefObject.st kernel/CType.st kernel/IdentitySet.st kernel/ProcSched.st kernel/ProcEnv.st kernel/ValueAdapt.st kernel/CharArray.st kernel/Integer.st kernel/Process.st kernel/CallinProcess.st kernel/WeakObjects.st kernel/Character.st kernel/UniChar.st kernel/Interval.st kernel/RWStream.st kernel/OtherArrays.st kernel/Class.st kernel/LargeInt.st kernel/Random.st kernel/WriteStream.st kernel/ClassDesc.st kernel/Link.st kernel/ReadStream.st kernel/ObjMemory.st kernel/Collection.st kernel/LinkedList.st kernel/Rectangle.st kernel/AnsiDates.st kernel/CompildCode.st kernel/LookupKey.st kernel/BindingDict.st kernel/AbstNamespc.st kernel/RootNamespc.st kernel/SysExcept.st kernel/DynVariable.st kernel/HashedColl.st kernel/FileDescr.st kernel/FloatD.st kernel/FloatE.st kernel/FloatQ.st kernel/URL.st kernel/VarBinding.st kernel/RecursionLock.st kernel/Getopt.st kernel/Regex.st kernel/StreamOps.st
+kernel/Array.st kernel/CompildMeth.st kernel/LookupTable.st kernel/RunArray.st kernel/Iterable.st kernel/ArrayColl.st kernel/CompiledBlk.st kernel/Magnitude.st kernel/Semaphore.st kernel/DeferBinding.st kernel/Association.st kernel/HomedAssoc.st kernel/ContextPart.st kernel/MappedColl.st kernel/SeqCollect.st kernel/Autoload.st kernel/DLD.st kernel/Memory.st kernel/Set.st kernel/Bag.st kernel/Date.st kernel/Message.st kernel/SharedQueue.st kernel/Behavior.st kernel/Delay.st kernel/Metaclass.st kernel/SmallInt.st kernel/BlkClosure.st kernel/Continuation.st kernel/Generator.st kernel/Dictionary.st kernel/MethodDict.st kernel/SortCollect.st kernel/BlkContext.st kernel/DirMessage.st kernel/MethodInfo.st kernel/Stream.st kernel/Boolean.st kernel/Directory.st kernel/MthContext.st kernel/String.st kernel/UniString.st kernel/ExcHandling.st kernel/Namespace.st kernel/SymLink.st kernel/VFS.st kernel/VFSZip.st kernel/Builtins.st kernel/False.st kernel/Number.st kernel/Symbol.st kernel/ByteArray.st kernel/FilePath.st kernel/File.st kernel/SysDict.st kernel/ScaledDec.st kernel/FileSegment.st kernel/Object.st kernel/Time.st kernel/FileStream.st kernel/Security.st kernel/OrderColl.st kernel/CCallable.st kernel/CCallback.st kernel/CFuncs.st kernel/Float.st kernel/PkgLoader.st kernel/Transcript.st kernel/CObject.st kernel/Fraction.st kernel/Point.st kernel/True.st kernel/CStruct.st kernel/IdentDict.st kernel/PosStream.st kernel/UndefObject.st kernel/CType.st kernel/IdentitySet.st kernel/ProcSched.st kernel/ProcEnv.st kernel/ValueAdapt.st kernel/CharArray.st kernel/Integer.st kernel/Process.st kernel/CallinProcess.st kernel/WeakObjects.st kernel/Character.st kernel/UniChar.st kernel/Interval.st kernel/RWStream.st kernel/OtherArrays.st kernel/Class.st kernel/LargeInt.st kernel/Random.st kernel/WriteStream.st kernel/ClassDesc.st kernel/Link.st kernel/ReadStream.st kernel/ObjMemory.st kernel/Collection.st kernel/LinkedList.st kernel/Rectangle.st kernel/AnsiDates.st kernel/CompildCode.st kernel/LookupKey.st kernel/BindingDict.st kernel/AbstNamespc.st kernel/RootNamespc.st kernel/UnusedNamespace.st kernel/SysExcept.st kernel/DynVariable.st kernel/HashedColl.st kernel/FileDescr.st kernel/FloatD.st kernel/FloatE.st kernel/FloatQ.st kernel/URL.st kernel/VarBinding.st kernel/RecursionLock.st kernel/Getopt.st kernel/Regex.st kernel/StreamOps.st
touch $(srcdir)/kernel/stamp-classes
diff --git a/kernel/Namespace.st b/kernel/Namespace.st
index c99e658..ccdafe8 100644
--- a/kernel/Namespace.st
+++ b/kernel/Namespace.st
@@ -46,7 +46,7 @@ AbstractNamespace subclass: Namespace [
<category: 'initialization'>
self allInstancesDo:
- [:each |
+ [:each |
each superspace isNil ifTrue: [each setSuperspace: Smalltalk].
each superspace subspaces add: each]
]
diff --git a/kernel/ObjMemory.st b/kernel/ObjMemory.st
index fc08834..ce7c902 100644
--- a/kernel/ObjMemory.st
+++ b/kernel/ObjMemory.st
@@ -91,6 +91,7 @@ state.'>
Time initialize.
FileDescriptor initialize.
Namespace initialize.
+ UnusedNamespace initialize.
Processor initialize.
SystemDictionary initialize.
self changed: #returnFromSnapshot
@@ -646,6 +647,6 @@ state.'>
Eval [
- ObjectMemory initialize
+ ObjectMemory initialize.
]
diff --git a/kernel/RootNamespc.st b/kernel/RootNamespc.st
index 0f31ccf..2460c83 100644
--- a/kernel/RootNamespc.st
+++ b/kernel/RootNamespc.st
@@ -43,9 +43,12 @@ an instance of me; it is called their `environment''. '>
"Create a new root namespace with the given name, and add to Smalltalk
a key that references it."
- <category: 'instance creation'>
- ^Smalltalk at: spaceName asGlobalKey
- put: ((super new: 24) setSuperspace: nil)
+ <category: 'instance creation'>
+
+ ^ Smalltalk at: spaceName asGlobalKey
+ put: ((super new: 24)
+ name: spaceName asSymbol;
+ yourself)
]
inheritedKeys [
diff --git a/kernel/UnusedNamespace.st b/kernel/UnusedNamespace.st
new file mode 100644
index 0000000..cdc0377
--- /dev/null
+++ b/kernel/UnusedNamespace.st
@@ -0,0 +1,42 @@
+RootNamespace subclass: UnusedNamespace [
+
+ <shape: #pointer>
+
+ UnusedNamespace class >> initialize [
+ <category: 'initialization'>
+
+ self new: #UnusedGlobals
+ ]
+
+ unusedBindings [
+ <category: 'accessing'>
+
+ | set |
+ set := Set new.
+ self primDo: [ :pos :each |
+ each isUsed ifFalse: [ set add: each ] ].
+ ^ set
+ ]
+
+ removeUnusedBindings [
+ <category: 'accessing'>
+
+ | set |
+ set := Set new.
+ self primDo: [ :pos :each |
+ each isUsed ifFalse: [
+ set add: each.
+ self primAt: pos put: nil ] ].
+ ^ set
+ ]
+
+ primDo: aTwoArgsBlock [
+ <category: 'private'>
+
+ | assoc |
+ 1 to: self basicSize do: [ :i |
+ assoc := self primAt: i.
+ assoc isNil ifFalse: [ aTwoArgsBlock value: i value: assoc ] ]
+ ]
+]
+
diff --git a/kernel/VarBinding.st b/kernel/VarBinding.st
index 243ad92..00c9c6f 100644
--- a/kernel/VarBinding.st
+++ b/kernel/VarBinding.st
@@ -38,6 +38,14 @@ HomedAssociation subclass: VariableBinding [
its value. I print different than a normal Association, and know
about my parent namespace, otherwise my behavior is the same.'>
+ isUsed [
+ <category: 'testing'>
+
+ CompiledMethod allInstancesDo: [ :each |
+ (each literals includes: self) ifTrue: [ ^ true ] ].
+ ^ false
+ ]
+
isDefined [
"Answer true if this VariableBinding lives outside the
Undeclared dictionary"
diff --git a/libgst/dict.c b/libgst/dict.c
index bfd2515..bb2bc50 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -161,6 +161,7 @@ OOP _gst_string_class = NULL;
OOP _gst_sym_link_class = NULL;
OOP _gst_symbol_class = NULL;
OOP _gst_system_dictionary_class = NULL;
+OOP _gst_unused_namespace_class = NULL;
OOP _gst_time_class = NULL;
OOP _gst_true_class = NULL;
OOP _gst_undefined_object_class = NULL;
@@ -605,6 +606,10 @@ static const class_definition class_info[] = {
GST_ISP_POINTER, false, 0,
"SystemDictionary", NULL, NULL, NULL },
+ {&_gst_unused_namespace_class, &_gst_root_namespace_class,
+ GST_ISP_POINTER, false, 0,
+ "UnusedNamespace", NULL, NULL, NULL },
+
{&_gst_stream_class, &_gst_iterable_class,
GST_ISP_FIXED, false, 0,
"Stream", NULL, NULL, NULL },
diff --git a/libgst/dict.h b/libgst/dict.h
index de79926..394065b 100644
--- a/libgst/dict.h
+++ b/libgst/dict.h
@@ -423,6 +423,7 @@ extern OOP _gst_string_class ATTRIBUTE_HIDDEN;
extern OOP _gst_sym_link_class ATTRIBUTE_HIDDEN;
extern OOP _gst_symbol_class ATTRIBUTE_HIDDEN;
extern OOP _gst_system_dictionary_class ATTRIBUTE_HIDDEN;
+extern OOP _gst_unused_namespace_class ATTRIBUTE_HIDDEN;
extern OOP _gst_time_class ATTRIBUTE_HIDDEN;
extern OOP _gst_true_class ATTRIBUTE_HIDDEN;
extern OOP _gst_undefined_object_class ATTRIBUTE_HIDDEN;
diff --git a/libgst/files.c b/libgst/files.c
index 2ec0fe8..40a2508 100644
--- a/libgst/files.c
+++ b/libgst/files.c
@@ -240,6 +240,7 @@ static const char standard_files[] = {
"SymLink.st\0"
"Security.st\0"
"WeakObjects.st\0"
+ "UnusedNamespace.st\0"
"ObjMemory.st\0"
/* More core classes */
diff --git a/packages.xml b/packages.xml
index 2fbcaa3..249e7cc 100644
--- a/packages.xml
+++ b/packages.xml
@@ -193,6 +193,7 @@
<file>BindingDict.st</file>
<file>AbstNamespc.st</file>
<file>RootNamespc.st</file>
+ <file>UnusedNamespace.st</file>
<file>SysExcept.st</file>
<file>DynVariable.st</file>
<file>HashedColl.st</file>
diff --git a/tests/Makefile.am b/tests/Makefile.am
index f227386..2ede5aa 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -18,7 +18,7 @@ objinst.st processes.ok processes.st prodcons.ok prodcons.st quit.ok \
quit.st random-bench.ok random-bench.st untrusted.ok untrusted.st sets.ok \
sets.st sieve.ok sieve.st strcat.ok strcat.st strings.ok strings.st \
pools.ok pools.st Ansi.st AnsiDB.st AnsiInit.st AnsiLoad.st AnsiRun.st \
-stcompiler.st stcompiler.ok shape.st shape.ok
+stcompiler.st stcompiler.ok shape.st shape.ok unusedNamespace.st unusedNamespace.ok
CLEANFILES = gst.im
DISTCLEANFILES = atconfig
diff --git a/tests/testsuite.at b/tests/testsuite.at
index 4be63b6..4e026f1 100644
--- a/tests/testsuite.at
+++ b/tests/testsuite.at
@@ -51,6 +51,7 @@ AT_DIFF_TEST([getopt.st])
AT_DIFF_TEST([quit.st])
AT_DIFF_TEST([pools.st])
AT_DIFF_TEST([shape.st])
+AT_DIFF_TEST([unusedNamespace.st])
AT_BANNER([Other simple tests.])
AT_DIFF_TEST([ackermann.st])
diff --git a/tests/unusedNamespace.ok b/tests/unusedNamespace.ok
new file mode 100644
index 0000000..f2ed781
--- /dev/null
+++ b/tests/unusedNamespace.ok
@@ -0,0 +1,6 @@
+
+Execution begins...
+returned value is Bar
+
+Execution begins...
+returned value is UnusedNamespace
diff --git a/tests/unusedNamespace.st b/tests/unusedNamespace.st
new file mode 100644
index 0000000..11a8a9d
--- /dev/null
+++ b/tests/unusedNamespace.st
@@ -0,0 +1,58 @@
+"======================================================================
+|
+| Test UnusedNamespace operations
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright (C) 2011 Free Software Foundation.
+| Written by Gwenael Casaccio
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Eval [
+ Object subclass: #Foo.
+ Object compile: 'foo [ ^ Foo ]'.
+ Object subclass: #Bar.
+]
+
+UnusedNamespace class extend [
+
+ assert: aBoolean [
+ <category: 'testing'>
+
+ aBoolean ifFalse: [ self halt ]
+ ]
+
+ test [
+ <category: 'testing'>
+
+ Smalltalk removeKey: #Foo.
+ self assert: (UnusedGlobals includesKey: #Foo).
+ Smalltalk removeKey: #Bar.
+ self assert: (UnusedGlobals includesKey: #Bar) not.
+ self assert: UnusedGlobals unusedBindings isEmpty.
+ ]
+]
+
+Eval [
+ UnusedNamespace test
+]
--
1.7.4.1
_______________________________________________
help-smalltalk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-smalltalk
