[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Improve gst-load/gst-sunit scripts
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] Improve gst-load/gst-sunit scripts |
Date: |
Sun, 20 May 2007 13:53:06 +0200 |
User-agent: |
Thunderbird 2.0.0.0 (Macintosh/20070326) |
This patch improves the installed scripts gst-load and gst-sunit. It is
best to show the help messages:
Usage:
gst-sunit [ flag ... ] class.tests ...
Options:
-q --quiet hide the output
-v --verbose show passed tests
-f --file=FILE load file before running subsequent tests
-p --package=PACKAGE load package and run its tests
-h --help show this message
Usage:
gst-load [ flag ... ] package ...
Options:
-q --quiet hide the output
-v --verbose show loaded files
-f --force reload package if already loaded
-n --dry-run don't save the image after loading
-h --help show this message
The XML package description file is grown another tag, <sunit>, which
specifies a SUnit script to be executed by "gst-sunit -p". For now,
only "gst-sunit -p SUnit" works but I'll add support for more packages
soon (unless someone beats me and sends patches, of course!). This also
simplifies testing external packages upon "make check".
I *think* I'll apply this to 2.3 as well, but I'm not sure. Opinions
are welcome.
Paolo
2007-05-18 Paolo Bonzini <address@hidden>
* scripts/Load.st: Rewrite.
* scripts/Test.st: Rewrite.
* scripts/Reload.st: Replace with...
* scripts/gst-reload.sh: ... this script.
--- orig/Makefile.am
+++ mod/Makefile.am
@@ -56,7 +56,7 @@ pkglib_DATA = libc.la
noinst_DATA = gst.im
dist_noinst_DATA += smalltalk-mode.el.in gst-mode.el.in .gdbinit \
kernel/stamp-classes blox-tk/stamp-classes tcp/stamp-classes \
- i18n/stamp-classes scripts/Load.st scripts/Reload.st \
+ i18n/stamp-classes scripts/Load.st scripts/gst-reload.sh \
scripts/Test.st scripts/Finish.st scripts/GenLibDoc.st \
scripts/GenBaseDoc.st gsticon.ico
@@ -83,7 +83,7 @@ install-exec-hook:
$(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/scripts/Load.st \
> $(DESTDIR)$(bindir)/gst-load
chmod +x $(DESTDIR)$(bindir)/gst-load
- $(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/scripts/Reload.st \
+ $(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/scripts/gst-reload.sh \
> $(DESTDIR)$(bindir)/gst-reload
chmod +x $(DESTDIR)$(bindir)/gst-reload
$(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/scripts/Test.st \
--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -32,7 +32,7 @@
Object subclass: #Package
- instanceVariableNames: 'name features prerequisites builtFiles files
fileIns directory libraries modules callouts namespace'
+ instanceVariableNames: 'name features prerequisites builtFiles files
fileIns directory libraries modules callouts namespace sunitScripts'
classVariableNames: ''
poolDictionaries: ''
category: 'Language-Packaging'
@@ -101,6 +101,11 @@ printOn: aStream
self
printXmlOn: aStream
+ collection: self sunitScripts
+ tag: 'sunit'.
+
+ self
+ printXmlOn: aStream
collection: self callouts asSortedCollection
tag: 'callout'.
@@ -200,6 +205,18 @@ modules
modules isNil ifTrue: [ modules := Set new ].
^modules!
+sunitScript
+ "Answer a String containing a SUnit script that
+ describes the package's test suite."
+ self sunitScripts isEmpty ifTrue: [ ^'' ].
+ ^self sunitScripts fold: [ :a :b | a, ' ', b ]!
+
+sunitScripts
+ "Answer a (modifiable) OrderedCollection of SUnit scripts that
+ compose the package's test suite."
+ sunitScripts isNil ifTrue: [ sunitScripts := OrderedCollection new ].
+ ^sunitScripts!
+
callouts
"Answer a (modifiable) Set of call-outs that are required to load
the package. Their presence is checked after the libraries and
@@ -340,6 +357,12 @@ fileInsFor: package
^(self packageAt: package) fileIns.
!
+sunitScriptFor: package
+ "Answer a Strings containing a SUnit script that describes the package's
+ test suite."
+ ^(self packageAt: package) sunitScript.
+!
+
calloutsFor: package
"Answer a Set of Strings containing the filenames of the given package's
required callouts (relative to the directory answered by #directoryFor:)"
@@ -592,7 +615,8 @@ processPackageFile: fileName baseDirecto
(package baseDirs: baseDirs)
ifTrue: [ packages at: package name put: package ]]
ifFalse: [
tag = 'built-file' ifTrue: [ package builtFiles add: cdata ]
ifFalse: [
- tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]].
+ tag = 'sunit' ifTrue: [ package sunitScripts add: cdata ] ifFalse: [
+ tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]]].
cdata := nil.
].
ch isAlphaNumeric ifTrue: [
--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -398,6 +398,9 @@
<package>
<name>SUnit</name>
+ <sunit>SUnitTest.*</sunit>
+ <sunit>TestSuitesScriptTest.*</sunit>
+
<filein>SUnitPreload.st</filein>
<filein>SUnit.st</filein>
<filein>SUnitTests.st</filein>
--- orig/scripts/Load.st
+++ mod/scripts/Load.st
@@ -30,15 +30,59 @@
|
======================================================================"
-| ok verbose |
-ok := false.
-verbose := FileStream verbose: true.
-[
- PackageLoader fileInPackages: Smalltalk arguments.
- ok := true
-] valueWithUnwind.
+Smalltalk arguments isEmpty ifTrue: [ ObjectMemory quit ]!
+
+| helpString verbose snapshot force |
+snapshot := true.
+force := false.
+verbose := FileStream verbose: false.
+
+helpString :=
+'Usage:
+ gst-load [ flag ... ] package ...
+
+Options:
+ -q --quiet hide the output
+ -v --verbose show loaded files
+ -f --force reload package if already loaded
+ -n --dry-run don''t save the image after loading
+ -h --help show this message
+'.
+
+"Parse the command-line arguments."
+Smalltalk
+ arguments: '-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force'
+ do: [ :opt :arg |
+
+ opt = 'help' ifTrue: [
+ helpString displayOn: stderr.
+ ObjectMemory quit: 0 ].
+
+ opt = 'quiet' ifTrue: [
+ OutputVerbosity := 0.
+ FileStream verbose: false ].
+
+ opt = 'verbose' ifTrue: [
+ OutputVerbosity := 1.
+ FileStream verbose: true ].
+
+ opt = 'force' ifTrue: [
+ force := true ].
+
+ opt = 'dry-run' ifTrue: [
+ snapshot := false ].
+
+ opt isNil ifTrue: [
+ [
+ force ifTrue: [ Smalltalk removeFeature: arg asSymbol ].
+ PackageLoader fileInPackage: arg ]
+ ifCurtailed: [ ObjectMemory quit: 1 ] ] ]
+
+ ifError: [
+ helpString displayOn: stderr.
+ ObjectMemory quit: 1 ].
+
FileStream verbose: verbose.
-ok ifFalse: [ ObjectMemory quit: 1 ]!
-ObjectMemory snapshot!
+snapshot ifTrue: [ ObjectMemory snapshot ]!
--- orig/scripts/Test.st
+++ mod/scripts/Test.st
@@ -10,7 +10,7 @@
"======================================================================
|
-| Copyright 2003 Free Software Foundation, Inc.
+| Copyright 2003, 2007 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of GNU Smalltalk.
@@ -30,27 +30,97 @@
|
======================================================================"
-(Smalltalk includesKey: #TestSuitesScripter)
- ifFalse: [
- Transcript show: 'SUnit not loaded.'; nl.
- ObjectMemory quit: 1 ]!
-
-| suite script result |
-Smalltalk arguments isEmpty ifTrue: [ ^self ].
-script := Smalltalk arguments fold: [ :a :b | a, ' ', b ].
+Smalltalk arguments isEmpty ifTrue: [ ObjectMemory quit ]!
+
+| helpString verbose script suite result quiet |
+quiet := false.
+verbose := false.
+FileStream verbose: true.
+script := ''.
+
+helpString :=
+'Usage:
+ gst-sunit [ flag ... ] class.tests ...
+
+Options:
+ -q --quiet hide the output
+ -v --verbose show passed tests
+ -f --file=FILE load file before running subsequent tests
+ -p --package=PACKAGE load package and run its tests
+ -h --help show this message
+'.
+
+"Parse the command-line arguments."
+Smalltalk
+ arguments: '-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package:'
+ do: [ :opt :arg |
+
+ opt = 'help' ifTrue: [
+ helpString displayOn: stderr.
+ ObjectMemory quit: 0 ].
+
+ opt = 'verbose' ifTrue: [
+ OutputVerbosity := 1.
+ quiet := false.
+ verbose := true.
+ FileStream verbose: true ].
+
+ opt = 'quiet' ifTrue: [
+ OutputVerbosity := 0.
+ quiet := true.
+ verbose := false.
+ FileStream verbose: false ].
+
+ opt = 'package' ifTrue: [
+ [
+ | pkg |
+ pkg := PackageLoader packageAt: arg.
+ pkg fileIn.
+ script := script, ' ', pkg sunitScript ]
+ ifCurtailed: [ ObjectMemory quit: 2 ] ].
+
+ opt = 'file' ifTrue: [
+ [ FileStream fileIn: arg ]
+ ifCurtailed: [ ObjectMemory quit: 2 ] ].
+
+ opt isNil ifTrue: [
+ script := script, ' ', arg ] ]
+
+ ifError: [
+ helpString displayOn: stderr.
+ ObjectMemory quit: 1 ].
+
+script isEmpty ifTrue: [ ^self ].
+
+FileStream verbose: false.
+PackageLoader fileInPackage: #SUnit.
suite := TestSuitesScripter run: script.
+
+"Set log policy to write to stdout."
+quiet
+ ifTrue: [ suite logPolicy: TestLogPolicy null ].
+verbose
+ ifTrue: [ suite logPolicy: (TestVerboseLog on: stdout) ].
+(quiet or: [ verbose ])
+ ifFalse: [ suite logPolicy: (TestCondensedLog on: stdout) ].
+
result := suite run.
-result printNl.
-result errorCount > 0 ifTrue: [
- Transcript show: 'Errors:'; nl.
- (result errors asSortedCollection: [ :a :b | a printString <= b
printString ])
- do: [ :each | Transcript show: ' '; print: each; nl ] ].
-
-result failureCount > 0 ifTrue: [
- Transcript show: 'Failures:'; nl.
- (result failures asSortedCollection: [ :a :b | a printString <= b
printString ])
- do: [ :each | Transcript show: ' '; print: each; nl ] ].
+"Print result depending on verboseness."
+quiet ifFalse: [
+ result runCount < result passedCount
+ ifTrue: [ stdout nl ].
+
+ result printNl.
+ result errorCount > 0 ifTrue: [
+ aStream nextPutAll: 'Errors:'; nl.
+ (result errors asSortedCollection: [ :a :b | a printString <= b
printString ])
+ do: [ :each | aStream nextPutAll: ' '; print: each; nl ] ].
+
+ result failureCount > 0 ifTrue: [
+ aStream nextPutAll: 'Failures:'; nl.
+ (result failures asSortedCollection: [ :a :b | a printString <= b
printString ])
+ do: [ :each | aStream nextPutAll: ' '; print: each; nl ] ] ].
-result runCount = result passedCount ifFalse: [
- ObjectMemory quit: 1 ]!
+result runCount = result passedCount
+ ifFalse: [ ObjectMemory quit: 1 ]!
--- orig/sunit/SUnit.st
+++ mod/sunit/SUnit.st
@@ -140,6 +140,13 @@ defaultResources
addAll: testCase resources;
yourself]!
+isLogging
+ ^true!
+
+logPolicy: aLogPolicy
+ self tests do: [ :each |
+ each isLogging ifTrue: [ each logPolicy: aLogPolicy ] ]!
+
name
^name!
--- orig/sunit/SUnitScript.st
+++ mod/sunit/SUnitScript.st
@@ -201,4 +201,3 @@ testTwoCommentsScript
self assert: suite tests size = 1
! !
-(TestSuitesScriptTest->TestSuitesScriptTest buildSuite run) printNl!
--- orig/sunit/SUnitTests.st
+++ mod/sunit/SUnitTests.st
@@ -434,5 +434,3 @@ testResourcesCollection
collection := self resources.
self assert: collection size = 1! !
-(SUnitTest -> SUnitTest buildSuite run) printNl!
-
* added files
--- /dev/null
+++
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./scripts/.arch-ids/gst-reload.sh.id
@@ -0,0 +1 @@
+Paolo Bonzini <address@hidden> Sat May 19 18:21:55 2007 6838.0
--- /dev/null
+++
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./scripts/gst-reload.sh
@@ -0,0 +1,3 @@
+#! /bin/sh
+
address@hidden@/gst-load --force ${1+"$@"}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Improve gst-load/gst-sunit scripts,
Paolo Bonzini <=