On 10/07/2012 10:36, Paolo Bonzini wrote:
Il 10/07/2012 10:32, Gwenaël Casaccio ha scritto:
Hello,

here is the first version of the patch for adding <dir name="...">
support in package.xml.

example:

   <filein>compiler/initialization/SystemInitialization.st</filein>
   <filein>compiler/type/Extensions.st</filein>
   ...

becomes:


<dir name="compiler">
   <filein>...</filein>
  </dir>

Comments are welcome
I sent some coding style comments offlist (because you sent it first
only to me), but in general it looks promising.

Thanks!

Paolo


Here is the new iteration, there is one issue with the bytecode checker: jump skips extension bytecode
If I comment self checkTagIfInPath: tag. it works

Gwen


diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index 8a3a429..029126e 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -1185,7 +1185,7 @@ Object subclass: Version [
 Kernel.PackageInfo subclass: Package [
     | features prerequisites builtFiles files fileIns relativeDirectory
        baseDirectories libraries modules callouts url namespace sunitScripts
-       startScript stopScript test version |
+       startScript stopScript test version path |
     
     <category: 'Language-Packaging'>
     <comment: 'I am not part of a standard Smalltalk system. I store internally the
@@ -1200,7 +1200,7 @@ XML.'>
        ^ Tags ifNil: [ Tags := Dictionary from: {      
                         'file' -> #addFile:.
                         'filein' -> #addFileIn:.
-                       'prereq' -> #addPrerequisite:.
+                        'prereq' -> #addPrerequisite:.
                         'provides' -> #addFeature:.
                         'module' -> #addModule:.
                         'directory' -> #relativeDirectory:.
@@ -1345,7 +1345,7 @@ XML.'>
     addBuiltFile: aString [
        <category: 'accessing'>
 
-       self builtFiles add: aString
+       self builtFiles add: self path, aString
     ]
 
     builtFiles [
@@ -1360,7 +1360,7 @@ XML.'>
         <category: 'accessing'>
 
 	files isNil ifTrue: [files := OrderedCollection new].
-        files add: aString
+        files add: self path, aString
     ]
 
     files [
@@ -1379,7 +1379,7 @@ XML.'>
     addFileIn: aString [
         <category: 'accessing'>
 
-        self fileIns add: aString
+        self fileIns add: self path, aString
     ]
 
     fileIns [
@@ -1573,9 +1573,55 @@ XML.'>
 		    Namespace current: namespace]
     ]
 
+    path [
+
+	^ path ifNil: [ path := '' ]
+    ]
+
+    path: aString [
+
+	path := aString
+    ]
+
+    isInPath [
+
+	^ self path ~= ''
+    ]
+
+    checkTagIfInPath: aString [
+
+	self isInPath ifFalse: [ ^ self ].
+	(aString = 'file' or: [ aString = 'filein' or: [ aString = 'built-file' ] ]) ifFalse: [ self error: 'invalid tag in a dir tag ', aString ]
+    ]
+
+    dir: file tag: aDictionary [
+
+	| oldPath |
+	oldPath := self path.
+	self path: (self path, (aDictionary at: 'name' ifAbsent: [ self error: 'name attribute is not present in a dir tag' ]), '/').
+	self parse: file tag: 'dir'.
+	self path: oldPath.
+    ]
+
+    parseAttributes: aString [
+
+        | attribute args key value tag |
+        attribute := ReadStream on: aString.
+        tag := attribute upTo: $ .
+        args := OrderedCollection new.
+        [ attribute atEnd ] whileFalse: [
+                attribute peek isAlphaNumeric ifTrue: [
+                    key := attribute upTo: $=.
+                    attribute upTo: $".
+                    value := attribute upTo: $".
+                    args add: key->value. ].
+                attribute next ].
+        ^ Dictionary from: args.
+    ]
+
     parse: file tag: openingTag [
 	<category: 'private-initializing'>
-	| stack cdata ch tag testPackage |
+	| stack cdata ch tag testPackage temp |
 	stack := OrderedCollection new.
 	stack addLast: openingTag.
 	
@@ -1591,18 +1637,22 @@ XML.'>
 			ifTrue: 
 			    [tag := stack removeLast.
 			    file next.
-                           (file upTo: $>) = tag 
-                               ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag].
-
+                            (file upTo: $>) = tag 
+                               ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag ].
                            tag = openingTag ifTrue: [ ^ self ].
-                           self perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata.
-                           cdata := nil].
+			   self checkTagIfInPath: tag.
+			   self perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata.
+			   cdata := nil ].
                    ch isAlphaNumeric 
                        ifTrue: 
 			    [tag := file upTo: $>.
+			    temp := tag substrings.
+			    temp first = 'dir'
+				ifTrue: [ self dir: file tag: (self parseAttributes: tag) ]
+				ifFalse: [
 			    tag = 'test' 
 				ifTrue: [self test: (TestPackage new parse: file tag: tag)]
-				ifFalse: [stack addLast: tag].
+				ifFalse: [stack addLast: tag] ].
 			    cdata trimSeparators isEmpty 
 				ifFalse: [^self error: 'unexpected character data'].
 			    cdata := nil]]] 
_______________________________________________
help-smalltalk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

Reply via email to