Skip to content

Commit

Permalink
add support for <dir> tag in package.xml files
Browse files Browse the repository at this point in the history 
2012-02-22  Gwenael Casaccio  <mrgwen@gmail.com>
            Paolo Bonzini  <bonzini@gnu.org>

	* kernel/PkgLoader.st: Add support for <dir> tag.
  • Loading branch information
@bonzini
bonzini committed Jul 15, 2012
1 parent 417d01c commit 5d5f0d0
Show file tree
Hide file tree
Showing 3 changed files with 113 additions and 14 deletions.
5 changes: 5 additions & 0 deletions ChangeLog
View file
@@ -1,3 +1,8 @@
2012-02-22 Gwenael Casaccio <mrgwen@gmail.com>
Paolo Bonzini <bonzini@gnu.org>

* kernel/PkgLoader.st: Add support for <dir> tag.

2012-07-15 Paolo Bonzini <bonzini@gnu.org>

* scripts/Package.st: Disable again backtraces.
Expand Down
5 changes: 5 additions & 0 deletions doc/gst.texi
View file
Expand Up @@ -2036,6 +2036,11 @@ will execute in order to shut down the service implemented
in the package. Before executing the script, @code{%1} is replaced
with either @code{nil} or a String literal.

@item dir
Should include a @code{name} attribute. The @code{file}, @code{filein}
and @code{built-file} tags that are nested within a @code{dir} tag are
prepended with the directory specified by the attribute.

@item test
Specifies a subpackage that is only loaded by @file{gst-sunit} in order
to test the package. The subpackage may include arbitrary tags (including
Expand Down
117 changes: 103 additions & 14 deletions kernel/PkgLoader.st
View file
Expand Up @@ -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
Expand All @@ -1200,7 +1200,7 @@ XML.'>
^ Tags ifNil: [ Tags := Dictionary from: {
'file' -> #addFile:.
'filein' -> #addFileIn:.
'prereq' -> #addPrerequisite:.
'prereq' -> #addPrerequisite:.
'provides' -> #addFeature:.
'module' -> #addModule:.
'directory' -> #relativeDirectory:.
Expand Down Expand Up @@ -1317,6 +1317,7 @@ XML.'>
addFeature: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <feature> inside <dir> tag'].
self features add: aString
]

Expand All @@ -1331,6 +1332,7 @@ XML.'>
addPrerequisite: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <prereq> inside <dir> tag'].
self prerequisites add: aString
]

Expand All @@ -1345,7 +1347,7 @@ XML.'>
addBuiltFile: aString [
<category: 'accessing'>

self builtFiles add: aString
self builtFiles add: self path, aString
]

builtFiles [
Expand All @@ -1360,7 +1362,7 @@ XML.'>
<category: 'accessing'>

files isNil ifTrue: [files := OrderedCollection new].
files add: aString
files add: self path, aString
]

files [
Expand All @@ -1379,7 +1381,7 @@ XML.'>
addFileIn: aString [
<category: 'accessing'>

self fileIns add: aString
self fileIns add: self path, aString
]

fileIns [
Expand All @@ -1395,6 +1397,7 @@ XML.'>
addLibrary: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <library> inside <dir> tag'].
self libraries add: aString
]

Expand All @@ -1409,6 +1412,7 @@ XML.'>
addModule: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <module> inside <dir> tag'].
self modules add: aString
]

Expand All @@ -1423,6 +1427,7 @@ XML.'>
addSunitScript: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <sunit> inside <dir> tag'].
self sunitScripts add: aString
]

Expand All @@ -1437,6 +1442,7 @@ XML.'>
addCallout: aString [
<category: 'accessing'>

self path isEmpty ifFalse: [self error: 'unexpected <callout> inside <dir> tag'].
self callouts add: aString
]

Expand Down Expand Up @@ -1573,9 +1579,86 @@ 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 newPath |
newPath := aDictionary
at: 'name'
ifAbsent: [ self error: 'name attribute is not present in a dir tag' ].
newPath isEmpty
ifTrue: [ self error: 'name attribute is empty' ].

oldPath := self path.
newPath := oldPath, newPath.
(newPath notEmpty and: [newPath last isPathSeparator not])
ifTrue: [ newPath := newPath, Directory pathSeparatorString].
self path: newPath.
self parse: file tag: 'dir'.
self path: oldPath.
]

parseAttributes: aString [

| attribute args key value terminator ch |
attribute := ReadStream on: aString.
args := LookupTable new.
[
attribute atEnd ifTrue: [^args].
attribute peek isSeparator ifFalse: [
self error: 'expected separator'].
[
attribute next.
attribute atEnd ifTrue: [^args].
attribute peek isSeparator ] whileTrue.
attribute peek isAlphaNumeric ifFalse: [
self error: 'expected attribute'].

key := String streamContents: [ :s |
[
attribute atEnd ifTrue: [
self error: 'expected attribute'].
ch := attribute next. ch = $= ] whileFalse: [
ch isAlphaNumeric ifFalse: [
self error: 'invalid attribute name'].
s nextPut: ch ] ].

terminator := attribute next.
(terminator = $' or: [terminator = $"]) ifFalse: [
self error: 'expected single or double quote'].
value := String streamContents: [ :s |
[
attribute atEnd ifTrue: [
self error: 'expected %1' % { terminator }].
ch := attribute next. ch = terminator ] whileFalse: [
s nextPut: ch ] ].
args at: key put: value.
] repeat
]
parse: file tag: openingTag [
<category: 'private-initializing'>
| stack cdata ch tag testPackage |
| stack cdata ch tag testPackage words |
stack := OrderedCollection new.
stack addLast: openingTag.
Expand All @@ -1591,18 +1674,24 @@ 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: $>.
tag = 'test'
ifTrue: [self test: (TestPackage new parse: file tag: tag)]
ifFalse: [stack addLast: tag].
words := tag substrings.
words first = 'dir' ifTrue: [
self
dir: file
tag: (self parseAttributes: (tag copyFrom: words first size + 1)) ]
ifFalse: [
words first = 'test'
ifTrue: [self test: (TestPackage new parse: file tag: tag)]
ifFalse: [stack addLast: tag] ].
cdata trimSeparators isEmpty
ifFalse: [^self error: 'unexpected character data'].
cdata := nil]]]
Expand Down

0 comments on commit 5d5f0d0

Please sign in to comment.