[Help-smalltalk] [PATCH] Add --image-file option to gst-load and gst-sunit

[Paolo Bonzini]

This option obviously cannot be implemented in the same file as 
scripts/Load.st and scripts/Test.st, because it must be passed to gst 
directly as -I.  So we need to make gst-load and gst-sunit a different 
script than the Load.st and Test.st files.

I chose to write a shell script, but with a nice command-line parser 
written in Smalltalk (about 15 lines of code!).

In addition, I added a --test option to gst-load, so that you can avoid 
loading the package if the testsuite fails.  In theory, this could be 
implemented within scripts/Load.st, but in the future we'll support 
running the testsuite *without putting it in the saved image*; so I've 
already implemented it outside scripts/Load.st.

Paolo

2007-06-01  Paolo Bonzini  <address@hidden>

        * scripts/Getopt.st: New.
        * scripts/Load.st: Add (and ignore) --test and --image-file.
        * scripts/Test.st: Add (and ignore) --image-file.

* looking for address@hidden/smalltalk--devo--2.2--patch-369 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-369
A  .arch-ids/gst-load.in.id
A  .arch-ids/gst-sunit.in.id
A  gst-load.in
A  gst-sunit.in
A  scripts/.arch-ids/Getopt.st.id
A  scripts/Getopt.st
M  gst-reload.in
M  configure.ac
M  doc/gst.texi
M  ChangeLog
M  Makefile.am
M  packages.xml.in
M  scripts/Load.st
M  scripts/Test.st
=> scripts/.arch-ids/gst-reload.sh.id   .arch-ids/gst-reload.in.id
=> scripts/gst-reload.sh        gst-reload.in

* modified files


--- orig/Makefile.am
+++ mod/Makefile.am
@@ -56,8 +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/gst-reload.sh \
-       scripts/Test.st scripts/Finish.st scripts/GenLibDoc.st \
+       i18n/stamp-classes scripts/Finish.st scripts/GenLibDoc.st \
        scripts/GenBaseDoc.st scripts/Convert.st gsticon.ico
 
 if WITH_EMACS
@@ -67,7 +66,7 @@ nodist_lisp_LISP += gst-mode.el
 endif
 endif
 
-bin_SCRIPTS = gst-package gst-config
+bin_SCRIPTS = gst-package gst-config gst-load gst-reload gst-sunit
 DISTCLEANFILES = termbold termnorm smalltalk-mode.el gst-mode.el
 CLEANFILES = gst.im $(lisp_LISP)
 
@@ -79,22 +78,6 @@ gst-mode.el: gst-mode.el.in
        $(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/gst-mode.el.in \
          > gst-mode.el
 
-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/gst-reload.sh \
-         > $(DESTDIR)$(bindir)/gst-reload
-       chmod +x $(DESTDIR)$(bindir)/gst-reload
-       $(SED) -e "s,@\(bindir\)@,$(bindir)," $(srcdir)/scripts/Test.st \
-         > $(DESTDIR)$(bindir)/gst-sunit
-       chmod +x $(DESTDIR)$(bindir)/gst-sunit
-
-uninstall-local::
-       -rm -f $(DESTDIR)$(bindir)/gst-load
-       -rm -f $(DESTDIR)$(bindir)/gst-reload
-       -rm -f $(DESTDIR)$(bindir)/gst-sunit
-
 ###########################################################
 #
 #        Rules for building the VM


--- orig/configure.ac
+++ mod/configure.ac
@@ -362,6 +362,9 @@ dnl Scripts & data files
 AC_CONFIG_FILES(gnu-smalltalk.pc)
 AC_CONFIG_FILES(gst-config, chmod +x gst-config)
 AC_CONFIG_FILES(gst-package, chmod +x gst-package)
+AC_CONFIG_FILES(gst-load, chmod +x gst-load)
+AC_CONFIG_FILES(gst-reload, chmod +x gst-reload)
+AC_CONFIG_FILES(gst-sunit, chmod +x gst-sunit)
 AC_CONFIG_FILES(packages.xml)
 AC_CONFIG_FILES(libc.la)
 


--- orig/doc/gst.texi
+++ mod/doc/gst.texi
@@ -1652,8 +1652,7 @@ first way is to use the PackageLoader's 
 The second way is to use the @file{gst-load} script which is installed
 together with the virtual machine.  For example, you can do:
 
address@hidden@ @ @ @ gst-load Browser Blox address@hidden
-When using an alternate image path, use the @env{SMALLTALK_IMAGE} variable.}
address@hidden@ @ @ @ gst-load Browser Blox Compiler}
 
 @noindent
 and GST will automatically file in:
@@ -1671,6 +1670,10 @@ Then it will save the Smalltalk image, a
 @file{gst-load} supports several options:
 
 @table @option
address@hidden -I
address@hidden --image-file
+Load the packages inside the given image.
+
 @item -q
 @itemx --quiet
 Hide the script's output.
@@ -1684,6 +1687,12 @@ Show which files are loaded, one by one.
 If a package given on the command-line is already present, reload it.
 This does not apply to automatically selected prerequisites.
 
address@hidden -t
address@hidden --test
+Run the package testsuite before installing, and exit with a failure
+if the tests fail.  Currently, the testsuites are placed in the image
+together with the package, but this may change in future versions.
+
 @item -n
 @item --dry-run
 Do not save the image after loading.
@@ -2363,6 +2372,10 @@ It is called @command{gst-sunit}.  The c
 specifies the packages, files and classes to test:
 
 @table @option
address@hidden -I
address@hidden --image-file
+Run tests inside the given image.
+
 @item -q
 @itemx --quiet
 Hide the program's output.  The results are still communicated with the


--- orig/scripts/gst-reload.sh
+++ mod/gst-reload.in
@@ -1,3 +1,6 @@
 #! /bin/sh
 
address@hidden@
address@hidden@
+
 @bindir@/gst-load --force ${1+"$@"}


--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -792,4 +792,13 @@
   <file>../vfs/utar</file>
 </disabled-package>
 
+<disabled-package>
+  <name>AuxScripts</name>
+  <directory>scripts</directory>
+
+  <file>Test.st</file>
+  <file>Load.st</file>
+  <file>Getopt.st</file>
+</disabled-package>
+
 </packages>


--- orig/scripts/Load.st
+++ mod/scripts/Load.st
@@ -46,12 +46,15 @@ Options:
     -v --verbose          show loaded files
     -f --force            reload package if already loaded
     -n --dry-run          don''t save the image after loading
+    -t --test             run SUnit tests if available
+    -I --image-file=FILE  load into the specified image
     -h --help             show this message
 '.
 
 "Parse the command-line arguments."
 Smalltalk
-    arguments: '-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force'
+    arguments: '-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force
+               -t|--test -I|--image-file:'
     do: [ :opt :arg |
 
     opt = 'help' ifTrue: [


--- orig/scripts/Test.st
+++ mod/scripts/Test.st
@@ -47,12 +47,14 @@ Options:
     -v --verbose          show passed tests
     -f --file=FILE        load file before running subsequent tests
     -p --package=PACKAGE  load package and run its tests
+    -I --image-file=FILE  run tests on the specified image file
     -h --help             show this message
 '.
 
 "Parse the command-line arguments."
 Smalltalk
-    arguments: '-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package:'
+    arguments: '-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package:
+               -I|--image-file'
     do: [ :opt :arg |
 
     opt = 'help' ifTrue: [



--- /dev/null
+++ mod/gst-load.in
@@ -0,0 +1,83 @@
+#! /bin/sh
+
+#######################################################################
+#
+#   Smalltalk package loader (utility script)
+#
+#
+#######################################################################
+
+
+#######################################################################
+#
+# Copyright 2007 Free Software Foundation, Inc.
+# Written by Paolo Bonzini.
+#
+# 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.  
+#
+########################################################################
+
+OPTIONS='-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force 
-t|--test -I|--image-file:'
address@hidden@
address@hidden@
+: address@hidden@/gst}
+
+gst () {
+  script=$1
+  shift
+  if test x${image_file:+set} = xset; then
+    "$GST" $GSTARGS -I "$image_file" -qK "$script" -a "$@"
+  else
+    "$GST" $GSTARGS -qK "$script" -a "$@"
+  fi
+}
+
+show_help () {
+  "$GST" $GSTARGS -qK scripts/Load.st -a $1
+  exit $?
+}
+
+getopt () {
+  "$GST" $GSTARGS -qK scripts/Getopt.st -a "$OPTIONS" "$@"
+}
+
+getopt "$@" | {
+  test=false
+  packages=
+  verbosity=
+  while read opt arg; do
+    case $opt in
+      ERROR) show_help --bad ;;
+      --help) show_help --help ;;
+      --quiet) verbosity="$verbosity $opt" ;;
+      --verbose) verbosity="$verbosity $opt" ;;
+      --test) test=: ;;
+      --image-file)
+       test x${image_file:+set} = xset && show_help --bad
+       image_file=$arg ;;
+      --) packages="$packages -p$arg" ;;
+    esac
+  done
+
+  if $test; then
+    gst scripts/Test.st $verbosity $packages
+    result=$?
+    test $result -gt 0 && exit 1
+  fi
+
+  gst scripts/Load.st "$@"
+  exit $?
+}
--- /dev/null
+++ mod/gst-sunit.in
@@ -0,0 +1,73 @@
+#! /bin/sh
+
+#######################################################################
+#
+#   Smalltalk package loader (utility script)
+#
+#
+#######################################################################
+
+
+#######################################################################
+#
+# Copyright 2007 Free Software Foundation, Inc.
+# Written by Paolo Bonzini.
+#
+# 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.  
+#
+########################################################################
+
+OPTIONS='-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package: 
-I|--image-file'
address@hidden@
address@hidden@
+
+: address@hidden@/gst}
+
+gst () {
+  script=$1
+  shift
+  if test x${image_file:+set} = xset; then
+    "$GST" $GSTARGS -I "$image_file" -qK "$script" -a "$@"
+  else
+    "$GST" $GSTARGS -qK "$script" -a "$@"
+  fi
+}
+
+show_help () {
+  "$GST" $GSTARGS -qK scripts/Test.st -a $1
+  exit $?
+}
+
+getopt () {
+  "$GST" $GSTARGS -qK scripts/Getopt.st -a "$OPTIONS" "$@"
+}
+
+getopt "$@" | {
+  test=false
+  packages=
+  while read opt arg; do
+    case $opt in
+      ERROR) show_help --bad ;;
+      --help) show_help --help ;;
+      --image-file)
+       test x${image_file:+set} = xset && show_help --bad
+       image_file=$arg ;;
+    esac
+  done
+
+  gst scripts/Test.st "$@"
+  exit $?
+}
--- /dev/null
+++ mod/scripts/Getopt.st
@@ -0,0 +1,46 @@
+#! @bindir@/gst -f
+
+"======================================================================
+|
+|   Command-line parsing utility for Smalltalk
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| 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.  
+|
+ ======================================================================"
+
+Smalltalk arguments size < 1 ifTrue: [ ObjectMemory quit: 1 ].
+Smalltalk arguments size = 1 ifTrue: [ ObjectMemory quit: 0 ].
+
+"Usage: Getopt.st PATTERN [ OPTIONS ... ]"
+
+Getopt
+    parse: (Smalltalk arguments copyFrom: 2)
+    with: (Smalltalk arguments first)
+    do: [ :opt :arg || pat o a |
+       o := opt ifNil: [ '' ].
+       pat := o isString ifTrue: [ '--%1 %2' ] ifFalse: [ '-%1 %2' ].
+       a := arg ifNil: [ '' ].
+       (pat bindWith: o with: a) displayNl ]
+    ifError: [ 'ERROR' displayNl ]