[patch] represent <test/> packages with TestPackage

smalltalk--backstage--2.2--patch-38, against devo patch-410, adds class
TestPackage.  This fixes a bug where changes to an outer package during
testing (i.e. namespace or directory) would not be propagated to the
test package after it had been created, thus preventing Parser (and
other expressible packages) from being added to the package db.

Also attached.

--
Stephen Compall
But you know how reluctant paranormal phenomena are to reveal
themselves when skeptics are present. --Robert Sheaffer, SkI 9/2003

2007-06-23  Stephen Compall  <[hidden email]>

        * kernel/PkgLoader.st: Add class TestPackage, reifying its
        relationship with its owner package, and use it for all <test/>
        tags.

--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -106,6 +106,25 @@
 information on a Smalltalk package, and can output my description in
 XML.'!
 
+Namespace current: Kernel!
+
+Smalltalk.Package subclass: #TestPackage
+  instanceVariableNames: 'owner'
+  classVariableNames: ''
+  poolDictionaries: ''
+  category: 'Language-Packaging'
+!
+
+TestPackage comment:
+'I am not part of a standard Smalltalk system.  I am an unnamed
+subpackage of a regular package, representing an SUnit test suite for
+that package.
+
+    owner
+ The Package I provide tests for; initialized by the owner.'!
+
+Namespace current: Smalltalk!
+
 Object subclass: #PackageLoader
  instanceVariableNames: ''
  classVariableNames: ''
@@ -690,10 +709,7 @@
     aPackage name isNil ifFalse: [
  self error: 'test package must not have names' ].
     aPackage prerequisites add: 'SUnit'; add: self name.
-    aPackage directory isNil ifTrue: [
-        aPackage directory: self directory ].
-    aPackage namespace isNil ifTrue: [
-        aPackage namespace: self namespace ].
+    aPackage owner: self.
     test := aPackage!
 
 namespace
@@ -905,7 +921,7 @@
     ch isAlphaNumeric ifTrue: [
         tag := file upTo: $>.
  tag = 'test'
-    ifTrue: [ self test: (Package new parse: file tag: tag) ]
+    ifTrue: [ self test: (TestPackage new parse: file tag: tag) ]
             ifFalse: [ stack addLast: tag ].
 
  cdata trimSeparators isEmpty ifFalse: [
@@ -922,6 +938,24 @@
 ! !
 
 
+!Kernel.TestPackage methodsFor: 'accessing'!
+
+owner: aPackage
+    "Set the Package I test."
+    owner := aPackage.
+!
+
+directory
+    "Answer the base directory from which to load the package."
+    ^super directory ifNil: [owner directory]
+!
+
+namespace
+    "Answer the namespace in which the package is loaded."
+    ^super namespace ifNil: [owner namespace]
+! !
+
+
 !PackageLoader class methodsFor: 'accessing'!
 
 packageAt: package




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

Stephen Compall wrote:
> smalltalk--backstage--2.2--patch-38, against devo patch-410, adds class
> TestPackage.  This fixes a bug where changes to an outer package during
> testing (i.e. namespace or directory) would not be propagated to the
> test package after it had been created, thus preventing Parser (and
> other expressible packages) from being added to the package db.
>
> Also attached.

Both patches applied; this one had conflicts, so I attached the
PkgLoader.st patch with conflicts resolved.

Paolo

--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -137,6 +137,25 @@ XML.'!
 
 Namespace current: Smalltalk!
 
+Namespace current: Kernel!
+
+Smalltalk.Package subclass: #TestPackage
+  instanceVariableNames: 'owner'
+  classVariableNames: ''
+  poolDictionaries: ''
+  category: 'Language-Packaging'
+!
+
+TestPackage comment:
+'I am not part of a standard Smalltalk system.  I am an unnamed
+subpackage of a regular package, representing an SUnit test suite for
+that package.
+
+    owner
+ The Package I provide tests for; initialized by the owner.'!
+
+Namespace current: Smalltalk!
+
 Object subclass: #PackageLoader
  instanceVariableNames: ''
  classVariableNames: ''
@@ -781,13 +800,7 @@ test: aPackage
  ifFalse: [ self error: 'test package must not have names' ].
 
     aPackage prerequisites add: 'SUnit'; add: self name.
-    aPackage namespace isNil
- ifTrue: [ aPackage namespace: self namespace ].
-    aPackage relativeDirectory isNil
- ifTrue: [ aPackage relativeDirectory: self relativeDirectory ].
-
-    self baseDirectories isNil ifFalse: [
-        aPackage baseDirectories: self baseDirectories ].
+    aPackage owner: self.
     test := aPackage!
 
 namespace
@@ -1013,7 +1026,7 @@ parse: file tag: openingTag
     ch isAlphaNumeric ifTrue: [
         tag := file upTo: $>.
  tag = 'test'
-    ifTrue: [ testPackage := Package new parse: file tag: tag ]
+    ifTrue: [ self test: (TestPackage new parse: file tag: tag) ]
             ifFalse: [ stack addLast: tag ].
 
  cdata trimSeparators isEmpty ifFalse: [
@@ -1023,9 +1036,6 @@ parse: file tag: openingTag
     ].
         ].
     ] ensure: [
- "Do this now, so that our <namespace> and <directory> are honored."
- testPackage isNil ifFalse: [ self test: testPackage ].
-
         stack isEmpty ifFalse: [
     self error: 'error in packages file: unmatched start tags',
  stack asArray printString ]
@@ -1043,6 +1053,29 @@ isDisabled
 ! !
 
 
+!Kernel.TestPackage methodsFor: 'accessing'!
+
+owner: aPackage
+    "Set the Package I test."
+    owner := aPackage.
+!
+
+relativeDirectory
+    "Answer the base directory from which to load the package."
+    ^super relativeDirectory ifNil: [owner relativeDirectory]
+!
+
+namespace
+    "Answer the namespace in which the package is loaded."
+    ^super namespace ifNil: [owner namespace]
+!
+
+baseDirectories
+    "Answer the namespace in which the package is loaded."
+    ^super baseDirectories ifNil: [owner baseDirectories]
+! !
+
+
 !PackageLoader class methodsFor: 'accessing'!
 
 packageAt: package

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk