diff -rNu smalltalk-2.3.3/ChangeLog smalltalk-2.3.4/ChangeLog --- smalltalk-2.3.3/ChangeLog 2007-02-04 11:42:06.000000000 +0100 +++ smalltalk-2.3.4/ChangeLog 2007-05-28 12:12:37.000000000 +0200 @@ -1,3 +1,132 @@ +2007-05-28 Paolo Bonzini + + * kernel/LargeInt.st: Fix division when GMP is absent. + +2007-05-26 Paolo Bonzini + + * kernel/Number.st: Change #asScaledDecimal:scale: to + #asScaledDecimal:radix:scale:. + +2007-05-26 Paolo Bonzini + + * kernel/Behavior.st: Support nil superclass more thoroughly. + * kernel/Builtins.st: Move #instanceVariableNames: to + ClassDescription. + * kernel/Float.st: Print exponent for 1.0e/1.0q. The zillionth + printing bug. + * kernel/ScaledDec.st: Remove initial space. + +2007-05-24 Paolo Bonzini + + * tests/floatmath.st: Test printing on hexadecimal patterns. + +2007-05-24 Paolo Bonzini + + * examples/gdbmtests.st: Remove created files. + +2007-05-24 Paolo Bonzini + Stephen Compall + + * kernel/Collection.st: Don't use #basicSize in #copyWith:. + * kernel/Dictionary.st: Replace #primSize with #capacity. + * kernel/HashedColl.st: Replace #primSize with #capacity. + * kernel/LookupTable.st: Replace #primSize with #capacity. + + * numerics/NumericsAdds.st: Make all tests pass. + * numerics/NumericsTests.st: Update usage of SUnit logging API. + + * examples/Continuations.st: Add the Amb class from seaside and + related SUnit tests. + + * examples/gdbm-c.st: Fix finalization bug. Move tests from here... + * examples/gdbm.st: ... and here... + * examples/gdbmtests.st: ... to here. + + * kernel/PkgLoader.st: Add public #fileIn method to Package. + + * examples/md5tests.st: New. + + * examples/zlibtests.st: New file split from examples/zlib.st. + Convert to an SUnit test. + + * scripts/Load.st: Rewrite. + * scripts/Test.st: Rewrite. + * scripts/Reload.st: Replace with... + * scripts/gst-reload.sh: ... this script. + +2007-05-22 Paolo Bonzini + + * kernel/Fraction.st: Fix multiplication/division by zero. + +2007-05-18 Paolo Bonzini + + * kernel/PipeStream.st: New. + * kernel/zlib.st: Use it. + +2007-05-18 Paolo Bonzini + + * kernel/ByteStream.st: Support #nextPutAll: of Streams into Streams. + * kernel/Collection.st: Add #isSequenceable. + * kernel/FileDescr.st: Add #next:putAll:startingAt:. Support + #nextPutAll: of Streams into Streams. Fix #next: + * kernel/FileStream.st: Support #nextPutAll: of Streams into Streams. + * kernel/SeqCollect.st: Add #isSequenceable. + * kernel/Stream.st: Add #isSequenceable. Support #nextPutAll: of + Streams into Streams. + +2007-05-17 Paolo Bonzini + + * kernel/PosStream.st: Fix comment of #species. + * kernel/Stream.st: Fix #nextHunk. + * examples/zlib.c: New. + * examples/zlib.st: New. + +2007-05-14 Paolo Bonzini + + * kernel/Behavior.st: Fix #kindOfSubclass. + +2007-03-29 Stephen Compall + + * kernel/Dictionary.st: Use a smaller default size in new. + * kernel/HashedColl.st: Treat new:'s argument as a requested + capacity. + +2007-03-26 Paolo Bonzini + + * kernel/Float.st: Add exclamation mark. + +2007-03-26 Paolo Bonzini + + * kernel/HashedColl.st: Add #withAll:. + +2007-03-20 Paolo Bonzini + + * kernel/Integer.st: Fix infinite loop in #binomial: when anInteger + is 0 or self. + +2007-03-20 Paolo Bonzini + + * kernel/CharArray.st: Point out that #lineDelimiter is not usable + on this class. + * kernel/Dictionary.st: Fix #addAll:, suggested by Janis Rucis. + +2007-03-19 Janis Rucis + + * examples/Publish.st: Fix two typos. + +2007-03-16 Paolo Bonzini + + * kernel/Regex.st: Fix calls to #interval. + +2007-03-09 Paolo Bonzini + + * scripts/Finish.st: Fix DESTDIR installation. + +2007-03-06 Paolo Bonzini + + * examples/Continuations.st: Make more compatible with Seaside's + implementation. + 2007-02-04 Paolo Bonzini * kernel/Float.st: Remove debugging statement. diff -rNu smalltalk-2.3.3/Makefile.am smalltalk-2.3.4/Makefile.am --- smalltalk-2.3.3/Makefile.am 2007-02-13 16:13:22.000000000 +0100 +++ smalltalk-2.3.4/Makefile.am 2007-05-28 12:12:32.000000000 +0200 @@ -56,7 +56,7 @@ 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 @@ $(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 \ @@ -188,7 +188,7 @@ uninstall-local:: gst-package ./gst-package --uninstall --destdir="$(DESTDIR)" packages.xml -rm -f $(DESTDIR)$(pkgdatadir)/packages.xml - -rm -f $(DESTDIR)$(pkgdatadir)/gst.im + -rm -f $(DESTDIR)$(imagedir)/gst.im installcheck-local: if test -n "$(DESTDIR)"; then :; else \ diff -rNu smalltalk-2.3.3/Makefile.in smalltalk-2.3.4/Makefile.in --- smalltalk-2.3.3/Makefile.in 2007-02-13 16:13:32.000000000 +0100 +++ smalltalk-2.3.4/Makefile.in 2007-05-28 12:40:11.000000000 +0200 @@ -189,6 +189,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ @@ -369,7 +370,7 @@ dist_noinst_DATA = Doxyfile 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 scripts/Test.st scripts/Finish.st \ + scripts/gst-reload.sh scripts/Test.st scripts/Finish.st \ scripts/GenLibDoc.st scripts/GenBaseDoc.st gsticon.ico \ superops/ChangeLog superops/Makefile superops/README \ superops/bool-array.cc superops/bool-array.h \ @@ -1087,7 +1088,7 @@ $(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 \ @@ -1146,7 +1147,7 @@ uninstall-local:: gst-package ./gst-package --uninstall --destdir="$(DESTDIR)" packages.xml -rm -f $(DESTDIR)$(pkgdatadir)/packages.xml - -rm -f $(DESTDIR)$(pkgdatadir)/gst.im + -rm -f $(DESTDIR)$(imagedir)/gst.im installcheck-local: if test -n "$(DESTDIR)"; then :; else \ diff -rNu smalltalk-2.3.3/NEWS smalltalk-2.3.4/NEWS --- smalltalk-2.3.3/NEWS 2007-02-13 09:53:01.000000000 +0100 +++ smalltalk-2.3.4/NEWS 2007-05-28 12:40:31.000000000 +0200 @@ -1,5 +1,39 @@ List of user-visible changes in GNU Smalltalk +NEWS FROM 2.3.3 TO 2.3.4 + +o Behavior>>#evaluate: and MethodDictionary>>#removeAt:ifAbsent: would + cause the method dictionary's size to double. This caused sometimes + spurious failures in floatmath.st. + +o Fixed bug in LargeInteger division on systems not equipped with GMP. + +o Fixed bug in socket #nextHunk implementation, which lost the first + or second byte in the input buffer. + +o Fixed paths in the image when "make DESTDIR" was used. + +o Fixed implementation of Dictionary>>#addAll:, and fixed Integer>>#binomial: + when the argument is 0 or self. + +o Fixed various minor bugs and imprecisions in the documentation. + +o Improvements to the ancillary scripts gst-load and gst-sunit. In + particular, a package can describe the classes that constitute its + testsuite, and gst-sunit allows to quickly run the testsuite for a + package. + +o Improvements to the test suite. Several of the modules included with + GNU Smalltalk are tested. The testsuite is now written using Autotest. + +o Some libffi files (for IA64 and PA) were missing from the distribution. + +o Upgraded libsigsegv, for improved Mac OS X on Intel support + +o zlib bindings provided in package ZLib. + +----------------------------------------------------------------------------- + NEWS FROM 2.3.2 TO 2.3.3 o Introduced the --with-imagedir configure option to specify the directory diff -rNu smalltalk-2.3.3/THANKS smalltalk-2.3.4/THANKS --- smalltalk-2.3.3/THANKS 2007-01-28 22:38:38.000000000 +0100 +++ smalltalk-2.3.4/THANKS 2007-03-19 17:54:08.000000000 +0100 @@ -65,6 +65,7 @@ Ian Piumarta J Pfersich Robin Redeker +Janis Rucis Jeff Rosenwald Stefan Schmiedl Alexander Shinn diff -rNu smalltalk-2.3.3/blox-tk/Makefile.in smalltalk-2.3.4/blox-tk/Makefile.in --- smalltalk-2.3.3/blox-tk/Makefile.in 2007-02-13 09:25:23.000000000 +0100 +++ smalltalk-2.3.4/blox-tk/Makefile.in 2007-05-28 12:40:06.000000000 +0200 @@ -118,6 +118,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/build-aux/sigaltstack-longjmp.m4 smalltalk-2.3.4/build-aux/sigaltstack-longjmp.m4 --- smalltalk-2.3.3/build-aux/sigaltstack-longjmp.m4 2006-02-05 19:41:19.000000000 +0100 +++ smalltalk-2.3.4/build-aux/sigaltstack-longjmp.m4 2007-05-12 12:02:18.000000000 +0200 @@ -1,5 +1,5 @@ -# sigaltstack-longjmp.m4 serial 2 (libsigsegv-2.2) -dnl Copyright (C) 2002-2003 Bruno Haible +# sigaltstack-longjmp.m4 serial 3 (libsigsegv-2.4) +dnl Copyright (C) 2002-2003, 2006 Bruno Haible dnl This file is free software, distributed under the terms of the GNU dnl General Public License. As a special exception to the GNU General dnl Public License, this file may be distributed as part of a program @@ -37,12 +37,16 @@ { $5 } longjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { diff -rNu smalltalk-2.3.3/build-aux/sigaltstack-siglongjmp.m4 smalltalk-2.3.4/build-aux/sigaltstack-siglongjmp.m4 --- smalltalk-2.3.3/build-aux/sigaltstack-siglongjmp.m4 2006-02-05 19:41:19.000000000 +0100 +++ smalltalk-2.3.4/build-aux/sigaltstack-siglongjmp.m4 2007-05-12 12:02:18.000000000 +0200 @@ -1,5 +1,5 @@ -# sigaltstack-siglongjmp.m4 serial 2 (libsigsegv-2.2) -dnl Copyright (C) 2002-2003 Bruno Haible +# sigaltstack-siglongjmp.m4 serial 3 (libsigsegv-2.4) +dnl Copyright (C) 2002-2003, 2006 Bruno Haible dnl This file is free software, distributed under the terms of the GNU dnl General Public License. As a special exception to the GNU General dnl Public License, this file may be distributed as part of a program @@ -35,12 +35,16 @@ { $5 } siglongjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { diff -rNu smalltalk-2.3.3/build-aux/sigaltstack.m4 smalltalk-2.3.4/build-aux/sigaltstack.m4 --- smalltalk-2.3.3/build-aux/sigaltstack.m4 2006-02-05 19:41:19.000000000 +0100 +++ smalltalk-2.3.4/build-aux/sigaltstack.m4 2007-05-12 12:02:18.000000000 +0200 @@ -1,5 +1,5 @@ -# sigaltstack.m4 serial 3 (libsigsegv-2.2) -dnl Copyright (C) 2002-2003 Bruno Haible +# sigaltstack.m4 serial 6 (libsigsegv-2.4) +dnl Copyright (C) 2002-2006 Bruno Haible dnl This file is free software, distributed under the terms of the GNU dnl General Public License. As a special exception to the GNU General dnl Public License, this file may be distributed as part of a program @@ -28,8 +28,20 @@ AC_CACHE_CHECK([for working sigaltstack], sv_cv_sigaltstack, [ if test "$ac_cv_func_sigaltstack" = yes; then - AC_RUN_IFELSE([ - AC_LANG_SOURCE([[ + case "$host_os" in + macos* | darwin[[6-9]]* | darwin[[1-9]][[0-9]]*) + # On MacOS X 10.2 or newer, just assume that if it compiles, it will + # work. If we were to perform the real test, 1 Crash Report dialog + # window would pop up. + AC_LINK_IFELSE([ + AC_LANG_PROGRAM([[#include ]], + [[int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss);]])], + [sv_cv_sigaltstack="guessing yes"], + [sv_cv_sigaltstack=no]) + ;; + *) + AC_RUN_IFELSE([ + AC_LANG_SOURCE([[ #include #include #if HAVE_SYS_SIGNAL_H @@ -45,12 +57,16 @@ /* If we get here, the stack overflow was caught. */ exit (0); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { @@ -81,18 +97,22 @@ recurse (0); exit (2); }]])], - [sv_cv_sigaltstack=yes], - [sv_cv_sigaltstack=no], - [ - dnl FIXME: Put in some more known values here. - case "$host_os" in - *) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss);]])], - sv_cv_sigaltstack="guessing yes", sv_cv_sigaltstack=no) - ;; - esac - ]) + [sv_cv_sigaltstack=yes], + [sv_cv_sigaltstack=no], + [ + dnl FIXME: Put in some more known values here. + case "$host_os" in + *) + AC_LINK_IFELSE([ + AC_LANG_PROGRAM([[#include ]], + [[int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss);]])], + [sv_cv_sigaltstack="guessing yes"], + [sv_cv_sigaltstack=no]) + ;; + esac + ]) + ;; + esac else sv_cv_sigaltstack=no fi diff -rNu smalltalk-2.3.3/compiler/ChangeLog smalltalk-2.3.4/compiler/ChangeLog --- smalltalk-2.3.3/compiler/ChangeLog 2007-01-31 09:58:38.000000000 +0100 +++ smalltalk-2.3.4/compiler/ChangeLog 2007-05-25 11:47:00.000000000 +0200 @@ -1,3 +1,32 @@ +2007-05-24 Paolo Bonzini + + * compiler/ParseTreeSearcher.st: Sync with development version. + * compiler/RewriteTests.st: New. + +2007-05-22 Paolo Bonzini + + * compiler/RBParseNodes.st: Add #deepCopy. Our #copy is as deep + as it needs to be. + +2007-05-14 Paolo Bonzini + + * compiler/STLoader.st: Update for class shapes, add new methods. + * compiler/STLoaderObjs.st: Update for class shapes, add new methods. + +2007-04-16 Stephen Compall + Paolo Bonzini + + * compiler/OrderedSet.st: Added (by Stephen Compall). + * compiler/STSymTable.st: Use it. + +2007-04-08 Stephen Compall + + * compiler/STSymTable.st: Add superclass environments and shared + pools to global variable search. + + * compiler/RBParser.st: Reset `tags' instance variable before each + method parse in a method definition list. + 2007-01-31 Paolo Bonzini * compiler/STCompiler.st: Avoid that #compileAttribute: shadows diff -rNu smalltalk-2.3.3/compiler/OrderedSet.st smalltalk-2.3.4/compiler/OrderedSet.st --- smalltalk-2.3.3/compiler/OrderedSet.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/compiler/OrderedSet.st 2007-05-17 13:57:56.000000000 +0200 @@ -0,0 +1,316 @@ +"====================================================================== +| +| OrderedSet Method Definitions +| +| + ======================================================================" + + +"====================================================================== +| +| Copyright (C) 2007 Free Software Foundation, Inc. +| Written by Stephen Compall. +| +| This file is part of the GNU Smalltalk class library. +| +| The GNU Smalltalk class library is free software; you can redistribute it +| and/or modify it under the terms of the GNU Lesser General Public License +| as published by the Free Software Foundation; either version 2.1, or (at +| your option) any later version. +| +| The GNU Smalltalk class library 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 Lesser +| General Public License for more details. +| +| You should have received a copy of the GNU Lesser General Public License +| along with the GNU Smalltalk class library; see the file COPYING.LIB. +| If not, write to the Free Software Foundation, 59 Temple Place - Suite +| 330, Boston, MA 02110-1301, USA. +| + ======================================================================" + +OrderedCollection variableSubclass: #OrderedSet + instanceVariableNames: 'unorderedSet' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Sequenceable' +! + +OrderedSet comment: +'My instances represent sets of unique objects that may be accessed by +an arbitrary index. Besides allowing addition, removal, and insertion +of objects at indexed locations in my instances, I impose the +invariant that a particular element cannot appear more than once. + +This invariant leads to varying behavior, as in some cases it makes +sense to behave as an OrderedCollection, whereas in others it makes +more sense to behave as a Set. For example, #collect: may answer an +OrderedSet with fewer elements than the receiver, #at:put: will signal +an error if its put: argument is already present as a different +element, and #with:with: may potentially answer an OrderedSet with +only one element. + +I use a Set, called "unordered set", to decide whether an element is +already present.' +! + + +!OrderedSet class methodsFor: 'instance creation'! + +identityNew: anInteger + "Answer an OrderedSet of size anInteger which uses #== to compare its + elements." + ^self on: (IdentitySet new: anInteger)! + +new: anInteger + "Answer an OrderedSet of size anInteger." + ^self on: (Set new: anInteger)! + +on: anEmptySet + "Answer an OrderedSet that uses anEmptySet as an unordered set to + maintain my set-property." + anEmptySet isEmpty + ifFalse: [ self error: 'expected empty collection' ]. + ^(super new: anEmptySet basicSize) + unorderedSet: anEmptySet; + yourself +! ! + +!OrderedSet methodsFor: 'accessing'! + +at: anIndex put: anObject + "Store anObject at the anIndex-th item of the receiver, answer + anObject. Signal an error if anObject is already present as + another element of the receiver." + | oldElement | + oldElement := self at: anIndex. + "Though it is somewhat inefficient to remove then possibly readd + the old element, the case is rare enough that the precision of + unorderedSet-based comparison is worth it." + unorderedSet remove: oldElement. + (unorderedSet includes: anObject) + ifTrue: [unorderedSet add: oldElement. + ^self error: 'anObject is already present']. + unorderedSet add: anObject. + ^super at: anIndex put: anObject +! ! + +!OrderedSet methodsFor: 'copying'! + +postCopy + super postCopy. + unorderedSet := unorderedSet copy. +! + +copyEmpty: newSize + "Answer an empty copy of the receiver." + ^self species on: (unorderedSet copyEmpty: newSize) +! ! + +!OrderedSet methodsFor: 'searching for elements'! + +includes: anObject + "Answer whether anObject is one of my elements, according to my + 'unordered set'." + ^unorderedSet includes: anObject +! + +occurrencesOf: anObject + "Answer how many of anObject I contain. As I am a set, this is + always 0 or 1." + ^(self includes: anObject) ifTrue: [1] ifFalse: [0] +! + +indexOf: anElement startingAt: anIndex ifAbsent: exceptionBlock + "Answer the first index > anIndex which contains anElement. + Invoke exceptionBlock and answer its result if no item is found." + ^((self includes: anElement) + or: [(anIndex between: 1 and: self size + 1) not]) + "if anIndex isn't valid, super method will catch it. Also, + super method may not find the element, which is fine" + ifTrue: [super indexOf: anElement startingAt: anIndex + ifAbsent: exceptionBlock] + ifFalse: [exceptionBlock value] +! ! + +!OrderedSet methodsFor: 'adding'! + +add: anObject + "Add anObject in the receiver if it is not already present, and + answer it." + (unorderedSet includes: anObject) + ifFalse: [super add: anObject. + unorderedSet add: anObject.]. + ^anObject +! + +add: newObject afterIndex: i + "Add newObject in the receiver just after the i-th, unless it is + already present, and answer it. Fail if i < 0 or i > self size " + (unorderedSet includes: newObject) + ifFalse: [super add: newObject afterIndex: i. + unorderedSet add: newObject.]. + ^newObject +! + +addAll: aCollection + "Add every item of aCollection to the receiver that is not already + present, and answer it." + ^self addAllLast: aCollection +! + +addAll: newCollection afterIndex: i + "Add every item of newCollection to the receiver just after + the i-th, answer it. Fail if i < 0 or i > self size" + + | index | + + (i between: 0 and: self size) ifFalse: [ + ^SystemExceptions.IndexOutOfRange signalOn: self withIndex: i + ]. + + index := i + firstIndex. + self makeRoomLastFor: newCollection size. + + lastIndex to: index by: -1 do: [ :i | + self basicAt: i + newCollection size put: (self basicAt: i) + ]. + lastIndex := lastIndex + newCollection size. + + newCollection do: [:each | + (unorderedSet includes: each) ifFalse: + [unorderedSet add: each. + self basicAt: index put: each. + index := 1 + index.]]. + + self closeGapFrom: index - firstIndex + 1 + to: i + newCollection size. + ^newCollection +! + +addAllFirst: aCollection + "Add every item of newCollection to the receiver right at the start + of the receiver. Answer aCollection" + | index | + self makeRoomFirstFor: aCollection size. + firstIndex := index := firstIndex - aCollection size. + aCollection do: [:elt | + (unorderedSet includes: elt) ifFalse: + [self basicAt: index put: elt. + unorderedSet add: elt. + index := index + 1]]. + + self closeGapFrom: index - firstIndex + 1 to: aCollection size. + ^aCollection +! + +addAllLast: aCollection + "Add every item of newCollection to the receiver right at the end + of the receiver. Answer aCollection" + + | index newElements newElementCount | + "might be too big, but probably not too much" + self makeRoomLastFor: aCollection size. + + aCollection do: [ :element | + (unorderedSet includes: element) + ifFalse: [lastIndex := lastIndex + 1. + self basicAt: lastIndex put: element. + unorderedSet add: element]]. + + ^aCollection +! + +addFirst: newObject + "Add newObject to the receiver right at the start of the receiver, + unless it is already present as an element. Answer newObject" + (unorderedSet includes: newObject) + ifFalse: [unorderedSet add: newObject. + super addFirst: newObject]. + ^newObject +! + +addLast: newObject + "Add newObject to the receiver right at the end of the receiver, + unless it is already present as an element. Answer newObject" + (unorderedSet includes: newObject) + ifFalse: [unorderedSet add: newObject. + super addLast: newObject]. + ^newObject +! ! + + + +!OrderedSet methodsFor: 'removing'! + +removeFirst + "Remove an object from the start of the receiver. Fail if the receiver + is empty" + ^unorderedSet remove: super removeFirst +! + +removeLast + "Remove an object from the end of the receiver. Fail if the receiver + is empty." + ^unorderedSet remove: super removeLast +! + +removeAtIndex: anIndex + "Remove the object at index anIndex from the receiver. Fail if the + index is out of bounds." + ^unorderedSet remove: (super removeAtIndex: anIndex) +! ! + + +!OrderedSet methodsFor: 'private methods'! + +closeGapFrom: gapStart to: gapEnd + "Remove all elements between gapStart and gapEnd, inclusive, + without modifying the unordered set. I simply ignore this + message if gapStart or gapEnd is bad." + | realStart realEnd | + "these vars are almost always exactly the current basic gap" + realStart := firstIndex + gapStart - 1. + realEnd := firstIndex + gapEnd - 1. + + "trivial cases" + (gapStart <= gapEnd and: + [(realStart between: firstIndex and: lastIndex) and: + [realEnd between: firstIndex and: lastIndex]]) + ifFalse: [^self]. + realEnd = lastIndex ifTrue: [lastIndex := realStart - 1. ^self]. + realStart = firstIndex ifTrue: [firstIndex := realEnd + 1. ^self]. + + "shift from before?" + (gapStart - 1) < (lastIndex - realEnd) + ifTrue: + [[self basicAt: realEnd + put: (self basicAt: (realStart := realStart - 1)). + realEnd := realEnd - 1. + realStart = firstIndex] whileFalse. + firstIndex := realEnd + 1] + ifFalse: + ["shift from after" + [self basicAt: realStart + put: (self basicAt: (realEnd := realEnd + 1)). + realStart := realStart + 1. + realEnd = lastIndex] whileFalse. + lastIndex := realStart - 1]. + "help the gc" + realStart to: realEnd do: [:i | self basicAt: i put: nil]. +! + +growBy: delta shiftBy: shiftCount + "This may be private to OrderedCollection, but its inlining of + new-instance filling breaks me." + | uSet | + uSet := unorderedSet. + super growBy: delta shiftBy: shiftCount. + "effectively copy after #become: invocation" + unorderedSet := uSet. +! + +unorderedSet: aSet + unorderedSet := aSet +! ! diff -rNu smalltalk-2.3.3/compiler/ParseTreeSearcher.st smalltalk-2.3.4/compiler/ParseTreeSearcher.st --- smalltalk-2.3.3/compiler/ParseTreeSearcher.st 2007-01-15 08:32:34.000000000 +0100 +++ smalltalk-2.3.4/compiler/ParseTreeSearcher.st 2007-05-25 11:46:23.000000000 +0200 @@ -277,6 +277,12 @@ !RBSmallDictionary methodsFor: 'private'! +capacity + ^super primSize! + +capacity + ^super primSize! + whileGrowingAt: key put: value tally := tally + 1. self primAt: self size put: key. @@ -758,79 +764,143 @@ answer := true! lookForMoreMatchesInContext: oldContext - oldContext keysAndValuesDo: - [:key :value | - (key isString not and: [key recurseInto]) - ifTrue: - [oldContext at: key put: (value collect: [:each | self visitNode: each])]]! ! + oldContext keysAndValuesDo: [:key :value || newValue | + (key isString not and: [key recurseInto]) ifTrue: [ + "Of course, the following statement does nothing without the `deepCopy' + which fixes the bug." + newValue := oldContext at: key put: value deepCopy "<<<". + self visitNodes: newValue + onMatch: [:newValue | + oldContext at: key put: newValue]]]! ! !ParseTreeRewriter methodsFor: 'visiting'! -visitArguments: aNodeCollection - ^aNodeCollection collect: [:each | self visitArgument: each]! ! +visitNode: aNode + ^self visitNode: aNode searches: searches onMatch: [:newNode |]! + +visitNode: aNode onMatch: aBlock + ^self visitNode: aNode searches: searches onMatch: aBlock! + +visitNodes: aNodeList + ^self visitNodes: aNodeList onMatch: [:newNodes |]! + +visitNodes: aNodeList onMatch: aBlock + ^self visitNodes: aNodeList searches: searches onMatch: aBlock! + +visitArgument: aNode + ^self visitNode: aNode searches: argumentSearches onMatch: [:newNode |]! + +visitArguments: aNodeList + ^self visitArguments: aNodeList onMatch: [:newNodes |]! + +visitArguments: aNodeList onMatch: aBlock + ^self visitNodes: aNodeList searches: argumentSearches onMatch: aBlock! + +visitNode: aNode searches: theseSearches onMatch: aBlock + "Visit aNode, sending visitNode:'s answer to aBlock if + performSearches:on: finds a match." + | newNode | + newNode := self performSearches: theseSearches on: aNode. + ^newNode isNil ifTrue: [aNode acceptVisitor: self. aNode] + ifFalse: [aBlock value: newNode. newNode]! + +visitNodes: aNodeList searches: theseSearches onMatch: aBlock + "Answer aNodeList but with each element replaced by the result of + visitNode:onMatch: with said element (and a block of my own). If + any matches occur, I'll call aBlock afterwards with the + replacement of aNodeList before answering it." + | replacementList rlHasMatch | + rlHasMatch := false. + replacementList := aNodeList collect: [:eltNode | + self visitNode: eltNode + searches: theseSearches + onMatch: [:newElt | rlHasMatch := true]]. + ^rlHasMatch + ifTrue: [aBlock value: replacementList. replacementList] + ifFalse: [aNodeList]! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching'! acceptAssignmentNode: anAssignmentNode - anAssignmentNode variable: (self visitNode: anAssignmentNode variable). - anAssignmentNode value: (self visitNode: anAssignmentNode value)! + self visitNode: anAssignmentNode variable + onMatch: [:newField | anAssignmentNode variable: newField]. + self visitNode: anAssignmentNode value + onMatch: [:newField | anAssignmentNode value: newField]! acceptArrayConstructorNode: anArrayNode - anArrayNode body: (self visitNode: anArrayNode body)! + self visitNode: anArrayNode body + onMatch: [:newField | anArrayNode body: newField]! acceptBlockNode: aBlockNode - aBlockNode arguments: (self visitArguments: aBlockNode arguments). - aBlockNode body: (self visitNode: aBlockNode body)! + self visitArguments: aBlockNode arguments + onMatch: [:newField | aBlockNode arguments: newField]. + self visitNode: aBlockNode body + onMatch: [:newField | aBlockNode body: newField]! + +searchCascadeNodeMessage: aMessageNode messagesTo: newMessages + "Helper for acceptCascadeNode: -- descend to aMessageNode, but no + further. Add the resulting message or cascade of messages from + the tree rule's foundMatchFor: to newMessages and answer said + result if a match is found. Add aMessageNode to newMessages and + answer nil otherwise." + | answer newNode | + answer := self performSearches: searches on: aMessageNode. + newNode := answer ifNil: [aMessageNode]. + newNode isCascade + ifTrue: [newMessages addAll: newNode messages] + ifFalse: [newMessages add: + (newNode isMessage ifTrue: [newNode] + ifFalse: [Warning signal: 'Cannot replace message node inside of cascaded node with non-message node'. + answer := nil. "<<<" + aMessageNode])]. + ^answer! acceptCascadeNode: aCascadeNode | newMessages notFound | newMessages := OrderedCollection new: aCascadeNode messages size. notFound := OrderedCollection new: aCascadeNode messages size. - aCascadeNode messages do: - [:each | - | newNode | - newNode := self performSearches: searches on: each. - newNode isNil - ifTrue: - [newNode := each. - notFound add: newNode]. - newNode isMessage - ifTrue: [newMessages add: newNode] - ifFalse: - [newNode isCascade - ifTrue: [newMessages addAll: newNode messages] - ifFalse: - [Transcript - show: 'Cannot replace message node inside of cascaded node with non-message node.'; - cr. - newMessages add: each]]]. + aCascadeNode messages do: [:each | + (self searchCascadeNodeMessage: each + messagesTo: newMessages) + isNil ifTrue: [notFound add: each]]. + + "Rewrite the receiver once and distribute it among the messages if + no replacements were made." notFound size == aCascadeNode messages size ifTrue: - [| receiver | - receiver := self visitNode: aCascadeNode messages first receiver. - newMessages do: [:each | each receiver: receiver]]. + [self visitNode: aCascadeNode messages first receiver + onMatch: [:receiver | + newMessages do: [:each | each receiver: receiver]]]. notFound - do: [:each | each arguments: (each arguments collect: [:arg | self visitNode: arg])]. + do: [:each | self visitNodes: each arguments + onMatch: [:newArgs | each arguments: newArgs]]. aCascadeNode messages: newMessages! acceptMessageNode: aMessageNode - aMessageNode receiver: (self visitNode: aMessageNode receiver). - aMessageNode - arguments: (aMessageNode arguments collect: [:each | self visitNode: each])! + self visitNode: aMessageNode receiver + onMatch: [:newField | aMessageNode receiver: newField]. + self visitNodes: aMessageNode arguments + onMatch: [:newField | aMessageNode arguments: newField]! acceptMethodNode: aMethodNode - aMethodNode arguments: (self visitArguments: aMethodNode arguments). - aMethodNode body: (self visitNode: aMethodNode body)! + self visitArguments: aMethodNode arguments + onMatch: [:newField | aMethodNode arguments: newField]. + self visitNode: aMethodNode body + onMatch: [:newField | aMethodNode body: newField]! acceptOptimizedNode: anOptimizedNode - anOptimizedNode body: (self visitNode: anOptimizedNode body)! + self visitNode: anOptimizedNode body + onMatch: [:newField | anOptimizedNode body: newField]! acceptReturnNode: aReturnNode - aReturnNode value: (self visitNode: aReturnNode value)! + self visitNode: aReturnNode value + onMatch: [:newField | aReturnNode value: newField]! acceptSequenceNode: aSequenceNode - aSequenceNode temporaries: (self visitArguments: aSequenceNode temporaries). - aSequenceNode statements: (aSequenceNode statements collect: [:each | self visitNode: each])! ! + self visitArguments: aSequenceNode temporaries + onMatch: [:newField | aSequenceNode temporaries: newField]. + self visitNodes: aSequenceNode statements + onMatch: [:newField | aSequenceNode statements: newField]! ! ParseTreeRewriter class instanceVariableNames: ''! diff -rNu smalltalk-2.3.3/compiler/RBParseNodes.st smalltalk-2.3.4/compiler/RBParseNodes.st --- smalltalk-2.3.3/compiler/RBParseNodes.st 2007-01-02 09:01:29.000000000 +0100 +++ smalltalk-2.3.4/compiler/RBParseNodes.st 2007-05-25 11:47:48.000000000 +0200 @@ -253,6 +253,13 @@ !RBProgramNode methodsFor: 'enumeration'! +deepCopy + "Hacked to fit collection protocols. We use #deepCopy to obtain a list + of copied nodes. We do already copy for our instance variables + through #postCopy, so we redirect #deepCopy to be a normal #copy." + + ^self copy! + collect: aBlock "Hacked to fit collection protocols" diff -rNu smalltalk-2.3.3/compiler/RBParser.st smalltalk-2.3.4/compiler/RBParser.st --- smalltalk-2.3.3/compiler/RBParser.st 2007-01-02 09:01:29.000000000 +0100 +++ smalltalk-2.3.4/compiler/RBParser.st 2007-04-10 08:11:07.000000000 +0200 @@ -323,6 +323,7 @@ and: [ currentToken value == $! ] ] ] whileFalse: [ start := currentToken start - 1. + tags := nil. node := self parseMethod. "One -1 accounts for base-1 vs. base-0 (as above), the diff -rNu smalltalk-2.3.3/compiler/RewriteTests.st smalltalk-2.3.4/compiler/RewriteTests.st --- smalltalk-2.3.3/compiler/RewriteTests.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/compiler/RewriteTests.st 2007-05-25 11:46:23.000000000 +0200 @@ -0,0 +1,240 @@ +"====================================================================== +| +| ParseTreeRewriter tests +| +| + ======================================================================" + + +"====================================================================== +| +| Copyright (C) 2007 Free Software Foundation, Inc. +| Written by Stephen Compall. +| +| This file is part of the GNU Smalltalk class library. +| +| The GNU Smalltalk class library is free software; you can redistribute it +| and/or modify it under the terms of the GNU Lesser General Public License +| as published by the Free Software Foundation; either version 2.1, or (at +| your option) any later version. +| +| The GNU Smalltalk class library 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 Lesser +| General Public License for more details. +| +| You should have received a copy of the GNU Lesser General Public License +| along with the GNU Smalltalk class library; see the file COPYING.LIB. +| If not, write to the Free Software Foundation, 59 Temple Place - Suite +| 330, Boston, MA 02110-1301, USA. +| + ======================================================================" + +STInST addSubspace: #Tests! +Namespace current: STInST.Tests! + +TestCase subclass: #TestStandardRewrites + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Refactory-Tests' +! + +TestStandardRewrites comment: +'I test the ParseTreeRewriter with string rewrites provided directly +by PTR''s methods. + +This is a series of unit tests written with SUnit to check the +functionality of STInST.ParseTreeRewriter and its +helper classes. It was written based on the original functionality, +so that one could perform a radical rewrite and ensure that its +behavior stayed the same, at least as much as I care it to stay so.'! + + +!TestStandardRewrites methodsFor: 'testing'! + +testExpressions + "Basic testing of proper descent" + self rewrite: '(self foo: (one isNil ifTrue: [self uhOh. two] + ifFalse: [one])) + isNil ifTrue: [three isNil ifFalse: [three] + ifTrue: [four]] + ifFalse: [self foo: (one isNil ifTrue: [self uhOh. two] ifFalse: [one])]' + from: '``@receiver isNil ifTrue: [|`@otherVars| ``@.other] + ifFalse: [``@receiver]' + to: '``@receiver ifNil: [|`@otherVars| ``@.other]' + shouldBe: '(self foo: (one ifNil: [self uhOh. two])) + ifNil: [three isNil ifFalse: [three] + ifTrue: [four]]'. + "descent and simple replacement behavior with cascades" + self rewrite: '| temp | + temp := self one at: two put: three. + (self qqq at: temp put: dict) + at: four put: (five at: half put: quarter); + at: (six at: q put: r) put: 7; + w: (1 at: 2 put: 3). + ^42' + "``@receiver it was, until I found that a cascade corner + described below causes the w: send below to have the wrong + receiver. After all, it just doesn't make sense to descend + to the receiver for some cascade messages but not others!" + from: '`@receiver at: ``@key put: `@value' + to: '`@receiver set: ``@key to: `@value' + shouldBe: '| temp | + temp := self one set: two to: three. + (self qqq at: temp put: dict) + set: four to: (five at: half put: quarter); + set: (six set: q to: r) to: 7; + w: (1 set: 2 to: 3). + ^42'. +! + +testCascadeCornerCases + "Issue non-messages-are-found: If replacement isn't a cascade or + message, it drops. Oddly, PTR didn't count this as a 'not + found'; it doesn't descend into arguments of the original node in + this case, and, as a result, it won't descend to the receiver. This + behavior was changed, the original implementation needed this + shouldBe: content: + + obj. + (stream display: z) display: (stream display: x); + display: y; nextPut: $q" + self rewrite: 'stream display: obj. + (stream display: z) display: (stream display: x); + display: y; nextPut: $q' + from: '``@receiver display: ``@object' + to: '``@object' + shouldBe: 'obj. + z display: x; + display: y; nextPut: $q'. + + "Cascades within cascades are flattened." + self rewrite: 'stream nextPut: $r; display: (what display: qqq); tab' + from: '``@recv display: ``@obj' + to: '``@recv display: ``@obj; nl' + shouldBe: 'stream nextPut: $r; + display: (what display: qqq; nl); + nl; tab'. + + "Issue rsic-doesnt-copy: lookForMoreMatchesInContext: doesn't copy + its values. As a result, replacement in successful replacements + later rejected by acceptCascadeNode: (after + lookForMoreMatchesInContext: is already sent, after all) depends + on where in the subtree a match happened. This is why selective + recursion into successful matches before giving outer contexts + the opportunity to reject them isn't so great. It can be 'fixed' + by #copy-ing each value in the context before descending into it. + I would prefer removing that 'feature' altogether, and my own + 'trampoline' rewriter does just this. + + This replacement test depends on the non-message rejection oddity + described above, though fixing that won't entirely fix this + issue. If that issue is not, this test will need this shouldBe: + qqq display: (qqq display: sss); + display: [[sss]]'" + self rewrite: 'qqq display: (qqq display: sss); + display: [qqq display: sss]' + from: '``@recv display: ``@obj' + to: '[``@obj]' + shouldBe: 'qqq display: [sss]; + display: [[sss]]'. + [| rsicCopiesPRewriter sourceExp | + rsicCopiesPRewriter := self rewriterClass new + replace: '``@recv display: ``@obj' with: '[``@obj]'; + replace: '`@recv value' with: '`@recv'; + yourself. + sourceExp := RBParser parseExpression: + 'qqq display: (qqq display: sss value value); + display: [qqq display: sss value value]'. + self deny: (self rewriting: sourceExp + with: rsicCopiesPRewriter + yields: + 'qqq display: (qqq display: sss value value); + display: [[sss value]]') + description: + 'neither non-messages-are-found nor rsic-doesnt-copy fixed'. + self deny: (self rewriting: sourceExp + with: rsicCopiesPRewriter + yields: + 'qqq display: [sss value]; + display: [[sss]]') + description: + 'non-messages-are-found fixed, but not rsic-doesnt-copy'. + self assert: (self rewriting: sourceExp + with: rsicCopiesPRewriter + yields: + 'qqq display: [sss value]; + display: [[sss value]]') + description: + 'both non-messages-are-found and rsic-doesnt-copy fixed'.] + value. + + "Unmatched messages in a cascade get their arguments rewritten, + but not the receiver, provided that some other message in the + cascade was rewritten. This can lead to unreal trees if that + message had a recurseInto receiver." + self assert: + ((RBCascadeNode messages: + (RBParser parseExpression: '(1 b) b. (1 a) c') statements) + match: (self rewriterClass + replace: '``@recv a' + with: '``@recv b' + in: (RBParser parseExpression: '(1 a) a; c')) + inContext: RBSmallDictionary new) + description: 'Don''t rewrite cascade receivers unless no submessages matched'. +! + +testMultiRewrite + | rewriter origTree match1 match2 | + match1 := RBParser parseExpression: 'x value'. + match2 := RBParser parseExpression: 'x'. + origTree := RBParser parseExpression: 'x value value'. + + #(('`' '') ('' '`')) do: [:prefixes| | prefix1 prefix2 rewriter | + prefix1 := prefixes at: 1. + prefix2 := prefixes at: 2. + rewriter := ParseTreeRewriter new. + rewriter replace: prefix1 , '`@x value' with: prefix1 , '`@x'; + replace: prefix2 , '`@x value' with: prefix2 , '`@x'. + rewriter executeTree: origTree copy. + self assert: ({match1. match2} contains: [:matchTree | + matchTree match: rewriter tree + inContext: RBSmallDictionary new]) + description: 'Rewrite one or the other']. +! ! + +!TestStandardRewrites methodsFor: 'rewriting'! + +rewriterClass + ^ParseTreeRewriter +! + +rewriting: codeTree with: rewriter yields: newCodeString + "Answer whether rewriting codeTree (untouched) with rewriter + yields newCodeString." + ^(RBParser parseExpression: newCodeString) + match: (rewriter executeTree: codeTree copy; tree) + inContext: RBSmallDictionary new +! + +rewrite: codeString from: pattern to: replacement + shouldBe: newCodeString + "Assert that replacing pattern with replacement in codeString + yields newCodeString." + ^self assert: ((RBParser parseRewriteExpression: newCodeString) + match: (self rewriterClass + replace: pattern + with: replacement + in: (RBParser parseExpression: + codeString)) + inContext: Dictionary new) + description: ((WriteStream on: (String new: 50)) + display: codeString; nl; + nextPutAll: ' ==| ('; print: pattern; + nextPutAll: ' => '; print: replacement; + nextPut: $); nl; nextPutAll: ' ==> '; + display: newCodeString; contents) +! ! + +Namespace current: STInST! diff -rNu smalltalk-2.3.3/compiler/STLoader.st smalltalk-2.3.4/compiler/STLoader.st --- smalltalk-2.3.3/compiler/STLoader.st 2006-02-05 19:41:19.000000000 +0100 +++ smalltalk-2.3.4/compiler/STLoader.st 2007-05-17 13:56:56.000000000 +0200 @@ -8,7 +8,7 @@ "====================================================================== | -| Copyright 2001, 2002 Free Software Foundation, Inc. +| Copyright 2001, 2002, 2007 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | This file is part of GNU Smalltalk. @@ -69,21 +69,31 @@ !STInterpreter methodsFor: 'overrides'! +evaluationMethodFor: selector + | method class | + class := self class. + [ + class evaluationMethods isNil ifFalse: [ + method := class evaluationMethods at: selector ifAbsent: [ nil ]. + method isNil ifFalse: [ ^method ]. + ]. + class == STInterpreter ifTrue: [ ^#unknownTo:selector:arguments: ]. + class := class superclass + ] repeat +! + evaluateStatement: node - | receiver selector argumentNodes result | - receiver := node receiver. - selector := node selector. - argumentNodes := node arguments. - - result := false. - self class evaluationMethods at: selector ifPresent: [ :method | - result := self - perform: method - with: receiver - with: selector - with: argumentNodes ]. + | method | + method := self evaluationMethodFor: node selector. + ^self + perform: method + with: node receiver + with: node selector + with: node arguments +! - ^result +unknownTo: receiver selector: selector arguments: argumentNodes + ^false ! evaluate: node @@ -101,9 +111,15 @@ initialize self + toEvaluate: #subclass: + perform: #doSubclass:selector:arguments:; + toEvaluate: #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: perform: #doSubclass:selector:arguments:; + toEvaluate: #variable:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: + perform: #doSubclass:selector:arguments:; + toEvaluate: #variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: perform: #doSubclass:selector:arguments:; @@ -122,11 +138,23 @@ toEvaluate: #current: perform: #doSetNamespace:selector:arguments:; + toEvaluate: #import: + perform: #doImport:selector:arguments:; + + toEvaluate: #category: + perform: #doSend:selector:arguments:; + toEvaluate: #comment: - perform: #doComment:selector:arguments:; + perform: #doSend:selector:arguments:; + + toEvaluate: #shape: + perform: #doSend:selector:arguments:; + + toEvaluate: #addClassVarName: + perform: #doSend:selector:arguments:; toEvaluate: #instanceVariableNames: - perform: #doClassInstVars:selector:arguments: + perform: #doSend:selector:arguments: ! ! !STClassLoader class methodsFor: 'instance creation'! @@ -193,26 +221,26 @@ ^false ! -doComment: receiver selector: selector arguments: argumentNodes - | class | +doSend: receiver selector: selector arguments: argumentNodes + | isClass class | (argumentNodes allSatisfy: [ :each | each isLiteral ]) ifFalse: [ ^false ]. - class := self resolveClass: receiver. - class comment: argumentNodes first value. + isClass := receiver isMessage and: [ receiver selector = #class ]. + class := isClass + ifTrue: [ (self resolveClass: receiver receiver) asMetaclass ] + ifFalse: [ self resolveClass: receiver ]. + + class perform: selector with: argumentNodes first value. ^false ! -doClassInstVars: receiver selector: selector arguments: argumentNodes - | class | - (argumentNodes allSatisfy: [ :each | each isLiteral ]) - ifFalse: [ ^false ]. - - receiver isMessage ifFalse: [ ^false ]. - receiver selector = #class ifFalse: [ ^false ]. - +doImport: receiver selector: selector arguments: argumentNodes + | class namespace | + receiver isMessage ifTrue: [ ^false ]. class := self resolveClass: receiver. - class instanceVariableNames: argumentNodes first value. + namespace := self resolveNamespace: argumentNodes first. + class import: namespace. ^false ! diff -rNu smalltalk-2.3.3/compiler/STLoaderObjs.st smalltalk-2.3.4/compiler/STLoaderObjs.st --- smalltalk-2.3.3/compiler/STLoaderObjs.st 2006-02-05 19:41:19.000000000 +0100 +++ smalltalk-2.3.4/compiler/STLoaderObjs.st 2007-05-17 13:56:56.000000000 +0200 @@ -8,7 +8,7 @@ "====================================================================== | -| Copyright 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +| Copyright 1999, 2000, 2001, 2002, 2007 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | This file is part of GNU Smalltalk. @@ -139,7 +139,7 @@ LoadedBehavior subclass: #LoadedClass instanceVariableNames: 'name category sharedPools classVars class - environment kind ' + environment shape ' classVariableNames: '' poolDictionaries: '' category: 'System-Compiler'! @@ -210,7 +210,7 @@ classVariableNames: cvn poolDictionaries: pd category: c - kind: 'variableByteSubclass:' + shape: #byte loader: loader! variableWordSubclass: s instanceVariableNames: ivn classVariableNames: cvn @@ -223,7 +223,20 @@ classVariableNames: cvn poolDictionaries: pd category: c - kind: 'variableWordSubclass:' + shape: #word + loader: loader! + +variable: shape subclass: s instanceVariableNames: ivn classVariableNames: cvn + poolDictionaries: pd category: c + + ^LoadedClass + superclass: self + name: s + instanceVariableNames: ivn + classVariableNames: cvn + poolDictionaries: pd + category: c + shape: shape loader: loader! variableSubclass: s instanceVariableNames: ivn classVariableNames: cvn @@ -236,7 +249,7 @@ classVariableNames: cvn poolDictionaries: pd category: c - kind: 'variableSubclass:' + shape: #pointer loader: loader! subclass: s instanceVariableNames: ivn classVariableNames: cvn @@ -249,7 +262,19 @@ classVariableNames: cvn poolDictionaries: pd category: c - kind: 'subclass:' + shape: nil + loader: loader! + +subclass: s + + ^LoadedClass + superclass: self + name: s + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: '' + shape: nil loader: loader! !PseudoBehavior methodsFor: 'method dictionary services'! @@ -520,6 +545,14 @@ self subclassResponsibility ! +category + self subclassResponsibility +! + +category: aString + self subclassResponsibility +! + comment self subclassResponsibility ! @@ -528,6 +561,14 @@ self subclassResponsibility ! +shape + self subclassResponsibility +! + +shape: aSymbol + self subclassResponsibility +! + environment self subclassResponsibility ! @@ -604,6 +645,14 @@ ^true ! +category + ^self asClass category +! + +category: aString + ^self asClass category: aString +! + comment ^self asClass comment ! @@ -651,6 +700,10 @@ ^instVars ! +instanceVariableNames: ivn + instVars := (TokenStream on: ivn) contents. +! + superclass ^superclass ! @@ -674,10 +727,6 @@ ^true ! -instanceVariableNames: ivn - instVars := (TokenStream on: ivn) contents. -! - asClass ^instanceClass ! @@ -712,8 +761,8 @@ ^self asClass environment ! -kindOfSubclass - ^'subclass:' +shape + ^nil ! classVarNames @@ -752,10 +801,10 @@ !LoadedClass class methodsFor: 'creating classes'! superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn - poolDictionaries: pd category: c kind: kind loader: loader + poolDictionaries: pd category: c shape: sh loader: loader ^self new superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn - poolDictionaries: pd category: c kind: kind loader: loader + poolDictionaries: pd category: c shape: sh loader: loader ! ! !LoadedClass methodsFor: 'accessing'! @@ -782,6 +831,21 @@ ^category ! +category: aString + "Set the class category" + category := aString +! + +shape + "Answer the class shape" + ^shape +! + +shape: aSymbol + "Set the class shape" + shape := aSymbol +! + comment "Answer the class comment" ^comment @@ -798,8 +862,11 @@ ! kindOfSubclass - ^kind -! + "Return a string indicating the type of class the receiver is" + self isVariable ifFalse: [ ^'subclass:' ]. + self isPointers ifTrue: [ ^'variableSubclass:' ]. + ^'variable: ', self shape storeString, 'subclass:' +! classVarNames "Answer the names of the variables in the class pool dictionary" @@ -811,6 +878,18 @@ "Return the names of the shared pools defined by the class" ^sharedPools +! + +addClassVarName: aString + "Return the names of the shared pools defined by the class" + + sharedPools := sharedPools copyWith: aString +! + +import: aNamespace + "Return the names of the shared pools defined by the class" + + sharedPools := sharedPools copyWith: (aNamespace nameIn: self environment) ! ! !LoadedClass methodsFor: 'filing'! @@ -903,12 +982,12 @@ !LoadedClass methodsFor: 'initializing'! superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn - poolDictionaries: pd category: c kind: k loader: loader + poolDictionaries: pd category: c shape: sh loader: loader self initialize: loader. superclass := sup. name := s. category := c. - kind := k. + shape := sh. environment := loader currentNamespace. class := LoadedMetaclass new for: self. instVars := (TokenStream on: ivn) contents. diff -rNu smalltalk-2.3.3/compiler/STSymTable.st smalltalk-2.3.4/compiler/STSymTable.st --- smalltalk-2.3.3/compiler/STSymTable.st 2007-01-02 09:01:29.000000000 +0100 +++ smalltalk-2.3.4/compiler/STSymTable.st 2007-05-17 13:57:56.000000000 +0200 @@ -188,14 +188,14 @@ ]. behavior withAllSuperclassesDo: [ :class | - self addPool: behavior environment. + self addPool: class environment. class classPool isEmpty ifFalse: [ pools add: class classPool ] ]. behavior withAllSuperclassesDo: [ :class || dicts | - dicts := behavior sharedPoolDictionaries. + dicts := class sharedPoolDictionaries. dicts isNil ifFalse: [ dicts do: [ :sp | self addPool: sp ] ] @@ -364,7 +364,7 @@ instVars := Dictionary new: 7. scopeVariables := OrderedCollection new: 5. scopes := OrderedCollection new: 5. - pools := IdentitySet new: 7. + pools := OrderedSet identityNew: 7. tempCount := 0. ! diff -rNu smalltalk-2.3.3/config.h.in smalltalk-2.3.4/config.h.in --- smalltalk-2.3.3/config.h.in 2007-02-13 09:27:08.000000000 +0100 +++ smalltalk-2.3.4/config.h.in 2007-05-28 12:42:16.000000000 +0200 @@ -211,6 +211,9 @@ /* Define to 1 if the system has the type `long long int'. */ #undef HAVE_LONG_LONG_INT +/* Define to 1 if you have the `lrintl' function. */ +#undef HAVE_LRINTL + /* Define to 1 if you have the `lstat' function. */ #undef HAVE_LSTAT diff -rNu smalltalk-2.3.3/configure smalltalk-2.3.4/configure --- smalltalk-2.3.3/configure 2007-02-13 09:25:30.000000000 +0100 +++ smalltalk-2.3.4/configure 2007-05-28 12:40:14.000000000 +0200 @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.61 for GNU Smalltalk 2.3.3. +# Generated by GNU Autoconf 2.61 for GNU Smalltalk 2.3.4. # # Report bugs to . # @@ -724,8 +724,8 @@ # Identity of this package. PACKAGE_NAME='GNU Smalltalk' PACKAGE_TARNAME='smalltalk' -PACKAGE_VERSION='2.3.3' -PACKAGE_STRING='GNU Smalltalk 2.3.3' +PACKAGE_VERSION='2.3.4' +PACKAGE_STRING='GNU Smalltalk 2.3.4' PACKAGE_BUGREPORT='help-smalltalk@gnu.org' ac_unique_file="main.c" @@ -868,6 +868,7 @@ LEX YACC GPERF +AUTOM4TE subdirs LIBSNPRINTFV INCSNPRINTFV @@ -1449,7 +1450,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures GNU Smalltalk 2.3.3 to adapt to many kinds of systems. +\`configure' configures GNU Smalltalk 2.3.4 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1519,7 +1520,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of GNU Smalltalk 2.3.3:";; + short | recursive ) echo "Configuration of GNU Smalltalk 2.3.4:";; esac cat <<\_ACEOF @@ -1647,7 +1648,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -GNU Smalltalk configure 2.3.3 +GNU Smalltalk configure 2.3.4 generated by GNU Autoconf 2.61 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1661,7 +1662,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by GNU Smalltalk $as_me 2.3.3, which was +It was created by GNU Smalltalk $as_me 2.3.4, which was generated by GNU Autoconf 2.61. Invocation command line was $ $0 $@ @@ -2140,6 +2141,9 @@ +ac_config_commands="$ac_config_commands tests/atconfig" + + ac_config_headers="$ac_config_headers config.h" am__api_version="1.9" @@ -2428,7 +2432,7 @@ # Define the identity of the package. PACKAGE='smalltalk' - VERSION='2.3.3' + VERSION='2.3.4' cat >>confdefs.h <<_ACEOF @@ -5007,7 +5011,7 @@ ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_dummy="$PATH:/sbin" +as_dummy="$PATH:/sbin:/usr/sbin" for as_dir in $as_dummy do IFS=$as_save_IFS @@ -5195,6 +5199,9 @@ GPERF=${GPERF-"${am_missing_run}gperf"} +AUTOM4TE=${AUTOM4TE-"${am_missing_run}autom4te"} + + subdirs="$subdirs libffi" @@ -8452,7 +8459,7 @@ ;; *-*-irix6*) # Find out which ABI we are using. - echo '#line 8455 "configure"' > conftest.$ac_ext + echo '#line 8462 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? @@ -10010,11 +10017,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:10013: $lt_compile\"" >&5) + (eval echo "\"\$as_me:10020: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:10017: \$? = $ac_status" >&5 + echo "$as_me:10024: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings @@ -10253,11 +10260,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:10256: $lt_compile\"" >&5) + (eval echo "\"\$as_me:10263: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:10260: \$? = $ac_status" >&5 + echo "$as_me:10267: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings @@ -10313,11 +10320,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:10316: $lt_compile\"" >&5) + (eval echo "\"\$as_me:10323: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:10320: \$? = $ac_status" >&5 + echo "$as_me:10327: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -12461,7 +12468,7 @@ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext < conftest.$ac_ext <&5 @@ -18061,7 +18069,7 @@ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <&5 +echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6; } +if test "${ac_cv_header_zlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_zlib_h" >&6; } +else + # Is the header compilable? +{ echo "$as_me:$LINENO: checking zlib.h usability" >&5 +echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_compiler=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6; } + +# Is the header present? +{ echo "$as_me:$LINENO: checking zlib.h presence" >&5 +echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi + +rm -f conftest.err conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;} + ( cat <<\_ASBOX +## ------------------------------------- ## +## Report this to help-smalltalk@gnu.org ## +## ------------------------------------- ## +_ASBOX + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +{ echo "$as_me:$LINENO: checking for zlib.h" >&5 +echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6; } +if test "${ac_cv_header_zlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_zlib_h=$ac_header_preproc +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_zlib_h" >&6; } + +fi +if test $ac_cv_header_zlib_h = yes; then + MODULES_EXAMPLE="$MODULES_EXAMPLE zlib.la" +fi + + # Check whether --enable-gtk was given. if test "${enable_gtk+set}" = set; then @@ -24088,7 +24231,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by GNU Smalltalk $as_me 2.3.3, which was +This file was extended by GNU Smalltalk $as_me 2.3.4, which was generated by GNU Autoconf 2.61. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -24145,7 +24288,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -GNU Smalltalk config.status 2.3.3 +GNU Smalltalk config.status 2.3.4 configured by $0, generated by GNU Autoconf 2.61, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" @@ -24262,6 +24405,7 @@ for ac_config_target in $ac_config_targets do case $ac_config_target in + "tests/atconfig") CONFIG_COMMANDS="$CONFIG_COMMANDS tests/atconfig" ;; "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; "lib-src/poll.h") CONFIG_LINKS="$CONFIG_LINKS lib-src/poll.h:lib-src/poll_.h" ;; @@ -24501,6 +24645,7 @@ LEX!$LEX$ac_delim YACC!$YACC$ac_delim GPERF!$GPERF$ac_delim +AUTOM4TE!$AUTOM4TE$ac_delim subdirs!$subdirs$ac_delim LIBSNPRINTFV!$LIBSNPRINTFV$ac_delim INCSNPRINTFV!$INCSNPRINTFV$ac_delim @@ -24568,7 +24713,7 @@ LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 72; then + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 73; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 @@ -25030,6 +25175,29 @@ case $ac_file$ac_mode in + "tests/atconfig":C) cat >tests/atconfig < @@ -1516,16 +1535,21 @@ bindings can use them. `callout' - Refuse to load the package if the function whose name is within - the tags is not available to be called from Smalltalk code. + Instructs to load the package only if the C function whose name is + within the tag is available to be called from Smalltalk code. + +`sunit' + Specifies a testing script that `gst-sunit' (*note SUnit::) will + run in order to test the package. If this is specified, the + package should list `SUnit' among the prerequisites. To install your package, you only have to do gst-package mypkg.xml - which is a small shell script which will merge the file with + `gst-package' is a small shell script which will merge the file with `packages.xml', install the files specified in the `file' tags and load the packages. The GNU Smalltalk makefile also use `gst-package' to -install packages and to prepare the distribution tarballs. +install packages and to prepare the distribution tarballs.(2) The rest of this chapter discusses the packages provided with GNU Smalltalk. @@ -1546,11 +1570,14 @@ (1) When using an alternate image path, use the `SMALLTALK_IMAGE' variable. + (2) The operation of gst-package is subject to change in future +releases, while keeping backwards compatibility. +  File: gst.info, Node: Blox, Next: Smalltalk-in-Smalltalk, Up: Packages -2.9.1 Blox ----------- +3.1 Blox +======== Blox is a GUI building block tool kit. It is an abstraction on top of the a platform's native GUI toolkit that is common across all platforms. @@ -1623,8 +1650,8 @@  File: gst.info, Node: Smalltalk-in-Smalltalk, Next: Database, Prev: Blox, Up: Packages -2.9.2 The Smalltalk-in-Smalltalk library ----------------------------------------- +3.2 The Smalltalk-in-Smalltalk library +====================================== The Smalltalk-in-Smalltalk library is a set of classes for looking at Smalltalk code, constructing models of Smalltalk classes that can later @@ -1632,14 +1659,6 @@ finding smelly code and automatically doing repetitive changes. This package incredibly enhances the reflective capabilities of Smalltalk. - Being quite big (20000 source code lines) this package is split into -three different packages: `Parser' loads the parser only, `STInST' -loads various other tools (which compose the "Refactoring Browser" -package by John Brant and Don Roberts and will be the foundation for -GNU Smalltalk's next generation browser), `STInSTTest' performs -comprehensive unit tests(1) (*note SUnit::). Porting of the `STInST' -package will be completed in GNU Smalltalk 2.2. - A fundamental part of the system is the recursive-descent parser which creates parse nodes in the form of instances of subclasses of `RBProgramNode'. @@ -1660,9 +1679,7 @@ with the browser, and by the compiler. * The parser is able to perform complex tree searches and rewrites, - through the ParseTreeSearcher and ParseTreeRewriter classes. This - mechanism is exploited by most of the tools loaded by the `STInST' - package. + through the ParseTreeSearcher and ParseTreeRewriter classes. In addition, two applications were created on top of this library which are specific to GNU Smalltalk. The first is a compiler for @@ -1678,15 +1695,11 @@ usual classes which can be fed to GNU Smalltalk's `ClassPublisher' (found in `examples/Publish.st'. - ---------- Footnotes ---------- - - (1) The tests can take *hours* to complete! -  File: gst.info, Node: Database, Next: Locales, Prev: Smalltalk-in-Smalltalk, Up: Packages -2.9.3 Database connectivity ---------------------------- +3.3 Database connectivity +========================= GNU Smalltalk includes support for connecting to databases. Currently this support is limited to retrieving result sets from SQL selection @@ -1773,8 +1786,8 @@  File: gst.info, Node: Locales, Next: SUnit, Prev: Database, Up: Packages -2.9.4 Internationalization and localization support ---------------------------------------------------- +3.4 Internationalization and localization support +================================================= Different countries and cultures have varying conventions for how to communicate. These conventions range from very simple ones, such as the @@ -1939,8 +1952,8 @@  File: gst.info, Node: SUnit, Next: Network support, Prev: Locales, Up: Packages -2.9.5 The SUnit testing package -------------------------------- +3.5 The SUnit testing package +============================= `SUnit' is a framework to write and perform test cases in Smalltalk, originarily written by the father of Extreme Programming(1), Kent Beck. @@ -1952,8 +1965,8 @@ description of its usage, excerpted from Kent Beck's paper in which he describes `SUnit'. -2.9.5.1 Where should you start? -............................... +3.5.1 Where should you start? +----------------------------- Testing is one of those impossible tasks. You'd like to be absolutely complete, so you can be sure the software will work. On the other hand, @@ -1980,8 +1993,8 @@ * Override setUp to initialize the variables -2.9.5.2 How do you represent a single unit of testing? -...................................................... +3.5.2 How do you represent a single unit of testing? +---------------------------------------------------- You can predict the results of sending a message to a fixture. You need to represent such a predictable situation somehow. The simplest way to @@ -2001,8 +2014,8 @@ fixture as a method._ Add a method to TestCase subclass, and stimulate the fixture in the method. -2.9.5.3 How do you test for expected results? -............................................. +3.5.3 How do you test for expected results? +------------------------------------------- If you're testing interactively, you check for expected results directly, by printing and inspecting your objects. Since tests are in @@ -2036,7 +2049,7 @@ In the example, after stimulating the fixture by adding an object to an empty Set, we want to check and make sure it's in there: - SetTestCasee>>#testAdd + SetTestCase>>#testAdd empty add: 5. self should: [empty includes: 5] @@ -2053,8 +2066,8 @@ If it runs to completion, the test worked. If you get a walkback, something went wrong. -2.9.5.4 How do you collect and run many different test cases? -............................................................. +3.5.4 How do you collect and run many different test cases? +----------------------------------------------------------- As soon as you have two test cases running, you'll want to run them both one after the other without having to execute two do it's. You could @@ -2082,6 +2095,37 @@ retrieved. You can easily store a suite, then bring it in and run it, comparing results with previous runs. + GNU Smalltalk includes a Smalltalk script to simplify running SUnit +test suites. It is called `gst-sunit'. The command-line to `gst-sunit' +specifies the packages, files and classes to test: + +`-q' +`--quiet' + Hide the program's output. The results are still communicated + with the program's exit code. + +`-v' +`--verbose' + Be more verbose, in particular this will cause `gst-sunit' to write + which test is currently being executed. + +`-f FILE' +`--file=FILE' + Load FILE before running the required test cases. + +`-p PACKAGE' + +`--package=PACKAGE' + Load PACKAGE and its dependencies, and add PACKAGE's tests to the + set of test cases to run. + +`CLASS' +`CLASS*' + Add CLASS to the set of test cases to run. An asterisk after the + class name adds all the classes in CLASS's hierarchy. In + particular, each selector whose name starts with `test' + constitutes a separate test case. + ---------- Footnotes ---------- (1) Extreme Programming is a software engineering technique that @@ -2092,8 +2136,8 @@  File: gst.info, Node: Network support, Next: XML, Prev: SUnit, Up: Packages -2.9.6 TCP, WebServer, NetClients --------------------------------- +3.6 TCP, WebServer, NetClients +============================== GNU Smalltalk includes an almost complete abstraction of the TCP, UDP and IP protocols. Although based on the standard BSD sockets, this @@ -2147,8 +2191,8 @@  File: gst.info, Node: XML, Next: Other packages, Prev: Network support, Up: Packages -2.9.7 An XML parser and object model for GNU Smalltalk ------------------------------------------------------- +3.7 An XML parser and object model for GNU Smalltalk +==================================================== The XML parser library for Smalltalk, loaded as package XML includes a validating XML parser and Document Object Model. This library is @@ -2159,8 +2203,8 @@  File: gst.info, Node: Other packages, Prev: XML, Up: Packages -2.9.8 Other packages --------------------- +3.8 Other packages +================== Various other "minor" packages are provided, typically as examples of writing modules for GNU Smalltalk (*note Linking your libraries to the @@ -2170,9 +2214,9 @@ cryptographically strong hash values.  -File: gst.info, Node: Emacs, Next: C and Smalltalk, Prev: Features, Up: Top +File: gst.info, Node: Emacs, Next: C and Smalltalk, Prev: Packages, Up: Top -3 Smalltalk interface for GNU Emacs +4 Smalltalk interface for GNU Emacs *********************************** GNU Smalltalk comes with its own Emacs mode for hacking Smalltalk code. @@ -2188,7 +2232,7 @@  File: gst.info, Node: Autoloading, Next: Editing, Up: Emacs -3.1 Autoloading GNU Smalltalk mode +4.1 Autoloading GNU Smalltalk mode ================================== To cause Emacs to automatically go into Smalltalk mode when you edit a @@ -2208,7 +2252,7 @@  File: gst.info, Node: Editing, Next: Interactor, Prev: Autoloading, Up: Emacs -3.2 Smalltalk editing mode +4.2 Smalltalk editing mode ========================== The GNU Smalltalk editing mode is there to assist you in editing your @@ -2237,7 +2281,7 @@  File: gst.info, Node: Interactor, Prev: Editing, Up: Emacs -3.3 Smalltalk interactor mode +4.3 Smalltalk interactor mode ============================= An interesting feature of Emacs Smalltalk is the Smalltalk interactor, @@ -2325,7 +2369,7 @@  File: gst.info, Node: C and Smalltalk, Next: Tutorial, Prev: Emacs, Up: Top -4 Interoperability between C and GNU Smalltalk +5 Interoperability between C and GNU Smalltalk ********************************************** * Menu: @@ -2344,7 +2388,7 @@  File: gst.info, Node: External modules, Next: C callout, Up: C and Smalltalk -4.1 Linking your libraries to the virtual machine +5.1 Linking your libraries to the virtual machine ================================================= A nice thing you can do with GNU Smalltalk is enhancing it with your own @@ -2455,7 +2499,7 @@  File: gst.info, Node: C callout, Next: C data types, Prev: External modules, Up: C and Smalltalk -4.2 Using the C callout mechanism +5.2 Using the C callout mechanism ================================= To use the C callout mechanism, you first need to inform Smalltalk about @@ -2722,7 +2766,7 @@  File: gst.info, Node: C data types, Next: Smalltalk types, Prev: C callout, Up: C and Smalltalk -4.3 The C data type manipulation system +5.3 The C data type manipulation system ======================================= `CType' is a class used to represent C data types themselves (no @@ -2945,7 +2989,7 @@  File: gst.info, Node: Smalltalk types, Next: Smalltalk callin, Prev: C data types, Up: C and Smalltalk -4.4 Manipulating Smalltalk data from C +5.4 Manipulating Smalltalk data from C ====================================== GNU Smalltalk internally maps every object except Integers to a data @@ -3037,8 +3081,8 @@ -- Function: long OOPToC (OOP) This functions assumes that the passed OOP is a String, a - ByteArray, a CObject, or a built-in object (nil, true, false, - character, integer). If the OOP is nil, it answers 0; else the + ByteArray, a CObject, or a built-in object (`nil', `true', `false', + character, integer). If the OOP is `nil', it answers 0; else the mapping for each object is exactly the same as for the above functions. Note that, even though the function is declared as returning a `long', you might need to cast it to either a `char *' @@ -3174,7 +3218,7 @@  File: gst.info, Node: Smalltalk callin, Next: Object representation, Prev: Smalltalk types, Up: C and Smalltalk -4.5 Calls from C to Smalltalk +5.5 Calls from C to Smalltalk ============================= GNU Smalltalk provides seven different function calls that allow you to @@ -3207,7 +3251,7 @@ intToOOP(1), symbolToOOP("+"), intToOOP(2), - nil); + NULL); -- Function: OOP strMsgSend (OOP receiver, char *selector, ...) This function is the same as above, but the selector is passed as @@ -3224,7 +3268,7 @@ intToOOP(1), "+", intToOOP(2), - nil); + NULL); -- Function: OOP vmsgSend (OOP receiver, OOP selector, OOP *args) This function is the same as msgSend, but accepts a pointer to the @@ -3233,7 +3277,7 @@ OOP arguments[2], shouldBeThreeOOP; arguments[0] = intToOOP(2); - arguments[1] = nil; + arguments[1] = NULL; /* ... some more code here ... */ shouldBeThreeOOP = vmProxy->vmsgSend( @@ -3286,8 +3330,8 @@ vmProxy->msgSendf(&aBoolean, "%b %o includes: %s", aCollection, "abc") /* 'This is a test' printNl -- in two different ways */ - vmProxy->msgSendf(nil, "%v %s printNl", "This is a test"); - vmProxy->msgSendf(nil, "%s %s printNl", "This is a test"); + vmProxy->msgSendf(NULL, "%v %s printNl", "This is a test"); + vmProxy->msgSendf(NULL, "%s %s printNl", "This is a test"); /* 'This is a test', ' ok?' */ char *str; @@ -3296,7 +3340,7 @@ As you can see, the parameters to msgSendf are, in order: * A pointer to the variable which will contain the record. If this - pointer is nil, it is discarded. + pointer is `NULL', it is discarded. * A description of the method's interface in this format (the object types, after percent signs, will be explained later in this @@ -3352,17 +3396,17 @@ ? 0 char *, PTR See oopToC o nilOOP OOP any (result is not converted) w '\0' wchar_t nil or a Character - W NULL wchar_t * nil, a UnicodeString + W NULL wchar_t * nil or a UnicodeString v / any (result is discarded) - Note that, if resultPtr is nil, the "result_type" is always treated -as `%v'. If an error occurs, the value in the `result if nil' column -is returned. + Note that, if resultPtr is `NULL', the "result_type" is always +treated as `%v'. If an error occurs, the value in the `result if nil' +column is returned.  File: gst.info, Node: Other C functions, Next: Using Smalltalk, Prev: Incubator, Up: C and Smalltalk -4.6 Other functions available to modules +5.6 Other functions available to modules ======================================== In addition to the functions above, the `VMProxy' that is made @@ -3553,7 +3597,7 @@  File: gst.info, Node: Object representation, Next: Incubator, Prev: Smalltalk callin, Up: C and Smalltalk -4.7 Manipulating instances of your own Smalltalk classes from C +5.7 Manipulating instances of your own Smalltalk classes from C =============================================================== Although GNU Smalltalk's library exposes functions to deal with @@ -3742,7 +3786,7 @@  File: gst.info, Node: Using Smalltalk, Prev: Other C functions, Up: C and Smalltalk -4.8 Using the Smalltalk environment as an extension library +5.8 Using the Smalltalk environment as an extension library =========================================================== If you are reading this chapter because you are going to write @@ -3783,7 +3827,7 @@ be be rebuilt and, if so, it reloads and recompiles the 37000 lines of Smalltalk code in a basic image. To avoid this check, pass a `-I' flag: - char myArgv[][] = { "-I", "myprog.im", nil }; + char myArgv[][] = { "-I", "myprog.im", NULL }; int myArgc; /* ... */ myArgc = sizeof(myArgv) / sizeof (char *) - 1; @@ -3817,7 +3861,7 @@  File: gst.info, Node: Incubator, Next: Other C functions, Prev: Object representation, Up: C and Smalltalk -4.9 Incubator support +5.9 Incubator support ===================== The incubator concept provides a mechanism to protect newly created @@ -3932,7 +3976,7 @@  File: gst.info, Node: Tutorial, Next: Future, Prev: C and Smalltalk, Up: Top -5 Tutorial +6 Tutorial ********** What this manual presents @@ -3969,7 +4013,7 @@  File: gst.info, Node: Getting started, Next: Some classes, Prev: Tutorial, Up: Tutorial -5.1 Getting started +6.1 Getting started =================== * Menu: @@ -3983,7 +4027,7 @@  File: gst.info, Node: Starting Smalltalk, Next: Saying hello, Prev: Getting started, Up: Getting started -5.1.1 Starting up Smalltalk +6.1.1 Starting up Smalltalk --------------------------- Assuming that GNU Smalltalk has been installed on your system, starting @@ -4001,7 +4045,7 @@  File: gst.info, Node: Saying hello, Next: What happened, Prev: Starting Smalltalk, Up: Getting started -5.1.2 Saying hello +6.1.2 Saying hello ------------------ An initial exercise is to make Smalltalk say "hello" to you. Type in @@ -4021,7 +4065,7 @@  File: gst.info, Node: What happened, Next: Doing math, Prev: Saying hello, Up: Getting started -5.1.3 What actually happened +6.1.3 What actually happened ---------------------------- The front-line Smalltalk interpreter gathers all text until a '!' @@ -4067,7 +4111,7 @@  File: gst.info, Node: Doing math, Next: Math in Smalltalk, Prev: What happened, Up: Getting started -5.1.4 Doing math +6.1.4 Doing math ---------------- A similar piece of code prints numbers: @@ -4104,7 +4148,7 @@  File: gst.info, Node: Math in Smalltalk, Prev: Doing math, Up: Getting started -5.1.5 Math in Smalltalk +6.1.5 Math in Smalltalk ----------------------- In this case, what happened was that the object `9' (an Integer), @@ -4132,7 +4176,7 @@  File: gst.info, Node: Some classes, Next: The hierarchy, Prev: Getting started, Up: Tutorial -5.2 Using some of the Smalltalk classes +6.2 Using some of the Smalltalk classes ======================================= This chapter has examples which need a place to hold the objects they @@ -4154,7 +4198,7 @@  File: gst.info, Node: Arrays, Next: Sets, Prev: Some classes, Up: Some classes -5.2.1 An array in Smalltalk +6.2.1 An array in Smalltalk --------------------------- An array in Smalltalk is similar to an array in any other language, @@ -4227,7 +4271,7 @@  File: gst.info, Node: Sets, Next: Dictionaries, Prev: Arrays, Up: Some classes -5.2.2 A set in Smalltalk +6.2.2 A set in Smalltalk ------------------------ We're done with the array we've been using, so we'll assign something @@ -4307,7 +4351,7 @@  File: gst.info, Node: Dictionaries, Next: Smalltalk dictionary, Prev: Sets, Up: Some classes -5.2.3 Dictionaries +6.2.3 Dictionaries ------------------ A dictionary is a special kind of collection. With a regular array, @@ -4347,7 +4391,7 @@  File: gst.info, Node: Smalltalk dictionary, Next: Closing thoughts, Prev: Dictionaries, Up: Some classes -5.2.4 Smalltalk dictionary +6.2.4 Smalltalk dictionary -------------------------- If you'll remember from the beginning of the chapter, we started out by @@ -4398,7 +4442,7 @@  File: gst.info, Node: Closing thoughts, Prev: Smalltalk dictionary, Up: Some classes -5.2.5 Closing thoughts +6.2.5 Closing thoughts ---------------------- You've seen how Smalltalk provides you with some very powerful data @@ -4418,7 +4462,7 @@  File: gst.info, Node: The hierarchy, Next: Creating classes, Prev: Some classes, Up: Tutorial -5.3 The Smalltalk class hierarchy +6.3 The Smalltalk class hierarchy ================================= When programming in Smalltalk, you sometimes need to create new kinds @@ -4437,7 +4481,7 @@  File: gst.info, Node: Class Object, Next: Animals, Prev: The hierarchy, Up: The hierarchy -5.3.1 Class `Object' +6.3.1 Class `Object' -------------------- Smalltalk organizes all of its classes as a tree hierarchy. At the @@ -4457,7 +4501,7 @@  File: gst.info, Node: Animals, Next: But why, Prev: Class Object, Up: The hierarchy -5.3.2 Animals +6.3.2 Animals ------------- Imagine that we have three kinds of objects, representing Animals, @@ -4538,7 +4582,7 @@  File: gst.info, Node: But why, Prev: Animals, Up: The hierarchy -5.3.3 The bottom line of the class hierarchy +6.3.3 The bottom line of the class hierarchy -------------------------------------------- The goal of the class hierarchy is to allow you to organize objects @@ -4560,7 +4604,7 @@  File: gst.info, Node: Creating classes, Next: Creating subclasses, Prev: The hierarchy, Up: Tutorial -5.4 Creating a new class of objects +6.4 Creating a new class of objects =================================== With the basic techniques presented in the preceding chapters, we're @@ -4601,7 +4645,7 @@  File: gst.info, Node: A new class, Next: Documenting the class, Prev: Creating classes, Up: Creating classes -5.4.1 Creating a new class +6.4.1 Creating a new class -------------------------- Guess how you create a new class? This should be getting monotonous by @@ -4632,7 +4676,7 @@  File: gst.info, Node: Documenting the class, Next: Defining methods, Prev: A new class, Up: Creating classes -5.4.2 Documenting the class +6.4.2 Documenting the class --------------------------- The next step is to associate a description with the class. You do @@ -4652,7 +4696,7 @@  File: gst.info, Node: Defining methods, Next: Instance methods, Prev: Documenting the class, Up: Creating classes -5.4.3 Defining a method for the class +6.4.3 Defining a method for the class ------------------------------------- We have created a class, but it isn't ready to do any work for us--we @@ -4752,7 +4796,7 @@  File: gst.info, Node: Instance methods, Next: A look at our object, Prev: Defining methods, Up: Creating classes -5.4.4 Defining an instance method +6.4.4 Defining an instance method --------------------------------- We need to define the `init' method for our Account objects, so that @@ -4790,7 +4834,7 @@  File: gst.info, Node: A look at our object, Next: Moving money around, Prev: Instance methods, Up: Creating classes -5.4.5 Looking at our Account +6.4.5 Looking at our Account ---------------------------- Let's create an instance of class Account: @@ -4843,7 +4887,7 @@  File: gst.info, Node: Moving money around, Next: Next coming, Prev: A look at our object, Up: Creating classes -5.4.6 Moving money around +6.4.6 Moving money around ------------------------- We can now create accounts, and look at them. As it stands, though, @@ -4869,7 +4913,7 @@  File: gst.info, Node: Next coming, Prev: Moving money around, Up: Creating classes -5.4.7 What's next? +6.4.7 What's next? ------------------ We now have a generic concept, an "Account". We can create them, check @@ -4881,7 +4925,7 @@  File: gst.info, Node: Creating subclasses, Next: Code blocks (I), Prev: Creating classes, Up: Tutorial -5.5 Two Subclasses for the Account Class +6.5 Two Subclasses for the Account Class ======================================== This chapter continues from the previous chapter in demonstrating how @@ -4900,7 +4944,7 @@  File: gst.info, Node: The Savings class, Next: The Checking class, Prev: Creating subclasses, Up: Creating subclasses -5.5.1 The Savings class +6.5.1 The Savings class ----------------------- We create the Savings class as a subclass of Account. It holds money, @@ -4993,7 +5037,7 @@  File: gst.info, Node: The Checking class, Next: Writing checks, Prev: The Savings class, Up: Creating subclasses -5.5.2 The Checking class +6.5.2 The Checking class ------------------------ Our second subclass of Account represents a checking account. We will @@ -5029,7 +5073,7 @@  File: gst.info, Node: Writing checks, Prev: The Checking class, Up: Creating subclasses -5.5.3 Writing checks +6.5.3 Writing checks -------------------- We will finish this chapter by adding a method for spending money @@ -5085,7 +5129,7 @@  File: gst.info, Node: Code blocks (I), Next: Code blocks (II), Prev: Creating subclasses, Up: Tutorial -5.6 Code blocks +6.6 Code blocks =============== The Account/Saving/Checking example from the last chapter has several @@ -5103,7 +5147,7 @@  File: gst.info, Node: Conditions, Next: Iteration, Prev: Code blocks (I), Up: Code blocks (I) -5.6.1 Conditions and decision making +6.6.1 Conditions and decision making ------------------------------------ Let's first add some code to keep you from writing too many checks. We @@ -5179,7 +5223,7 @@  File: gst.info, Node: Iteration, Prev: Conditions, Up: Code blocks (I) -5.6.2 Iteration and collections +6.6.2 Iteration and collections ------------------------------- Now that we have some sanity checking in place, it remains for us to @@ -5366,7 +5410,7 @@  File: gst.info, Node: Code blocks (II), Next: Debugging, Prev: Code blocks (I), Up: Tutorial -5.7 Code blocks, part two +6.7 Code blocks, part two ========================= In the last chapter, we looked at how code blocks could be used to @@ -5395,7 +5439,7 @@  File: gst.info, Node: Integer loops, Next: Intervals, Prev: Code blocks (II), Up: Code blocks (II) -5.7.1 Integer loops +6.7.1 Integer loops ------------------- Integer loops are constructed by telling a number to drive the loop. @@ -5411,7 +5455,7 @@  File: gst.info, Node: Intervals, Next: Invoking code blocks, Prev: Integer loops, Up: Code blocks (II) -5.7.2 Intervals +6.7.2 Intervals --------------- It is also possible to represent a range of numbers as a standalone @@ -5431,7 +5475,7 @@  File: gst.info, Node: Invoking code blocks, Prev: Intervals, Up: Code blocks (II) -5.7.3 Invoking code blocks +6.7.3 Invoking code blocks -------------------------- Let us revisit the checking example and add a method for scanning only @@ -5518,7 +5562,7 @@  File: gst.info, Node: Debugging, Next: More subclassing, Prev: Code blocks (II), Up: Tutorial -5.8 When Things Go Bad +6.8 When Things Go Bad ====================== So far we've been working with examples which work the first time. If @@ -5541,7 +5585,7 @@  File: gst.info, Node: Simple errors, Next: Nested calls, Prev: Debugging, Up: Debugging -5.8.1 A Simple Error +6.8.1 A Simple Error -------------------- First, let's take a look at a typical error. Type: @@ -5572,7 +5616,7 @@  File: gst.info, Node: Nested calls, Next: Looking at objects, Prev: Simple errors, Up: Debugging -5.8.2 Nested Calls +6.8.2 Nested Calls ------------------ Type the following lines: @@ -5630,7 +5674,7 @@  File: gst.info, Node: Looking at objects, Prev: Nested calls, Up: Debugging -5.8.3 Looking at Objects +6.8.3 Looking at Objects ------------------------ When you are chasing an error, it is often helpful to examine the @@ -5672,7 +5716,7 @@  File: gst.info, Node: More subclassing, Next: Streams, Prev: Debugging, Up: Tutorial -5.9 Coexisting in the Class Hierarchy +6.9 Coexisting in the Class Hierarchy ===================================== The early chapters of this tutorial discussed classes in one of two @@ -5702,7 +5746,7 @@  File: gst.info, Node: The existing hierarchy, Next: Playing with Arrays, Prev: More subclassing, Up: More subclassing -5.9.1 The Existing Class Hierarchy +6.9.1 The Existing Class Hierarchy ---------------------------------- To discuss where a new class might go, it is helpful to have a map of @@ -5893,7 +5937,7 @@  File: gst.info, Node: Playing with Arrays, Next: New kinds of Numbers, Prev: The existing hierarchy, Up: More subclassing -5.9.2 Playing with Arrays +6.9.2 Playing with Arrays ------------------------- Imagine that you need an array, but alas you need that if an index is @@ -5988,7 +6032,7 @@  File: gst.info, Node: New kinds of Numbers, Next: Inheritance and Polymorphism, Prev: Playing with Arrays, Up: More subclassing -5.9.3 Adding a New Kind of Number +6.9.3 Adding a New Kind of Number --------------------------------- If we were programming an application which did a large amount of @@ -6123,7 +6167,7 @@  File: gst.info, Node: Inheritance and Polymorphism, Prev: New kinds of Numbers, Up: More subclassing -5.9.4 Inheritance and Polymorphism +6.9.4 Inheritance and Polymorphism ---------------------------------- This is a good time to look at what we've done with the two previous @@ -6169,7 +6213,7 @@  File: gst.info, Node: Streams, Next: Behind the scenes, Prev: More subclassing, Up: Tutorial -5.10 Smalltalk Streams +6.10 Smalltalk Streams ====================== Our examples have used a mechanism extensively, even though we haven't @@ -6193,7 +6237,7 @@  File: gst.info, Node: The output stream, Next: Your own stream, Prev: Streams, Up: Streams -5.10.1 The Output Stream +6.10.1 The Output Stream ------------------------ The examples in this book all work because they write their output to @@ -6221,7 +6265,7 @@  File: gst.info, Node: Your own stream, Next: Files, Prev: The output stream, Up: Streams -5.10.2 Your Own Stream +6.10.2 Your Own Stream ---------------------- Unlike a pipe you might create in C, the underlying storage of a Stream @@ -6303,7 +6347,7 @@  File: gst.info, Node: Files, Next: Dynamic Strings, Prev: Your own stream, Up: Streams -5.10.3 Files +6.10.3 Files ------------ Streams can also operate on files. If you wanted to dump the file @@ -6323,7 +6367,7 @@  File: gst.info, Node: Dynamic Strings, Prev: Files, Up: Streams -5.10.4 Dynamic Strings +6.10.4 Dynamic Strings ---------------------- Streams provide a powerful abstraction for a number of data structures. @@ -6360,7 +6404,7 @@  File: gst.info, Node: Behind the scenes, Next: And now, Prev: Streams, Up: Tutorial -5.11 Some nice stuff from the Smalltalk innards +6.11 Some nice stuff from the Smalltalk innards =============================================== Just like with everything else, you'd probably end up asking yourself: @@ -6376,7 +6420,7 @@  File: gst.info, Node: Inside Arrays, Next: Two flavors of equality, Prev: Behind the scenes, Up: Behind the scenes -5.11.1 How Arrays Work +6.11.1 How Arrays Work ---------------------- Smalltalk provides a very adequate selection of predefined classes from @@ -6591,7 +6635,7 @@  File: gst.info, Node: Two flavors of equality, Next: Why is #new there?!?, Prev: Inside Arrays, Up: Behind the scenes -5.11.2 Two flavors of equality +6.11.2 Two flavors of equality ------------------------------ As first seen in chapter two, Smalltalk keys its dictionary with things @@ -6660,7 +6704,7 @@  File: gst.info, Node: Why is #new there?!?, Next: Performance, Prev: Two flavors of equality, Up: Behind the scenes -5.11.3 The truth about metaclasses +6.11.3 The truth about metaclasses ---------------------------------- Everybody, sooner or later, looks for the implementation of the `#new' @@ -6804,7 +6848,7 @@  File: gst.info, Node: Performance, Prev: Why is #new there?!?, Up: Behind the scenes -5.11.4 The truth of Smalltalk performance +6.11.4 The truth of Smalltalk performance ----------------------------------------- Everybody says Smalltalk is slow, yet this is not completely true for @@ -6907,7 +6951,7 @@  File: gst.info, Node: And now, Next: The syntax, Prev: Behind the scenes, Up: Tutorial -5.12 Some final words +6.12 Some final words ===================== The question is always how far to go in one document. At this point, diff -rNu smalltalk-2.3.3/doc/gst.info-2 smalltalk-2.3.4/doc/gst.info-2 --- smalltalk-2.3.3/doc/gst.info-2 2007-02-13 09:28:15.000000000 +0100 +++ smalltalk-2.3.4/doc/gst.info-2 2007-05-28 12:43:00.000000000 +0200 @@ -6,8 +6,8 @@ * GNU Smalltalk: (gst). The GNU Smalltalk environment. END-INFO-DIR-ENTRY - This file documents GNU Smalltalk Version 2.3.3. It was last -updated on 13 February 2007. + This file documents GNU Smalltalk Version 2.3.4. It was last +updated on 28 May 2007. Copyright (C) 1988, 1989, 1991, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc. @@ -27,7 +27,7 @@  File: gst.info, Node: The syntax, Prev: And now, Up: Tutorial -5.13 A Simple Overview of Smalltalk Syntax +6.13 A Simple Overview of Smalltalk Syntax ========================================== Smalltalk's power comes from its treatment of objects. In this @@ -220,7 +220,7 @@  File: gst.info, Node: Future, Prev: Tutorial, Up: Top -6 Future directions for GNU Smalltalk +7 Future directions for GNU Smalltalk ************************************* Presented below is the set of tasks that I feel need to be performed to diff -rNu smalltalk-2.3.3/doc/gst.texi smalltalk-2.3.4/doc/gst.texi --- smalltalk-2.3.3/doc/gst.texi 2007-02-13 09:07:20.000000000 +0100 +++ smalltalk-2.3.4/doc/gst.texi 2007-05-28 12:36:06.000000000 +0200 @@ -111,6 +111,7 @@ * Overview:: What @gst{} is. * Using GNU Smalltalk:: Running @gst{}. * Features:: A description of @gst{}'s special features. +* Packages:: An easy way to install Smalltalk code into an image. * Emacs:: @gst{} and Emacs. * C and Smalltalk:: @gst{}'s C/Smalltalk interoperability features. * Tutorial:: An introduction to Smalltalk and OOP. @@ -145,7 +146,6 @@ * Security:: Sandboxing and access control. * Special objects:: Methods to assign particular properties to objects. * Dynamic loading:: Picking external libraries and modules at run-time. -* Packages:: An easy way to install Smalltalk code into an image. Packages * Blox:: @gst{}'s user interface building blocks. @@ -728,7 +728,6 @@ * Security:: Sandboxing and access control. * Special objects:: Methods to assign particular properties to objects. * Dynamic loading:: Picking external libraries and modules at run-time. -* Packages:: An easy way to install Smalltalk code into an image. @end menu @@ -886,7 +885,7 @@ under the symbol @code{#Super}. Most environments inherit from Smalltalk, the standard root environment, but they are not required to do so; this is similar to how most classes derive from Object, yet one -can derive a class directly from nil. Since they all inherit from +can derive a class directly from @code{nil}. Since they all inherit from Smalltalk all global variables defined in it, it is not necessary to define a special global variable pointing to root in each environment. @@ -1497,12 +1496,12 @@ dynamic linking will result in an error. @node Packages -@section Packages +@chapter Packages -Thanks to Andreas Klimas' insight, @gst{} now includes a -powerful packaging system which allows one to file in components -(@dfn{goodies} in Smalltalk's very folkloristic terminology) -without caring of whether they need other goodies to be loaded. +@gst{} includes a packaging system which allows one to file in components +(often called @dfn{goodies} in Smalltalk's very folkloristic +terminology) without caring of whether they need other goodies to be +loaded first. The packaging system is implemented by a Smalltalk class, @code{PackageLoader}, which looks for information about packages in @@ -1533,10 +1532,31 @@ @bulletize Compiler (Blox is skipped because it has already been loaded) @end itemize -Then it will save the Smalltalk image, and finally exit! +Then it will save the Smalltalk image, and finally exit. + +@file{gst-load} supports several options: + +@table @option +@item -q +@itemx --quiet +Hide the script's output. + +@item -v +@itemx --verbose +Show which files are loaded, one by one. + +@item -f +@itemx --force +If a package given on the command-line is already present, reload it. +This does not apply to automatically selected prerequisites. + +@item -n +@item --dry-run +Do not save the image after loading. +@end table To provide support for this system, you have to give away with your GST -goodies a small file (say you call it @file{mypkg}) which looks like +goodies a small file (say you call it @file{mypkg.xml}) which looks like this: @example @@ -1590,8 +1610,13 @@ bindings can use them. @item callout -Refuse to load the package if the function whose name is within -the tags is not available to be called from Smalltalk code. +Instructs to load the package only if the C function whose name is +within the tag is available to be called from Smalltalk code. + +@item sunit +Specifies a testing script that @code{gst-sunit} (@pxref{SUnit}) will +run in order to test the package. If this is specified, the package +should list @code{SUnit} among the prerequisites. @end table To install your package, you only have to do @@ -1599,10 +1624,12 @@ gst-package mypkg.xml @end example -which is a small shell script which will merge the file with -@file{packages.xml}, install the files specified in the @code{file} tags +@command{gst-package} is a small shell script which will merge the file +with @file{packages.xml}, install the files specified in the @code{file} tags and load the packages. The @gst{} makefile also use @file{gst-package} -to install packages and to prepare the distribution tarballs. +to install packages and to prepare the distribution tarballs.@footnote{The + operation of gst-package is subject to change in future releases, while + keeping backwards compatibility.} The rest of this chapter discusses the packages provided with @gst{}. @@ -1618,7 +1645,7 @@ @end menu @node Blox -@subsection Blox +@section Blox Blox is a GUI building block tool kit. It is an abstraction on top of the a platform's native GUI toolkit that is common across all platforms. @@ -1690,7 +1717,7 @@ @node Smalltalk-in-Smalltalk -@subsection The Smalltalk-in-Smalltalk library +@section The Smalltalk-in-Smalltalk library The Smalltalk-in-Smalltalk library is a set of classes for looking at @@ -1699,6 +1726,7 @@ finding smelly code and automatically doing repetitive changes. This package incredibly enhances the reflective capabilities of Smalltalk. +@ignore Being quite big (20000 source code lines) this package is split into three different packages: @code{Parser} loads the parser only, @code{STInST} loads various other tools (which compose the @@ -1708,6 +1736,7 @@ The tests can take @strong{hours} to complete!} (@pxref{SUnit}). Porting of the @code{STInST} package will be completed in @gst{} 2.2. +@end ignore A fundamental part of the system is the recursive-descent parser which creates parse nodes in the form of instances of subclasses of @@ -1734,9 +1763,11 @@ @item The parser is able to perform complex tree searches and rewrites, -through the ParseTreeSearcher and ParseTreeRewriter classes. This -mechanism is exploited by most of the tools loaded by the @code{STInST} -package. +through the ParseTreeSearcher and ParseTreeRewriter classes. +@ignore +This mechanism is exploited by most of the tools loaded by the +@code{STInST} package. +@end ignore @end itemize In addition, two applications were created on top of this library @@ -1754,7 +1785,7 @@ (found in @file{examples/Publish.st}. @node Database -@subsection Database connectivity +@section Database connectivity @gst{} includes support for connecting to databases. Currently this support is limited to retrieving result sets from @acronym{SQL} selection @@ -1849,7 +1880,7 @@ @end example @node Locales -@subsection Internationalization and localization support +@section Internationalization and localization support Different countries and cultures have varying conventions for how to communicate. These conventions range from very simple ones, such as the @@ -2040,7 +2071,7 @@ @sc{mo} file format adopted by the @gnu{} @code{gettext} library. @node SUnit -@subsection The SUnit testing package +@section The SUnit testing package @code{SUnit} is a framework to write and perform test cases in Smalltalk, originarily written by the father of Extreme Programming@footnote{Extreme @@ -2057,7 +2088,7 @@ a description of its usage, excerpted from Kent Beck's paper in which he describes @code{SUnit}. -@subsubsection Where should you start? +@subsection Where should you start? Testing is one of those impossible tasks. You'd like to be absolutely complete, so you can be sure the software will work. On the other hand, @@ -2084,7 +2115,7 @@ @bulletize{Override setUp to initialize the variables} @end itemize -@subsubsection How do you represent a single unit of testing? +@subsection How do you represent a single unit of testing? You can predict the results of sending a message to a fixture. You need to represent such a predictable situation somehow. The simplest way to @@ -2104,7 +2135,7 @@ fixture as a method.} Add a method to TestCase subclass, and stimulate the fixture in the method. -@subsubsection How do you test for expected results? +@subsection How do you test for expected results? If you're testing interactively, you check for expected results directly, by printing and inspecting your objects. Since tests are in @@ -2141,7 +2172,7 @@ empty Set, we want to check and make sure it's in there: @example -SetTestCasee>>#testAdd +SetTestCase>>#testAdd empty add: 5. self should: [empty includes: 5] @end example @@ -2162,7 +2193,7 @@ If it runs to completion, the test worked. If you get a walkback, something went wrong. -@subsubsection How do you collect and run many different test cases? +@subsection How do you collect and run many different test cases? As soon as you have two test cases running, you'll want to run them both one after the other without having to execute two do it's. You could @@ -2193,8 +2224,40 @@ retrieved. You can easily store a suite, then bring it in and run it, comparing results with previous runs. +@gst{} includes a Smalltalk script to simplify running SUnit test suites. +It is called @command{gst-sunit}. The command-line to @command{gst-sunit} +specifies the packages, files and classes to test: + +@table @option +@item -q +@itemx --quiet +Hide the program's output. The results are still communicated with the +program's exit code. + +@item -v +@itemx --verbose +Be more verbose, in particular this will cause @command{gst-sunit} to write +which test is currently being executed. + +@item -f @var{FILE} +@itemx --file=@var{FILE} +Load @var{FILE} before running the required test cases. + +@item -p @var{PACKAGE} +@item --package=@var{PACKAGE} +Load @var{PACKAGE} and its dependencies, and add @var{PACKAGE}'s tests to +the set of test cases to run. + +@item @var{CLASS} +@itemx @var{CLASS}* +Add @var{CLASS} to the set of test cases to run. An asterisk after the class +name adds all the classes in @var{CLASS}'s hierarchy. In particular, +each selector whose name starts with @code{test} constitutes a separate +test case. +@end table + @node Network support -@subsection TCP, WebServer, NetClients +@section TCP, WebServer, NetClients @gst{} includes an almost complete abstraction of the @sc{tcp}, @sc{udp} and @sc{ip} protocols. Although based on the standard @sc{bsd} sockets, @@ -2245,7 +2308,7 @@ @gst{} will include documentation for these as well. @node XML -@subsection An XML parser and object model for @gst{} +@section An XML parser and object model for @gst{} The @sc{xml} parser library for Smalltalk, loaded as package XML includes a validating @sc{xml} parser and Document Object Model. @@ -2254,7 +2317,7 @@ well (see packages XPath and @sc{xsl}). @node Other packages -@subsection Other packages +@section Other packages Various other ``minor'' packages are provided, typically as examples of writing modules for @gst{} (@pxref{External modules, , Linking your @@ -3168,12 +3231,13 @@ @end deftypefun @deftypefun long OOPToC (OOP) -This functions assumes that the passed OOP is a String, a ByteArray, a -CObject, or a built-in object (nil, true, false, character, integer). -If the OOP is nil, it answers 0; else the mapping for each object is -exactly the same as for the above functions. Note that, even though the -function is declared as returning a @code{long}, you might need to cast -it to either a @code{char *} or @code{PTR}. +This functions assumes that the passed OOP is a String, a ByteArray, +a CObject, or a built-in object (@code{nil}, @code{true}, @code{false}, +character, integer). If the OOP is @code{nil}, it answers 0; else the +mapping for each object is exactly the same as for the above functions. +Note that, even though the function is declared as returning a +@code{long}, you might need to cast it to either a @code{char *} +or @code{PTR}. @end deftypefun While special care is needed to use the functions above (you will @@ -3359,7 +3423,7 @@ intToOOP(1), symbolToOOP("+"), intToOOP(2), - nil); + NULL); @end example @end deftypefun @@ -3379,7 +3443,7 @@ intToOOP(1), "+", intToOOP(2), - nil); + NULL); @end example @end deftypefun @@ -3391,7 +3455,7 @@ @example OOP arguments[2], shouldBeThreeOOP; arguments[0] = intToOOP(2); - arguments[1] = nil; + arguments[1] = NULL; /* @dots{} some more code here @dots{} */ shouldBeThreeOOP = vmProxy->vmsgSend( @@ -3451,8 +3515,8 @@ vmProxy->msgSendf(&aBoolean, "%b %o includes: %s", aCollection, "abc") /* 'This is a test' printNl -- in two different ways */ - vmProxy->msgSendf(nil, "%v %s printNl", "This is a test"); - vmProxy->msgSendf(nil, "%s %s printNl", "This is a test"); + vmProxy->msgSendf(NULL, "%v %s printNl", "This is a test"); + vmProxy->msgSendf(NULL, "%s %s printNl", "This is a test"); /* 'This is a test', ' ok?' */ char *str; @@ -3464,7 +3528,7 @@ @itemize @bullet @item A pointer to the variable which will contain the record. If this pointer -is nil, it is discarded. +is @code{NULL}, it is discarded. @item A description of the method's interface in this format (the object @@ -3530,13 +3594,13 @@ ? 0 char *, PTR See oopToC o nilOOP OOP any (result is not converted) w '\0' wchar_t nil or a Character - W NULL wchar_t * nil, a UnicodeString + W NULL wchar_t * nil or a UnicodeString v / any (result is discarded) @end example -Note that, if resultPtr is nil, the @dfn{result_type} is always treated -as @samp{%v}. If an error occurs, the value in the `result if nil' -column is returned. +Note that, if resultPtr is @code{NULL}, the @dfn{result_type} is always +treated as @samp{%v}. If an error occurs, the value in the `result if +nil' column is returned. @node Other C functions @section Other functions available to modules @@ -4001,7 +4065,7 @@ flag: @example -char myArgv[][] = @{ "-I", "myprog.im", nil @}; +char myArgv[][] = @{ "-I", "myprog.im", NULL @}; int myArgc; /* @dots{} */ myArgc = sizeof(myArgv) / sizeof (char *) - 1; diff -rNu smalltalk-2.3.3/doc/stamp-1 smalltalk-2.3.4/doc/stamp-1 --- smalltalk-2.3.3/doc/stamp-1 2007-02-13 09:32:04.000000000 +0100 +++ smalltalk-2.3.4/doc/stamp-1 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 13 February 2007 -@set UPDATED-MONTH February 2007 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 28 May 2007 +@set UPDATED-MONTH May 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/doc/stamp-2 smalltalk-2.3.4/doc/stamp-2 --- smalltalk-2.3.3/doc/stamp-2 2007-02-13 09:28:27.000000000 +0100 +++ smalltalk-2.3.4/doc/stamp-2 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 11 December 2006 -@set UPDATED-MONTH December 2006 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 21 March 2007 +@set UPDATED-MONTH March 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/doc/stamp-vti smalltalk-2.3.4/doc/stamp-vti --- smalltalk-2.3.3/doc/stamp-vti 2007-02-13 09:28:15.000000000 +0100 +++ smalltalk-2.3.4/doc/stamp-vti 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 13 February 2007 -@set UPDATED-MONTH February 2007 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 28 May 2007 +@set UPDATED-MONTH May 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/doc/vers-base.texi smalltalk-2.3.4/doc/vers-base.texi --- smalltalk-2.3.3/doc/vers-base.texi 2007-02-13 09:32:04.000000000 +0100 +++ smalltalk-2.3.4/doc/vers-base.texi 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 13 February 2007 -@set UPDATED-MONTH February 2007 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 28 May 2007 +@set UPDATED-MONTH May 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/doc/vers-gst.texi smalltalk-2.3.4/doc/vers-gst.texi --- smalltalk-2.3.3/doc/vers-gst.texi 2007-02-13 09:28:15.000000000 +0100 +++ smalltalk-2.3.4/doc/vers-gst.texi 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 13 February 2007 -@set UPDATED-MONTH February 2007 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 28 May 2007 +@set UPDATED-MONTH May 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/doc/vers-libs.texi smalltalk-2.3.4/doc/vers-libs.texi --- smalltalk-2.3.3/doc/vers-libs.texi 2007-01-31 11:59:35.000000000 +0100 +++ smalltalk-2.3.4/doc/vers-libs.texi 2007-05-28 12:42:56.000000000 +0200 @@ -1,4 +1,4 @@ -@set UPDATED 11 December 2006 -@set UPDATED-MONTH December 2006 -@set EDITION 2.3.3 -@set VERSION 2.3.3 +@set UPDATED 21 March 2007 +@set UPDATED-MONTH March 2007 +@set EDITION 2.3.4 +@set VERSION 2.3.4 diff -rNu smalltalk-2.3.3/examples/Continuations.st smalltalk-2.3.4/examples/Continuations.st --- smalltalk-2.3.3/examples/Continuations.st 2006-02-05 19:41:23.000000000 +0100 +++ smalltalk-2.3.4/examples/Continuations.st 2007-05-24 22:11:09.000000000 +0200 @@ -13,6 +13,7 @@ | ======================================================================" +PackageLoader fileInPackage: #SUnit! Object subclass: #Continuation instanceVariableNames: 'stack ' @@ -58,6 +59,12 @@ !Continuation class methodsFor: 'instance creation'! +current + ^self fromContext: thisContext sender! + +currentDo: aBlock + ^aBlock value: (self fromContext: thisContext sender)! + fromContext: aStack ^self new stack: aStack copyStack! ! @@ -99,6 +106,194 @@ ifTrue:[^self copy] ifFalse: [^self copy parentContext: self parentContext copyStack]! ! -(Continuation factorialExample: 4) printNl! -(Undeclared.RetryCC value: 10) printNl! -Undeclared removeKey: #RetryCC! +"(Continuation factorialExample: 4) printNl!" +"(Undeclared.RetryCC value: 10) printNl!" +"Undeclared removeKey: #RetryCC!" + + +Object subclass: #Amb + instanceVariableNames: 'failureContinuation ' + classVariableNames: '' + poolDictionaries: '' + category: 'Seaside-Seaside-Continuations'! + +!Amb class methodsFor: 'new'! + +new + ^ super new initialize! ! + +!Amb methodsFor: 'superpositions'! + +allValues: aBlock + |kPrev results| + kPrev := failureContinuation. + results := OrderedCollection new. + (Continuation currentDo: + [:kRetry | + failureContinuation := [:v | kRetry value: false]. + results add: aBlock value. + kRetry value: true]) + ifTrue: [self fail]. + failureContinuation := kPrev. + ^ results asArray! + +assert: aBoolean + aBoolean ifFalse: [self fail]! + +deny: aBoolean + self assert: aBoolean not! + +fail + ^ failureContinuation value: nil! + +initialize + failureContinuation := [:v | self error: 'Amb tree exhausted'].! + +maybe + ^ self oneOf: { true. false }! + +oneOf: aCollection + ^ self valueOfOneOf: (aCollection collect: [:ea | [ea] ])! + +valueOf: blockOne or: blockTwo + ^ self valueOfOneOf: { blockOne. blockTwo }! + +valueOf: blockOne or: blockTwo or: blockThree + ^ self valueOfOneOf: { blockOne. blockTwo. blockThree }! + +valueOfOneOf: blockCollection + |kPrev| + kPrev := failureContinuation. + ^ Continuation currentDo: + [:kEntry | + blockCollection do: + [:ea | + Continuation currentDo: + [:kNext | + failureContinuation := + [:v | failureContinuation := kPrev. kNext value: v] fixTemps. + kEntry value: ea value]]. + kPrev value: nil] +! ! + +TestCase subclass: #AmbTest + instanceVariableNames: 'amb ' + classVariableNames: '' + poolDictionaries: '' + category: 'Seaside-Seaside-Continuations'! + +!AmbTest methodsFor: 'as yet unclassified'! + +pickANumber + ^ self pickANumberGreaterThan: 0! + +pickANumberGreaterThan: aNumber + ^ amb valueOf: [aNumber + 1] or: [self pickANumberGreaterThan: aNumber + 1]! + +setUp + amb := Amb new! + +testAllValuesAboveFive + |x results| + results := amb allValues: + [x := amb oneOf: (1 to: 10). + amb assert: (x > 5). + x]. + self assert: results = #(6 7 8 9 10). +! + +testMaybe + |x y z| + x := amb maybe. + y := amb maybe. + z := amb maybe not. + + amb deny: x = y. + amb deny: x = z. + + self assert: x. + self deny: y. + self deny: z.! + +testPickANumber + self assert: self pickANumber = 1.! + +testPickANumberAboveFive + |x| + x := self pickANumber. + amb assert: (x > 5). + self assert: x = 6. +! + +testSicpLogicProblem + "Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?" + +"This implementation is too slow - uncomment to actually run it." + + |baker cooper fletcher miller smith| + baker := amb oneOf: (1 to: 5). + cooper := amb oneOf: (1 to: 5). + fletcher := amb oneOf: (1 to: 5). + miller := amb oneOf: (1 to: 5). + smith := amb oneOf: (1 to: 5). + + amb assert: (Set new add: baker; add: cooper; add: fletcher; add: miller; add: smith; size) = 5. + + amb deny: baker = 5. + amb deny: cooper = 1. + amb deny: fletcher = 5. + amb deny: fletcher = 1. + amb assert: miller > cooper. + amb deny: (smith - fletcher) abs = 1. + amb deny: (fletcher - cooper) abs = 1. + + self assert: baker = 3. + self assert: cooper = 2. + self assert: fletcher = 4. + self assert: miller = 5. + self assert: smith = 1. +! + +testSicpLogicProblemFaster + "Baker, Cooper, Fletcher, Miller, and Smith live on different floors + of an apartment house that contains only five floors. Baker does + not live on the top floor. Cooper does not live on the bottom + floor. Fletcher does not live on either the top or the bottom + floor. Miller lives on a higher floor than does Cooper. Smith does + not live on a floor adjacent to Fletcher's. Fletcher does not live + on a floor adjacent to Cooper's. Where does everyone live?" + + |baker cooper fletcher miller smith| + fletcher := amb oneOf: (1 to: 5). + amb deny: fletcher = 5. + amb deny: fletcher = 1. + + smith := amb oneOf: (1 to: 5). + amb deny: (smith - fletcher) abs = 1. + + cooper := amb oneOf: (1 to: 5). + amb deny: cooper = 1. + amb deny: (fletcher - cooper) abs = 1. + + miller := amb oneOf: (1 to: 5). + amb assert: miller > cooper. + + baker := amb oneOf: (1 to: 5). + amb deny: baker = 5. + + amb assert: (Set new add: baker; add: cooper; add: fletcher; add: miller; add: smith; size) = 5. + self assert: baker = 3. + self assert: cooper = 2. + self assert: fletcher = 4. + self assert: miller = 5. + self assert: smith = 1.! + +testSolveAnEquation + |x y| + x := amb oneOf: (1 to: 10). + y := amb oneOf: (1 to: 10). + amb assert: (y * x) = 42. + self assert: x = 6. + self assert: y = 7. +! ! + diff -rNu smalltalk-2.3.3/examples/Makefile.am smalltalk-2.3.4/examples/Makefile.am --- smalltalk-2.3.3/examples/Makefile.am 2006-02-05 19:41:23.000000000 +0100 +++ smalltalk-2.3.4/examples/Makefile.am 2007-05-24 22:10:25.000000000 +0200 @@ -1,8 +1,8 @@ examplemodulesdir = $(pkgdatadir)/examples/modules -dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st +dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st zlib.st zlibtests.st -EXTRA_LTLIBRARIES = gdbm.la +EXTRA_LTLIBRARIES = gdbm.la zlib.la pkglib_LTLIBRARIES = @MODULES_EXAMPLE@ md5.la gst_module_ldflags = -rpath $(pkglibdir) -release $(VERSION) -module \ @@ -16,4 +16,8 @@ md5_la_LIBADD = ../lib-src/library.la md5_la_LDFLAGS = $(gst_module_ldflags) +zlib_la_SOURCES = zlib.c +zlib_la_LIBADD = -lz +zlib_la_LDFLAGS = $(gst_module_ldflags) + AM_CPPFLAGS = -I$(top_srcdir)/libgst -I$(top_srcdir)/lib-src @INCSNPRINTFV@ diff -rNu smalltalk-2.3.3/examples/Makefile.in smalltalk-2.3.4/examples/Makefile.in --- smalltalk-2.3.3/examples/Makefile.in 2007-02-13 09:25:23.000000000 +0100 +++ smalltalk-2.3.4/examples/Makefile.in 2007-05-28 12:40:07.000000000 +0200 @@ -94,6 +94,9 @@ md5_la_DEPENDENCIES = ../lib-src/library.la am_md5_la_OBJECTS = md5.lo md5_la_OBJECTS = $(am_md5_la_OBJECTS) +zlib_la_DEPENDENCIES = +am_zlib_la_OBJECTS = zlib.lo +zlib_la_OBJECTS = $(am_zlib_la_OBJECTS) DEFAULT_INCLUDES = -I. -I$(srcdir) -I$(top_builddir) depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp am__depfiles_maybe = depfiles @@ -105,8 +108,8 @@ CCLD = $(CC) LINK = $(LIBTOOL) --tag=CC --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ $(AM_LDFLAGS) $(LDFLAGS) -o $@ -SOURCES = $(gdbm_la_SOURCES) $(md5_la_SOURCES) -DIST_SOURCES = $(gdbm_la_SOURCES) $(md5_la_SOURCES) +SOURCES = $(gdbm_la_SOURCES) $(md5_la_SOURCES) $(zlib_la_SOURCES) +DIST_SOURCES = $(gdbm_la_SOURCES) $(md5_la_SOURCES) $(zlib_la_SOURCES) dist_examplemodulesDATA_INSTALL = $(INSTALL_DATA) DATA = $(dist_examplemodules_DATA) ETAGS = etags @@ -123,6 +126,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ @@ -278,8 +282,8 @@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ examplemodulesdir = $(pkgdatadir)/examples/modules -dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st -EXTRA_LTLIBRARIES = gdbm.la +dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st zlib.st zlibtests.st +EXTRA_LTLIBRARIES = gdbm.la zlib.la pkglib_LTLIBRARIES = @MODULES_EXAMPLE@ md5.la gst_module_ldflags = -rpath $(pkglibdir) -release $(VERSION) -module \ -no-undefined -export-symbols-regex gst_initModule @@ -290,6 +294,9 @@ md5_la_SOURCES = md5.c md5_la_LIBADD = ../lib-src/library.la md5_la_LDFLAGS = $(gst_module_ldflags) +zlib_la_SOURCES = zlib.c +zlib_la_LIBADD = -lz +zlib_la_LDFLAGS = $(gst_module_ldflags) AM_CPPFLAGS = -I$(top_srcdir)/libgst -I$(top_srcdir)/lib-src @INCSNPRINTFV@ all: all-am @@ -355,6 +362,8 @@ $(LINK) $(gdbm_la_LDFLAGS) $(gdbm_la_OBJECTS) $(gdbm_la_LIBADD) $(LIBS) md5.la: $(md5_la_OBJECTS) $(md5_la_DEPENDENCIES) $(LINK) -rpath $(pkglibdir) $(md5_la_LDFLAGS) $(md5_la_OBJECTS) $(md5_la_LIBADD) $(LIBS) +zlib.la: $(zlib_la_OBJECTS) $(zlib_la_DEPENDENCIES) + $(LINK) $(zlib_la_LDFLAGS) $(zlib_la_OBJECTS) $(zlib_la_LIBADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) @@ -364,6 +373,7 @@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdbm.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/zlib.Plo@am__quote@ .c.o: @am__fastdepCC_TRUE@ if $(COMPILE) -MT $@ -MD -MP -MF "$(DEPDIR)/$*.Tpo" -c -o $@ $<; \ diff -rNu smalltalk-2.3.3/examples/PipeStream.st smalltalk-2.3.4/examples/PipeStream.st --- smalltalk-2.3.3/examples/PipeStream.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/PipeStream.st 2007-05-18 16:32:28.000000000 +0200 @@ -0,0 +1,234 @@ +"====================================================================== +| +| PipeStream class (part of the ZLib bindings) +| +| + ======================================================================" + + +"====================================================================== +| +| 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. +| + ======================================================================" + + +PositionableStream subclass: #PipeStream + instanceVariableNames: 'full data empty contents' + classVariableNames: 'BufferSize' + poolDictionaries: '' + category: 'Examples-Processes'! + +PipeStream comment: +'Used internally by the zlib bindings, the PipeStream provides two +pieces of functionality. The first is to provide a dual-ended FIFO +stream, which can be read and written by independent processes. The +second is to provide a WriteStream-to-ReadStream adaptor, where the +data is written to the PipeStream (the writing side), fueled to +an object expecting a ReadStream (possibly as a decorator), and taken +from there into the destination stream. The effect is to turn a +ReadStream decorator into a WriteStream decorator.'! + +!PipeStream class methodsFor: 'accessing'! + +bufferSize + "Answer the size of the output buffers that are passed to zlib. Each + zlib stream uses a buffer of this size." + BufferSize isNil ifTrue: [ BufferSize := 512 ]. + ^BufferSize! + +bufferSize: anInteger + "Set the size of the output buffers that are passed to zlib. Each + zlib stream uses a buffer of this size." + BufferSize := anInteger! + +!PipeStream class methodsFor: 'instance creation'! + +on: aCollection + "Answer a new stream using aCollection as its buffer." + aCollection size = 0 ifTrue: [ self halt ]. + ^self basicNew initCollection: aCollection! + +connectedTo: writeStream via: aBlock + "Create a PipeStream that acts as a WriteStream to ReadStream adaptor. + The pipe is passed to the 1-parameter block aBlock, which should use + the pipe as a ReadStream and return another ReadStream. The data that + will be written to the pipe will go through the return value of aBlock, + and then written to aStream. + + Example: + dest := PipeStream on: fileStream via: [ :r | DeflateStream on: r ]. + dest next: 100 put: $A." + + ^(self on: (writeStream species new: self bufferSize)) + connectTo: writeStream via: aBlock; + yourself! + +on: aCollection via: aBlock + "Create a PipeStream that acts as a WriteStream to ReadStream adaptor. + The pipe is passed to the 1-parameter block aBlock, which should use + the pipe as a ReadStream and return another ReadStream. The data that + will be written to the pipe will be placed into aCollection, and can + be retrieved using the #contents method of the PipeStream. + + Example: + dest := PipeStream on: String new via: [ :r | DeflateStream on: r ]. + dest next: 100 put: $A. + dest contents printNl" + + ^self connectedTo: aCollection writeStream via: aBlock! + +!PipeStream methodsFor: 'instance creation'! + +close + "Close the pipe, causing all blocked reads and writes to terminate + immediately." + | sema | + sema := full. + full := nil. + sema notifyAll. + + sema := empty. + empty := nil. + sema notifyAll. + + sema := data. + data := nil. + sema notifyAll! + +notConnected + "Answer whether the communication channel has been closed." + ^full isNil! + +isConnected + "Answer whether the communication channel is still open." + ^full notNil! + +atEnd + "Answer whether the communication channel is closed and there is no + data in the buffer." + ^super atEnd and: [ self notConnected ]! + +isEmpty + "Answer whether there is data in the buffer." + ^super atEnd! + +isFull + "Answer whether there is room in the buffer." + ^endPtr = collection size! + +next + "Retrieve the next byte of data from the pipe, blocking if there is none." + | result | + [ self isEmpty ] whileTrue: [ + self isConnected ifFalse: [ ^self pastEnd ]. + data wait ]. + result := super next. + empty notifyAll. + ^result! + +peek + "Retrieve the next byte of data from the pipe, without gobbling it and + blocking if there is none." + [ self isEmpty ] whileTrue: [ + self isConnected ifFalse: [ ^self pastEnd ]. + data wait ]. + ^super peek! + +nextPut: anObject + "Put anObject in the pipe, blocking if it is full." + [ self isFull ] whileTrue: [ + self isConnected ifFalse: [ ^self pastEnd ]. + empty wait ]. + endPtr := endPtr + 1. + collection at: endPtr put: anObject. + data notifyAll. + self isFull ifTrue: [ full notifyAll ]. + ^anObject! + +nextHunk + "Return a buffer worth of data, blocking until it is full or the pipe + is closed." + [ self isEmpty and: [ self isConnected ] ] whileTrue: [ full wait ]. + + "Here, the buffer is full and all writers are locked, so there is no + contention between the writer and the reader." + ^self bufferContents! + +contents + "Close the channel and return the full contents of the stream. For + pipes created with #on:, #contents closes the stream and returns the + leftover contents of buffer." + self close. + ^contents isNil + ifTrue: [ self bufferContents ] + ifFalse: [ contents value value ]! + +readStream + "Close the channel and return a readStream on the full contents of + the stream. For pipes created with #on:, the stream is created on the + leftover contents of buffer." + ^self contents readStream! + +reset + "Drop all data currently in the buffer. This should not be used + concurrently with other next or nextPut: operations." + + endPtr := 0. + ptr := 1. + empty notifyAll! + +!PipeStream methodsFor: 'private methods'! + +bufferContents + "Return the current contents of the buffer and empty it. This is private + because it requires a lock even in presence of a single reader and a single + writer." + | result | + result := collection copyFrom: ptr to: endPtr. + self reset. + ^result! + +connectTo: writeStream via: aBlock + "Establish a channel as explained in the class method #to:via:." + + "Overwrite the block with a Promise object, so that we complete processing + and return the entire contents of the underlying stream." + contents := Promise new. + [ + | readStream | + readStream := aBlock value: self. + [ + "This blocks the reader process if there is no data in the buffer." + writeStream nextPutAll: readStream nextHunk. + self isConnected and: [ readStream atEnd not ] ] whileTrue. + writeStream nextPutAll: readStream contents. + + "Don't evaluate unless requested." + contents value: [ writeStream contents ] ] fork! + +initCollection: aCollection + collection := aCollection. + ptr := 1. + endPtr := 0. + data := Semaphore new. + empty := Semaphore new. + full := Semaphore new. + contents := nil. +! ! diff -rNu smalltalk-2.3.3/examples/Publish.st smalltalk-2.3.4/examples/Publish.st --- smalltalk-2.3.3/examples/Publish.st 2006-02-05 19:41:23.000000000 +0100 +++ smalltalk-2.3.4/examples/Publish.st 2007-03-18 18:40:21.000000000 +0100 @@ -862,7 +862,7 @@ fileName := (each nameIn: Namespace current). ('writing documentation into ', fileName, '.htm') displayNl. - self publish: each onFile: fileName, '.htm' + self publish: each onFile: fileName, '.htm'. aFileStream nextPutAll: ('%1' bindWith: fileName); nl. @@ -979,7 +979,7 @@ nextPutAllText: self classCategory; nl; nextPutAll: '
Superclass: '; nextPutAllText: self superclassName; - nextPutAllText: '
'; nl; + nextPutAll: '
'; nl; nextPutAllText: self classComment; nl; nextPutAll: '

Method category index

'; nl diff -rNu smalltalk-2.3.3/examples/gdbm-c.st smalltalk-2.3.4/examples/gdbm-c.st --- smalltalk-2.3.3/examples/gdbm-c.st 2006-02-05 19:41:23.000000000 +0100 +++ smalltalk-2.3.4/examples/gdbm-c.st 2007-05-24 22:11:07.000000000 +0200 @@ -74,6 +74,7 @@ ! free + self removeToBeFinalized. self dPtr value free. super free ! ! @@ -125,85 +126,3 @@ ! ! -!GDBM class methodsFor: 'testing'! - -test - | database key value | - database := self open: 'test.gdbm' blockSize: 1024 flags: 2 "write/create" - mode: 8r666 fatalFunc: nil. - - key := DatumStruct fromString: 'fred'. - value := DatumStruct fromString: 'Fred Flintstone'. - database at: key put: value flag: 1 "replace". - key free. - value free. - - key := DatumStruct fromString: 'wilma'. - value := DatumStruct fromString: 'Wilma Flintstone'. - database at: key put: value flag: 1 "replace". - key free. - value free. - - database close. - - database := self open: 'test.gdbm' blockSize: 1024 flags: 0 "read" - mode: 8r666 fatalFunc: nil. - - value := (database at: (DatumStruct fromString: 'wilma')). - value asString printNl. - value free. - - value := (database at: (DatumStruct fromString: 'barney')). - value asString printNl. - value free. - - database close. -! - -test2 - | database newItem item value | - database := self open: 'test.gdbm' blockSize: 1024 flags: 0 "read" - mode: 8r666 fatalFunc: nil. - - item := database firstKey. - [ item dPtr value notNil ] - whileTrue: [ - value := database at: item. - Transcript nextPutAll: item asString; - nextPutAll: ' '; - nextPutAll: value asString; - nl. - - value free. - - newItem := database nextKey: item. - item free. - item := newItem ]. - - item free. - database close. -! - -test3 - | database newItem item value | - database := self open: 'test.gdbm' blockSize: 1024 flags: 0 "read" - mode: 8r666 fatalFunc: nil. - - item := database firstKey. - [ item dPtr value notNil ] - whileTrue: [ - Transcript nextPutAll: item asString; - nextPutAll: ' '. - - newItem := database nextKey: item. - Transcript - display: (newItem dPtr value - ifNotNil: [ :ignored | newItem asString ]); - nl. - item free. - item := newItem ]. - - item free. - database close. -! ! - diff -rNu smalltalk-2.3.3/examples/gdbm.st smalltalk-2.3.4/examples/gdbm.st --- smalltalk-2.3.3/examples/gdbm.st 2006-02-05 19:41:23.000000000 +0100 +++ smalltalk-2.3.4/examples/gdbm.st 2007-05-24 22:11:07.000000000 +0200 @@ -81,7 +81,7 @@ ! finalize - gdbm isNil ifFalse: [ gdbm close ] + gdbm isNil ifFalse: [ self close ] ! ! !Database methodsFor: 'accessing'! @@ -224,53 +224,3 @@ ! ! -!Database class methodsFor: 'testing'! - -test - | database key value | - database := self writeCreate: 'test.gdbm' blockSize: 1024 - mode: 8r666. - - database at: 'fred' put: 'Fred Flintstone'. - database at: 'wilma' put: 'Wilma Flintstone'. - database close. - - database := self read: 'test.gdbm' blockSize: 1024 - mode: 8r666. - - (database at: 'wilma') printNl. - (database at: 'barney' ifAbsent: [ nil ]) printNl. - - database close. -! - -test2 - | database newItem item value | - database := self read: 'test.gdbm' blockSize: 1024 - mode: 8r666. - - database keysAndValuesDo: [ :item :value | - Transcript nextPutAll: item; - nextPutAll: ' '; - nextPutAll: value; - nl. - ]. - - database close. -! - -test3 - | database newItem item value | - database := self read: 'test.gdbm' blockSize: 1024 - mode: 8r666. - - database keysDo: [ :item | - Transcript nextPutAll: item; - nextPutAll: ' '; - display: (database after: item); - nl. - ]. - - database close. -! ! - diff -rNu smalltalk-2.3.3/examples/gdbmtests.st smalltalk-2.3.4/examples/gdbmtests.st --- smalltalk-2.3.3/examples/gdbmtests.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/gdbmtests.st 2007-05-25 11:59:03.000000000 +0200 @@ -0,0 +1,197 @@ +"====================================================================== +| +| GDBM tests declarations +| +| + ======================================================================" + + +"====================================================================== +| +| 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. +| + ======================================================================" + +TestCase subclass: #GDBMTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Modules'! + +!GDBMTest methodsFor: 'creating test files'! + +data + ^{ 'fred'->'Fred Flintstone'. 'wilma'->'Wilma Flintstone'}! + +setUp + self cInterfaceSetup. + self stInterfaceSetup! + +tearDown + (File exists: 'test-c.gdbm') ifTrue: [ File remove: 'test-c.gdbm' ]. + (File exists: 'test-st.gdbm') ifTrue: [ File remove: 'test-st.gdbm' ]! + +cInterfaceSetup + | database key value | + (File exists: 'test-c.gdbm') ifTrue: [ File remove: 'test-c.gdbm' ]. + database := GDBM open: 'test-c.gdbm' blockSize: 1024 flags: 2 "write/create" + mode: 8r666 fatalFunc: nil. + + self data do: [ :each | + key := DatumStruct fromString: each key. + value := DatumStruct fromString: each value. + database at: key put: value flag: 1 "replace". + key free. + value free ]. + + database close! + +stInterfaceSetup + | database | + (File exists: 'test-st.gdbm') ifTrue: [ File remove: 'test-st.gdbm' ]. + database := Database writeCreate: 'test-st.gdbm' blockSize: 1024 mode: 8r666. + self data do: [ :each | database at: each key put: each value ]. + database close +! ! + +!GDBMTest methodsFor: 'testing (low-level)'! + +doTestCInterfaceAt: name + | database key value | + database := GDBM open: name blockSize: 1024 flags: 0 "read" + mode: 8r666 fatalFunc: nil. + + value := (database at: (DatumStruct fromString: 'wilma')). + self assert: value asString = 'Wilma Flintstone'. + value free. + + value := (database at: (DatumStruct fromString: 'barney')). + self assert: value dPtr value isNil. + self assert: value asString = ''. + value free. + + database close. +! + +doTestCInterfaceWalkKeys: name + | database newItem item value result | + database := GDBM open: name blockSize: 1024 flags: 0 "read" + mode: 8r666 fatalFunc: nil. + + result := SortedCollection sortBlock: [ :a :b | a key <= b key ]. + item := database firstKey. + [ item dPtr value notNil ] + whileTrue: [ + value := database at: item. + result add: item asString->value asString. + value free. + + newItem := database nextKey: item. + item free. + item := newItem ]. + + item free. + database close. + self assert: (result at: 1) = ('fred'->'Fred Flintstone'). + self assert: (result at: 2) = ('wilma'->'Wilma Flintstone'). +! + +doTestCInterfaceAfter: name + | database newItem item value result | + database := GDBM open: name blockSize: 1024 flags: 0 "read" + mode: 8r666 fatalFunc: nil. + + result := OrderedCollection new. + item := database firstKey. + [ item dPtr value notNil ] + whileTrue: [ + result add: item asString->nil. + newItem := database nextKey: item. + result last value: (newItem dPtr value + ifNotNil: [ :ignored | newItem asString ]). + + item free. + item := newItem ]. + + item free. + database close. + self assert: (result at: 1) value = (result at: 2) key. + self assert: (result at: 2) value isNil +! ! + +!GDBMTest methodsFor: 'testing (high-level)'! + +doTestAt: name + | database | + database := Database read: name blockSize: 1024 mode: 8r666. + self assert: (database at: 'wilma') = 'Wilma Flintstone'. + self assert: (database at: 'barney' ifAbsent: [ nil ]) isNil. + database close. +! + +doTestKeysAndValuesDo: name + | database newItem item value result | + database := Database read: name blockSize: 1024 mode: 8r666. + + result := SortedCollection sortBlock: [ :a :b | a key <= b key ]. + database keysAndValuesDo: [ :item :value | result add: item->value ]. + database close. + + self assert: (result at: 1) = ('fred'->'Fred Flintstone'). + self assert: (result at: 2) = ('wilma'->'Wilma Flintstone'). +! + +doTestAfter: name + | database newItem item value result | + database := Database read: name blockSize: 1024 mode: 8r666. + + result := OrderedCollection new. + database keysAndValuesDo: [ :item :value | + result add: item->(database after: item) ]. + database close. + + self assert: (result at: 1) value = (result at: 2) key. + self assert: (result at: 2) value isNil +! ! + +!GDBMTest methodsFor: 'testing'! + +testCInterfaceAt + self doTestCInterfaceAt: 'test-c.gdbm'. + self doTestCInterfaceAt: 'test-st.gdbm'! + +testCInterfaceWalkKeys + self doTestCInterfaceWalkKeys: 'test-c.gdbm'. + self doTestCInterfaceWalkKeys: 'test-st.gdbm'! + +testCInterfaceAfter + self doTestCInterfaceAfter: 'test-c.gdbm'. + self doTestCInterfaceAfter: 'test-st.gdbm'! + +testAt + self doTestAt: 'test-c.gdbm'. + self doTestAt: 'test-st.gdbm'! + +testKeysAndValuesDo + self doTestKeysAndValuesDo: 'test-c.gdbm'. + self doTestKeysAndValuesDo: 'test-st.gdbm'! + +testAfter + self doTestAfter: 'test-c.gdbm'. + self doTestAfter: 'test-st.gdbm'! ! diff -rNu smalltalk-2.3.3/examples/md5tests.st smalltalk-2.3.4/examples/md5tests.st --- smalltalk-2.3.3/examples/md5tests.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/md5tests.st 2007-05-24 22:11:04.000000000 +0200 @@ -0,0 +1,138 @@ +"====================================================================== +| +| MD5 tests declarations +| +| + ======================================================================" + + +"====================================================================== +| +| 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. +| + ======================================================================" + +TestCase subclass: #MD5Test + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Modules'! + +!MD5Test methodsFor: 'test vectors'! + +nullDigest + ^#[16rD4 16r1D 16r8C 16rD9 16r8F 16r00 16rB2 16r04 + 16rE9 16r80 16r09 16r98 16rEC 16rF8 16r42 16r7E]! + +hexNullDigest + ^'d41d8cd98f00b204e9800998ecf8427e'! + +abcDigest + ^#[16r90 16r01 16r50 16r98 16r3C 16rD2 16r4F 16rB0 + 16rD6 16r96 16r3F 16r7D 16r28 16rE1 16r7F 16r72]! + +hexAbcDigest + ^'900150983cd24fb0d6963f7d28e17f72'! + +abcdefDigest + ^#[16rE8 16r0B 16r50 16r17 16r09 16r89 16r50 16rFC + 16r58 16rAA 16rD8 16r3C 16r8C 16r14 16r97 16r8E]! + +hexAbcdefDigest + ^'e80b5017098950fc58aad83c8c14978e'! + +size64 + ^(2 to: 37) inject: '' into: [ :a :b | a, b printString ]! + +size64Digest + ^#[16r16 16r5B 16r2B 16r14 16rEC 16rCD 16rE0 16r3D + 16rE4 16r74 16r2A 16r2F 16r93 16r90 16rE1 16rA1]! + +hexSize64Digest + ^'165b2b14eccde03de4742a2f9390e1a1'! + +size128 + ^(2 to: 69) inject: '' into: [ :a :b | a, b printString ]! + +size128Digest + ^#[16r59 16rBD 16rA0 16r9A 16r8B 16r3E 16r1D 16r18 + 16r62 16r37 16rED 16r0F 16rED 16r34 16rD8 16r7A]! + +hexSize128Digest + ^'59bda09a8b3e1d186237ed0fed34d87a'! + +allTestCases + ^{ '' -> self nullDigest. + 'abc' -> self abcDigest. + 'abcdef' -> self abcdefDigest. + self size64 -> self size64Digest. + self size128 -> self size128Digest }! + +allHexTestCases + ^{ '' -> self hexNullDigest. + 'abc' -> self hexAbcDigest. + 'abcdef' -> self hexAbcdefDigest. + self size64 -> self hexSize64Digest. + self size128 -> self hexSize128Digest }! + +!MD5Test methodsFor: 'testing'! + +testDigestOf + self allTestCases do: [ :each | + self assert: (MD5 digestOf: each key) = each value ]! + +testByteArray + self allTestCases do: [ :each | + self assert: (MD5 digestOf: each key asByteArray) = each value ]! + +testHexDigestOf + self allHexTestCases do: [ :each | + self assert: (MD5 hexDigestOf: each key) = each value ]! + +testNextPut + self allTestCases do: [ :each | + | md5 | + md5 := MD5 new. + each key do: [ :ch | md5 nextPut: ch ]. + self assert: md5 digest = each value ]! + +testNextPutAll + self allTestCases do: [ :each | + | md5 | + md5 := MD5 new. + md5 nextPutAll: each key readStream. + self assert: md5 digest = each value ]! + +testPartial + | md5 | + md5 := MD5 new. + md5 nextPutAll: 'abc'. + self assert: md5 partialDigest = self abcDigest. + md5 nextPutAll: 'def'. + self assert: md5 partialDigest = self abcdefDigest. + self assert: md5 digest = self abcdefDigest! + +testPartialHex + | md5 | + md5 := MD5 new. + md5 nextPutAll: 'abc'. + self assert: md5 partialHexDigest = self hexAbcDigest. + md5 nextPutAll: 'def'. + self assert: md5 partialHexDigest = self hexAbcdefDigest. + self assert: md5 hexDigest = self hexAbcdefDigest! ! diff -rNu smalltalk-2.3.3/examples/zlib.c smalltalk-2.3.4/examples/zlib.c --- smalltalk-2.3.3/examples/zlib.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/zlib.c 2007-05-17 13:58:56.000000000 +0200 @@ -0,0 +1,237 @@ +/*********************************************************************** + * + * Zlib interface definitions for GNU 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. + * + * Linking GNU Smalltalk statically or dynamically with other modules is + * making a combined work based on GNU Smalltalk. Thus, the terms and + * conditions of the GNU General Public License cover the whole + * combination. + * + * In addition, as a special exception, the Free Software Foundation + * give you permission to combine GNU Smalltalk with free software + * programs or libraries that are released under the GNU LGPL and with + * independent programs running under the GNU Smalltalk virtual machine. + * + * You may copy and distribute such a system following the terms of the + * GNU GPL for GNU Smalltalk and the licenses of the other code + * concerned, provided that you include the source code of that other + * code when and as the GNU GPL requires distribution of source code. + * + * Note that people who make modified versions of GNU Smalltalk are not + * obligated to grant this special exception for their modified + * versions; it is their choice whether to do so. The GNU General + * Public License gives permission to release a modified version without + * this exception; this exception also makes it possible to release a + * modified version which carries forward this exception. + * + * 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. + * + ***********************************************************************/ + + + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include + +#include "gstpub.h" + +static VMProxy *vmProxy; + +typedef struct zlib_stream { + OBJ_HEADER; + OOP ptr; + OOP endPtr; + OOP inBytes; + OOP outBytes; + OOP delta; + OOP source; + OOP zlibObject; +} *zlib_stream; + + + +/* Wrappers around deflateInit/inflateInit. Additionally, we allow specifying + the window size to support raw and gzip encoding. */ + +void +gst_deflateInit (OOP oop, int factor, int winSize) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = calloc (1, sizeof (z_stream)); + + zs->zlibObject = vmProxy->cObjectToOOP (zlib_obj); + deflateInit2 (zlib_obj, factor, Z_DEFLATED, winSize, 8, Z_DEFAULT_STRATEGY); +} + + +void +gst_inflateInit (OOP oop, int winSize) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = calloc (1, sizeof (z_stream)); + + zs->zlibObject = vmProxy->cObjectToOOP (zlib_obj); + inflateInit2 (zlib_obj, winSize); +} + + +/* Wrappers around deflateEnd/inflateEnd. Nothing interesting goes on here. */ + +void +gst_deflateEnd (OOP oop) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject); + + deflateEnd (zlib_obj); + zs->zlibObject = vmProxy->nilOOP; + free (zlib_obj); +} + + +void +gst_inflateEnd (OOP oop) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject); + + inflateEnd (zlib_obj); + zs->zlibObject = vmProxy->nilOOP; + free (zlib_obj); +} + + +/* Common function to wrap deflate/inflate. Takes care of setting up the + zlib buffers so that they point into the Smalltalk buffers. */ + +static int +zlib_wrapper (OOP oop, int finish, int (*func) (z_stream *, int)) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject); + OOP inBytesOOP = zs->inBytes; + OOP outBytesOOP = zs->outBytes; + char *inBytes = &STRING_OOP_AT (OOP_TO_OBJ (inBytesOOP), 1); + char *outBytes = &STRING_OOP_AT (OOP_TO_OBJ (outBytesOOP), 1); + size_t inSize = vmProxy->OOPSize (inBytesOOP); + size_t outSize = vmProxy->OOPSize (outBytesOOP); + int ret; + + if (!zlib_obj) + return -1; + + /* If the buffer has leftover data, relocate next_in because the Smalltalk + object might have moved. Otherwise initialize it from inBytesOOP. */ + if (zlib_obj->opaque) + zlib_obj->next_in = inBytes + (ptrdiff_t) zlib_obj->opaque; + else + { + zlib_obj->next_in = inBytes; + zlib_obj->avail_in = inSize; + } + + /* Call the function we are wrapping. */ + zlib_obj->next_out = outBytes; + zlib_obj->avail_out = outSize; + ret = func (zlib_obj, finish ? Z_FINISH : Z_NO_FLUSH); + if (ret == Z_BUF_ERROR) + { + zlib_obj->msg = NULL; + ret = Z_OK; + } + + /* If the buffer has leftover data, clear the inBytes field of the object. + Otherwise store how many bytes were consumed in zs->opaque. */ + if (zlib_obj->avail_in == 0) + { + zs->inBytes = vmProxy->nilOOP; + zlib_obj->opaque = NULL; + } + else + zlib_obj->opaque = (PTR) ((char *) zlib_obj->next_in - (char *) inBytes); + + /* Return the number of bytes written to the output buffer, or -1 if the + output is finished. */ + if (ret < 0) + return -1; + else if (finish && inSize == 0 && outSize == zlib_obj->avail_out) + return -1; + else + return outSize - zlib_obj->avail_out; +} + + +int +gst_deflate (OOP oop, int finish) +{ + return zlib_wrapper (oop, finish, deflate); +} + + + +int +gst_inflate (OOP oop, int finish) +{ + return zlib_wrapper (oop, finish, inflate); +} + + +/* Retrieves the error message from the z_stream object. */ + +char * +gst_zlibError (OOP oop) +{ + zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop); + z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject); + char *result = NULL; + + if (zlib_obj) + { + result = zlib_obj->msg; + zlib_obj->msg = NULL; + } + + return result; +} + + +/* Module initialization function. */ + +void +gst_initModule (VMProxy * proxy) +{ + vmProxy = proxy; + vmProxy->defineCFunc ("gst_deflateInit", gst_deflateInit); + vmProxy->defineCFunc ("gst_deflateEnd", gst_deflateEnd); + vmProxy->defineCFunc ("gst_deflate", gst_deflate); + vmProxy->defineCFunc ("gst_inflateInit", gst_inflateInit); + vmProxy->defineCFunc ("gst_inflateEnd", gst_inflateEnd); + vmProxy->defineCFunc ("gst_inflate", gst_inflate); + vmProxy->defineCFunc ("gst_zlibError", gst_zlibError); +} diff -rNu smalltalk-2.3.3/examples/zlib.st smalltalk-2.3.4/examples/zlib.st --- smalltalk-2.3.3/examples/zlib.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/zlib.st 2007-05-24 22:10:25.000000000 +0200 @@ -0,0 +1,384 @@ +"====================================================================== +| +| ZLib module declarations +| +| + ======================================================================" + + +"====================================================================== +| +| 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. +| + ======================================================================" + +Error subclass: #ZlibError + instanceVariableNames: 'stream' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +ZlibError comment: 'This exception is raised whenever there is an error +in a compressed stream.'! + +Stream subclass: #ZlibStream + instanceVariableNames: 'ptr endPtr inBytes outBytes delta source zlibObject' + classVariableNames: 'BufferSize' + poolDictionaries: '' + category: 'Examples-Useful'! + +ZlibStream comment: 'This abstract class implements the basic buffering that is +used for communication with zlib.'! + +ZlibStream subclass: #RawDeflateStream + instanceVariableNames: '' + classVariableNames: 'DefaultCompressionLevel' + poolDictionaries: '' + category: 'Examples-Useful'! + +RawDeflateStream comment: 'Instances of this class produce "raw" (PKZIP) +deflated data.'! + +RawDeflateStream subclass: #DeflateStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +DeflateStream comment: 'Instances of this class produce "standard" +(zlib, RFC1950) deflated data.'! + +RawDeflateStream subclass: #GZipDeflateStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +GZipDeflateStream comment: 'Instances of this class produce GZip (RFC1952) +deflated data.'! + +ZlibStream subclass: #RawInflateStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +RawInflateStream comment: 'Instances of this class reinflate "raw" (PKZIP) +deflated data.'! + +RawInflateStream subclass: #InflateStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +InflateStream comment: 'Instances of this class reinflate "standard" +(zlib, RFC1950) deflated data.'! + +RawInflateStream subclass: #GZipInflateStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +GZipInflateStream comment: 'Instances of this class reinflate GZip (RFC1952) +deflated data.'! + + +!ZlibError methodsFor: 'accessing'! + +stream + "Answer the ZlibStream that caused the error." + ^stream! + +stream: anObject + "Set the ZlibStream that caused the error." + stream := anObject! ! + + +!ZlibStream class methodsFor: 'accessing'! + +bufferSize + "Answer the size of the output buffers that are passed to zlib. Each + zlib stream uses a buffer of this size." + BufferSize isNil ifTrue: [ BufferSize := 16384 ]. + ^BufferSize! + +bufferSize: anInteger + "Set the size of the output buffers that are passed to zlib. Each + zlib stream uses a buffer of this size." + BufferSize := anInteger! + + +!ZlibStream class methodsFor: 'instance creation'! + +new + self shouldNotImplement! + +on: aStream + "Answer an instance of the receiver that decorates aStream." + ^self basicNew initialize: aStream! + + + +!ZlibStream methodsFor: 'streaming'! + +atEnd + "Answer whether the stream has got to an end" + ptr >= endPtr ifFalse: [ ^false ]. + ^zlibObject isNil or: [ + self fillBuffer. + zlibObject isNil ]! + +isExternalStream + "Answer whether the receiver streams on a file or socket." + ^source isExternalStream! + +next + "Return the next object (character or byte) in the receiver." + self atEnd ifTrue: [ ^self pastEnd ]. + ptr := ptr + 1. + ^outBytes at: ptr! + +peekFor: anObject + "Returns true and gobbles the next element from the stream of it is + equal to anObject, returns false and doesn't gobble the next element + if the next element is not equal to anObject." + | result | + self atEnd ifTrue: [ ^self pastEnd ]. + result := (outBytes at: ptr + 1) = anObject. + result ifTrue: [ ptr := ptr + 1 ]. + ^result! + +nextHunk + "Answer the next buffers worth of stuff in the Stream represented + by the receiver. Do at most one actual compression/decompression + operation." + | result | + self atEnd ifTrue: [ ^self pastEnd ]. + result := outBytes copyFrom: ptr + 1 to: endPtr. + ptr := endPtr. + ^result! + +peek + "Returns the next element of the stream without moving the pointer. + Returns nil when at end of stream." + self atEnd ifTrue: [ ^nil ]. + ^outBytes at: ptr + 1! + +position + "Answer the current value of the stream pointer. Note that only inflating + streams support random access to the stream data." + ^delta + ptr! + +species + "Return the type of the collections returned by #upTo: etc." + ^source species! ! + + + +!ZlibStream methodsFor: 'private'! + +resetBuffer + delta := 0. + endPtr := 0. + self fillBuffer! + +initialize: aStream + source := aStream. + outBytes := self species new: self class bufferSize. + self addToBeFinalized. + self resetBuffer! + +fillBuffer + "Fill the output buffer, supplying data to zlib until it can actually + produce something." + delta := delta + endPtr. + ptr := 0. + [ + inBytes isNil ifTrue: [ + inBytes := source atEnd + ifTrue: [ #[] ] + ifFalse: [ source nextHunk ] ]. + + endPtr := self processInput: source atEnd. + endPtr = 0 ] whileTrue. + + "End of data, or zlib error encountered." + endPtr = -1 ifTrue: [ self checkError ]! + +finalize + self destroyZlibObject! ! + +!ZlibStream methodsFor: 'private zlib interface'! + +checkError + | error | + error := self getError. + self finalize; removeToBeFinalized. + error isNil ifFalse: [ + ZlibError new messageText: error; stream: self; signal ]! + +getError + ! + +destroyZlibObject + self subclassResponsibility! + +processInput: atEnd + self subclassResponsibility! ! + + + +!RawDeflateStream class methodsFor: 'accessing'! + +defaultCompressionLevel + "Return the default compression level used by deflating streams." + DefaultCompressionLevel isNil ifTrue: [ DefaultCompressionLevel := 6 ]. + ^DefaultCompressionLevel! + +defaultCompressionLevel: anInteger + "Set the default compression level used by deflating streams. It + should be a number between 1 and 9." + DefaultCompressionLevel := anInteger! + + +!RawDeflateStream class methodsFor: 'instance creation'! + +compressingTo: aStream + "Answer a stream that receives data via #nextPut: and compresses it onto + aStream." + ^PipeStream connectedTo: aStream via: [ :r | self on: r ]! + +compressingTo: aStream level: level + "Answer a stream that receives data via #nextPut: and compresses it onto + aStream with the given compression level." + ^PipeStream connectedTo: aStream via: [ :r | self on: r level: level ]! + +on: aStream + "Answer a stream that compresses the data in aStream with the default + compression level." + ^self basicNew + initializeZlibObject: self defaultCompressionLevel; + initialize: aStream! + +on: aStream level: compressionLevel + "Answer a stream that compresses the data in aStream with the given + compression level." + ^self basicNew + initializeZlibObject: compressionLevel; + initialize: aStream! + + +!RawDeflateStream methodsFor: 'private zlib interface'! + +initializeZlibObject: level windowSize: winSize + ! + +initializeZlibObject: level + self initializeZlibObject: level windowSize: -15! + +destroyZlibObject + ! + +processInput: atEnd + ! ! + + + +!DeflateStream methodsFor: 'private zlib interface'! + +initializeZlibObject: level + self initializeZlibObject: level windowSize: 15! ! + + +!GZipDeflateStream methodsFor: 'private zlib interface'! + +initializeZlibObject: level + self initializeZlibObject: level windowSize: 31! ! + + + +!RawInflateStream methodsFor: 'positioning'! + +position: anInteger + "Set the current position in the stream to anInteger. Notice that this + class can only provide the illusion of random access, by appropriately + rewinding the input stream or skipping compressed data." + delta > anInteger ifTrue: [ self reset ]. + [ delta + endPtr < anInteger ] whileTrue: [ self fillBuffer ]. + ptr := anInteger - delta! + +reset + "Reset the stream to the beginning of the compressed data." + source reset. + self destroyZlibObject; initializeZlibObject. + self resetBuffer! + +copyFrom: start to: end + "Answer the data on which the receiver is streaming, from + the start-th item to the end-th. Note that this method is 0-based, + unlike the one in Collection, because a Stream's #position method + returns 0-based values. Notice that this class can only provide + the illusion of random access, by appropriately rewinding the input + stream or skipping compressed data." + | pos | + pos := self position. + ^[ self position: start; next: end - start ] + ensure: [ self position: pos ]! + +isPositionable + "Answer true if the stream supports moving backwards with #skip:." + ^true! + +skip: anInteger + "Move the current position by anInteger places, either forwards or + backwards." + self position: self position + anInteger! + +!RawInflateStream methodsFor: 'private zlib interface'! + +initialize: aStream + self initializeZlibObject. + super initialize: aStream! + +initializeZlibObject: windowSize + ! + +initializeZlibObject + self initializeZlibObject: -15! + +destroyZlibObject + ! + +processInput: atEnd + ! ! + + + +!InflateStream methodsFor: 'private zlib interface'! + +initializeZlibObject + self initializeZlibObject: 15! ! + +!GZipInflateStream methodsFor: 'private zlib interface'! + +initializeZlibObject + self initializeZlibObject: 31! ! + diff -rNu smalltalk-2.3.3/examples/zlibtests.st smalltalk-2.3.4/examples/zlibtests.st --- smalltalk-2.3.3/examples/zlibtests.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/examples/zlibtests.st 2007-05-24 22:11:02.000000000 +0200 @@ -0,0 +1,131 @@ +"====================================================================== +| +| ZLib module unit tests +| +| + ======================================================================" + + +"====================================================================== +| +| Copyright 2007 Free Software Foundation, Inc. +| Written by Paolo Bonzini and Stephen Compall +| +| 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. +| + ======================================================================" + +TestCase subclass: #ZlibStreamTest + instanceVariableNames: 'oldBufSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-Useful'! + +!ZlibStreamTest class methodsFor: 'testing'! + +fooVector + "Return a long and repetitive string." + | original size answer | + original := 'The quick brown fox jumps over the lazy dog +'. + size := original size. + answer := String new: size * 81. + 1 to: 81 do: [:idx | + answer replaceFrom: (idx - 1) * size + 1 to: idx * size + with: original]. + ^answer! ! + +!ZlibStreamTest methodsFor: 'testing'! + +setUp + oldBufSize := ZlibStream bufferSize. + ZlibStream bufferSize: 512! + +tearDown + ZlibStream bufferSize: oldBufSize! + +assertFooVector: string + "SUnit-Assert that string = `self fooVector'." + self assert: string = self fooVector! + +fooVector + "Refactored to class." + ^self class fooVector! + +doDeflate + "Deflate the long string and return the result." + ^(DeflateStream on: self fooVector readStream) contents! + +testError + "Test whether catching errors works." + self should: [ (InflateStream on: #[12 34 56] readStream) contents ] + raise: ZlibError! + +testWrite + "Test the WriteStream version of DeflateStream." + | dest | + dest := DeflateStream compressingTo: String new writeStream. + dest nextPutAll: self fooVector. + self assert: dest contents asByteArray = self doDeflate asByteArray! + +testRaw + "Test connecting a DeflateStream back-to-back with an InflateStream." + | deflate | + deflate := RawDeflateStream on: self fooVector readStream. + self assertFooVector: (RawInflateStream on: deflate) contents! + +testGZip + "Test connecting a DeflateStream back-to-back with an InflateStream." + | deflate | + deflate := GZipDeflateStream on: self fooVector readStream. + self assertFooVector: (GZipInflateStream on: deflate) contents! + +testDirect + "Test connecting a DeflateStream back-to-back with an InflateStream." + | deflate | + deflate := DeflateStream on: self fooVector readStream. + self assertFooVector: (InflateStream on: deflate) contents! + +testInflate + "Basic compression/decompression test." + self assertFooVector: (InflateStream on: self doDeflate readStream) contents! + +testNextHunk + "Test accessing data with nextHunk (needed to file-in compressed data)." + | stream data | + stream := InflateStream on: self doDeflate readStream. + + data := String new. + [ stream atEnd ] whileFalse: [ data := data, stream nextHunk ]. + self assertFooVector: data! + +testRandomAccess + "Test random access to deflated data." + | original stream data ok | + original := self fooVector. + stream := InflateStream on: self doDeflate readStream. + stream contents. + + stream position: 0. + self assert: (original copyFrom: 1 to: 512) = (stream next: 512). + stream position: 512. + self assert: (original copyFrom: 513 to: 1024) = (stream next: 512). + stream position: 1536. + self assert: (original copyFrom: 1537 to: 2048) = (stream next: 512). + stream position: 1. + self assert: (original copyFrom: 2 to: 512) = (stream next: 511). + stream position: 514. + self assert: (original copyFrom: 515 to: 1024) = (stream next: 510)! ! diff -rNu smalltalk-2.3.3/gtk/Makefile.am smalltalk-2.3.4/gtk/Makefile.am --- smalltalk-2.3.3/gtk/Makefile.am 2006-02-05 19:41:24.000000000 +0100 +++ smalltalk-2.3.4/gtk/Makefile.am 2007-04-07 08:50:56.000000000 +0200 @@ -77,20 +77,20 @@ done Structs.st: structs sizeof$(EXEEXT) cpp order - xargs ./cpp < order | ./structs > Structs.st - ./sizeof >> Structs.st + LANG=C; export LANG; xargs ./cpp < order | ./structs > Structs.st + LANG=C ./sizeof >> Structs.st Enums.st: enums$(EXEEXT) - ./enums > Enums.st + LANG=C ./enums > Enums.st Funcs.st: funcs cpp order - xargs ./cpp < order | ./funcs > Funcs.st + LANG=C; export LANG; xargs ./cpp < order | ./funcs > Funcs.st sizeof.c: mk_sizeof cpp order - xargs ./cpp < order | ./mk_sizeof > sizeof.c + LANG=C; export LANG; xargs ./cpp < order | ./mk_sizeof > sizeof.c enums.c: mk_enums cpp order - xargs ./cpp < order | ./mk_enums > enums.c + LANG=C; export LANG; xargs ./cpp < order | ./mk_enums > enums.c order: order.st Makefile $(LOCAL_FILES) PKG_CONFIG='$(PKG_CONFIG)' ../gst \ diff -rNu smalltalk-2.3.3/gtk/Makefile.in smalltalk-2.3.4/gtk/Makefile.in --- smalltalk-2.3.3/gtk/Makefile.in 2007-02-13 09:25:24.000000000 +0100 +++ smalltalk-2.3.4/gtk/Makefile.in 2007-05-28 12:40:08.000000000 +0200 @@ -139,6 +139,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ @@ -661,20 +662,20 @@ @HAVE_GTK_TRUE@ done @HAVE_GTK_TRUE@Structs.st: structs sizeof$(EXEEXT) cpp order -@HAVE_GTK_TRUE@ xargs ./cpp < order | ./structs > Structs.st -@HAVE_GTK_TRUE@ ./sizeof >> Structs.st +@HAVE_GTK_TRUE@ LANG=C; export LANG; xargs ./cpp < order | ./structs > Structs.st +@HAVE_GTK_TRUE@ LANG=C ./sizeof >> Structs.st @HAVE_GTK_TRUE@Enums.st: enums$(EXEEXT) -@HAVE_GTK_TRUE@ ./enums > Enums.st +@HAVE_GTK_TRUE@ LANG=C ./enums > Enums.st @HAVE_GTK_TRUE@Funcs.st: funcs cpp order -@HAVE_GTK_TRUE@ xargs ./cpp < order | ./funcs > Funcs.st +@HAVE_GTK_TRUE@ LANG=C; export LANG; xargs ./cpp < order | ./funcs > Funcs.st @HAVE_GTK_TRUE@sizeof.c: mk_sizeof cpp order -@HAVE_GTK_TRUE@ xargs ./cpp < order | ./mk_sizeof > sizeof.c +@HAVE_GTK_TRUE@ LANG=C; export LANG; xargs ./cpp < order | ./mk_sizeof > sizeof.c @HAVE_GTK_TRUE@enums.c: mk_enums cpp order -@HAVE_GTK_TRUE@ xargs ./cpp < order | ./mk_enums > enums.c +@HAVE_GTK_TRUE@ LANG=C; export LANG; xargs ./cpp < order | ./mk_enums > enums.c @HAVE_GTK_TRUE@order: order.st Makefile $(LOCAL_FILES) @HAVE_GTK_TRUE@ PKG_CONFIG='$(PKG_CONFIG)' ../gst \ diff -rNu smalltalk-2.3.3/i18n/Makefile.in smalltalk-2.3.4/i18n/Makefile.in --- smalltalk-2.3.3/i18n/Makefile.in 2007-02-13 09:25:24.000000000 +0100 +++ smalltalk-2.3.4/i18n/Makefile.in 2007-05-28 12:40:08.000000000 +0200 @@ -119,6 +119,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/kernel/Behavior.st smalltalk-2.3.4/kernel/Behavior.st --- smalltalk-2.3.3/kernel/Behavior.st 2006-02-05 19:41:26.000000000 +0100 +++ smalltalk-2.3.4/kernel/Behavior.st 2007-05-26 14:01:34.000000000 +0200 @@ -904,7 +904,7 @@ kindOfSubclass "Return a string indicating the type of class the receiver is" self isVariable ifFalse: [ ^'subclass:' ]. - self isPointers ifFalse: [ ^'variableSubclass:' ]. + self isPointers ifTrue: [ ^'variableSubclass:' ]. ^'variable: ', self shape storeString, 'subclass:' ! @@ -1204,7 +1204,10 @@ | instVarMap startOfInstanceVars endOfInstanceVars newInstanceVars oldInstVars oldClass instances | - startOfInstanceVars := self superclass instSize + 1. + startOfInstanceVars := self superclass isNil + ifTrue: [ 1 ] + ifFalse: [ self superclass instSize + 1 ]. + endOfInstanceVars := self instSize. newInstanceVars := variableArray copyFrom: startOfInstanceVars diff -rNu smalltalk-2.3.3/kernel/ByteStream.st smalltalk-2.3.4/kernel/ByteStream.st --- smalltalk-2.3.3/kernel/ByteStream.st 2006-02-05 19:41:26.000000000 +0100 +++ smalltalk-2.3.4/kernel/ByteStream.st 2007-05-18 13:35:09.000000000 +0200 @@ -164,6 +164,9 @@ nextPutAll: aCollection "Write all the objects in aCollection to the receiver" | collEnd relative lastCopied | + aCollection isSequenceable + ifFalse: [ ^super nextPutAll: aCollection ]. + aCollection isEmpty ifTrue: [ ^self ]. collEnd := ptr + aCollection size - 1. diff -rNu smalltalk-2.3.3/kernel/CharArray.st smalltalk-2.3.4/kernel/CharArray.st --- smalltalk-2.3.3/kernel/CharArray.st 2007-02-01 11:54:45.000000000 +0100 +++ smalltalk-2.3.4/kernel/CharArray.st 2007-03-20 13:42:41.000000000 +0100 @@ -58,7 +58,8 @@ ! lineDelimiter - "Answer a CharacterArray which one can use as a line delimiter." + "Answer a CharacterArray which one can use as a line delimiter. + This is meant to be used on subclasses of CharacterArray." ^self with: Character nl ! ! diff -rNu smalltalk-2.3.3/kernel/Collection.st smalltalk-2.3.4/kernel/Collection.st --- smalltalk-2.3.3/kernel/Collection.st 2006-02-05 19:41:26.000000000 +0100 +++ smalltalk-2.3.4/kernel/Collection.st 2007-05-28 12:12:37.000000000 +0200 @@ -151,6 +151,12 @@ !Collection methodsFor: 'testing collections'! +isSequenceable + "Answer whether the receiver can be accessed by a numeric index with + #at:/#at:put:." + ^false +! + capacity "Answer how many elements the receiver can hold before having to grow." ^self basicSize @@ -431,8 +437,7 @@ copyWith: newElement "Answer a copy of the receiver to which newElement is added" - ^(self copyEmpty: self basicSize + 1) - addAll: self; + ^self copy add: newElement; yourself ! diff -rNu smalltalk-2.3.3/kernel/Dictionary.st smalltalk-2.3.4/kernel/Dictionary.st --- smalltalk-2.3.3/kernel/Dictionary.st 2007-01-26 08:23:34.000000000 +0100 +++ smalltalk-2.3.4/kernel/Dictionary.st 2007-05-28 12:12:37.000000000 +0200 @@ -55,7 +55,7 @@ to create dictionaries. Unfortunately, this #new method only creates dictionaries, so subclasses when trying to use this method, lose big. This fixes the problem." - ^self new: 31 + ^self new: 24 ! ! @@ -77,6 +77,13 @@ ^newObject ! +addAll: aCollection + "Adds all the elements of 'aCollection' to the receiver, answer + aCollection" + aCollection keysAndValuesDo: [ :key :value | self at: key put: value ]. + ^aCollection +! + at: key put: value "Store value as associated to the given key" | index assoc | @@ -310,7 +317,7 @@ "Answer a new dictionary where the keys are the same and the values are obtained by passing each value to aBlock and collecting the return values" | aDictionary | - aDictionary := self copyEmpty: self primSize. + aDictionary := self copyEmpty: self capacity. self keysAndValuesDo: [ :key :value | aDictionary at: key put: (aBlock value: value) ]. ^aDictionary @@ -320,7 +327,7 @@ "Answer a new dictionary containing the key/value pairs for which aBlock returns true. aBlock only receives the value part of the pairs." | newDict | - newDict := self copyEmpty: self primSize. + newDict := self copyEmpty: self capacity. self associationsDo: [ :assoc | (aBlock value: assoc value) ifTrue: [ newDict add: assoc ] ]. @@ -331,7 +338,7 @@ "Answer a new dictionary containing the key/value pairs for which aBlock returns false. aBlock only receives the value part of the pairs." | newDict | - newDict := self copyEmpty: self primSize. + newDict := self copyEmpty: self capacity. self associationsDo: [ :assoc | (aBlock value: assoc value) ifFalse: [ newDict add: assoc ] ]. diff -rNu smalltalk-2.3.3/kernel/FileDescr.st smalltalk-2.3.4/kernel/FileDescr.st --- smalltalk-2.3.3/kernel/FileDescr.st 2007-01-02 09:00:33.000000000 +0100 +++ smalltalk-2.3.4/kernel/FileDescr.st 2007-05-18 13:35:09.000000000 +0200 @@ -519,8 +519,21 @@ ^self size == 0 ! +next: n putAll: aCollection startingAt: position + "Put the characters in the supplied range of aCollection in the file" + ^self write: aCollection from: position to: position + n - 1! + nextPutAll: aCollection "Put all the characters in aCollection in the file" + | stream | + aCollection isSequenceable ifFalse: [ + [ stream := aCollection readStream ] + on: MessageNotUnderstood + do: [ :ex | ex return: aCollection asString readStream ]. + + [ stream atEnd ] whileFalse: [ self write: stream nextHunk ]. + ^self ]. + self write: aCollection asString ! @@ -545,8 +558,8 @@ n = 0 ifTrue: [ atEnd := true ]. ^n < anInteger - ifTrue: [ collection copyFrom: 1 to: n ] - ifFalse: [ collection ]. + ifTrue: [ result copyFrom: 1 to: n ] + ifFalse: [ result ]. ! ! diff -rNu smalltalk-2.3.3/kernel/FileStream.st smalltalk-2.3.4/kernel/FileStream.st --- smalltalk-2.3.3/kernel/FileStream.st 2006-12-18 16:37:45.000000000 +0100 +++ smalltalk-2.3.4/kernel/FileStream.st 2007-05-18 13:35:09.000000000 +0200 @@ -365,7 +365,20 @@ nextPutAll: aCollection "Put all the characters in aCollection in the file" | n coll written | - coll := aCollection asString. + "Just do 'coll := aCollection asString', but avoid expensive operations + in the common case where aCollection is already a String." + coll := aCollection isSequenceable + ifTrue: [ aCollection ] + ifFalse: [ + [ aCollection asString ] + on: MessageNotUnderstood + do: [ :ex | + "If we are in a stream, try to facilitate buffering." + [ aCollection atEnd ] whileFalse: [ + coll := aCollection nextHunk. + self next: coll size putAll: coll startingAt: 1 ]. + ^self ] ]. + n := coll size. written := collection size - ptr + 1 min: n. self next: written bufferAll: coll startingAt: 1. diff -rNu smalltalk-2.3.3/kernel/Float.st smalltalk-2.3.4/kernel/Float.st --- smalltalk-2.3.3/kernel/Float.st 2007-02-04 11:42:06.000000000 +0100 +++ smalltalk-2.3.4/kernel/Float.st 2007-05-26 14:01:35.000000000 +0200 @@ -293,7 +293,7 @@ ^Fraction numerator: (self < 0 ifTrue: [ n0 negated ] ifFalse: [ n0 ]) denominator: d0 -! +! ! !Float methodsFor: 'transcendental operations'! @@ -383,10 +383,19 @@ storeOn: aStream "Print a representation of the receiver on aStream" - self - printOn: aStream - special: #('%1 infinity' '%1 negativeInfinity' '%1 nan') -! ! + | printString | + (self isInfinite or: [ self isNaN ]) + ifTrue: [ + ^self + printOn: aStream + special: #('%1 infinity' '%1 negativeInfinity' '%1 nan') ]. + printString := self printString. + aStream nextPutAll: printString. + + "For FloatE/FloatQ, force printing the exponent at the end." + self exponentLetter == $d ifTrue: [ ^self ]. + (printString includes: self exponentLetter) + ifFalse: [ aStream nextPut: self exponentLetter ]! ! @@ -405,8 +414,8 @@ "Private - Print a decimal representation of the receiver on aStream, printing one of the three elements of whatToPrintArray if it is infinity, negative infinity, or a NaN" - | me exponential small num numLog den denLog gcd - intFactor precision int rounding digits digitStream exponent + | me exponential small num weight prevWeight digit eps + precision digits digitStream exponent dotPrinted | "First, take care of the easy cases." @@ -430,45 +439,32 @@ small := me < me unity. exponent := (me floorLog: 10) + 1. - "Compute a rational form of the number we will print..." - (exponential and: [ small not ]) - ifTrue: [ num := me asInteger. den := 1 ] - ifFalse: [ - num := (me timesTwoPower: me class precision - me exponent) asInteger. - den := 2 raisedToInteger: me class precision - me exponent. - - "(The mantissa if printing a small number in exponential notation)." - exponential ifTrue: [ num := num * (10 raisedTo: -1 - exponent) ]. + "Compute the digits one by one." + num := me asExactFraction. + digits := 0. + weight := 10 raisedToInteger: exponent - 1. + me class decimalDigits timesRepeat: [ + digit := num // weight. + digits := digits * 10 + digit. + num := num - (digit * weight). + prevWeight := weight. + weight := weight / 10 ]. + + num = 0 ifFalse: [ + "Smallest number such that me + eps ~= eps" + eps := 2 raisedToInteger: me exponent - me class precision + 1. + "For large numbers, don't let round-to-even bite us." + eps isInteger ifTrue: [ eps := eps / 2 ]. + (num - prevWeight quo: eps) = 0 ifTrue: [ digits := digits + 1 ] ]. - gcd := num gcd: den. - num := num // gcd. - den := den // gcd ]. - - "To round correctly, make sure den is even." - (den bitAnd: 1) = 1 ifTrue: [ num := num * 2. den := den * 2 ]. - - "Get the first `me class decimalDigits' base-10 digits of num // den, - appropriately rounded" - numLog := num ceilingLog: 10. - denLog := den ceilingLog: 10. - denLog < me class decimalDigits ifTrue: [ - denLog := denLog max: den highBit ]. - - intFactor := 10 raisedToInteger: denLog. - rounding := 10 raisedToInteger: numLog - me class decimalDigits. - int := ((num * intFactor) + ((den // 2) * (rounding + 1))) // den. - - digits := int printString. - digits size > me class decimalDigits - ifTrue: [ digits := digits copyFrom: 1 to: me class decimalDigits ]. + digits := digits printString. "Print the non-significant zeros." dotPrinted := false. (small and: [ exponential not ]) ifTrue: [ - (me floorLog: 10) negated timesRepeat: [ + 1 - exponent timesRepeat: [ aStream nextPut: $0. dotPrinted ifFalse: [ dotPrinted := true. aStream nextPut: $. ]. - int := int // 10. exponent := exponent + 1 ] ]. "Make a stream with the significant digits." diff -rNu smalltalk-2.3.3/kernel/Fraction.st smalltalk-2.3.4/kernel/Fraction.st --- smalltalk-2.3.3/kernel/Fraction.st 2007-01-28 22:38:38.000000000 +0100 +++ smalltalk-2.3.4/kernel/Fraction.st 2007-05-22 09:26:25.000000000 +0200 @@ -92,6 +92,8 @@ (aNumber generality = self generality) ifFalse: [^self retryMultiplicationCoercing: aNumber]. + aNumber numerator = 0 ifTrue: [ ^aNumber ]. + self numerator = 0 ifTrue: [ ^self ]. num := numerator * aNumber numerator. den := denominator * aNumber denominator. @@ -167,6 +169,8 @@ (aNumber generality = self generality) ifFalse: [^self retryDivisionCoercing: aNumber]. + aNumber numerator = 0 ifTrue: [ ^self zeroDivide ]. + self numerator = 0 ifTrue: [ ^self ]. num := numerator * aNumber denominator. den := denominator * aNumber numerator. gcd := (numerator gcd: aNumber numerator) * diff -rNu smalltalk-2.3.3/kernel/HashedColl.st smalltalk-2.3.4/kernel/HashedColl.st --- smalltalk-2.3.3/kernel/HashedColl.st 2007-01-15 08:32:36.000000000 +0100 +++ smalltalk-2.3.4/kernel/HashedColl.st 2007-05-28 12:12:37.000000000 +0200 @@ -51,18 +51,26 @@ new "Answer a new instance of the receiver with a default size" - ^self new: 8 + ^self new: 0 ! new: anInteger - "Answer a new instance of the receiver with the given size" + "Answer a new instance of the receiver with the given capacity" | realSize | - realSize := 8 max: anInteger. + realSize := 8 max: (anInteger * 4 + 2) // 3. (realSize bitAnd: (realSize - 1)) = 0 ifFalse: [ realSize := 1 bitShift: realSize highBit ]. ^(self primNew: realSize) initialize: realSize +! + +withAll: aCollection + "Answer a collection whose elements are all those in aCollection" + ^(self new: aCollection size * 2) + addAll: aCollection; + yourself + ! ! @@ -114,7 +122,7 @@ shallowCopy "Returns a shallow copy of the receiver (the instance variables are not copied)" - ^(self copyEmpty: self primSize) + ^(self copyEmpty: self capacity) copyAllFrom: self; yourself ! @@ -123,7 +131,7 @@ "Returns a deep copy of the receiver (the instance variables are copies of the receiver's instance variables)" | newHashedCollection | - newHashedCollection := self copyEmpty: self primSize. + newHashedCollection := self copyEmpty: self capacity. self do: [ :each | newHashedCollection addWhileGrowing: each copy ]. ^newHashedCollection ! ! @@ -256,7 +264,7 @@ "Answer whether the collection's size varied" | grown | (grown := tally >= (self primSize * 3 // 4)) - ifTrue: [ self growBy: self primSize ]. + ifTrue: [ self growBy: self capacity ]. tally := tally + 1. ^grown @@ -280,7 +288,7 @@ copyEmpty "Answer an empty copy of the receiver" - ^self copyEmpty: self primSize + ^self copyEmpty: self capacity ! copyAllFrom: aHashedCollection @@ -347,7 +355,7 @@ ! grow - ^self growBy: self primSize + ^self growBy: self capacity ! growBy: delta @@ -355,7 +363,7 @@ | newSize newHashedCollection | newSize := self primSize + delta. - newHashedCollection := self copyEmpty: self primSize + delta. + newHashedCollection := self copyEmpty: self capacity + delta. newHashedCollection copyAllFrom: self. ^self become: newHashedCollection ! ! diff -rNu smalltalk-2.3.3/kernel/Integer.st smalltalk-2.3.4/kernel/Integer.st --- smalltalk-2.3.3/kernel/Integer.st 2007-01-29 09:24:06.000000000 +0100 +++ smalltalk-2.3.4/kernel/Integer.st 2007-03-21 17:03:52.000000000 +0100 @@ -176,6 +176,9 @@ (self < 0 or: [ anInteger < 0 or: [ anInteger > self ]]) ifTrue: [ ^self arithmeticError: 'binomial coefficient with invalid arguments' ]. + "The easy one." + anInteger = 0 ifTrue: [ ^1 ]. + "The number of SmallInteger factors we computed so far" step := 1. diff -rNu smalltalk-2.3.3/kernel/LargeInt.st smalltalk-2.3.4/kernel/LargeInt.st --- smalltalk-2.3.3/kernel/LargeInt.st 2007-01-29 09:34:44.000000000 +0100 +++ smalltalk-2.3.4/kernel/LargeInt.st 2007-05-28 12:00:09.000000000 +0200 @@ -1308,7 +1308,7 @@ n := v size. sub := ByteArray new: n. m := u size - n. - q := ByteArray new: m + 1. + q := ByteArray new: m + 2. "1. Normalize the divisor Knuth's algorithm is based on an initial guess for the quotient. The diff -rNu smalltalk-2.3.3/kernel/LookupTable.st smalltalk-2.3.4/kernel/LookupTable.st --- smalltalk-2.3.3/kernel/LookupTable.st 2006-02-05 19:41:26.000000000 +0100 +++ smalltalk-2.3.4/kernel/LookupTable.st 2007-05-28 12:12:37.000000000 +0200 @@ -116,7 +116,7 @@ "Returns a deep copy of the receiver (the instance variables are copies of the receiver's instance variables)" | key newDict | - newDict := self copyEmpty: self primSize. + newDict := self copyEmpty: self capacity. 1 to: self primSize do: [ :index | key := self primAt: index. key isNil diff -rNu smalltalk-2.3.3/kernel/Number.st smalltalk-2.3.4/kernel/Number.st --- smalltalk-2.3.3/kernel/Number.st 2006-02-05 19:41:26.000000000 +0100 +++ smalltalk-2.3.4/kernel/Number.st 2007-05-26 14:16:09.000000000 +0200 @@ -144,12 +144,12 @@ scale: n ! -asScaledDecimal: denDigits scale: n - "Answer the receiver, divided by 10^denDigits and converted to +asScaledDecimal: denDigits radix: base scale: n + "Answer the receiver, divided by base^denDigits and converted to a ScaledDecimal object." ^ScaledDecimal newFromNumber: (self asFraction * - (10 raisedToInteger: denDigits)) + (base raisedToInteger: denDigits)) scale: n ! diff -rNu smalltalk-2.3.3/kernel/PkgLoader.st smalltalk-2.3.4/kernel/PkgLoader.st --- smalltalk-2.3.3/kernel/PkgLoader.st 2006-02-05 19:41:27.000000000 +0100 +++ smalltalk-2.3.4/kernel/PkgLoader.st 2007-05-24 22:11:05.000000000 +0200 @@ -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' @@ -59,6 +59,10 @@ !Package methodsFor: 'accessing'! +fileIn + "File in the given package and its dependencies." + PackageLoader fileInPackage: self name! + printXmlOn: aStream collection: aCollection tag: aString "Private - Print aCollection on aStream as a sequence of aString tags." @@ -98,6 +102,11 @@ self printXmlOn: aStream + collection: self sunitScripts + tag: 'sunit'. + + self + printXmlOn: aStream collection: self callouts asSortedCollection tag: 'callout'. @@ -197,6 +206,18 @@ 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 @@ -275,7 +296,7 @@ ]. ^ns! -fileIn +primFileIn "Private - File in the given package without paying attention at dependencies and C callout availability" | dir namespace | @@ -338,6 +359,12 @@ ^(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:)" @@ -477,7 +504,7 @@ extractDependenciesFor: packagesList onError: [ :errorMessage | ^self error: errorMessage ]. - toBeLoaded do: [ :each | (self packageAt: each) fileIn ] + toBeLoaded do: [ :each | (self packageAt: each) primFileIn ] ! ! @@ -586,7 +613,8 @@ (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: [ diff -rNu smalltalk-2.3.3/kernel/PosStream.st smalltalk-2.3.4/kernel/PosStream.st --- smalltalk-2.3.3/kernel/PosStream.st 2007-01-02 09:00:33.000000000 +0100 +++ smalltalk-2.3.4/kernel/PosStream.st 2007-05-17 13:58:56.000000000 +0200 @@ -271,7 +271,7 @@ ! species - "The collections returned by #upTo: etc. are the same kind as - those returned by the collection with methods such as #select:" + "Return the type of the collections returned by #upTo: etc., which are the + same kind as those returned by the collection with methods such as #select:." ^collection species ! ! diff -rNu smalltalk-2.3.3/kernel/Regex.st smalltalk-2.3.4/kernel/Regex.st --- smalltalk-2.3.3/kernel/Regex.st 2006-02-05 19:41:27.000000000 +0100 +++ smalltalk-2.3.4/kernel/Regex.st 2007-03-16 16:27:08.000000000 +0100 @@ -454,7 +454,7 @@ | regs | regs := self searchRegexInternal: regexString from: 1 to: self size. ^regs isNil - ifFalse: [ regs interval ] + ifFalse: [ regs matchInterval ] ifTrue: [ excBlock value ] ! @@ -465,7 +465,7 @@ | regs | regs := self searchRegexInternal: regexString from: index to: self size. ^regs isNil - ifFalse: [ regs interval ] + ifFalse: [ regs matchInterval ] ifTrue: [ excBlock value ] ! @@ -476,7 +476,7 @@ | regs | regs := self searchRegexInternal: regexString from: from to: to. ^regs isNil - ifFalse: [ regs interval ] + ifFalse: [ regs matchInterval ] ifTrue: [ excBlock value ] ! @@ -486,7 +486,7 @@ nil." | regs | regs := self searchRegexInternal: regexString from: 1 to: self size. - ^regs isNil ifFalse: [ regs interval ] + ^regs isNil ifFalse: [ regs matchInterval ] ! indexOfRegex: regexString startingAt: index @@ -495,7 +495,7 @@ the given index. Otherwise return nil." | regs | regs := self searchRegexInternal: regexString from: index to: self size. - ^regs isNil ifFalse: [ regs interval ] + ^regs isNil ifFalse: [ regs matchInterval ] ! indexOfRegex: regexString from: from to: to @@ -504,7 +504,7 @@ the given range of indices. Otherwise return nil." | regs | regs := self searchRegexInternal: regexString from: from to: to. - ^regs isNil ifFalse: [ regs interval ] + ^regs isNil ifFalse: [ regs matchInterval ] ! matchRegex: pattern diff -rNu smalltalk-2.3.3/kernel/ScaledDec.st smalltalk-2.3.4/kernel/ScaledDec.st --- smalltalk-2.3.3/kernel/ScaledDec.st 2006-02-05 19:41:27.000000000 +0100 +++ smalltalk-2.3.4/kernel/ScaledDec.st 2007-05-26 14:01:35.000000000 +0200 @@ -1,4 +1,4 @@ - "====================================================================== +"====================================================================== | | ScaledDecimal Method Definitions | diff -rNu smalltalk-2.3.3/kernel/SeqCollect.st smalltalk-2.3.4/kernel/SeqCollect.st --- smalltalk-2.3.3/kernel/SeqCollect.st 2006-02-05 19:41:27.000000000 +0100 +++ smalltalk-2.3.4/kernel/SeqCollect.st 2007-05-18 13:35:09.000000000 +0200 @@ -105,6 +105,12 @@ ! +isSequenceable + "Answer whether the receiver can be accessed by a numeric index with + #at:/#at:put:." + ^true +! + = aCollection "Answer whether the receiver's items match those in aCollection" diff -rNu smalltalk-2.3.3/kernel/Stream.st smalltalk-2.3.4/kernel/Stream.st --- smalltalk-2.3.3/kernel/Stream.st 2006-02-05 19:41:27.000000000 +0100 +++ smalltalk-2.3.4/kernel/Stream.st 2007-05-18 13:35:09.000000000 +0200 @@ -196,7 +196,9 @@ nextPutAll: aCollection "Write all the objects in aCollection to the receiver" - aCollection do: [ :element | self nextPut: element ]. + aCollection isSequenceable + ifTrue: [ self next: aCollection size putAll: aCollection startingAt: 1 ] + ifFalse: [ aCollection do: [ :element | self nextPut: element ] ]. ^aCollection ! @@ -215,6 +217,18 @@ self subclassResponsibility ! +readStream + "As a wild guess, return the receiver. WriteStreams should override + this method." + ^self +! + +isSequenceable + "Answer whether the receiver can be accessed by a numeric index with + #at:/#at:put:." + ^false +! + isExternalStream "Answer whether the receiver streams on a file or socket. By default, answer false." @@ -416,19 +430,23 @@ ch := self next. ] ] repeat -! ! - -!Stream methodsFor: 'private'! +! nextHunk - "Private - Used internally by the VM when we file in a stream." + "Answer a more-or-less arbitrary amount of data. When used on files, this + does at most one I/O operation. For other kinds of stream, the definition + may vary. This method is used by the VM when loading data from a Smalltalk + stream, and by various kind of Stream decorators supplied with GNU + Smalltalk (including zlib streams)." | s | s := self species new: 1024. 1 to: 1024 do: [ :i | - self atEnd ifTrue: [ ^s copyFrom: 1 to: i ]. + self atEnd ifTrue: [ ^s copyFrom: 1 to: i - 1 ]. s at: i put: self next ]. ^s -! +! ! + +!Stream methodsFor: 'private'! prefixTableFor: aCollection "Private - Answer the prefix table for the Knuth-Morris-Pratt algorithm. diff -rNu smalltalk-2.3.3/lib-src/ChangeLog smalltalk-2.3.4/lib-src/ChangeLog --- smalltalk-2.3.3/lib-src/ChangeLog 2007-01-28 22:38:38.000000000 +0100 +++ smalltalk-2.3.4/lib-src/ChangeLog 2007-04-06 16:18:56.000000000 +0200 @@ -1,3 +1,7 @@ +2007-04-07 Paolo Bonzini + + * lib-src/lrintl.c: New. + 2007-01-28 Paolo Bonzini * lib-src/truncl.c: New. diff -rNu smalltalk-2.3.3/lib-src/Makefile.in smalltalk-2.3.4/lib-src/Makefile.in --- smalltalk-2.3.3/lib-src/Makefile.in 2007-02-13 09:25:25.000000000 +0100 +++ smalltalk-2.3.4/lib-src/Makefile.in 2007-05-28 12:40:09.000000000 +0200 @@ -42,9 +42,9 @@ $(srcdir)/Makefile.in $(srcdir)/poll_.h ChangeLog acosl.c \ alloca.c asinl.c atanl.c ceill.c cosl.c expl.c floorl.c \ frexpl.c ftruncate.c getdtablesize.c getpagesize.c ldexpl.c \ - logl.c mkstemp.c obstack.c obstack.h poll.c putenv.c sinl.c \ - sqrtl.c strdup.c strerror.c strpbrk.c strsep.c strsignal.c \ - strstr.c strtoul.c tanl.c truncl.c + logl.c lrintl.c mkstemp.c obstack.c obstack.h poll.c putenv.c \ + sinl.c sqrtl.c strdup.c strerror.c strpbrk.c strsep.c \ + strsignal.c strstr.c strtoul.c tanl.c truncl.c ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/build-aux/bold.m4 \ $(top_srcdir)/build-aux/codeset.m4 \ @@ -116,6 +116,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ @@ -350,6 +351,7 @@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/getpagesize.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/ldexpl.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/logl.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/lrintl.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/mkstemp.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/obstack.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@$(DEPDIR)/poll.Plo@am__quote@ diff -rNu smalltalk-2.3.3/lib-src/lrintl.c smalltalk-2.3.4/lib-src/lrintl.c --- smalltalk-2.3.3/lib-src/lrintl.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/lib-src/lrintl.c 2007-04-06 15:17:07.000000000 +0200 @@ -0,0 +1,79 @@ +/******************************** -*- C -*- **************************** + * + * Emulation for lrintl + * + * + ***********************************************************************/ + +/*********************************************************************** + * + * 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. + * + * Linking GNU Smalltalk statically or dynamically with other modules is + * making a combined work based on GNU Smalltalk. Thus, the terms and + * conditions of the GNU General Public License cover the whole + * combination. + * + * In addition, as a special exception, the Free Software Foundation + * give you permission to combine GNU Smalltalk with free software + * programs or libraries that are released under the GNU LGPL and with + * independent programs running under the GNU Smalltalk virtual machine. + * + * You may copy and distribute such a system following the terms of the + * GNU GPL for GNU Smalltalk and the licenses of the other code + * concerned, provided that you include the source code of that other + * code when and as the GNU GPL requires distribution of source code. + * + * Note that people who make modified versions of GNU Smalltalk are not + * obligated to grant this special exception for their modified + * versions; it is their choice whether to do so. The GNU General + * Public License gives permission to release a modified version without + * this exception; this exception also makes it possible to release a + * modified version which carries forward this exception. + * + * 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. + * + ***********************************************************************/ + +#include + +#include "mathl.h" + +/* To compute the integer part of X, sum a big enough + integer so that the precision of the floating point + number is exactly 1. */ + +long +lrintl(long double x) +{ + long double y; + if (x < 0.0L) + { + y = -(1.0L / LDBL_EPSILON - x - 1.0 / LDBL_EPSILON); + if (y < x) + y = y + 1.0L; + } + else + { + y = 1.0L / LDBL_EPSILON + x - 1.0 / LDBL_EPSILON; + if (y > x) + y = y - 1.0L; + } + + return (long) y; +} diff -rNu smalltalk-2.3.3/libffi/ChangeLog.libgcj smalltalk-2.3.4/libffi/ChangeLog.libgcj --- smalltalk-2.3.3/libffi/ChangeLog.libgcj 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/ChangeLog.libgcj 2006-02-05 19:41:30.000000000 +0100 @@ -0,0 +1,40 @@ +2004-01-14 Kelley Cook + + * configure.in: Add in AC_PREREQ(2.13) + +2003-02-20 Alexandre Oliva + + * configure.in: Propagate ORIGINAL_LD_FOR_MULTILIBS to + config.status. + * configure: Rebuilt. + +2002-01-27 Alexandre Oliva + + * configure.in (toolexecdir, toolexeclibdir): Set and AC_SUBST. + Remove USE_LIBDIR conditional. + * Makefile.am (toolexecdir, toolexeclibdir): Don't override. + * Makefile.in, configure: Rebuilt. + +Mon Aug 9 18:33:38 1999 Rainer Orth + + * include/Makefile.in: Rebuilt. + * Makefile.in: Rebuilt + * Makefile.am (toolexeclibdir): Add $(MULTISUBDIR) even for native + builds. + Use USE_LIBDIR. + + * configure: Rebuilt. + * configure.in (USE_LIBDIR): Define for native builds. + Use lowercase in configure --help explanations. + +1999-08-08 Anthony Green + + * include/ffi.h.in (FFI_FN): Remove `...'. + +1999-08-08 Anthony Green + + * Makefile.in: Rebuilt. + * Makefile.am (AM_CFLAGS): Compile with -fexceptions. + + * src/x86/sysv.S: Add exception handling metadata. + diff -rNu smalltalk-2.3.3/libffi/Makefile.am smalltalk-2.3.4/libffi/Makefile.am --- smalltalk-2.3.3/libffi/Makefile.am 2006-02-05 19:41:30.000000000 +0100 +++ smalltalk-2.3.4/libffi/Makefile.am 2007-03-21 14:10:51.000000000 +0100 @@ -5,10 +5,12 @@ SUBDIRS = include -EXTRA_DIST = LICENSE ChangeLog.v1 configure.host \ +EXTRA_DIST = LICENSE ChangeLog.v1 ChangeLog.libgcj configure.host \ src/alpha/ffi.c src/alpha/osf.S src/alpha/ffitarget.h \ src/arm/ffi.c src/arm/sysv.S src/arm/ffitarget.h \ src/cris/ffi.c src/cris/sysv.S src/cris/ffitarget.h \ + src/ia64/ffi.c src/ia64/ffitarget.h src/ia64/ia64_flags.h \ + src/ia64/unix.S \ src/mips/ffi.c src/mips/n32.S src/mips/o32.S \ src/mips/ffitarget.h \ src/m32r/ffi.c src/m32r/sysv.S src/m32r/ffitarget.h \ @@ -26,8 +28,8 @@ src/sparc/ffi.c \ src/x86/ffi.c src/x86/sysv.S src/x86/win32.S src/x86/darwin.S \ src/x86/ffi64.c src/x86/unix64.S src/x86/ffitarget.h \ - src/pa/ffi.c src/pa/linux.S src/pa/hpux32.S \ - src/frv/eabi.S src/frv/ffitarget.h + src/pa/ffitarget.h src/pa/ffi.c src/pa/linux.S src/pa/hpux32.S \ + src/frv/ffi.c src/frv/eabi.S src/frv/ffitarget.h ## ################################################################ diff -rNu smalltalk-2.3.3/libffi/Makefile.in smalltalk-2.3.4/libffi/Makefile.in --- smalltalk-2.3.3/libffi/Makefile.in 2006-12-11 17:00:03.000000000 +0100 +++ smalltalk-2.3.4/libffi/Makefile.in 2007-03-21 14:11:26.000000000 +0100 @@ -328,10 +328,12 @@ AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I ../build-aux SUBDIRS = include -EXTRA_DIST = LICENSE ChangeLog.v1 configure.host \ +EXTRA_DIST = LICENSE ChangeLog.v1 ChangeLog.libgcj configure.host \ src/alpha/ffi.c src/alpha/osf.S src/alpha/ffitarget.h \ src/arm/ffi.c src/arm/sysv.S src/arm/ffitarget.h \ src/cris/ffi.c src/cris/sysv.S src/cris/ffitarget.h \ + src/ia64/ffi.c src/ia64/ffitarget.h src/ia64/ia64_flags.h \ + src/ia64/unix.S \ src/mips/ffi.c src/mips/n32.S src/mips/o32.S \ src/mips/ffitarget.h \ src/m32r/ffi.c src/m32r/sysv.S src/m32r/ffitarget.h \ @@ -349,8 +351,8 @@ src/sparc/ffi.c \ src/x86/ffi.c src/x86/sysv.S src/x86/win32.S src/x86/darwin.S \ src/x86/ffi64.c src/x86/unix64.S src/x86/ffitarget.h \ - src/pa/ffi.c src/pa/linux.S src/pa/hpux32.S \ - src/frv/eabi.S src/frv/ffitarget.h + src/pa/ffitarget.h src/pa/ffi.c src/pa/linux.S src/pa/hpux32.S \ + src/frv/ffi.c src/frv/eabi.S src/frv/ffitarget.h # Work around what appears to be a GNU make bug handling MAKEFLAGS @@ -985,7 +987,7 @@ distdir: $(DISTFILES) $(am__remove_distdir) mkdir $(distdir) - $(mkdir_p) $(distdir)/../build-aux $(distdir)/include $(distdir)/src/alpha $(distdir)/src/arm $(distdir)/src/cris $(distdir)/src/frv $(distdir)/src/m32r $(distdir)/src/m68k $(distdir)/src/mips $(distdir)/src/pa $(distdir)/src/powerpc $(distdir)/src/s390 $(distdir)/src/sh $(distdir)/src/sh64 $(distdir)/src/sparc $(distdir)/src/x86 + $(mkdir_p) $(distdir)/../build-aux $(distdir)/include $(distdir)/src/alpha $(distdir)/src/arm $(distdir)/src/cris $(distdir)/src/frv $(distdir)/src/ia64 $(distdir)/src/m32r $(distdir)/src/m68k $(distdir)/src/mips $(distdir)/src/pa $(distdir)/src/powerpc $(distdir)/src/s390 $(distdir)/src/sh $(distdir)/src/sh64 $(distdir)/src/sparc $(distdir)/src/x86 @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ list='$(DISTFILES)'; for file in $$list; do \ diff -rNu smalltalk-2.3.3/libffi/src/frv/ffi.c smalltalk-2.3.4/libffi/src/frv/ffi.c --- smalltalk-2.3.3/libffi/src/frv/ffi.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/frv/ffi.c 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,287 @@ +/* ----------------------------------------------------------------------- + ffi.c - Copyright (c) 2004 Anthony Green + + FR-V Foreign Function Interface + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + ----------------------------------------------------------------------- */ + +#include +#include + +#include + +/* ffi_prep_args is called by the assembly routine once stack space + has been allocated for the function's arguments */ + +void *ffi_prep_args(char *stack, extended_cif *ecif) +{ + register unsigned int i; + register void **p_argv; + register char *argp; + register ffi_type **p_arg; + register int count = 0; + + p_argv = ecif->avalue; + argp = stack; + + for (i = ecif->cif->nargs, p_arg = ecif->cif->arg_types; + (i != 0); + i--, p_arg++) + { + size_t z; + + z = (*p_arg)->size; + + if ((*p_arg)->type == FFI_TYPE_STRUCT) + { + z = sizeof(void*); + *(void **) argp = *p_argv; + } + /* if ((*p_arg)->type == FFI_TYPE_FLOAT) + { + if (count > 24) + { + // This is going on the stack. Turn it into a double. + *(double *) argp = (double) *(float*)(* p_argv); + z = sizeof(double); + } + else + *(void **) argp = *(void **)(* p_argv); + } */ + else if (z < sizeof(int)) + { + z = sizeof(int); + switch ((*p_arg)->type) + { + case FFI_TYPE_SINT8: + *(signed int *) argp = (signed int)*(SINT8 *)(* p_argv); + break; + + case FFI_TYPE_UINT8: + *(unsigned int *) argp = (unsigned int)*(UINT8 *)(* p_argv); + break; + + case FFI_TYPE_SINT16: + *(signed int *) argp = (signed int)*(SINT16 *)(* p_argv); + break; + + case FFI_TYPE_UINT16: + *(unsigned int *) argp = (unsigned int)*(UINT16 *)(* p_argv); + break; + + default: + FFI_ASSERT(0); + } + } + else if (z == sizeof(int)) + { + *(unsigned int *) argp = (unsigned int)*(UINT32 *)(* p_argv); + } + else + { + memcpy(argp, *p_argv, z); + } + p_argv++; + argp += z; + count += z; + } + + return (stack + ((count > 24) ? 24 : ALIGN_DOWN(count, 8))); +} + +/* Perform machine dependent cif processing */ +ffi_status ffi_prep_cif_machdep(ffi_cif *cif) +{ + if (cif->rtype->type == FFI_TYPE_STRUCT) + cif->flags = -1; + else + cif->flags = cif->rtype->size; + + cif->bytes = ALIGN (cif->bytes, 8); + + return FFI_OK; +} + +extern void ffi_call_EABI(void *(*)(char *, extended_cif *), + extended_cif *, + unsigned, unsigned, + unsigned *, + void (*fn)()); + +void ffi_call(ffi_cif *cif, + void (*fn)(), + void *rvalue, + void **avalue) +{ + extended_cif ecif; + + ecif.cif = cif; + ecif.avalue = avalue; + + /* If the return value is a struct and we don't have a return */ + /* value address then we need to make one */ + + if ((rvalue == NULL) && + (cif->rtype->type == FFI_TYPE_STRUCT)) + { + ecif.rvalue = alloca(cif->rtype->size); + } + else + ecif.rvalue = rvalue; + + + switch (cif->abi) + { + case FFI_EABI: + ffi_call_EABI(ffi_prep_args, &ecif, cif->bytes, + cif->flags, ecif.rvalue, fn); + break; + default: + FFI_ASSERT(0); + break; + } +} + +void ffi_closure_eabi (unsigned arg1, unsigned arg2, unsigned arg3, + unsigned arg4, unsigned arg5, unsigned arg6) +{ + /* This function is called by a trampoline. The trampoline stows a + pointer to the ffi_closure object in gr7. We must save this + pointer in a place that will persist while we do our work. */ + register ffi_closure *creg __asm__ ("gr7"); + ffi_closure *closure = creg; + + /* Arguments that don't fit in registers are found on the stack + at a fixed offset above the current frame pointer. */ + register char *frame_pointer __asm__ ("fp"); + char *stack_args = frame_pointer + 16; + + /* Lay the register arguments down in a continuous chunk of memory. */ + unsigned register_args[6] = + { arg1, arg2, arg3, arg4, arg5, arg6 }; + + ffi_cif *cif = closure->cif; + ffi_type **arg_types = cif->arg_types; + void **avalue = alloca (cif->nargs * sizeof(void *)); + char *ptr = (char *) register_args; + int i; + + /* Find the address of each argument. */ + for (i = 0; i < cif->nargs; i++) + { + switch (arg_types[i]->type) + { + case FFI_TYPE_SINT8: + case FFI_TYPE_UINT8: + avalue[i] = ptr + 3; + break; + case FFI_TYPE_SINT16: + case FFI_TYPE_UINT16: + avalue[i] = ptr + 2; + break; + case FFI_TYPE_SINT32: + case FFI_TYPE_UINT32: + case FFI_TYPE_FLOAT: + avalue[i] = ptr; + break; + case FFI_TYPE_STRUCT: + avalue[i] = *(void**)ptr; + break; + default: + /* This is an 8-byte value. */ + avalue[i] = ptr; + ptr += 4; + break; + } + ptr += 4; + + /* If we've handled more arguments than fit in registers, + start looking at the those passed on the stack. */ + if (ptr == ((char *)register_args + (6*4))) + ptr = stack_args; + } + + /* Invoke the closure. */ + if (cif->rtype->type == FFI_TYPE_STRUCT) + { + /* The caller allocates space for the return structure, and + passes a pointer to this space in gr3. Use this value directly + as the return value. */ + register void *return_struct_ptr __asm__("gr3"); + (closure->fun) (cif, return_struct_ptr, avalue, closure->user_data); + } + else + { + /* Allocate space for the return value and call the function. */ + long long rvalue; + (closure->fun) (cif, &rvalue, avalue, closure->user_data); + + /* Functions return 4-byte or smaller results in gr8. 8-byte + values also use gr9. We fill the both, even for small return + values, just to avoid a branch. */ + asm ("ldi @(%0, #0), gr8" : : "r" (&rvalue)); + asm ("ldi @(%0, #0), gr9" : : "r" (&((int *) &rvalue)[1])); + } +} + +ffi_status +ffi_prep_closure (ffi_closure* closure, + ffi_cif* cif, + void (*fun)(ffi_cif*, void*, void**, void*), + void *user_data) +{ + unsigned int *tramp = (unsigned int *) &closure->tramp[0]; + unsigned long fn = (long) ffi_closure_eabi; + unsigned long cls = (long) closure; +#ifdef __FRV_FDPIC__ + register void *got __asm__("gr15"); +#endif + int i; + + fn = (unsigned long) ffi_closure_eabi; + +#ifdef __FRV_FDPIC__ + tramp[0] = &tramp[2]; + tramp[1] = got; + tramp[2] = 0x8cfc0000 + (fn & 0xffff); /* setlos lo(fn), gr6 */ + tramp[3] = 0x8efc0000 + (cls & 0xffff); /* setlos lo(cls), gr7 */ + tramp[4] = 0x8cf80000 + (fn >> 16); /* sethi hi(fn), gr6 */ + tramp[5] = 0x8ef80000 + (cls >> 16); /* sethi hi(cls), gr7 */ + tramp[6] = 0x9cc86000; /* ldi @(gr6, #0), gr14 */ + tramp[7] = 0x8030e000; /* jmpl @(gr14, gr0) */ +#else + tramp[0] = 0x8cfc0000 + (fn & 0xffff); /* setlos lo(fn), gr6 */ + tramp[1] = 0x8efc0000 + (cls & 0xffff); /* setlos lo(cls), gr7 */ + tramp[2] = 0x8cf80000 + (fn >> 16); /* sethi hi(fn), gr6 */ + tramp[3] = 0x8ef80000 + (cls >> 16); /* sethi hi(cls), gr7 */ + tramp[4] = 0x80300006; /* jmpl @(gr0, gr6) */ +#endif + + closure->cif = cif; + closure->fun = fun; + closure->user_data = user_data; + + /* Cache flushing. */ + for (i = 0; i < FFI_TRAMPOLINE_SIZE; i++) + __asm__ volatile ("dcf @(%0,%1)\n\tici @(%0,%1)" :: "r" (tramp), "r" (i)); + + return FFI_OK; +} diff -rNu smalltalk-2.3.3/libffi/src/ia64/ffi.c smalltalk-2.3.4/libffi/src/ia64/ffi.c --- smalltalk-2.3.3/libffi/src/ia64/ffi.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/ia64/ffi.c 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,578 @@ +/* ----------------------------------------------------------------------- + ffi.c - Copyright (c) 1998 Red Hat, Inc. + Copyright (c) 2000 Hewlett Packard Company + + IA64 Foreign Function Interface + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + ----------------------------------------------------------------------- */ + +#include +#include + +#include +#include +#include + +#include "ia64_flags.h" + +/* A 64-bit pointer value. In LP64 mode, this is effectively a plain + pointer. In ILP32 mode, it's a pointer that's been extended to + 64 bits by "addp4". */ +typedef void *PTR64 __attribute__((mode(DI))); + +/* Memory image of fp register contents. This is the implementation + specific format used by ldf.fill/stf.spill. All we care about is + that it wants a 16 byte aligned slot. */ +typedef struct +{ + UINT64 x[2] __attribute__((aligned(16))); +} fpreg; + + +/* The stack layout given to ffi_call_unix and ffi_closure_unix_inner. */ + +struct ia64_args +{ + fpreg fp_regs[8]; /* Contents of 8 fp arg registers. */ + UINT64 gp_regs[8]; /* Contents of 8 gp arg registers. */ + UINT64 other_args[]; /* Arguments passed on stack, variable size. */ +}; + + +/* Adjust ADDR, a pointer to an 8 byte slot, to point to the low LEN bytes. */ + +static inline void * +endian_adjust (void *addr, size_t len) +{ +#ifdef __BIG_ENDIAN__ + return addr + (8 - len); +#else + return addr; +#endif +} + +/* Store VALUE to ADDR in the current cpu implementation's fp spill format. + This is a macro instead of a function, so that it works for all 3 floating + point types without type conversions. Type conversion to long double breaks + the denorm support. */ + +#define stf_spill(addr, value) \ + asm ("stf.spill %0 = %1%P0" : "=m" (*addr) : "f"(value)); + +/* Load a value from ADDR, which is in the current cpu implementation's + fp spill format. As above, this must also be a macro. */ + +#define ldf_fill(result, addr) \ + asm ("ldf.fill %0 = %1%P1" : "=f"(result) : "m"(*addr)); + +/* Return the size of the C type associated with with TYPE. Which will + be one of the FFI_IA64_TYPE_HFA_* values. */ + +static size_t +hfa_type_size (int type) +{ + switch (type) + { + case FFI_IA64_TYPE_HFA_FLOAT: + return sizeof(float); + case FFI_IA64_TYPE_HFA_DOUBLE: + return sizeof(double); + case FFI_IA64_TYPE_HFA_LDOUBLE: + return sizeof(__float80); + default: + abort (); + } +} + +/* Load from ADDR a value indicated by TYPE. Which will be one of + the FFI_IA64_TYPE_HFA_* values. */ + +static void +hfa_type_load (fpreg *fpaddr, int type, void *addr) +{ + switch (type) + { + case FFI_IA64_TYPE_HFA_FLOAT: + stf_spill (fpaddr, *(float *) addr); + return; + case FFI_IA64_TYPE_HFA_DOUBLE: + stf_spill (fpaddr, *(double *) addr); + return; + case FFI_IA64_TYPE_HFA_LDOUBLE: + stf_spill (fpaddr, *(__float80 *) addr); + return; + default: + abort (); + } +} + +/* Load VALUE into ADDR as indicated by TYPE. Which will be one of + the FFI_IA64_TYPE_HFA_* values. */ + +static void +hfa_type_store (int type, void *addr, fpreg *fpaddr) +{ + switch (type) + { + case FFI_IA64_TYPE_HFA_FLOAT: + { + float result; + ldf_fill (result, fpaddr); + *(float *) addr = result; + break; + } + case FFI_IA64_TYPE_HFA_DOUBLE: + { + double result; + ldf_fill (result, fpaddr); + *(double *) addr = result; + break; + } + case FFI_IA64_TYPE_HFA_LDOUBLE: + { + __float80 result; + ldf_fill (result, fpaddr); + *(__float80 *) addr = result; + break; + } + default: + abort (); + } +} + +/* Is TYPE a struct containing floats, doubles, or extended doubles, + all of the same fp type? If so, return the element type. Return + FFI_TYPE_VOID if not. */ + +static int +hfa_element_type (ffi_type *type, int nested) +{ + int element = FFI_TYPE_VOID; + + switch (type->type) + { + case FFI_TYPE_FLOAT: + /* We want to return VOID for raw floating-point types, but the + synthetic HFA type if we're nested within an aggregate. */ + if (nested) + element = FFI_IA64_TYPE_HFA_FLOAT; + break; + + case FFI_TYPE_DOUBLE: + /* Similarly. */ + if (nested) + element = FFI_IA64_TYPE_HFA_DOUBLE; + break; + + case FFI_TYPE_LONGDOUBLE: + /* Similarly, except that that HFA is true for double extended, + but not quad precision. Both have sizeof == 16, so tell the + difference based on the precision. */ + if (LDBL_MANT_DIG == 64 && nested) + element = FFI_IA64_TYPE_HFA_LDOUBLE; + break; + + case FFI_TYPE_STRUCT: + { + ffi_type **ptr = &type->elements[0]; + + for (ptr = &type->elements[0]; *ptr ; ptr++) + { + int sub_element = hfa_element_type (*ptr, 1); + if (sub_element == FFI_TYPE_VOID) + return FFI_TYPE_VOID; + + if (element == FFI_TYPE_VOID) + element = sub_element; + else if (element != sub_element) + return FFI_TYPE_VOID; + } + } + break; + + default: + return FFI_TYPE_VOID; + } + + return element; +} + + +/* Perform machine dependent cif processing. */ + +ffi_status +ffi_prep_cif_machdep(ffi_cif *cif) +{ + int flags; + + /* Adjust cif->bytes to include space for the bits of the ia64_args frame + that preceeds the integer register portion. The estimate that the + generic bits did for the argument space required is good enough for the + integer component. */ + cif->bytes += offsetof(struct ia64_args, gp_regs[0]); + if (cif->bytes < sizeof(struct ia64_args)) + cif->bytes = sizeof(struct ia64_args); + + /* Set the return type flag. */ + flags = cif->rtype->type; + switch (cif->rtype->type) + { + case FFI_TYPE_LONGDOUBLE: + /* Leave FFI_TYPE_LONGDOUBLE as meaning double extended precision, + and encode quad precision as a two-word integer structure. */ + if (LDBL_MANT_DIG != 64) + flags = FFI_IA64_TYPE_SMALL_STRUCT | (16 << 8); + break; + + case FFI_TYPE_STRUCT: + { + size_t size = cif->rtype->size; + int hfa_type = hfa_element_type (cif->rtype, 0); + + if (hfa_type != FFI_TYPE_VOID) + { + size_t nelts = size / hfa_type_size (hfa_type); + if (nelts <= 8) + flags = hfa_type | (size << 8); + } + else + { + if (size <= 32) + flags = FFI_IA64_TYPE_SMALL_STRUCT | (size << 8); + } + } + break; + + default: + break; + } + cif->flags = flags; + + return FFI_OK; +} + +extern int ffi_call_unix (struct ia64_args *, PTR64, void (*)(), UINT64); + +void +ffi_call(ffi_cif *cif, void (*fn)(), void *rvalue, void **avalue) +{ + struct ia64_args *stack; + long i, avn, gpcount, fpcount; + ffi_type **p_arg; + + FFI_ASSERT (cif->abi == FFI_UNIX); + + /* If we have no spot for a return value, make one. */ + if (rvalue == NULL && cif->rtype->type != FFI_TYPE_VOID) + rvalue = alloca (cif->rtype->size); + + /* Allocate the stack frame. */ + stack = alloca (cif->bytes); + + gpcount = fpcount = 0; + avn = cif->nargs; + for (i = 0, p_arg = cif->arg_types; i < avn; i++, p_arg++) + { + switch ((*p_arg)->type) + { + case FFI_TYPE_SINT8: + stack->gp_regs[gpcount++] = *(SINT8 *)avalue[i]; + break; + case FFI_TYPE_UINT8: + stack->gp_regs[gpcount++] = *(UINT8 *)avalue[i]; + break; + case FFI_TYPE_SINT16: + stack->gp_regs[gpcount++] = *(SINT16 *)avalue[i]; + break; + case FFI_TYPE_UINT16: + stack->gp_regs[gpcount++] = *(UINT16 *)avalue[i]; + break; + case FFI_TYPE_SINT32: + stack->gp_regs[gpcount++] = *(SINT32 *)avalue[i]; + break; + case FFI_TYPE_UINT32: + stack->gp_regs[gpcount++] = *(UINT32 *)avalue[i]; + break; + case FFI_TYPE_SINT64: + case FFI_TYPE_UINT64: + stack->gp_regs[gpcount++] = *(UINT64 *)avalue[i]; + break; + + case FFI_TYPE_POINTER: + stack->gp_regs[gpcount++] = (UINT64)(PTR64) *(void **)avalue[i]; + break; + + case FFI_TYPE_FLOAT: + if (gpcount < 8 && fpcount < 8) + stf_spill (&stack->fp_regs[fpcount++], *(float *)avalue[i]); + stack->gp_regs[gpcount++] = *(UINT32 *)avalue[i]; + break; + + case FFI_TYPE_DOUBLE: + if (gpcount < 8 && fpcount < 8) + stf_spill (&stack->fp_regs[fpcount++], *(double *)avalue[i]); + stack->gp_regs[gpcount++] = *(UINT64 *)avalue[i]; + break; + + case FFI_TYPE_LONGDOUBLE: + if (gpcount & 1) + gpcount++; + if (LDBL_MANT_DIG == 64 && gpcount < 8 && fpcount < 8) + stf_spill (&stack->fp_regs[fpcount++], *(__float80 *)avalue[i]); + memcpy (&stack->gp_regs[gpcount], avalue[i], 16); + gpcount += 2; + break; + + case FFI_TYPE_STRUCT: + { + size_t size = (*p_arg)->size; + size_t align = (*p_arg)->alignment; + int hfa_type = hfa_element_type (*p_arg, 0); + + FFI_ASSERT (align <= 16); + if (align == 16 && (gpcount & 1)) + gpcount++; + + if (hfa_type != FFI_TYPE_VOID) + { + size_t hfa_size = hfa_type_size (hfa_type); + size_t offset = 0; + size_t gp_offset = gpcount * 8; + + while (fpcount < 8 + && offset < size + && gp_offset < 8 * 8) + { + hfa_type_load (&stack->fp_regs[fpcount], hfa_type, + avalue[i] + offset); + offset += hfa_size; + gp_offset += hfa_size; + fpcount += 1; + } + } + + memcpy (&stack->gp_regs[gpcount], avalue[i], size); + gpcount += (size + 7) / 8; + } + break; + + default: + abort (); + } + } + + ffi_call_unix (stack, rvalue, fn, cif->flags); +} + +/* Closures represent a pair consisting of a function pointer, and + some user data. A closure is invoked by reinterpreting the closure + as a function pointer, and branching to it. Thus we can make an + interpreted function callable as a C function: We turn the + interpreter itself, together with a pointer specifying the + interpreted procedure, into a closure. + + For IA64, function pointer are already pairs consisting of a code + pointer, and a gp pointer. The latter is needed to access global + variables. Here we set up such a pair as the first two words of + the closure (in the "trampoline" area), but we replace the gp + pointer with a pointer to the closure itself. We also add the real + gp pointer to the closure. This allows the function entry code to + both retrieve the user data, and to restire the correct gp pointer. */ + +extern void ffi_closure_unix (); + +ffi_status +ffi_prep_closure (ffi_closure* closure, + ffi_cif* cif, + void (*fun)(ffi_cif*,void*,void**,void*), + void *user_data) +{ + /* The layout of a function descriptor. A C function pointer really + points to one of these. */ + struct ia64_fd + { + UINT64 code_pointer; + UINT64 gp; + }; + + struct ffi_ia64_trampoline_struct + { + UINT64 code_pointer; /* Pointer to ffi_closure_unix. */ + UINT64 fake_gp; /* Pointer to closure, installed as gp. */ + UINT64 real_gp; /* Real gp value. */ + }; + + struct ffi_ia64_trampoline_struct *tramp; + struct ia64_fd *fd; + + FFI_ASSERT (cif->abi == FFI_UNIX); + + tramp = (struct ffi_ia64_trampoline_struct *)closure->tramp; + fd = (struct ia64_fd *)(void *)ffi_closure_unix; + + tramp->code_pointer = fd->code_pointer; + tramp->real_gp = fd->gp; + tramp->fake_gp = (UINT64)(PTR64)closure; + closure->cif = cif; + closure->user_data = user_data; + closure->fun = fun; + + return FFI_OK; +} + + +UINT64 +ffi_closure_unix_inner (ffi_closure *closure, struct ia64_args *stack, + void *rvalue, void *r8) +{ + ffi_cif *cif; + void **avalue; + ffi_type **p_arg; + long i, avn, gpcount, fpcount; + + cif = closure->cif; + avn = cif->nargs; + avalue = alloca (avn * sizeof (void *)); + + /* If the structure return value is passed in memory get that location + from r8 so as to pass the value directly back to the caller. */ + if (cif->flags == FFI_TYPE_STRUCT) + rvalue = r8; + + gpcount = fpcount = 0; + for (i = 0, p_arg = cif->arg_types; i < avn; i++, p_arg++) + { + switch ((*p_arg)->type) + { + case FFI_TYPE_SINT8: + case FFI_TYPE_UINT8: + avalue[i] = endian_adjust(&stack->gp_regs[gpcount++], 1); + break; + case FFI_TYPE_SINT16: + case FFI_TYPE_UINT16: + avalue[i] = endian_adjust(&stack->gp_regs[gpcount++], 2); + break; + case FFI_TYPE_SINT32: + case FFI_TYPE_UINT32: + avalue[i] = endian_adjust(&stack->gp_regs[gpcount++], 4); + break; + case FFI_TYPE_SINT64: + case FFI_TYPE_UINT64: + avalue[i] = &stack->gp_regs[gpcount++]; + break; + case FFI_TYPE_POINTER: + avalue[i] = endian_adjust(&stack->gp_regs[gpcount++], sizeof(void*)); + break; + + case FFI_TYPE_FLOAT: + if (gpcount < 8 && fpcount < 8) + { + fpreg *addr = &stack->fp_regs[fpcount++]; + float result; + avalue[i] = addr; + ldf_fill (result, addr); + *(float *)addr = result; + } + else + avalue[i] = endian_adjust(&stack->gp_regs[gpcount], 4); + gpcount++; + break; + + case FFI_TYPE_DOUBLE: + if (gpcount < 8 && fpcount < 8) + { + fpreg *addr = &stack->fp_regs[fpcount++]; + double result; + avalue[i] = addr; + ldf_fill (result, addr); + *(double *)addr = result; + } + else + avalue[i] = &stack->gp_regs[gpcount]; + gpcount++; + break; + + case FFI_TYPE_LONGDOUBLE: + if (gpcount & 1) + gpcount++; + if (LDBL_MANT_DIG == 64 && gpcount < 8 && fpcount < 8) + { + fpreg *addr = &stack->fp_regs[fpcount++]; + __float80 result; + avalue[i] = addr; + ldf_fill (result, addr); + *(__float80 *)addr = result; + } + else + avalue[i] = &stack->gp_regs[gpcount]; + gpcount += 2; + break; + + case FFI_TYPE_STRUCT: + { + size_t size = (*p_arg)->size; + size_t align = (*p_arg)->alignment; + int hfa_type = hfa_element_type (*p_arg, 0); + + FFI_ASSERT (align <= 16); + if (align == 16 && (gpcount & 1)) + gpcount++; + + if (hfa_type != FFI_TYPE_VOID) + { + size_t hfa_size = hfa_type_size (hfa_type); + size_t offset = 0; + size_t gp_offset = gpcount * 8; + void *addr = alloca (size); + + avalue[i] = addr; + + while (fpcount < 8 + && offset < size + && gp_offset < 8 * 8) + { + hfa_type_store (hfa_type, addr + offset, + &stack->fp_regs[fpcount]); + offset += hfa_size; + gp_offset += hfa_size; + fpcount += 1; + } + + if (offset < size) + memcpy (addr + offset, (char *)stack->gp_regs + gp_offset, + size - offset); + } + else + avalue[i] = &stack->gp_regs[gpcount]; + + gpcount += (size + 7) / 8; + } + break; + + default: + abort (); + } + } + + closure->fun (cif, rvalue, avalue, closure->user_data); + + return cif->flags; +} diff -rNu smalltalk-2.3.3/libffi/src/ia64/ffitarget.h smalltalk-2.3.4/libffi/src/ia64/ffitarget.h --- smalltalk-2.3.3/libffi/src/ia64/ffitarget.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/ia64/ffitarget.h 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,49 @@ +/* -----------------------------------------------------------------*-C-*- + ffitarget.h - Copyright (c) 1996-2003 Red Hat, Inc. + Target configuration macros for IA-64. + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + + ----------------------------------------------------------------------- */ + +#ifndef LIBFFI_TARGET_H +#define LIBFFI_TARGET_H + +#ifndef LIBFFI_ASM +typedef unsigned long long ffi_arg; +typedef signed long long ffi_sarg; + +typedef enum ffi_abi { + FFI_FIRST_ABI = 0, + FFI_UNIX, /* Linux and all Unix variants use the same conventions */ + FFI_DEFAULT_ABI = FFI_UNIX, + FFI_LAST_ABI = FFI_DEFAULT_ABI + 1 +} ffi_abi; +#endif + +/* ---- Definitions for closures ----------------------------------------- */ + +#define FFI_CLOSURES 1 +#define FFI_TRAMPOLINE_SIZE 24 /* Really the following struct, which */ + /* can be interpreted as a C function */ + /* descriptor: */ + +#endif + diff -rNu smalltalk-2.3.3/libffi/src/ia64/ia64_flags.h smalltalk-2.3.4/libffi/src/ia64/ia64_flags.h --- smalltalk-2.3.3/libffi/src/ia64/ia64_flags.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/ia64/ia64_flags.h 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,39 @@ +/* ----------------------------------------------------------------------- + ia64_flags.h - Copyright (c) 2000 Hewlett Packard Company + + IA64/unix Foreign Function Interface + + Original author: Hans Boehm, HP Labs + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + ----------------------------------------------------------------------- */ + +/* "Type" codes used between assembly and C. When used as a part of + a cfi->flags value, the low byte will be these extra type codes, + and bits 8-31 will be the actual size of the type. */ + +/* Small structures containing N words in integer registers. */ +#define FFI_IA64_TYPE_SMALL_STRUCT (FFI_TYPE_LAST + 1) + +/* Homogeneous Floating Point Aggregates (HFAs) which are returned + in FP registers. */ +#define FFI_IA64_TYPE_HFA_FLOAT (FFI_TYPE_LAST + 2) +#define FFI_IA64_TYPE_HFA_DOUBLE (FFI_TYPE_LAST + 3) +#define FFI_IA64_TYPE_HFA_LDOUBLE (FFI_TYPE_LAST + 4) diff -rNu smalltalk-2.3.3/libffi/src/ia64/unix.S smalltalk-2.3.4/libffi/src/ia64/unix.S --- smalltalk-2.3.3/libffi/src/ia64/unix.S 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/ia64/unix.S 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,555 @@ +/* ----------------------------------------------------------------------- + unix.S - Copyright (c) 1998 Red Hat, Inc. + Copyright (c) 2000 Hewlett Packard Company + + IA64/unix Foreign Function Interface + + Primary author: Hans Boehm, HP Labs + + Loosely modeled on Cygnus code for other platforms. + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + ----------------------------------------------------------------------- */ + +#define LIBFFI_ASM +#include +#include +#include "ia64_flags.h" + + .pred.safe_across_calls p1-p5,p16-p63 +.text + +/* int ffi_call_unix (struct ia64_args *stack, PTR64 rvalue, + void (*fn)(), int flags); + */ + + .align 16 + .global ffi_call_unix + .proc ffi_call_unix +ffi_call_unix: + .prologue + /* Bit o trickiness. We actually share a stack frame with ffi_call. + Rely on the fact that ffi_call uses a vframe and don't bother + tracking one here at all. */ + .fframe 0 + .save ar.pfs, r36 // loc0 + alloc loc0 = ar.pfs, 4, 3, 8, 0 + .save rp, loc1 + mov loc1 = b0 + .body + add r16 = 16, in0 + mov loc2 = gp + mov r8 = in1 + ;; + + /* Load up all of the argument registers. */ + ldf.fill f8 = [in0], 32 + ldf.fill f9 = [r16], 32 + ;; + ldf.fill f10 = [in0], 32 + ldf.fill f11 = [r16], 32 + ;; + ldf.fill f12 = [in0], 32 + ldf.fill f13 = [r16], 32 + ;; + ldf.fill f14 = [in0], 32 + ldf.fill f15 = [r16], 24 + ;; + ld8 out0 = [in0], 16 + ld8 out1 = [r16], 16 + ;; + ld8 out2 = [in0], 16 + ld8 out3 = [r16], 16 + ;; + ld8 out4 = [in0], 16 + ld8 out5 = [r16], 16 + ;; + ld8 out6 = [in0] + ld8 out7 = [r16] + ;; + + /* Deallocate the register save area from the stack frame. */ + mov sp = in0 + + /* Call the target function. */ + ld8 r16 = [in2], 8 + ;; + ld8 gp = [in2] + mov b6 = r16 + br.call.sptk.many b0 = b6 + ;; + + /* Dispatch to handle return value. */ + mov gp = loc2 + zxt1 r16 = in3 + ;; + mov ar.pfs = loc0 + addl r18 = @ltoffx(.Lst_table), gp + ;; + ld8.mov r18 = [r18], .Lst_table + mov b0 = loc1 + ;; + shladd r18 = r16, 3, r18 + ;; + ld8 r17 = [r18] + shr in3 = in3, 8 + ;; + add r17 = r17, r18 + ;; + mov b6 = r17 + br b6 + ;; + +.Lst_void: + br.ret.sptk.many b0 + ;; +.Lst_uint8: + zxt1 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_sint8: + sxt1 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_uint16: + zxt2 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_sint16: + sxt2 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_uint32: + zxt4 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_sint32: + sxt4 r8 = r8 + ;; + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_int64: + st8 [in1] = r8 + br.ret.sptk.many b0 + ;; +.Lst_float: + stfs [in1] = f8 + br.ret.sptk.many b0 + ;; +.Lst_double: + stfd [in1] = f8 + br.ret.sptk.many b0 + ;; +.Lst_ldouble: + stfe [in1] = f8 + br.ret.sptk.many b0 + ;; + +.Lst_small_struct: + add sp = -16, sp + cmp.lt p6, p0 = 8, in3 + cmp.lt p7, p0 = 16, in3 + cmp.lt p8, p0 = 24, in3 + ;; + add r16 = 8, sp + add r17 = 16, sp + add r18 = 24, sp + ;; + st8 [sp] = r8 +(p6) st8 [r16] = r9 + mov out0 = in1 +(p7) st8 [r17] = r10 +(p8) st8 [r18] = r11 + mov out1 = sp + mov out2 = in3 + br.call.sptk.many b0 = memcpy# + ;; + mov ar.pfs = loc0 + mov b0 = loc1 + mov gp = loc2 + br.ret.sptk.many b0 + +.Lst_hfa_float: + add r16 = 4, in1 + cmp.lt p6, p0 = 4, in3 + ;; + stfs [in1] = f8, 8 +(p6) stfs [r16] = f9, 8 + cmp.lt p7, p0 = 8, in3 + cmp.lt p8, p0 = 12, in3 + ;; +(p7) stfs [in1] = f10, 8 +(p8) stfs [r16] = f11, 8 + cmp.lt p9, p0 = 16, in3 + cmp.lt p10, p0 = 20, in3 + ;; +(p9) stfs [in1] = f12, 8 +(p10) stfs [r16] = f13, 8 + cmp.lt p6, p0 = 24, in3 + cmp.lt p7, p0 = 28, in3 + ;; +(p6) stfs [in1] = f14 +(p7) stfs [r16] = f15 + br.ret.sptk.many b0 + ;; + +.Lst_hfa_double: + add r16 = 8, in1 + cmp.lt p6, p0 = 8, in3 + ;; + stfd [in1] = f8, 16 +(p6) stfd [r16] = f9, 16 + cmp.lt p7, p0 = 16, in3 + cmp.lt p8, p0 = 24, in3 + ;; +(p7) stfd [in1] = f10, 16 +(p8) stfd [r16] = f11, 16 + cmp.lt p9, p0 = 32, in3 + cmp.lt p10, p0 = 40, in3 + ;; +(p9) stfd [in1] = f12, 16 +(p10) stfd [r16] = f13, 16 + cmp.lt p6, p0 = 48, in3 + cmp.lt p7, p0 = 56, in3 + ;; +(p6) stfd [in1] = f14 +(p7) stfd [r16] = f15 + br.ret.sptk.many b0 + ;; + +.Lst_hfa_ldouble: + add r16 = 16, in1 + cmp.lt p6, p0 = 16, in3 + ;; + stfe [in1] = f8, 32 +(p6) stfe [r16] = f9, 32 + cmp.lt p7, p0 = 32, in3 + cmp.lt p8, p0 = 48, in3 + ;; +(p7) stfe [in1] = f10, 32 +(p8) stfe [r16] = f11, 32 + cmp.lt p9, p0 = 64, in3 + cmp.lt p10, p0 = 80, in3 + ;; +(p9) stfe [in1] = f12, 32 +(p10) stfe [r16] = f13, 32 + cmp.lt p6, p0 = 96, in3 + cmp.lt p7, p0 = 112, in3 + ;; +(p6) stfe [in1] = f14 +(p7) stfe [r16] = f15 + br.ret.sptk.many b0 + ;; + + .endp ffi_call_unix + + .align 16 + .global ffi_closure_unix + .proc ffi_closure_unix + +#define FRAME_SIZE (8*16 + 8*8 + 8*16) + +ffi_closure_unix: + .prologue + .save ar.pfs, r40 // loc0 + alloc loc0 = ar.pfs, 8, 4, 4, 0 + .fframe FRAME_SIZE + add r12 = -FRAME_SIZE, r12 + .save rp, loc1 + mov loc1 = b0 + .save ar.unat, loc2 + mov loc2 = ar.unat + .body + + /* Retrieve closure pointer and real gp. */ +#ifdef _ILP32 + addp4 out0 = 0, gp + addp4 gp = 16, gp +#else + mov out0 = gp + add gp = 16, gp +#endif + ;; + ld8 gp = [gp] + + /* Spill all of the possible argument registers. */ + add r16 = 16 + 8*16, sp + add r17 = 16 + 8*16 + 16, sp + ;; + stf.spill [r16] = f8, 32 + stf.spill [r17] = f9, 32 + mov loc3 = gp + ;; + stf.spill [r16] = f10, 32 + stf.spill [r17] = f11, 32 + ;; + stf.spill [r16] = f12, 32 + stf.spill [r17] = f13, 32 + ;; + stf.spill [r16] = f14, 32 + stf.spill [r17] = f15, 24 + ;; + .mem.offset 0, 0 + st8.spill [r16] = in0, 16 + .mem.offset 8, 0 + st8.spill [r17] = in1, 16 + add out1 = 16 + 8*16, sp + ;; + .mem.offset 0, 0 + st8.spill [r16] = in2, 16 + .mem.offset 8, 0 + st8.spill [r17] = in3, 16 + add out2 = 16, sp + ;; + .mem.offset 0, 0 + st8.spill [r16] = in4, 16 + .mem.offset 8, 0 + st8.spill [r17] = in5, 16 + mov out3 = r8 + ;; + .mem.offset 0, 0 + st8.spill [r16] = in6 + .mem.offset 8, 0 + st8.spill [r17] = in7 + + /* Invoke ffi_closure_unix_inner for the hard work. */ + br.call.sptk.many b0 = ffi_closure_unix_inner + ;; + + /* Dispatch to handle return value. */ + mov gp = loc3 + zxt1 r16 = r8 + ;; + addl r18 = @ltoffx(.Lld_table), gp + mov ar.pfs = loc0 + ;; + ld8.mov r18 = [r18], .Lld_table + mov b0 = loc1 + ;; + shladd r18 = r16, 3, r18 + mov ar.unat = loc2 + ;; + ld8 r17 = [r18] + shr r8 = r8, 8 + ;; + add r17 = r17, r18 + add r16 = 16, sp + ;; + mov b6 = r17 + br b6 + ;; + .label_state 1 + +.Lld_void: + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; +.Lld_int: + .body + .copy_state 1 + ld8 r8 = [r16] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; +.Lld_float: + .body + .copy_state 1 + ldfs f8 = [r16] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; +.Lld_double: + .body + .copy_state 1 + ldfd f8 = [r16] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; +.Lld_ldouble: + .body + .copy_state 1 + ldfe f8 = [r16] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; + +.Lld_small_struct: + .body + .copy_state 1 + add r17 = 8, r16 + cmp.lt p6, p0 = 8, r8 + cmp.lt p7, p0 = 16, r8 + cmp.lt p8, p0 = 24, r8 + ;; + ld8 r8 = [r16], 16 +(p6) ld8 r9 = [r17], 16 + ;; +(p7) ld8 r10 = [r16] +(p8) ld8 r11 = [r17] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; + +.Lld_hfa_float: + .body + .copy_state 1 + add r17 = 4, r16 + cmp.lt p6, p0 = 4, r8 + ;; + ldfs f8 = [r16], 8 +(p6) ldfs f9 = [r17], 8 + cmp.lt p7, p0 = 8, r8 + cmp.lt p8, p0 = 12, r8 + ;; +(p7) ldfs f10 = [r16], 8 +(p8) ldfs f11 = [r17], 8 + cmp.lt p9, p0 = 16, r8 + cmp.lt p10, p0 = 20, r8 + ;; +(p9) ldfs f12 = [r16], 8 +(p10) ldfs f13 = [r17], 8 + cmp.lt p6, p0 = 24, r8 + cmp.lt p7, p0 = 28, r8 + ;; +(p6) ldfs f14 = [r16] +(p7) ldfs f15 = [r17] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; + +.Lld_hfa_double: + .body + .copy_state 1 + add r17 = 8, r16 + cmp.lt p6, p0 = 8, r8 + ;; + ldfd f8 = [r16], 16 +(p6) ldfd f9 = [r17], 16 + cmp.lt p7, p0 = 16, r8 + cmp.lt p8, p0 = 24, r8 + ;; +(p7) ldfd f10 = [r16], 16 +(p8) ldfd f11 = [r17], 16 + cmp.lt p9, p0 = 32, r8 + cmp.lt p10, p0 = 40, r8 + ;; +(p9) ldfd f12 = [r16], 16 +(p10) ldfd f13 = [r17], 16 + cmp.lt p6, p0 = 48, r8 + cmp.lt p7, p0 = 56, r8 + ;; +(p6) ldfd f14 = [r16] +(p7) ldfd f15 = [r17] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; + +.Lld_hfa_ldouble: + .body + .copy_state 1 + add r17 = 16, r16 + cmp.lt p6, p0 = 16, r8 + ;; + ldfe f8 = [r16], 32 +(p6) ldfe f9 = [r17], 32 + cmp.lt p7, p0 = 32, r8 + cmp.lt p8, p0 = 48, r8 + ;; +(p7) ldfe f10 = [r16], 32 +(p8) ldfe f11 = [r17], 32 + cmp.lt p9, p0 = 64, r8 + cmp.lt p10, p0 = 80, r8 + ;; +(p9) ldfe f12 = [r16], 32 +(p10) ldfe f13 = [r17], 32 + cmp.lt p6, p0 = 96, r8 + cmp.lt p7, p0 = 112, r8 + ;; +(p6) ldfe f14 = [r16] +(p7) ldfe f15 = [r17] + .restore sp + add sp = FRAME_SIZE, sp + br.ret.sptk.many b0 + ;; + + .endp ffi_closure_unix + + .section .rodata + .align 8 +.Lst_table: + data8 @pcrel(.Lst_void) // FFI_TYPE_VOID + data8 @pcrel(.Lst_sint32) // FFI_TYPE_INT + data8 @pcrel(.Lst_float) // FFI_TYPE_FLOAT + data8 @pcrel(.Lst_double) // FFI_TYPE_DOUBLE + data8 @pcrel(.Lst_ldouble) // FFI_TYPE_LONGDOUBLE + data8 @pcrel(.Lst_uint8) // FFI_TYPE_UINT8 + data8 @pcrel(.Lst_sint8) // FFI_TYPE_SINT8 + data8 @pcrel(.Lst_uint16) // FFI_TYPE_UINT16 + data8 @pcrel(.Lst_sint16) // FFI_TYPE_SINT16 + data8 @pcrel(.Lst_uint32) // FFI_TYPE_UINT32 + data8 @pcrel(.Lst_sint32) // FFI_TYPE_SINT32 + data8 @pcrel(.Lst_int64) // FFI_TYPE_UINT64 + data8 @pcrel(.Lst_int64) // FFI_TYPE_SINT64 + data8 @pcrel(.Lst_void) // FFI_TYPE_STRUCT + data8 @pcrel(.Lst_int64) // FFI_TYPE_POINTER + data8 @pcrel(.Lst_small_struct) // FFI_IA64_TYPE_SMALL_STRUCT + data8 @pcrel(.Lst_hfa_float) // FFI_IA64_TYPE_HFA_FLOAT + data8 @pcrel(.Lst_hfa_double) // FFI_IA64_TYPE_HFA_DOUBLE + data8 @pcrel(.Lst_hfa_ldouble) // FFI_IA64_TYPE_HFA_LDOUBLE + +.Lld_table: + data8 @pcrel(.Lld_void) // FFI_TYPE_VOID + data8 @pcrel(.Lld_int) // FFI_TYPE_INT + data8 @pcrel(.Lld_float) // FFI_TYPE_FLOAT + data8 @pcrel(.Lld_double) // FFI_TYPE_DOUBLE + data8 @pcrel(.Lld_ldouble) // FFI_TYPE_LONGDOUBLE + data8 @pcrel(.Lld_int) // FFI_TYPE_UINT8 + data8 @pcrel(.Lld_int) // FFI_TYPE_SINT8 + data8 @pcrel(.Lld_int) // FFI_TYPE_UINT16 + data8 @pcrel(.Lld_int) // FFI_TYPE_SINT16 + data8 @pcrel(.Lld_int) // FFI_TYPE_UINT32 + data8 @pcrel(.Lld_int) // FFI_TYPE_SINT32 + data8 @pcrel(.Lld_int) // FFI_TYPE_UINT64 + data8 @pcrel(.Lld_int) // FFI_TYPE_SINT64 + data8 @pcrel(.Lld_void) // FFI_TYPE_STRUCT + data8 @pcrel(.Lld_int) // FFI_TYPE_POINTER + data8 @pcrel(.Lld_small_struct) // FFI_IA64_TYPE_SMALL_STRUCT + data8 @pcrel(.Lld_hfa_float) // FFI_IA64_TYPE_HFA_FLOAT + data8 @pcrel(.Lld_hfa_double) // FFI_IA64_TYPE_HFA_DOUBLE + data8 @pcrel(.Lld_hfa_ldouble) // FFI_IA64_TYPE_HFA_LDOUBLE diff -rNu smalltalk-2.3.3/libffi/src/pa/ffitarget.h smalltalk-2.3.4/libffi/src/pa/ffitarget.h --- smalltalk-2.3.3/libffi/src/pa/ffitarget.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/libffi/src/pa/ffitarget.h 2006-02-05 19:41:31.000000000 +0100 @@ -0,0 +1,76 @@ +/* -----------------------------------------------------------------*-C-*- + ffitarget.h - Copyright (c) 1996-2003 Red Hat, Inc. + Target configuration macros for hppa. + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + + ----------------------------------------------------------------------- */ + +#ifndef LIBFFI_TARGET_H +#define LIBFFI_TARGET_H + +/* ---- System specific configurations ----------------------------------- */ + +#ifndef LIBFFI_ASM +typedef unsigned long ffi_arg; +typedef signed long ffi_sarg; + +typedef enum ffi_abi { + FFI_FIRST_ABI = 0, + +#ifdef PA_LINUX + FFI_PA32, + FFI_DEFAULT_ABI = FFI_PA32, +#endif + +#ifdef PA_HPUX + FFI_PA32, + FFI_DEFAULT_ABI = FFI_PA32, +#endif + +#ifdef PA64_HPUX +#error "PA64_HPUX FFI is not yet implemented" + FFI_PA64, + FFI_DEFAULT_ABI = FFI_PA64, +#endif + + FFI_LAST_ABI = FFI_DEFAULT_ABI + 1 +} ffi_abi; +#endif + +/* ---- Definitions for closures ----------------------------------------- */ + +#define FFI_CLOSURES 1 +#define FFI_NATIVE_RAW_API 0 + +#ifdef PA_LINUX +#define FFI_TRAMPOLINE_SIZE 32 +#else +#define FFI_TRAMPOLINE_SIZE 40 +#endif + +#define FFI_TYPE_SMALL_STRUCT2 -1 +#define FFI_TYPE_SMALL_STRUCT3 -2 +#define FFI_TYPE_SMALL_STRUCT4 -3 +#define FFI_TYPE_SMALL_STRUCT5 -4 +#define FFI_TYPE_SMALL_STRUCT6 -5 +#define FFI_TYPE_SMALL_STRUCT7 -6 +#define FFI_TYPE_SMALL_STRUCT8 -7 +#endif diff -rNu smalltalk-2.3.3/libgst/ChangeLog smalltalk-2.3.4/libgst/ChangeLog --- smalltalk-2.3.3/libgst/ChangeLog 2007-01-29 09:24:51.000000000 +0100 +++ smalltalk-2.3.4/libgst/ChangeLog 2007-05-26 14:16:42.000000000 +0200 @@ -1,3 +1,50 @@ +2007-05-26 Paolo Bonzini + + * libgst/lex.c: Pass radix when converting ScaledDecimals like 2r1.1s. + * libgst/sym.c: Change #asScaledDecimal:scale: to + #asScaledDecimal:radix:scale:. + * libgst/sym.h: Likewise. + +2007-05-24 Paolo Bonzini + + * libgst/dict.c: Don't trust {FLT,DBL,LDBL}_DIG. + +2007-05-07 Stephen Compall + + * libgst/sysdep.c: Fix return value of anon_mmap_commit. + +2007-04-18 Paolo Bonzini + + * libgst/md-config.h: Fix spelling of __PIC__. + +2007-04-17 Paolo Bonzini + + * libgst/input.c: More Smalltalk Stream fixes. + +2007-04-17 Paolo Bonzini + + * libgst/input.c: Fix latent bug with Smalltalk Stream parsing. + +2007-04-16 Paolo Bonzini + + * libgst/interp-bc.inl: Fix building on s390. + +2007-04-11 Paolo Bonzini + Thomas Girard + + * libgst/vm.def: Fix pipelining typo. + * libgst/interp-bc.inl: Fix pipelining typo. + +2007-04-11 Paolo Bonzini + Daniele Sciascia + + * libgst/gst-parse.c: Fix parsing when expressions were required + but not found. + +2007-03-28 Paolo Bonzini + + * libgst/lex.c: Fix parsing of #-123. + 2007-01-29 Paolo Bonzini * libgst/prims.def: Use truncl and lrint to implement diff -rNu smalltalk-2.3.3/libgst/Makefile.in smalltalk-2.3.4/libgst/Makefile.in --- smalltalk-2.3.3/libgst/Makefile.in 2007-02-13 17:33:25.000000000 +0100 +++ smalltalk-2.3.4/libgst/Makefile.in 2007-05-28 12:40:09.000000000 +0200 @@ -152,6 +152,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/libgst/dict.c smalltalk-2.3.4/libgst/dict.c --- smalltalk-2.3.3/libgst/dict.c 2006-02-05 19:41:33.000000000 +0100 +++ smalltalk-2.3.4/libgst/dict.c 2007-05-24 14:36:11.000000000 +0200 @@ -1099,7 +1099,7 @@ NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleNaN"), floatd_new ((double) NAN)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleDigits"), - FROM_INT (DBL_DIG)); + FROM_INT (ceil (DBL_MANT_DIG * 0.301029995663981))); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleBinaryDigits"), FROM_INT (DBL_MANT_DIG)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleMinExp"), @@ -1120,7 +1120,7 @@ NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMax"), floate_new (FLT_MAX)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatDigits"), - FROM_INT (FLT_DIG)); + FROM_INT (ceil (FLT_MANT_DIG * 0.301029995663981))); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatBinaryDigits"), FROM_INT (FLT_MANT_DIG)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMinExp"), @@ -1141,7 +1141,7 @@ NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMax"), floatq_new (LDBL_MAX)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleDigits"), - FROM_INT (LDBL_DIG)); + FROM_INT (ceil (LDBL_MANT_DIG * 0.301029995663981))); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleBinaryDigits"), FROM_INT (LDBL_MANT_DIG)); NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMinExp"), diff -rNu smalltalk-2.3.3/libgst/gst-parse.c smalltalk-2.3.4/libgst/gst-parse.c --- smalltalk-2.3.3/libgst/gst-parse.c 2006-02-05 19:41:34.000000000 +0100 +++ smalltalk-2.3.4/libgst/gst-parse.c 2007-04-12 11:39:11.000000000 +0200 @@ -105,6 +105,7 @@ mst_Boolean implied_pipe); static tree_node parse_statements (gst_parser *p, mst_Boolean accept_caret); +static tree_node parse_required_expression (gst_parser *p); static tree_node parse_expression (gst_parser *p, enum expr_kinds kind); static tree_node parse_primary (gst_parser *p); @@ -526,18 +527,14 @@ do { caret = accept_caret && lex_skip_if (p, '^', false); - stmt = parse_expression (p, EXPR_ANY); if (caret) { - if (stmt == NULL) - { - _gst_errorf ("expected statement after '^'"); - recover_error (p); - } + stmt = parse_required_expression (p); stmt = _gst_make_return (&stmt->location, stmt); } else { + stmt = parse_expression (p, EXPR_ANY); if (stmt == NULL) break; } @@ -590,6 +587,17 @@ return node; } +static tree_node +parse_required_expression (gst_parser *p) +{ + tree_node stmt = parse_expression (p, EXPR_ANY); + if (!stmt) + { + _gst_errorf ("expected expression"); + recover_error (p); + } + return stmt; +} /* primary: variable_primary | '(' expression ')' @@ -631,7 +639,7 @@ case '(': lex (p); - node = parse_expression (p, EXPR_ANY); + node = parse_required_expression (p); lex_skip_mandatory (p, ')'); break; diff -rNu smalltalk-2.3.3/libgst/input.c smalltalk-2.3.4/libgst/input.c --- smalltalk-2.3.3/libgst/input.c 2006-02-05 19:41:34.000000000 +0100 +++ smalltalk-2.3.4/libgst/input.c 2007-04-18 02:25:04.000000000 +0200 @@ -554,8 +554,10 @@ /* Copy back to the beginning of the buffer to save memory. TODO: might want to do so at the first overflow instead. */ - size = in_stream->st_oop.end - in_stream->st_oop.ptr + 1; - memmove (in_stream->st_oop.buf, in_stream->st_oop.ptr, size); + size = in_stream->st_oop.end - in_stream->st_oop.ptr; + if (size) + memmove (in_stream->st_oop.buf, in_stream->st_oop.ptr, size); + in_stream->st_oop.buf[size] = 0; in_stream->fileOffset += in_stream->st_oop.ptr - in_stream->st_oop.buf; in_stream->st_oop.ptr = in_stream->st_oop.buf; in_stream->st_oop.end = in_stream->st_oop.buf + size; diff -rNu smalltalk-2.3.3/libgst/interp-bc.inl smalltalk-2.3.4/libgst/interp-bc.inl --- smalltalk-2.3.3/libgst/interp-bc.inl 2006-02-05 19:41:34.000000000 +0100 +++ smalltalk-2.3.4/libgst/interp-bc.inl 2007-04-16 15:38:21.000000000 +0200 @@ -476,11 +476,15 @@ #endif /* !LOCAL_REGS */ #ifdef PIPELINING - gst_uchar b1, arg2, b4; /* pre-fetch queue */ + gst_uchar b2, arg2, b4; /* pre-fetch queue */ void *t2; /* pre-decode queue */ BRANCH_REGISTER (t); #elif REG_AVAILABILITY >= 1 +#ifdef BRANCH_REGISTER BRANCH_REGISTER(prefetch); +#else + void *prefetch; +#endif #endif /* !PIPELINING */ #include "vm.inl" diff -rNu smalltalk-2.3.3/libgst/lex.c smalltalk-2.3.4/libgst/lex.c --- smalltalk-2.3.3/libgst/lex.c 2007-01-29 09:24:06.000000000 +0100 +++ smalltalk-2.3.4/libgst/lex.c 2007-05-26 14:16:10.000000000 +0200 @@ -140,7 +140,14 @@ /* Parse a binary operator. C is the first symbol in the selector */ static int scan_bin_op (int c, - YYSTYPE * lvalp); + YYSTYPE * lvalp); + +/* Actual work for scan_bin_op is done here. MAYBE_NUMBER is false if + we cannot parse a negative number in this context. */ +static int scan_bin_op_1 (int c, + YYSTYPE * lvalp, + mst_Boolean maybe_number); + /* Parse a string literal. C is '\'' */ static int string_literal (int c, @@ -487,7 +494,7 @@ /* We can read a binary operator and return a SYMBOL_LITERAL,... */ if (CHAR_TAB (ic)->char_class & BIN_OP_CHAR) { - scan_bin_op (ic, lvalp); + scan_bin_op_1 (ic, lvalp, false); return SYMBOL_LITERAL; } @@ -519,8 +526,9 @@ int -scan_bin_op (int c, - YYSTYPE *lvalp) +scan_bin_op_1 (int c, + YYSTYPE *lvalp, + mst_Boolean maybe_number) { char buf[3]; int ic; @@ -551,7 +559,7 @@ /* We come here also for a negative number, which we handle specially. */ - if (c == '-' && is_digit (ic)) + if (maybe_number && c == '-' && is_digit (ic)) return (scan_number ('-', lvalp)); buf[1] = 0; @@ -568,6 +576,13 @@ } int +scan_bin_op (int c, + YYSTYPE *lvalp) +{ + return scan_bin_op_1 (c, lvalp, true); +} + +int string_literal (int c, YYSTYPE * lvalp) { @@ -801,8 +816,9 @@ (num * (10 raisedToInteger: exponent) asScaledDecimal: floatExponent) */ lvalp->oval = - _gst_msg_send (numOOP, _gst_as_scaled_decimal_scale_symbol, + _gst_msg_send (numOOP, _gst_as_scaled_decimal_radix_scale_symbol, FROM_INT (exponent), + FROM_INT (base), FROM_INT ((int) floatExponent), NULL); diff -rNu smalltalk-2.3.3/libgst/md-config.h smalltalk-2.3.4/libgst/md-config.h --- smalltalk-2.3.3/libgst/md-config.h 2006-02-05 19:41:34.000000000 +0100 +++ smalltalk-2.3.4/libgst/md-config.h 2007-04-18 13:42:05.000000000 +0200 @@ -57,7 +57,6 @@ # define __DECL_REG1 __asm("$16") # define __DECL_REG2 __asm("$17") # define __DECL_REG3 __asm("$18") -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__DECL_REG1) && defined(__sparc__) @@ -65,7 +64,6 @@ # define __DECL_REG1 __asm("%l0") # define __DECL_REG2 __asm("%l1") # define __DECL_REG3 __asm("%l2") -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__DECL_REG1) && defined(__alpha__) @@ -77,12 +75,10 @@ # define __DECL_REG1 __asm("r9") # define __DECL_REG2 __asm("r10") # define __DECL_REG3 /* __asm("r11") */ -# define BRANCH_REGISTER(name) void *name # else # define __DECL_REG1 __asm("$9") # define __DECL_REG2 __asm("$10") # define __DECL_REG3 /* __asm("$11") */ -# define BRANCH_REGISTER(name) void *name # endif # define L1_CACHE_SHIFT 6 #endif @@ -91,12 +87,11 @@ # define REG_AVAILABILITY 0 # define __DECL_REG1 __asm("%esi") # define __DECL_REG2 __asm("%edi") -# ifdef PIC +# if defined __PIC__ || defined __pic__ # define __DECL_REG3 __asm("%edx") /* Don't conflict with GOT pointer... */ # else # define __DECL_REG3 __asm("%ebx") /* ...but prefer a callee-save reg. */ # endif -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__DECL_REG1) && defined(PPC) || defined(_POWER) || defined(_IBMR2) @@ -104,7 +99,6 @@ # define __DECL_REG1 __asm("26") # define __DECL_REG2 __asm("27") # define __DECL_REG3 __asm("28") -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__DECL_REG1) && defined(__hppa__) @@ -112,7 +106,6 @@ # define __DECL_REG1 __asm("%r16") # define __DECL_REG2 __asm("%r17") # define __DECL_REG3 __asm("%r18") -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__DECL_REG1) && defined(__mc68000__) @@ -122,7 +115,6 @@ # define __DECL_REG1 __asm("a5") # define __DECL_REG2 __asm("a4") # define __DECL_REG3 __asm("d7") -# define BRANCH_REGISTER(name) void *name # define L1_CACHE_SHIFT 4 #endif @@ -157,7 +149,6 @@ #ifndef REG_AVAILABILITY # define REG_AVAILABILITY 1 -# define BRANCH_REGISTER(name) void *name #endif #if !defined(__GNUC__) || !defined(__DECL_REG1) diff -rNu smalltalk-2.3.3/libgst/sym.c smalltalk-2.3.4/libgst/sym.c --- smalltalk-2.3.3/libgst/sym.c 2006-02-05 19:41:35.000000000 +0100 +++ smalltalk-2.3.4/libgst/sym.c 2007-05-26 14:16:57.000000000 +0200 @@ -95,7 +95,7 @@ OOP _gst_and_symbol = NULL; -OOP _gst_as_scaled_decimal_scale_symbol = NULL; +OOP _gst_as_scaled_decimal_radix_scale_symbol = NULL; OOP _gst_at_put_symbol = NULL; OOP _gst_at_symbol = NULL; OOP _gst_at_end_symbol = NULL; @@ -278,7 +278,7 @@ and is used to restore the global variables upon image load. */ static const symbol_info sym_info[] = { {&_gst_and_symbol, "and:"}, - {&_gst_as_scaled_decimal_scale_symbol, "asScaledDecimal:scale:"}, + {&_gst_as_scaled_decimal_radix_scale_symbol, "asScaledDecimal:radix:scale:"}, {&_gst_at_put_symbol, "at:put:"}, {&_gst_at_symbol, "at:"}, {&_gst_at_end_symbol, "atEnd"}, diff -rNu smalltalk-2.3.3/libgst/sym.h smalltalk-2.3.4/libgst/sym.h --- smalltalk-2.3.3/libgst/sym.h 2006-02-05 19:41:35.000000000 +0100 +++ smalltalk-2.3.4/libgst/sym.h 2007-05-26 14:17:01.000000000 +0200 @@ -89,7 +89,7 @@ ATTRIBUTE_HIDDEN; extern OOP _gst_and_symbol ATTRIBUTE_HIDDEN; -extern OOP _gst_as_scaled_decimal_scale_symbol ATTRIBUTE_HIDDEN; +extern OOP _gst_as_scaled_decimal_radix_scale_symbol ATTRIBUTE_HIDDEN; extern OOP _gst_at_put_symbol ATTRIBUTE_HIDDEN; extern OOP _gst_at_symbol ATTRIBUTE_HIDDEN; extern OOP _gst_at_end_symbol ATTRIBUTE_HIDDEN; diff -rNu smalltalk-2.3.3/libgst/sysdep.c smalltalk-2.3.4/libgst/sysdep.c --- smalltalk-2.3.3/libgst/sysdep.c 2006-02-05 19:41:35.000000000 +0100 +++ smalltalk-2.3.4/libgst/sysdep.c 2007-05-07 15:12:04.000000000 +0200 @@ -1658,7 +1658,7 @@ PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_FIXED); - return result; + return UNCOMMON (result == MAP_FAILED) ? NULL : result; } /* This is hairy and a hack. We have to find a place for our heaps... */ diff -rNu smalltalk-2.3.3/libgst/vm.def smalltalk-2.3.4/libgst/vm.def --- smalltalk-2.3.3/libgst/vm.def 2006-02-05 19:41:35.000000000 +0100 +++ smalltalk-2.3.4/libgst/vm.def 2007-04-13 07:19:17.000000000 +0200 @@ -166,7 +166,7 @@ bytecode. GET_ARG holds a pointer to the (possibly prefetched) argument of the next bytecode. */ -#if PIPELINING +#ifdef PIPELINING #define FETCH(v) goto *(t = (v)[*ip], b2 = ip[2], b4 = ip[4], \ arg = ip[1], arg2 = ip[3], t2 = dispatch_vec[b2], \ t) diff -rNu smalltalk-2.3.3/libgst/vm.inl smalltalk-2.3.4/libgst/vm.inl --- smalltalk-2.3.3/libgst/vm.inl 2006-02-05 19:41:35.000000000 +0100 +++ smalltalk-2.3.4/libgst/vm.inl 2007-04-16 15:44:15.000000000 +0200 @@ -81,7 +81,7 @@ } #endif -#if PIPELINING +#ifdef PIPELINING #define FETCH(v) goto *(t = (v)[*ip], b2 = ip[2], b4 = ip[4], \ arg = ip[1], arg2 = ip[3], t2 = dispatch_vec[b2], \ t) diff -rNu smalltalk-2.3.3/lightning/Makefile.in smalltalk-2.3.4/lightning/Makefile.in --- smalltalk-2.3.3/lightning/Makefile.in 2007-02-13 09:25:26.000000000 +0100 +++ smalltalk-2.3.4/lightning/Makefile.in 2007-05-28 12:40:10.000000000 +0200 @@ -111,6 +111,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/numerics/NumericsAdds.st smalltalk-2.3.4/numerics/NumericsAdds.st --- smalltalk-2.3.3/numerics/NumericsAdds.st 2006-02-05 19:41:36.000000000 +0100 +++ smalltalk-2.3.4/numerics/NumericsAdds.st 2007-05-24 22:11:47.000000000 +0200 @@ -35,11 +35,11 @@ !Smalltalk.Number class methodsFor: 'numerics'! random - "Answers a random number between 0 and the receiver + "Answers a random number between 0 and 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " - ^Dhb.DhbMitchellMooreGenerator new floatValue * self! ! + ^Dhb.DhbMitchellMooreGenerator new floatValue! ! !Smalltalk.Number methodsFor: 'numerics'! @@ -205,7 +205,7 @@ asVector ^(Dhb.DhbVector new: self size) - replaceElementsFrom: 1 to: self size withArray: self startingAt: 1 + replaceFrom: 1 to: self size with: self startingAt: 1 ! ! !Dhb.DhbPolynomial methodsFor: 'numerics'! diff -rNu smalltalk-2.3.3/numerics/NumericsTests.st smalltalk-2.3.4/numerics/NumericsTests.st --- smalltalk-2.3.3/numerics/NumericsTests.st 2006-02-05 19:41:36.000000000 +0100 +++ smalltalk-2.3.4/numerics/NumericsTests.st 2007-05-24 22:11:47.000000000 +0200 @@ -23,7 +23,7 @@ !DhbTestCase methodsFor: 'logging'! -logPolicy +defaultLogPolicyClass ^TestVerboseLog ! ! diff -rNu smalltalk-2.3.3/opcode/Makefile.in smalltalk-2.3.4/opcode/Makefile.in --- smalltalk-2.3.3/opcode/Makefile.in 2007-02-13 09:25:26.000000000 +0100 +++ smalltalk-2.3.4/opcode/Makefile.in 2007-05-28 12:40:10.000000000 +0200 @@ -111,6 +111,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/packages.xml smalltalk-2.3.4/packages.xml --- smalltalk-2.3.3/packages.xml 2007-02-13 17:33:36.000000000 +0100 +++ smalltalk-2.3.4/packages.xml 2007-05-28 12:43:05.000000000 +0200 @@ -1,4 +1,4 @@ - + @@ -239,7 +239,10 @@ DhbNumericalMethods Dhb + + Dhb.DhbTestCase* SUnit + Basic.st Statistics.st RNG.st @@ -268,13 +271,18 @@ GDBM + GDBMTest + SUnit + gdbm-c.st gdbm.st + gdbmtests.st gdbm examples gdbm.st gdbm-c.st + gdbmtests.st @@ -287,12 +295,33 @@ + ZLib + ZlibStreamTest + SUnit + + PipeStream.st + zlib.st + zlibtests.st + zlib + examples + + PipeStream.st + zlib.st + zlibtests.st + + + MD5 + MD5Test + SUnit + md5.st + md5tests.st md5 examples md5.st + md5tests.st @@ -350,12 +379,16 @@ Parser + STInST.Tests.TestStandardRewrites + SUnit + STInST RBToken.st RBParseNodes.st RBParser.st ParseTreeSearcher.st RBFormatter.st + OrderedSet.st STCompLit.st STSymTable.st STCompiler.st @@ -363,6 +396,8 @@ STLoaderObjs.st STLoader.st + RewriteTests.st + compiler ParseTreeSearcher.st @@ -370,12 +405,14 @@ RBParseNodes.st RBParser.st RBToken.st + OrderedSet.st STCompLit.st STCompiler.st STDecompiler.st STLoader.st STLoaderObjs.st STSymTable.st + RewriteTests.st @@ -385,6 +422,9 @@ SUnit + SUnitTest + TestSuitesScriptTest + SUnitPreload.st SUnit.st SUnitTests.st @@ -561,6 +601,7 @@ bug.st bug2.st bug4.st + echo.st er2.st market.st resolve.st @@ -569,10 +610,20 @@ torture.st + + Continuations + AmbTest + SUnit + + Continuations.st + + examples + Continuations.st + + Examples examples - Continuations.st Debugger.st LazyCollection.st Man.st diff -rNu smalltalk-2.3.3/packages.xml.in smalltalk-2.3.4/packages.xml.in --- smalltalk-2.3.3/packages.xml.in 2006-12-13 08:58:45.000000000 +0100 +++ smalltalk-2.3.4/packages.xml.in 2007-05-25 11:46:23.000000000 +0200 @@ -239,7 +239,10 @@ DhbNumericalMethods Dhb + + Dhb.DhbTestCase* SUnit + Basic.st Statistics.st RNG.st @@ -268,13 +271,18 @@ GDBM + GDBMTest + SUnit + gdbm-c.st gdbm.st + gdbmtests.st gdbm examples gdbm.st gdbm-c.st + gdbmtests.st <@NCURSES_DISABLED@package> @@ -287,12 +295,33 @@ + ZLib + ZlibStreamTest + SUnit + + PipeStream.st + zlib.st + zlibtests.st + zlib + examples + + PipeStream.st + zlib.st + zlibtests.st + + + MD5 + MD5Test + SUnit + md5.st + md5tests.st md5 examples md5.st + md5tests.st @@ -350,12 +379,16 @@ Parser + STInST.Tests.TestStandardRewrites + SUnit + STInST RBToken.st RBParseNodes.st RBParser.st ParseTreeSearcher.st RBFormatter.st + OrderedSet.st STCompLit.st STSymTable.st STCompiler.st @@ -363,6 +396,8 @@ STLoaderObjs.st STLoader.st + RewriteTests.st + compiler ParseTreeSearcher.st @@ -370,12 +405,14 @@ RBParseNodes.st RBParser.st RBToken.st + OrderedSet.st STCompLit.st STCompiler.st STDecompiler.st STLoader.st STLoaderObjs.st STSymTable.st + RewriteTests.st @@ -385,6 +422,9 @@ SUnit + SUnitTest + TestSuitesScriptTest + SUnitPreload.st SUnit.st SUnitTests.st @@ -561,6 +601,7 @@ bug.st bug2.st bug4.st + echo.st er2.st market.st resolve.st @@ -569,10 +610,20 @@ torture.st + + Continuations + AmbTest + SUnit + + Continuations.st + + examples + Continuations.st + + Examples examples - Continuations.st Debugger.st LazyCollection.st Man.st diff -rNu smalltalk-2.3.3/scripts/Finish.st smalltalk-2.3.4/scripts/Finish.st --- smalltalk-2.3.3/scripts/Finish.st 2007-02-13 09:21:55.000000000 +0100 +++ smalltalk-2.3.4/scripts/Finish.st 2007-03-09 14:08:38.000000000 +0100 @@ -43,11 +43,12 @@ "Remove DESTDIR and references to the build directory, from the paths stored in the image" -| newImagePath newKernelBasePath | +| newImagePath oldKernelBasePath newKernelBasePath | +oldKernelBasePath := File pathFor: KernelFilePath. newKernelBasePath := Smalltalk arguments at: 1. newImagePath := Smalltalk arguments at: 2. -KernelFilePath = newKernelBasePath - ifFalse: [ FileSegment relocateFrom: KernelFilePath to: newKernelBasePath ]. +oldKernelBasePath = newKernelBasePath ifFalse: [ + FileSegment relocateFrom: oldKernelBasePath to: newKernelBasePath ]. ImageFileName := 'gst.im'. ImageFilePath := newImagePath. diff -rNu smalltalk-2.3.3/scripts/Load.st smalltalk-2.3.4/scripts/Load.st --- smalltalk-2.3.3/scripts/Load.st 2006-02-05 19:41:36.000000000 +0100 +++ smalltalk-2.3.4/scripts/Load.st 2007-05-24 22:10:22.000000000 +0200 @@ -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 ]! diff -rNu smalltalk-2.3.3/scripts/Reload.st smalltalk-2.3.4/scripts/Reload.st --- smalltalk-2.3.3/scripts/Reload.st 2006-02-05 19:41:36.000000000 +0100 +++ smalltalk-2.3.4/scripts/Reload.st 1970-01-01 01:00:00.000000000 +0100 @@ -1,45 +0,0 @@ -#! @bindir@/gst -f - -"====================================================================== -| -| Smalltalk package loader (utility script) -| -| - ======================================================================" - - -"====================================================================== -| -| Copyright 1999, 2000, 2002, 2004 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. -| - ======================================================================" - -| ok verbose | -ok := false. -verbose := FileStream verbose: true. -[ - Smalltalk arguments do: [ :each | Smalltalk removeFeature: each asSymbol ]. - PackageLoader fileInPackages: Smalltalk arguments. - ok := true -] valueWithUnwind. -FileStream verbose: verbose. - -ok ifFalse: [ ObjectMemory quit: 1 ]! -ObjectMemory snapshot! - diff -rNu smalltalk-2.3.3/scripts/Test.st smalltalk-2.3.4/scripts/Test.st --- smalltalk-2.3.3/scripts/Test.st 2006-02-05 19:41:36.000000000 +0100 +++ smalltalk-2.3.4/scripts/Test.st 2007-05-28 12:27:33.000000000 +0200 @@ -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,102 @@ | ======================================================================" -(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 ]! + +FileStream verbose: false. +OutputVerbosity := 0. +PackageLoader fileInPackage: #SUnit. +OutputVerbosity := 1! + +| 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. 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: [ + stdout nextPutAll: 'Errors:'; nl. + (result errors asSortedCollection: [ :a :b | a printString <= b printString ]) + do: [ :each | stdout nextPutAll: ' '; print: each; nl ] ]. + + result failureCount > 0 ifTrue: [ + stdout nextPutAll: 'Failures:'; nl. + (result failures asSortedCollection: [ :a :b | a printString <= b printString ]) + do: [ :each | stdout nextPutAll: ' '; print: each; nl ] ] ]. -result runCount = result passedCount ifFalse: [ - ObjectMemory quit: 1 ]! +result runCount = result passedCount + ifFalse: [ ObjectMemory quit: 1 ]! diff -rNu smalltalk-2.3.3/scripts/gst-reload.sh smalltalk-2.3.4/scripts/gst-reload.sh --- smalltalk-2.3.3/scripts/gst-reload.sh 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/scripts/gst-reload.sh 2007-05-24 22:10:21.000000000 +0200 @@ -0,0 +1,3 @@ +#! /bin/sh + +@bindir@/gst-load --force ${1+"$@"} diff -rNu smalltalk-2.3.3/sigsegv/COPYING smalltalk-2.3.4/sigsegv/COPYING --- smalltalk-2.3.3/sigsegv/COPYING 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/COPYING 2007-05-12 12:01:45.000000000 +0200 @@ -2,8 +2,8 @@ Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, - USA. + 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -306,7 +306,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. diff -rNu smalltalk-2.3.3/sigsegv/ChangeLog smalltalk-2.3.4/sigsegv/ChangeLog --- smalltalk-2.3.3/sigsegv/ChangeLog 2007-02-06 17:30:47.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/ChangeLog 2007-05-12 12:01:45.000000000 +0200 @@ -1,29 +1,250 @@ -2007-02-06 Paolo Bonzini +2006-06-23 Bruno Haible - * configure.ac: Remove AM_DISABLE_SHARED. + * Version 2.4 released. -2006-10-16 Roman Zippel - Paolo Bonzini +2006-06-23 Bruno Haible - * configure.ac: m68k ugly code to get fault address, is not that ugly. - Plus, add cross compilation defaults. - * src/handler-win32.c: Merge from upstream. - -2003-12-19 Paolo Bonzini - - * configure.in: Save results of heuristics detection - in CFG_HEURISTICS. - * src/heur-none.h: New file. - * src/heur-ab.h: New file. - * src/heur-ac.h: New file. - * src/heur-bc.h: New file. - * src/handler-macos.c (mach_initialize): Argh, had to - reintroduce signal (xxx, SIG_IGN). Also, use - heuristics.h. - * src/handler-unix.c (sigsegv_handler): Replace - most ugly code with usage of heuristics.h. - * src/stackvma-mach.c (sigsegv_get_vma): Add - debugging printf. + * configure.ac: Bump version number to 2.4. + * src/sigsegv.h.in (LIBSIGSEGV_VERSION): Likewise. + +2006-06-17 Bruno Haible + + * src/Makefile.am (noinst_HEADERS): Add fault-netbsd.h. + +2006-06-17 Bruno Haible + + * sigaltstack.m4: Insert 'volatile' and pass a pointer, to defeat + GCC 4 optimizations. + * sigaltstack-longjmp.m4: Likewise. + * sigaltstack-siglongjmp.m4: Likewise. + +2006-06-17 Bruno Haible + + * tests/stackoverflow1.c (recurse): Remove useless cast. + * tests/stackoverflow2.c (recurse): Likewise. + +2006-06-17 Bruno Haible + + * src/stackvma-freebsd.c (sigsegv_get_vma): Test whether mincore() + works as expected before using it. + +2006-03-28 Ralf Wildenhues + + * m4/libtool.m4 (_LT_SYS_DYNAMIC_LINKER) [ linux ]: Avoid warning when + "parsing" /etc/ld.so.conf and empty /etc/ld.so.conf.d. + +2006-06-13 Bruno Haible + + Make NetBSD/i386 stack overflow detection work even without mincore. + * src/fault-netbsd.h: New file. + * configure.ac (CFG_FAULT): Choose it when appropriate. + +2006-05-16 Bruno Haible + + Don't allow the compiler to reorder instructions in the tests. + * tests/sigsegv1.c (crashes): Use volatile in pointer access. + * tests/sigsegv2.c (main): Likewise. + * tests/stackoverflow2.c (main): Likewise. + +2006-05-14 Bruno Haible + + Exploit the mincore() system call where available. + * src/stackvma-mincore.c: New file. + * src/Makefile.am (EXTRA_DIST): Add it. + * src/stackvma.h: Add double-inclusion guard. + * src/stackvma-freebsd.c: If mincore() is available, include also + stackvma-mincore.c. + (sigsegv_get_vma): If mincore() is available, use it as fallback. + * src/stackvma-linux.c: If mincore() is available, include also + stackvma-mincore.c. + (sigsegv_get_vma): If mincore() is available, use it as fallback. + * src/stackvma-procfs.c: If mincore() is available, include also + stackvma-mincore.c. + (sigsegv_get_vma): If mincore() is available, use it as fallback. + * configure.ac: Test for mincore. + (CFG_STACKVMA): Set to stackvma-mincore.c if nothing else is available. + +2006-05-14 Bruno Haible + + * src/stackvma-simple.c: New file, extracted from handler-unix.c. + * src/Makefile.am (EXTRA_DIST): Add it. + * src/stackvma-beos.c: Include stackvma-simple.c. + (sigsegv_get_vma): Fill the vma's is_near_this field. + * src/stackvma-freebsd.c: Include stackvma-simple.c. + (sigsegv_get_vma): Fill the vma's is_near_this field. + * src/stackvma-linux.c: Include stackvma-simple.c. + (sigsegv_get_vma): Fill the vma's is_near_this field. + * src/stackvma-mach.c: Include stackvma-simple.c. + (sigsegv_get_vma): Fill the vma's is_near_this field. + * src/stackvma-procfs.c: Include stackvma-simple.c. + (sigsegv_get_vma): Fill the vma's is_near_this field. + * src/stackvma.h (vma_struct): Add is_near_this field. + * src/handler-unix.c (sigsegv_handler): Use the vma's is_near_this + function. + +2006-04-28 Bruno Haible + + * Version 2.3 released. + +2006-04-28 Bruno Haible + + * configure.ac: Bump version number to 2.3. + * src/sigsegv.h.in (LIBSIGSEGV_VERSION): Likewise. + + * build-aux/config.guess, build-aux/config.sub: Update to GNU version + 2006-04-26. + + * build-aux/install-sh: Update from automake-1.9.6. + * build-aux/missing: Likewise. + + * build-aux/ltmain.sh: Update from libtool-1.5.22. + * m4/libtool.m4: Likewise. + +2006-04-28 Bruno Haible + + * build-aux: Renamed from autoconf. + * configure.ac (AC_CONFIG_AUX_DIR): Set to build-aux. + +2006-04-22 Bruno Haible + + * configure.ac: Renamed from configure.in. + +2006-04-21 Bruno Haible + + * src/machfault-macos-i386.h: Rewritten for Darwin 8.6.1. + * configure.in: Change FAULT_CONTEXT for i?86-darwin. + +2005-06-21 Paolo Bonzini + + * configure.in: For handler-macos.c, include mach/thread_status.h. + * configure: Regenerate. + +2005-06-21 Paolo Bonzini + + * tests/stackoverflow1.c (recurse): Make more resilient to compiler + optimization. + (recurse_1): New. + * tests/stackoverflow2.c: Likewise. + +2005-05-24 Bruno Haible + + * src/handler-win32.c (main_exception_filter): Copy CONTEXT structure + to safe area on the stack. + Based on patch by Doug Currie . + + * src/handler-win32.c (main_exception_filter): Swap arguments passed + to stack_overflow_handler. + Patch by Doug Currie . + + * src/handler-win32.c (main_exception_filter): Align %esp on a 16-byte + boundary. + +2005-03-02 Bruno Haible + + * Version 2.2 released. + +2005-03-02 Bruno Haible + + * autoconf/config.guess: Update. + * autoconf/config.sub: Update. + * autoconf/missing: Update from automake-1.9.5. + + * m4/libtool.m4: Upgrade to libtool-1.5.14 with gettext modifications. + * autoconf/ltmain.sh: Likewise. + +2005-03-02 Bruno Haible + + * src/fault-aix5.h: New file. + * src/fault-aix5-powerpc.h: New file. + * src/Makefile.am (noinst_HEADERS): Add them. + * configure.in: Choose them when the POSIX test succeeds on AIX. + + * src/fault-aix3-powerpc.h: Renamed from src/fault-aix-powerpc.h. + * src/fault-aix3.h: Renamed from src/fault-aix.h. + * src/Makefile.am (noinst_HEADERS): Update. + * configure.in: Update. When cross-compiling, assume the AIX test + succeeds only on AIX 3 and AIX 4. + +2005-03-01 Bruno Haible + + * configure.in: Fix test of CFG_MACHFAULT. + +2005-02-27 Bruno Haible + + * configure.in: Skip tests that are not needed on MacOS X >= 10.2. + * m4/sigaltstack.m4 (SV_SIGALTSTACK): Don't perform the test on + MacOS X >= 10.2. + +2005-02-18 Bruno Haible + + * tests/sigsegv1.c (handler_called): Declare as volatile. + * tests/sigsegv2.c (logcount, logdata): Likewise. + * tests/stackoverflow1.c (pass): Likewise. + * tests/stackoverflow2.c (pass): Likewise. + +2005-01-29 Bruno Haible + + * src/sigsegv.h.in (LIBSIGSEGV_VERSION): New macro. + (libsigsegv_version): New declaration. + * src/version.c: New file. + * src/Makefile.am (libsigsegv_la_SOURCES): Add version.c. + * Makefile.msvc (OBJECTS): Add version.obj. + (version.obj): New rule. + Suggested by Sam Steingold. + +2004-08-25 Bruno Haible + + * m4/libtool.m4: Upgrade to libtool-1.5.6. + * autoconf/ltmain.sh: Upgrade to libtool-1.5.6. + +2004-08-18 Bruno Haible + + * configure.in: Bump version number to 2.2. + +2004-08-17 Bruno Haible + + Finish the Mach-based MacOS X support. + * src/handler-macos.c: Don't include mach/vm_map.h. + Include machfault.h instead of fault.h. + (save_exc_state): Remove variable. + (save_thread_state): New variable. + (terminating_handler): New function. + (altstack_handler): Pass the save_thread_state, not the save_exc_state, + to the user's handler. + (catch_exception_raise): Make it work also for platforms which don't + have an exc_state type. Call SIGSEGV_FAULT_ADDRESS with 2 arguments. + Don't clobber the exc_state; instead set the thread's program counter + to terminating_handler or altstack_handler, depending on the case. + Return KERN_SUCCESS at the end. + * src/machfault.h: New file. + * src/machfault-macos-powerpc.h (SIGSEGV_FAULT_ADDRESS): Add a second + argument. + * src/machfault-macos-i386.h: New file. + * src/Makefile.am (EXTRA_DIST): Add handler-macos.c. + (NOINST_HEADERS): Add machfault.h, machfault-macos-i386.h, + machfault-macos-powerpc.h. + * configure.in (CFG_HANDLER): Initialize to empty. + (CFG_MACHFAULT): New substituted variable. + On MacOS X PowerPC+i386, use CFG_HANDLER=handler-macos.c + unconditionally. + (sv_cv_fault_include, sv_cv_have_stack_overflow_recovery): Set + correctly also in the handler-macos.c case. + +2004-08-16 Bruno Haible + + Support for MacOS X 10.3 on PowerPC. + * src/fault-macosdarwin5-powerpc.h: Renamed from + src/fault-macos-powerpc.h. + * src/fault-macosdarwin5-powerpc.c: Renamed from + src/fault-macos-powerpc.c. + * src/fault-macosdarwin7-powerpc.h: New file. + * src/fault-macosdarwin7-powerpc.c: New file. + * src/Makefile.am (noinst_HEADERS): Update. + * configure.in: Test the method for MacOSX/Darwin5 PowerPC only after + the method for MacOSX/Darwin7 PowerPC failed. + Substitute FAULT_CONTEXT_INCLUDE2. + * src/sigsegv.h.in: Insert @FAULT_CONTEXT_INCLUDE2@. + * src/Makefile.am (sigsegv.h.msvc): Replace @FAULT_CONTEXT_INCLUDE2@. 2003-12-09 Paolo Bonzini diff -rNu smalltalk-2.3.3/sigsegv/INSTALL smalltalk-2.3.4/sigsegv/INSTALL --- smalltalk-2.3.3/sigsegv/INSTALL 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/INSTALL 2007-05-12 12:01:45.000000000 +0200 @@ -1,43 +1,27 @@ -Installation Instructions -************************* - -Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005 Free -Software Foundation, Inc. - -This file is free documentation; the Free Software Foundation gives -unlimited permission to copy, distribute and modify it. - Basic Installation ================== -These are generic installation instructions. + These are generic installation instructions. The `configure' shell script attempts to guess correct values for various system-dependent variables used during compilation. It uses those values to create a `Makefile' in each directory of the package. It may also create one or more `.h' files containing system-dependent definitions. Finally, it creates a shell script `config.status' that -you can run in the future to recreate the current configuration, and a -file `config.log' containing compiler output (useful mainly for -debugging `configure'). - - It can also use an optional file (typically called `config.cache' -and enabled with `--cache-file=config.cache' or simply `-C') that saves -the results of its tests to speed up reconfiguring. (Caching is -disabled by default to prevent problems with accidental use of stale -cache files.) +you can run in the future to recreate the current configuration, a file +`config.cache' that saves the results of its tests to speed up +reconfiguring, and a file `config.log' containing compiler output +(useful mainly for debugging `configure'). If you need to do unusual things to compile the package, please try to figure out how `configure' could check whether to do them, and mail diffs or instructions to the address given in the `README' so they can -be considered for the next release. If you are using the cache, and at -some point `config.cache' contains results you don't want to keep, you -may remove or edit it. - - The file `configure.ac' (or `configure.in') is used to create -`configure' by a program called `autoconf'. You only need -`configure.ac' if you want to change it or regenerate `configure' using -a newer version of `autoconf'. +be considered for the next release. If at some point `config.cache' +contains results you don't want to keep, you may remove or edit it. + + The file `configure.in' is used to create `configure' by a program +called `autoconf'. You only need `configure.in' if you want to change +it or regenerate `configure' using a newer version of `autoconf'. The simplest way to compile this package is: @@ -70,22 +54,20 @@ Compilers and Options ===================== -Some systems require unusual options for compilation or linking that the -`configure' script does not know about. Run `./configure --help' for -details on some of the pertinent environment variables. - - You can give `configure' initial values for configuration parameters -by setting variables in the command line or in the environment. Here -is an example: + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. You can give `configure' +initial values for variables by setting them in the environment. Using +a Bourne-compatible shell, you can do that on the command line like +this: + CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure - ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix - - *Note Defining Variables::, for more details. +Or on systems that have the `env' program, you can do it like this: + env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure Compiling For Multiple Architectures ==================================== -You can compile the package for more than one kind of computer at the + You can compile the package for more than one kind of computer at the same time, by placing the object files for each architecture in their own directory. To do this, you must use a version of `make' that supports the `VPATH' variable, such as GNU `make'. `cd' to the @@ -93,28 +75,28 @@ the `configure' script. `configure' automatically checks for the source code in the directory that `configure' is in and in `..'. - If you have to use a `make' that does not support the `VPATH' -variable, you have to compile the package for one architecture at a -time in the source code directory. After you have installed the -package for one architecture, use `make distclean' before reconfiguring -for another architecture. + If you have to use a `make' that does not supports the `VPATH' +variable, you have to compile the package for one architecture at a time +in the source code directory. After you have installed the package for +one architecture, use `make distclean' before reconfiguring for another +architecture. Installation Names ================== -By default, `make install' installs the package's commands under -`/usr/local/bin', include files under `/usr/local/include', etc. You -can specify an installation prefix other than `/usr/local' by giving -`configure' the option `--prefix=PREFIX'. + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. You can specify separate installation prefixes for architecture-specific files and architecture-independent files. If you -pass the option `--exec-prefix=PREFIX' to `configure', the package uses -PREFIX as the prefix for installing programs and libraries. -Documentation and other data files still use the regular prefix. +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. In addition, if you use an unusual directory layout you can give -options like `--bindir=DIR' to specify different values for particular +options like `--bindir=PATH' to specify different values for particular kinds of files. Run `configure --help' for a list of the directories you can set and what kinds of files go in them. @@ -125,7 +107,7 @@ Optional Features ================= -Some packages pay attention to `--enable-FEATURE' options to + Some packages pay attention to `--enable-FEATURE' options to `configure', where FEATURE indicates an optional part of the package. They may also pay attention to `--with-PACKAGE' options, where PACKAGE is something like `gnu-as' or `x' (for the X Window System). The @@ -137,89 +119,75 @@ you can use the `configure' options `--x-includes=DIR' and `--x-libraries=DIR' to specify their locations. -Specifying the System Type -========================== + For packages that use the GNU libiconv library, you can use the +`configure' option `--with-libiconv-prefix' to specify the prefix you +used while installing libiconv. -There may be some features `configure' cannot figure out automatically, -but needs to determine by the type of machine the package will run on. -Usually, assuming the package is built to be run on the _same_ -architectures, `configure' can figure that out, but if it prints a -message saying it cannot guess the machine type, give it the -`--build=TYPE' option. TYPE can either be a short name for the system -type, such as `sun4', or a canonical name which has the form: +Particular Systems +================== - CPU-COMPANY-SYSTEM + On HP-UX, the default C compiler is not ANSI C compatible. If GNU CC +is not installed, it is recommended to use the following options in order +to use an ANSI C compiler: + + env CC="cc -Ae" ./configure + + On AIX 3, the C include files by default don't define some necessary +prototype declarations. If GNU CC is not installed, it is recommended to +use the following options: + + env CC="xlc -D_ALL_SOURCE" ./configure -where SYSTEM can have one of these forms: + On BeOS, user installed software goes in /boot/home/config, not +/usr/local. It is recommended to use the following options: + + ./configure --prefix=/boot/home/config + +Specifying the System Type +========================== - OS KERNEL-OS + There may be some features `configure' can not figure out +automatically, but needs to determine by the type of host the package +will run on. Usually `configure' can figure that out, but if it prints +a message saying it can not guess the host type, give it the +`--host=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name with three fields: + CPU-COMPANY-SYSTEM - See the file `config.sub' for the possible values of each field. If +See the file `config.sub' for the possible values of each field. If `config.sub' isn't included in this package, then this package doesn't -need to know the machine type. +need to know the host type. - If you are _building_ compiler tools for cross-compiling, you should -use the option `--target=TYPE' to select the type of system they will -produce code for. - - If you want to _use_ a cross compiler, that generates code for a -platform different from the build platform, you should specify the -"host" platform (i.e., that on which the generated programs will -eventually be run) with `--host=TYPE'. + If you are building compiler tools for cross-compiling, you can also +use the `--target=TYPE' option to select the type of system they will +produce code for and the `--build=TYPE' option to select the type of +system on which you are compiling the package. Sharing Defaults ================ -If you want to set default values for `configure' scripts to share, you -can create a site shell script called `config.site' that gives default -values for variables like `CC', `cache_file', and `prefix'. + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. `configure' looks for `PREFIX/share/config.site' if it exists, then `PREFIX/etc/config.site' if it exists. Or, you can set the `CONFIG_SITE' environment variable to the location of the site script. A warning: not all `configure' scripts look for a site script. -Defining Variables +Operation Controls ================== -Variables not defined in a site shell script can be set in the -environment passed to `configure'. However, some packages may run -configure again during the build, and the customized values of these -variables may be lost. In order to avoid this problem, you should set -them in the `configure' command line, using `VAR=value'. For example: - - ./configure CC=/usr/local2/bin/gcc - -causes the specified `gcc' to be used as the C compiler (unless it is -overridden in the site shell script). Here is a another example: - - /bin/bash ./configure CONFIG_SHELL=/bin/bash - -Here the `CONFIG_SHELL=/bin/bash' operand causes subsequent -configuration-related scripts to be executed by `/bin/bash'. + `configure' recognizes the following options to control how it +operates. -`configure' Invocation -====================== - -`configure' recognizes the following options to control how it operates. +`--cache-file=FILE' + Use and save the results of the tests in FILE instead of + `./config.cache'. Set FILE to `/dev/null' to disable caching, for + debugging `configure'. `--help' -`-h' Print a summary of the options to `configure', and exit. -`--version' -`-V' - Print the version of Autoconf used to generate the `configure' - script, and exit. - -`--cache-file=FILE' - Enable the cache: use and save the results of the tests in FILE, - traditionally `config.cache'. FILE defaults to `/dev/null' to - disable caching. - -`--config-cache' -`-C' - Alias for `--cache-file=config.cache'. - `--quiet' `--silent' `-q' @@ -231,6 +199,9 @@ Look for the package's source code in directory DIR. Usually `configure' can determine that directory automatically. -`configure' also accepts some other, not widely useful, options. Run -`configure --help' for more details. +`--version' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`configure' also accepts some other, not widely useful, options. diff -rNu smalltalk-2.3.3/sigsegv/Makefile.am smalltalk-2.3.4/sigsegv/Makefile.am --- smalltalk-2.3.3/sigsegv/Makefile.am 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/Makefile.am 2007-05-12 12:01:45.000000000 +0200 @@ -13,7 +13,8 @@ ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software -## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +## USA. ## Process this file with automake to produce Makefile.in. @@ -71,4 +72,4 @@ # Rules for "make dist". $(srcdir)/config.h.msvc : config.h.in - $(SED) -e 's/#undef CFG_HANDLER/#define CFG_HANDLER "handler-win32.c"/' < $(srcdir)/config.h.in > $@ + sed -e 's/#undef CFG_HANDLER/#define CFG_HANDLER "handler-win32.c"/' < $(srcdir)/config.h.in > $@ diff -rNu smalltalk-2.3.3/sigsegv/Makefile.in smalltalk-2.3.4/sigsegv/Makefile.in --- smalltalk-2.3.3/sigsegv/Makefile.in 2007-02-13 09:27:22.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/Makefile.in 2007-05-12 12:11:34.000000000 +0200 @@ -104,11 +104,8 @@ AWK = @AWK@ CC = @CC@ CCDEPMODE = @CCDEPMODE@ -CFG_FAULT = @CFG_FAULT@ CFG_HANDLER = @CFG_HANDLER@ -CFG_HEURISTICS = @CFG_HEURISTICS@ CFG_LEAVE = @CFG_LEAVE@ -CFG_SIGNALS = @CFG_SIGNALS@ CFG_STACKVMA = @CFG_STACKVMA@ CFLAGS = @CFLAGS@ CPP = @CPP@ @@ -124,6 +121,7 @@ EXEEXT = @EXEEXT@ FAULT_CONTEXT = @FAULT_CONTEXT@ FAULT_CONTEXT_INCLUDE = @FAULT_CONTEXT_INCLUDE@ +FAULT_CONTEXT_INCLUDE2 = @FAULT_CONTEXT_INCLUDE2@ GREP = @GREP@ HAVE_SIGSEGV_RECOVERY = @HAVE_SIGSEGV_RECOVERY@ HAVE_STACK_OVERFLOW_RECOVERY = @HAVE_STACK_OVERFLOW_RECOVERY@ @@ -684,7 +682,7 @@ # Rules for "make dist". $(srcdir)/config.h.msvc : config.h.in - $(SED) -e 's/#undef CFG_HANDLER/#define CFG_HANDLER "handler-win32.c"/' < $(srcdir)/config.h.in > $@ + sed -e 's/#undef CFG_HANDLER/#define CFG_HANDLER "handler-win32.c"/' < $(srcdir)/config.h.in > $@ # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: diff -rNu smalltalk-2.3.3/sigsegv/Makefile.msvc smalltalk-2.3.4/sigsegv/Makefile.msvc --- smalltalk-2.3.3/sigsegv/Makefile.msvc 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/Makefile.msvc 2007-05-12 12:01:45.000000000 +0200 @@ -61,7 +61,7 @@ SHELL = /bin/sh -OBJECTS = handler.obj dispatcher.obj +OBJECTS = handler.obj dispatcher.obj version.obj all : sigsegv.lib @@ -77,6 +77,9 @@ dispatcher.obj : $(srcdir)/src/dispatcher.c sigsegv.h config.h $(CC) $(CFLAGS) $(INCLUDES) -c $(srcdir)/src/dispatcher.c +version.obj : $(srcdir)/src/version.c sigsegv.h + $(CC) $(CFLAGS) $(INCLUDES) -c $(srcdir)/src/version.c + !if !$(DLL) sigsegv.lib : $(OBJECTS) $(RM) sigsegv.lib diff -rNu smalltalk-2.3.3/sigsegv/NEWS smalltalk-2.3.4/sigsegv/NEWS --- smalltalk-2.3.3/sigsegv/NEWS 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/NEWS 2007-05-12 12:01:45.000000000 +0200 @@ -1,7 +1,21 @@ -New in 2.2: +New in 2.4: + +* Support for GCC 4 on more platforms. +* Added support for catching stack overflow on NetBSD. +* Improved support for catching stack overflow on Linux, Solaris: + Works also when /proc is not mounted or lacks read permissions. + +New in 2.3: -* Support for Mach contributed by Paolo Bonzini. +* Support for GCC 4 on some platforms contributed by Paolo Bonzini. +* Support for MacOS X i386 contributed by Bruno Haible. +* Improved support for Woe32 contributed by Doug Currie. + +New in 2.2: +* Support for new versions of MacOS X contributed by Paolo Bonzini. +* Improved support for AIX 5, contributed by Bruno Haible. + New in 2.1: * Support for MacOS X contributed by Paolo Bonzini. diff -rNu smalltalk-2.3.3/sigsegv/PORTING smalltalk-2.3.4/sigsegv/PORTING --- smalltalk-2.3.3/sigsegv/PORTING 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/PORTING 2007-05-12 12:01:45.000000000 +0200 @@ -4,33 +4,46 @@ __PLATFORM__________________________________SIGSEGV__STACK_OVERFLOW__VERSION___ | | | alpha-dec-osf4.0d | yes | yes | 2.1 -alpha-dec-osf4.0f | yes | yes | 2.0 +alpha-dec-osf4.0f | yes | yes | 2.1 +alphaev56-dec-osf4.0f | yes | yes | 2.3 alpha-dec-osf4.0g | yes | yes | 2.1 alpha-dec-osf5.1 | yes | yes | 2.1 +alphaev67-dec-osf5.1 | yes | yes | 2.2 alpha-unknown-freebsd4.8 | yes | yes | 2.1 +alpha-portbld-freebsd5.5 | yes | yes | 2.3 alphaev67-unknown-linux2.4.17-gnu-glibc2.1 | yes | yes | 1.95 alphaev6-unknown-linux2.2.19-gnu-glibc2.2 | yes | yes | 2.1 +alphaev67-unknown-linux2.2.20-gnu-glibc2.2 | yes | yes | 2.1 alphaev67-unknown-linux2.4.4-gnu-glibc2.2 | yes | yes | 2.1 alphaev6-unknown-linux2.4.9-gnu-glibc2.2 | yes | yes | 2.1 alphaev67-unknown-linux2.4.9-gnu-glibc2.2 | yes | yes | 2.1 alphaev6-unknown-linux2.4.18-gnu-glibc2.2 | yes | yes | 2.1 alphaev67-unknown-linux2.4.18-gnu-glibc2.2 | yes | yes | 2.1 +alpha-unknown-linux2.4.19-gnu-glibc2.3 | yes | yes | 2.3 +alphaev68-unknown-linux2.6.11-gnu-glibc2.3 | yes | yes | 2.2 +alpha-unknown-openbsd3.7 | yes | yes | 2.2 alpha-unknown-netbsd1.6 | yes | yes | 2.1 armv4l-unknown-linux2.4.0-gnu-glibc2.2 | no | yes | 2.1 armv4l-unknown-linux2.4.3-gnu-glibc2.2 | yes | yes | 2.1 armv4l-unknown-linux2.4.9-gnu-glibc2.2 | no | yes | 2.0.1 -hppa2.0-hp-hpux10.20 | yes | yes | 2.1 -hppa2.0w-hp-hpux11.00 | yes | yes | 2.1 -hppa2.0w-hp-hpux11.11 | yes | yes | 2.1 +armv5tel-unknown-linux2.4.20-gnu-glibc2.2 | yes | yes | 2.2 +hppa1.1-hp-hpux11.00 | yes | yes | 2.1 +hppa2.0-hp-hpux10.20 | yes | yes | 2.2 +hppa2.0w-hp-hpux11.00 | yes | yes | 2.2 +hppa2.0w-hp-hpux11.11 | yes | yes | 2.2 hppa-unknown-linux2.4.19-gnu-glibc2.2 | yes | yes | 2.0.1 hppa64-unknown-linux2.4.17-gnu-glibc2.2 | yes | yes | 2.1 i586-pc-beos | no | yes | 2.1 i686-pc-cygwin | yes | yes | 2.02 +i686-pc-cygwin | yes | yes | 2.2 +i386-apple-darwin8.6.1 | yes | yes | 2.3 +i686-apple-darwin8.6.1 | yes | yes | 2.3 i586-pc-linux2.2.14-gnu-glibc2.1 | yes | yes | 2.1 i686-pc-linux2.2.14-gnu-glibc2.1 | yes | yes | 2.0 i686-pc-linux2.2.19-gnu-glibc2.1 | yes | yes | 1.95 i486-pc-linux2.2.21-gnu-glibc2.1 | yes | yes | 2.0 i586-pc-linux2.4.18-gnu-glibc2.1 | yes | yes | 2.0 +i686-pc-linux2.4.19-gnu-glibc2.1 | yes | yes | 2.2 i686-pc-linux2.2.16-gnu-glibc2.2 | yes | yes | 2.0 i686-pc-linux2.2.19-gnu-glibc2.2 | yes | yes | 2.0 i686-pc-linux2.4.7-gnu-glibc2.2 | yes | yes | 2.1 @@ -47,30 +60,84 @@ i586-pc-linux2.4.20-gnu-glibc2.3 | yes | yes | 2.0 i686-pc-linux2.4.20-gnu-glibc2.3 | yes | yes | 2.0 i686-pc-linux2.4.21-gnu-glibc2.3 | yes | yes | 2.0 -i386-pc-mingw32 | yes | yes | 2.0 +i586-pc-linux2.4.22-gnu-glibc2.3 | yes | yes | 2.0 +i386-pc-mingw32 | yes | yes | 2.2 +i586-pc-mingw32 | yes | yes | 2.1 i686-pc-mingw32 | yes | yes | 1.96 +i386-pc-solaris2.9 | yes | yes | 2.2 +i386-pc-solaris2.10 | yes | yes | 2.3 +i386-pc-solaris2.11 | yes | yes | 2.2 i686-pc-win32-msvc6 | yes | yes | 1.96 i386-unknown-freebsd4.0 | yes | yes | 2.1 i386-unknown-freebsd4.0-gnu-glibc2.3 | yes | yes | 2.1 i386-unknown-freebsd4.6 | yes | yes | 1.95 i386-unknown-freebsd4.7 | yes | yes | 2.1 i386-unknown-freebsd4.8 | yes | yes | 2.1 +i386-unknown-freebsd4.9 | yes | yes | 2.2 +i386-unknown-freebsd4.10 | yes | yes | 2.2 +i386-unknown-freebsd5.0 | yes | yes | 2.3 +i386-portbld-freebsd6.0 | yes | yes | 2.3 i386-unknown-netbsdelf1.6 | no | no | 2.1 -i386-unknown-openbsd3.2 | yes | yes | 2.1 +i386-unknown-netbsdelf2.0.2 | yes | yes | 2.4 +i386-unknown-netbsdelf3.0 | yes | yes | 2.4 +i386-unknown-netbsd | yes | no | 2.2 +i386-unknown-openbsd3.2 | yes | yes | 2.3 +i386-unknown-openbsd3.3 | yes | yes | 2.1 +i386-unknown-openbsd3.4 | yes | yes | 2.2 +i386-unknown-openbsd3.6 | yes | yes | 2.1 +ia64-portbld-freebsd7.0 | yes | no | 2.3 ia64-hp-hpux11.22 | yes | no | 2.1 -ia64-unknown-linux2.4.18-gnu-glibc2.2 | yes | yes | 2.1 -mips-sgi-irix6.5 | yes | yes | 2.1 -rs6000-ibm-aix3.2.5 | yes | no | 2.1 +ia64-hp-hpux11.23 | yes | no | 2.2 +ia64-unknown-linux2.4.18-gnu-glibc2.2 | yes | yes | 2.4 +ia64-unknown-linux2.6.9-gnu-glibc2.3 | yes | no | 2.3 +mips-sgi-irix6.5 | yes | yes | 2.3 +mips-unknown-linux2.4.27-gnu-glibc2.3 | yes | yes | 2.3 +nsr-tandem-nsk | no | no | 2.1 +rs6000-ibm-aix3.2.5 | yes | no | 2.2 +rs6000-ibm-aix4.2.0.0 | yes | yes | 2.2 +rs6000-ibm-aix4.2.1.0 | yes | yes | 2.1 +powerpc-ibm-aix4.3.2.0 | yes | yes | 2.3 powerpc-ibm-aix4.3.3.0 | yes | yes | 1.95 +powerpc-ibm-aix5.1.0.0 | yes | yes | 2.3 +powerpc-ibm-aix5.2.0.0 | yes | no | 2.1 powerpc-apple-darwin5.5 | yes | yes | 2.2 powerpc-apple-darwin6.8 | yes | yes | 2.2 +powerpc-apple-darwin7.7.0 | yes | yes | 2.2 +powerpc-apple-darwin7.8.0 | yes | yes | 2.2 +powerpc-apple-darwin7.9.0 | yes | yes | 2.3 +powerpc-apple-darwin8.1.0 | yes | yes | 2.2 +powerpc-apple-darwin8.3.0 | yes | yes | 2.2 +powerpc-apple-darwin8.4.0 | yes | yes | 2.2 powerpc-unknown-linux2.2.17-gnu-glibc2.1 | no | yes | 1.95 powerpc-unknown-linux2.2.17-gnu-glibc2.2 | yes | yes | 2.0.1 -sparc-sun-solaris2.6 | yes | yes | 2.0 -sparc-sun-solaris2.7 | yes | yes | 2.1 -sparc-sun-solaris2.8 | yes | yes | 2.1 -sparc-sun-solaris2.9 | yes | yes | 2.1 +powerpc-unknown-linux2.4.19-gnu-glibc2.2 | yes | yes | 2.3 +powerpc-unknown-linux2.4.28-gnu-glibc2.2 | yes | yes | 2.1 +powerpc-unknown-linux2.4.26-gnu-glibc2.3 | yes | yes | 2.1 +powerpc-unknown-linux2.6.10-gnu-glibc2.3 | yes | yes | 2.2 +powerpc-unknown-netbsd2.0 | yes | no | 2.1 +powerpc64-unknown-linux2.6.5-gnu-glibc2.3 | yes | yes | 2.4 +sparc-sun-solaris2.5.1 | yes | yes | 2.2 +sparc-sun-solaris2.6 | yes | yes | 2.2 +sparc-sun-solaris2.7 | yes | yes | 2.3 +sparc-sun-solaris2.8 | yes | yes | 2.3 +sparc-sun-solaris2.9 | yes | yes | 2.3 +sparc-sun-solaris2.10 | yes | yes | 2.3 +sparc-sun-solaris2.11 | yes | yes | 2.4 sparc64-unknown-linux2.2.18-gnu-glibc2.1 | no | no | 1.95 +sparc64-unknown-linux2.4.28-gnu-glibc2.3 | yes | no | 2.3 +sparc64-unknown-openbsd3.6 | no | no | 2.2 +x86_64-unknown-linux2.4.21-gnu-glibc2.2 | yes | yes | 2.1 +x86_64-unknown-linux2.4.21-gnu-glibc2.3 | yes | yes | 2.1 +x86_64-unknown-linux2.6.3-gnu-glibc2.3 | yes | yes | 2.1 +x86_64-unknown-linux2.6.9-gnu-glibc2.3 | yes | yes | 2.3 +x86_64-unknown-linux2.6.16.13-gnu-glibc2.4 | yes | yes | 2.4 +amd64-portbld-freebsd5.4 | yes | yes | 2.2 +amd64-portbld-freebsd6.0 | yes | yes | 2.3 +amd64-portbld-freebsd7.0 | yes | yes | 2.3 + + +On FreeBSD 5.2, libsigsegv works best if the /proc filesystem is mounted. +(It is not mounted by default.) Porting to new platforms @@ -94,10 +161,6 @@ This is a file among stackvma-*.c. configure chooses and sets the variable CFG_STACKVMA. - * How to determine if a fault is actually a stack overflow (more on - this later). This is a file among heur-*.h. - configure chooses and sets the variable CFG_HEURISTICS. - * How to leave a signal handler that is executing on the alternate signal stack. This is a file among leave-*.c. @@ -123,68 +186,3 @@ - Verify that "make" and "make check" pass. For non-Unix systems, a separate handler-.c is likely to be needed. -There are already two of them, namely handler-win32.c and handler-mach.c; -the latter is configurable with a machfault--.h file similarly to -the generic Unix port. - -If this is the case, you should add code at the top of the configure script -which chooses it depending on the host system's triplet. There is a case -statement with an arm for each such file, which also enables some or all of -the other parts of the configuration by setting the CFG_* variables. A -value of "detect" will try to use the existing configuration machinery to -detect the most appropriate file. - -Try to make the handler-.c file as generic as possible; the -handler-unix.c and handler-mach.c are good examples of this. If possible, -move the platform dependencies to CFG_FAULT, and maybe try to detect them -as part of the configuration process. If an operating system is composed -of more than one layer (such as Darwin's BSD and Mach layers, or Cygwin's -Win32 and POSIX layers) pick the most appropriate one instead of relying -on both: otherwise, the code will probably be less maintainable and more -subject to negative interactions between the various layers. - -Stack-overflow detection -======================== - -On the average platform, including Unix and Mach, we must distinguish -stack overflow from other segmentation violations using some kind of -heuristics. At least two of the following must be true: - - A) CFG_FAULT points to an include file which defines - SIGSEGV_FAULT_ADDRESS. - B) CFG_FAULT points to an include file which defines - SIGSEGV_FAULT_STACKPOINTER. - C) There is a stackvma-*.c, other than stackvma-none.c, which - defines sigsegv_get_vma. - -If we have A) and B), we use the - - Heuristic AB: If the fault address is near the stack pointer, it's a - stack overflow. This is implemented in heur-ab.h and takes special - care for the IA-64's special stack handling. - -If we have A) and C), we use the - - Heuristic AC: If the fault address is near and beyond the bottom of - the stack's virtual memory area, it's a stack overflow. This is - implemented in heur-ac.h. - -If we have B) and C), we use the - - Heuristic BC: If the stack pointer is near the bottom of the stack's - virtual memory area, it's a stack overflow. This is implemented in - heur-bc.h and comes in two flavours: on OSes which let the stack's - VMA grow continuously, we determine the bottom by use of getrlimit(); - on OSes which preallocate the stack's VMA with its maximum size - (like BeOS), we use the stack's VMA directly. - -Using these heuristics is quite easy. Just set CFG_STACKVMA to a file -name or "detect" at the top of configure.in, and make sure that the -appropriate #defines are made in your CFG_FAULT file. Also make sure -that you don't set sv_cv_have_stack_overflow_recovery: then, configure -will do the appropriate checks automatically and define -HAVE_STACK_OVERFLOW_RECOVERY to 1 if and only if one of the heuristics -can be adopted. - -On the other hand, if you do not need any heuristics (like under Win32), -be sure to set sv_cv_have_stack_overflow_recovery to yes. diff -rNu smalltalk-2.3.3/sigsegv/README smalltalk-2.3.4/sigsegv/README --- smalltalk-2.3.3/sigsegv/README 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/README 2007-05-12 12:01:45.000000000 +0200 @@ -94,8 +94,8 @@ Copyright notice: -Copyright 1998-1999, 2002-2003 Bruno Haible -Copyright 2002-2003 Paolo Bonzini +Copyright 1998-1999, 2002-2005 Bruno Haible +Copyright 2002-2005 Paolo Bonzini This is free software distributed under the GNU General Public Licence described in the file COPYING. There is ABSOLUTELY NO WARRANTY, explicit or @@ -104,8 +104,8 @@ Distribution: -ftp://ftp.gnu.org/pub/gnu/libsigsegv/libsigsegv-2.1.tar.gz -http://ftp.gnu.org/gnu/libsigsegv/libsigsegv-2.1.tar.gz +ftp://ftp.gnu.org/pub/gnu/libsigsegv/libsigsegv-2.2.tar.gz +http://ftp.gnu.org/gnu/libsigsegv/libsigsegv-2.2.tar.gz Homepage: diff -rNu smalltalk-2.3.3/sigsegv/README.woe32 smalltalk-2.3.4/sigsegv/README.woe32 --- smalltalk-2.3.3/sigsegv/README.woe32 2006-02-05 19:41:37.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/README.woe32 2007-05-12 12:01:45.000000000 +0200 @@ -17,9 +17,18 @@ make install =============================================================================== -Installation instructions on Woe32 with MS Visual C/C++ 4.0, 5.0, or 6.0: +Installation instructions on Woe32 with MS Visual C/C++ 4.0, 5.0, 6.0, or 7.0: -- Requires MS Visual C/C++ 4.0 or 5.0 or 6.0. +- Requires MS Visual C/C++ 4.0 or 5.0 or 6.0 or 7.0. + + Note that binaries created with MSVC 7.0 should not be distributed: They + depend on a closed-source library 'msvcr70.dll' which is not normally part + of a Woe32 installation. You cannot distribute 'msvcr70.dll' with the + binaries - this would be a violation of the GPL and of the Microsoft EULA. + You can distribute the binaries without including 'msvcr70.dll', but this + will cause problems for users that don't have this library on their system. + Therefore it is not recommended. This problem does not occur with MSVC 6.0 + and earlier. - Cannot build in a separate directory. diff -rNu smalltalk-2.3.3/sigsegv/config.h.in smalltalk-2.3.4/sigsegv/config.h.in --- smalltalk-2.3.3/sigsegv/config.h.in 2007-02-13 09:27:51.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/config.h.in 2007-05-12 12:11:28.000000000 +0200 @@ -6,14 +6,13 @@ /* The name of the file implementing the handler functionality. */ #undef CFG_HANDLER -/* The name of the include file describing the stack overflow detection - heuristics. */ -#undef CFG_HEURISTICS - /* The name of the file implementing sigsegv_reset_onstack_flag. */ #undef CFG_LEAVE -/* The name of the include file describing which signals should be trapped. */ +/* The name of the include file describing the Mach fault handler. */ +#undef CFG_MACHFAULT + +/* The name of the include file describing the fault signals. */ #undef CFG_SIGNALS /* The name of the file determining the stack virtual memory area. */ @@ -34,6 +33,9 @@ /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H +/* Define to 1 if you have the `mincore' function. */ +#undef HAVE_MINCORE + /* Define if defines MAP_ANON and mmaping with MAP_ANON works. */ #undef HAVE_MMAP_ANON @@ -53,6 +55,9 @@ /* Define to 1 if you have the `sigaltstack' function. */ #undef HAVE_SIGALTSTACK +/* Define if CFG_STACKVMA is set to a nontrivial source file. */ +#undef HAVE_STACKVMA + /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H diff -rNu smalltalk-2.3.3/sigsegv/config.h.msvc smalltalk-2.3.4/sigsegv/config.h.msvc --- smalltalk-2.3.3/sigsegv/config.h.msvc 2007-02-13 09:38:03.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/config.h.msvc 2007-05-25 11:07:40.000000000 +0200 @@ -6,14 +6,13 @@ /* The name of the file implementing the handler functionality. */ #define CFG_HANDLER "handler-win32.c" -/* The name of the include file describing the stack overflow detection - heuristics. */ -#undef CFG_HEURISTICS - /* The name of the file implementing sigsegv_reset_onstack_flag. */ #undef CFG_LEAVE -/* The name of the include file describing which signals should be trapped. */ +/* The name of the include file describing the Mach fault handler. */ +#undef CFG_MACHFAULT + +/* The name of the include file describing the fault signals. */ #undef CFG_SIGNALS /* The name of the file determining the stack virtual memory area. */ @@ -34,6 +33,9 @@ /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H +/* Define to 1 if you have the `mincore' function. */ +#undef HAVE_MINCORE + /* Define if defines MAP_ANON and mmaping with MAP_ANON works. */ #undef HAVE_MMAP_ANON @@ -53,6 +55,9 @@ /* Define to 1 if you have the `sigaltstack' function. */ #undef HAVE_SIGALTSTACK +/* Define if CFG_STACKVMA is set to a nontrivial source file. */ +#undef HAVE_STACKVMA + /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H diff -rNu smalltalk-2.3.3/sigsegv/configure smalltalk-2.3.4/sigsegv/configure --- smalltalk-2.3.3/sigsegv/configure 2007-02-13 09:27:24.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/configure 2007-05-12 12:11:26.000000000 +0200 @@ -855,16 +855,14 @@ AR RANLIB LIBTOOL +FAULT_CONTEXT +FAULT_CONTEXT_INCLUDE +FAULT_CONTEXT_INCLUDE2 HAVE_SIGSEGV_RECOVERY -HAVE_STACK_OVERFLOW_RECOVERY -CFG_HEURISTICS -CFG_SIGNALS -CFG_FAULT CFG_STACKVMA +HAVE_STACK_OVERFLOW_RECOVERY CFG_LEAVE CFG_HANDLER -FAULT_CONTEXT -FAULT_CONTEXT_INCLUDE RELOCATABLE LIBOBJS LTLIBOBJS' @@ -2272,7 +2270,7 @@ # Define the identity of the package. PACKAGE=libsigsegv - VERSION=2.2 + VERSION=2.4 cat >>confdefs.h <<_ACEOF @@ -4718,7 +4716,7 @@ ;; *-*-irix6*) # Find out which ABI we are using. - echo '#line 4721 "configure"' > conftest.$ac_ext + echo '#line 4719 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? @@ -6225,11 +6223,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:6228: $lt_compile\"" >&5) + (eval echo "\"\$as_me:6226: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:6232: \$? = $ac_status" >&5 + echo "$as_me:6230: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings @@ -6468,11 +6466,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:6471: $lt_compile\"" >&5) + (eval echo "\"\$as_me:6469: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:6475: \$? = $ac_status" >&5 + echo "$as_me:6473: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings @@ -6528,11 +6526,11 @@ -e 's:.*FLAGS}? :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:6531: $lt_compile\"" >&5) + (eval echo "\"\$as_me:6529: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:6535: \$? = $ac_status" >&5 + echo "$as_me:6533: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -8676,7 +8674,7 @@ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext < conftest.$ac_ext <& 6 -# Headers to be included with . for ac_header in sys/signal.h do @@ -9583,6 +9580,24 @@ done +case "$host_os" in + sunos4* | freebsd* | openbsd* | netbsd*) + CFG_SIGNALS=signals-bsd.h ;; + hpux*) + CFG_SIGNALS=signals-hpux.h ;; + macos* | darwin*) + CFG_SIGNALS=signals-macos.h ;; + gnu*) + CFG_SIGNALS=signals-hurd.h ;; + *) + CFG_SIGNALS=signals.h ;; +esac + +cat >>confdefs.h <<_ACEOF +#define CFG_SIGNALS "$CFG_SIGNALS" +_ACEOF + + # How to determine the memory page size. @@ -10320,57 +10335,50 @@ fi +# How to write a SIGSEGV handler with access to the fault address. +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 5 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[6-9]* | darwin[1-9][0-9]*) ;; + *) -for ac_func in getrlimit setrlimit -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } -if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then + + + + + { echo "$as_me:$LINENO: checking whether a fault handler according to POSIX works" >&5 +echo $ECHO_N "checking whether a fault handler according to POSIX works... $ECHO_C" >&6; } +if test "${sv_cv_fault_posix+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + + if test "$cross_compiling" = yes; then + case "$host" in + *-*-solaris2.[7-9] | i?86-*-linux2.[4-9]* | i?86-*-freebsd[4-9]* | alpha*-dec-osf[4-9]* | *-*-hpux11* | mips-sgi-irix6*) sv_cv_fault_posix=yes ;; + *) + cat >conftest.$ac_ext <<_ACEOF + + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif -#undef $ac_func +#include -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined __stub_$ac_func || defined __stub___$ac_func -choke me -#endif +void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) +{ + void *fault_address = (void *) (sip->si_addr); +} int main () { -return $ac_func (); +struct sigaction action; +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; ; return 0; } @@ -10393,261 +10401,184 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - eval "$as_ac_var=yes" + sv_cv_fault_posix="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - eval "$as_ac_var=no" + sv_cv_fault_posix=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext -fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -# The idea here is that some other OS than Unix may need -# some of the detection magic, which seems plausible -# especially for CFG_STACKVMA. -case "$host" in - i?86-*-mingw* | i?86-*-cygwin*) - FAULT_CONTEXT='CONTEXT' - FAULT_CONTEXT_INCLUDE='#include ' - CFG_HANDLER=handler-win32.c - CFG_STACKVMA=stackvma-none.c - CFG_FAULT=fault-none.h - CFG_LEAVE=leave-none.c - CFG_SIGNALS=signals.h - sv_cv_have_sigsegv_recovery=yes - sv_cv_have_stack_overflow_recovery=yes - ;; - - powerpc-*-macos* | powerpc-*-darwin*) - FAULT_CONTEXT='ppc_exception_state_t' - FAULT_CONTEXT_INCLUDE='#include ' - CFG_FAULT=machfault-macos-powerpc.h - CFG_HANDLER=handler-macos.c - CFG_LEAVE=leave-none.c - CFG_SIGNALS=signals.h - CFG_STACKVMA=detect - sv_cv_have_sigsegv_recovery=yes - ;; - - *) - FAULT_CONTEXT=void - FAULT_CONTEXT_INCLUDE= - CFG_HANDLER=handler-unix.c - CFG_STACKVMA=detect - CFG_LEAVE=detect - CFG_SIGNALS=detect - - # Catching stack overflow requires an alternate signal stack. - # The old "install a guard page" trick would be unreliable, because - # we don't know where exactly to place the guard page. - - - - + ;; + esac -for ac_func in sigaltstack -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -{ echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } -if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then - echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ -#ifdef __STDC__ -# include -#else -# include +#include +#include +#if HAVE_SYS_SIGNAL_H +# include #endif -#undef $ac_func - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" +#include +#include +#if HAVE_MMAP_DEVZERO +# include +# ifndef MAP_FILE +# define MAP_FILE 0 +# endif #endif -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined __stub_$ac_func || defined __stub___$ac_func -choke me +#ifndef PROT_NONE +# define PROT_NONE 0 #endif - -int -main () +#if HAVE_MMAP_ANON +# define zero_fd -1 +# define map_flags MAP_ANON | MAP_PRIVATE +#elif HAVE_MMAP_ANONYMOUS +# define zero_fd -1 +# define map_flags MAP_ANONYMOUS | MAP_PRIVATE +#elif HAVE_MMAP_DEVZERO +static int zero_fd; +# define map_flags MAP_FILE | MAP_PRIVATE +#endif +unsigned long page; +int handler_called = 0; +void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) { -return $ac_func (); - ; + void *fault_address = (void *) (sip->si_addr); + handler_called++; + if (handler_called == 10) + exit (4); + if (fault_address != (void*)(page + 0x678)) + exit (3); + if (mprotect ((void *) page, 0x10000, PROT_READ | PROT_WRITE) < 0) + exit (2); +} +void crasher (unsigned long p) +{ + *(int *) (p + 0x678) = 42; +} +int main () +{ + void *p; + struct sigaction action; + /* Preparations. */ +#if !HAVE_MMAP_ANON && !HAVE_MMAP_ANONYMOUS && HAVE_MMAP_DEVZERO + zero_fd = open ("/dev/zero", O_RDONLY, 0644); +#endif + /* Setup some mmaped memory. */ +#ifdef __hpux + /* HP-UX 10 mmap() often fails when given a hint. So give the OS complete + freedom about the address range. */ + p = mmap ((void *) 0, 0x10000, PROT_READ | PROT_WRITE, map_flags, zero_fd, 0); +#else + p = mmap ((void *) 0x12340000, 0x10000, PROT_READ | PROT_WRITE, map_flags, zero_fd, 0); +#endif + if (p == (void *)(-1)) + exit (2); + page = (unsigned long) p; + /* Make it read-only. */ + if (mprotect ((void *) page, 0x10000, PROT_READ) < 0) + exit (2); + /* Install the SIGSEGV handler. */ + sigemptyset(&action.sa_mask); +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); + sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* The first write access should invoke the handler and then complete. */ + crasher (page); + /* The second write access should not invoke the handler. */ + crasher (page); + /* Check that the handler was called only once. */ + if (handler_called != 1) + exit (1); + /* Test passed! */ return 0; } _ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext +rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_link") 2>conftest.er1 + (eval "$ac_link") 2>&5 ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then - eval "$as_ac_var=yes" + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + sv_cv_fault_posix=yes else - echo "$as_me: failed program was:" >&5 + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - eval "$as_ac_var=no" +( exit $ac_status ) +sv_cv_fault_posix=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ - conftest$ac_exeext conftest.$ac_ext -fi -ac_res=`eval echo '${'$as_ac_var'}'` - { echo "$as_me:$LINENO: result: $ac_res" >&5 -echo "${ECHO_T}$ac_res" >&6; } -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - - if test "$ac_cv_func_sigaltstack" = yes; then - { echo "$as_me:$LINENO: checking for stack_t" >&5 -echo $ECHO_N "checking for stack_t... $ECHO_C" >&6; } -if test "${ac_cv_type_stack_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -#include -#if HAVE_SYS_SIGNAL_H -# include -#endif - - -typedef stack_t ac__type_new_; -int -main () -{ -if ((ac__type_new_ *) 0) - return 0; -if (sizeof (ac__type_new_)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_compile") 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext; then - ac_cv_type_stack_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_cv_type_stack_t=no + + fi +{ echo "$as_me:$LINENO: result: $sv_cv_fault_posix" >&5 +echo "${ECHO_T}$sv_cv_fault_posix" >&6; } -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ echo "$as_me:$LINENO: result: $ac_cv_type_stack_t" >&5 -echo "${ECHO_T}$ac_cv_type_stack_t" >&6; } -if test $ac_cv_type_stack_t = yes; then - : -else -cat >>confdefs.h <<\_ACEOF -#define stack_t struct sigaltstack -_ACEOF -fi - fi - { echo "$as_me:$LINENO: checking for working sigaltstack" >&5 -echo $ECHO_N "checking for working sigaltstack... $ECHO_C" >&6; } -if test "${sv_cv_sigaltstack+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/i386 works" >&5 +echo $ECHO_N "checking whether a fault handler according to Linux/i386 works... $ECHO_C" >&6; } +if test "${sv_cv_fault_linux_i386+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$ac_cv_func_sigaltstack" = yes; then - if test "$cross_compiling" = yes; then + if test "$cross_compiling" = yes; then + case "$host" in + i?86-*-linux2.[2-9]*) sv_cv_fault_linux_i386=yes ;; + *) + cat >conftest.$ac_ext <<_ACEOF - case "$host_os" in - *) - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ + #include +#include +void sigsegv_handler (int sig, struct sigcontext sc) +{ + void *fault_address = (void *) (sc.cr2); +} + int main () { -int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss); +struct sigaction action; + ; return 0; } @@ -10670,23 +10601,23 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_sigaltstack="guessing yes" + sv_cv_fault_linux_i386="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_sigaltstack=no + sv_cv_fault_linux_i386=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext - ;; - esac + ;; + esac else cat >conftest.$ac_ext <<_ACEOF - /* confdefs.h. */ + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF @@ -10697,51 +10628,84 @@ #if HAVE_SYS_SIGNAL_H # include #endif -#if HAVE_SETRLIMIT -# include -# include -# include +#include +#include +#include +#if HAVE_MMAP_DEVZERO +# include +# ifndef MAP_FILE +# define MAP_FILE 0 +# endif #endif -void stackoverflow_handler (int sig) +#ifndef PROT_NONE +# define PROT_NONE 0 +#endif +#if HAVE_MMAP_ANON +# define zero_fd -1 +# define map_flags MAP_ANON | MAP_PRIVATE +#elif HAVE_MMAP_ANONYMOUS +# define zero_fd -1 +# define map_flags MAP_ANONYMOUS | MAP_PRIVATE +#elif HAVE_MMAP_DEVZERO +static int zero_fd; +# define map_flags MAP_FILE | MAP_PRIVATE +#endif +unsigned long page; +int handler_called = 0; +void sigsegv_handler (int sig, struct sigcontext sc) { - /* If we get here, the stack overflow was caught. */ - exit (0); + void *fault_address = (void *) (sc.cr2); + handler_called++; + if (handler_called == 10) + exit (4); + if (fault_address != (void*)(page + 0x678)) + exit (3); + if (mprotect ((void *) page, 0x10000, PROT_READ | PROT_WRITE) < 0) + exit (2); } -int recurse (int n) +void crasher (unsigned long p) { - if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *(int *) (p + 0x678) = 42; } int main () { - char mystack[16384]; - stack_t altstack; + void *p; struct sigaction action; -#if defined HAVE_SETRLIMIT && defined RLIMIT_STACK - /* Before starting the endless recursion, try to be friendly to the user's - machine. On some Linux 2.2.x systems, there is no stack limit for user - processes at all. We don't want to kill such systems. */ - struct rlimit rl; - rl.rlim_cur = rl.rlim_max = 0x100000; /* 1 MB */ - setrlimit (RLIMIT_STACK, &rl); + /* Preparations. */ +#if !HAVE_MMAP_ANON && !HAVE_MMAP_ANONYMOUS && HAVE_MMAP_DEVZERO + zero_fd = open ("/dev/zero", O_RDONLY, 0644); #endif - /* Install the alternate stack. */ - altstack.ss_sp = mystack; - altstack.ss_size = sizeof (mystack); - altstack.ss_flags = 0; /* no SS_DISABLE */ - if (sigaltstack (&altstack, NULL) < 0) - exit (1); + /* Setup some mmaped memory. */ +#ifdef __hpux + /* HP-UX 10 mmap() often fails when given a hint. So give the OS complete + freedom about the address range. */ + p = mmap ((void *) 0, 0x10000, PROT_READ | PROT_WRITE, map_flags, zero_fd, 0); +#else + p = mmap ((void *) 0x12340000, 0x10000, PROT_READ | PROT_WRITE, map_flags, zero_fd, 0); +#endif + if (p == (void *)(-1)) + exit (2); + page = (unsigned long) p; + /* Make it read-only. */ + if (mprotect ((void *) page, 0x10000, PROT_READ) < 0) + exit (2); /* Install the SIGSEGV handler. */ - sigemptyset (&action.sa_mask); - action.sa_handler = &stackoverflow_handler; - action.sa_flags = SA_ONSTACK; + sigemptyset(&action.sa_mask); + + action.sa_handler = (void (*) (int)) &sigsegv_handler; + action.sa_flags = 0; + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); - /* Provoke a stack overflow. */ - recurse (0); - exit (2); + /* The first write access should invoke the handler and then complete. */ + crasher (page); + /* The second write access should not invoke the handler. */ + crasher (page); + /* Check that the handler was called only once. */ + if (handler_called != 1) + exit (1); + /* Test passed! */ + return 0; } _ACEOF rm -f conftest$ac_exeext @@ -10764,61 +10728,38 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_sigaltstack=yes + sv_cv_fault_linux_i386=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_sigaltstack=no +sv_cv_fault_linux_i386=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi - else - sv_cv_sigaltstack=no - fi fi -{ echo "$as_me:$LINENO: result: $sv_cv_sigaltstack" >&5 -echo "${ECHO_T}$sv_cv_sigaltstack" >&6; } - if test "$sv_cv_sigaltstack" != no; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_WORKING_SIGALTSTACK 1 -_ACEOF - - fi - +{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_i386" >&5 +echo "${ECHO_T}$sv_cv_fault_linux_i386" >&6; } - # List of signals that are sent when an invalid virtual memory address - # is accessed, or when the stack overflows. - case "$host_os" in - sunos4* | freebsd* | openbsd* | netbsd*) - CFG_SIGNALS=signals-bsd.h ;; - hpux*) - CFG_SIGNALS=signals-hpux.h ;; - gnu*) - CFG_SIGNALS=signals-hurd.h ;; - *) - CFG_SIGNALS=signals.h ;; - esac - { echo "$as_me:$LINENO: checking whether a fault handler according to POSIX works" >&5 -echo $ECHO_N "checking whether a fault handler according to POSIX works... $ECHO_C" >&6; } -if test "${sv_cv_fault_posix+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to old Linux/i386 works" >&5 +echo $ECHO_N "checking whether a fault handler according to old Linux/i386 works... $ECHO_C" >&6; } +if test "${sv_cv_fault_linux_i386_old+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - *-*-solaris2.[7-9] | i?86-*-linux2.[4-9]* | i?86-*-freebsd[4-9]* | alpha*-dec-osf[4-9]* | *-*-hpux11* | mips-sgi-irix6*) sv_cv_fault_posix=yes ;; + i?86-*-linux2.[2-9]*) sv_cv_fault_linux_i386_old=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -10830,17 +10771,16 @@ #include -void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) +void sigsegv_handler (int sig, unsigned int more) { - void *fault_address = (void *) (sip->si_addr); + void *fault_address = (void *) (((unsigned long *) &more) [21]); } int main () { struct sigaction action; -action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO; + ; return 0; } @@ -10863,12 +10803,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_posix="guessing no" + sv_cv_fault_linux_i386_old="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_posix=no + sv_cv_fault_linux_i386_old=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -10914,9 +10854,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) +void sigsegv_handler (int sig, unsigned int more) { - void *fault_address = (void *) (sip->si_addr); + void *fault_address = (void *) (((unsigned long *) &more) [21]); handler_called++; if (handler_called == 10) exit (4); @@ -10953,11 +10893,13 @@ exit (2); /* Install the SIGSEGV handler. */ sigemptyset(&action.sa_mask); -action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO; - sigaction (SIGSEGV, &action, (struct sigaction *) NULL); - sigaction (SIGBUS, &action, (struct sigaction *) NULL); - /* The first write access should invoke the handler and then complete. */ + + action.sa_handler = (void (*) (int)) &sigsegv_handler; + action.sa_flags = 0; + + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); + sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* The first write access should invoke the handler and then complete. */ crasher (page); /* The second write access should not invoke the handler. */ crasher (page); @@ -10988,14 +10930,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_posix=yes + sv_cv_fault_linux_i386_old=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_posix=no +sv_cv_fault_linux_i386_old=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -11003,23 +10945,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_posix" >&5 -echo "${ECHO_T}$sv_cv_fault_posix" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_i386_old" >&5 +echo "${ECHO_T}$sv_cv_fault_linux_i386_old" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/i386 works" >&5 -echo $ECHO_N "checking whether a fault handler according to Linux/i386 works... $ECHO_C" >&6; } -if test "${sv_cv_fault_linux_i386+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/m68k works" >&5 +echo $ECHO_N "checking whether a fault handler according to Linux/m68k works... $ECHO_C" >&6; } +if test "${sv_cv_fault_linux_m68k+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - i?86-*-linux2.[2-9]*) sv_cv_fault_linux_i386=yes ;; + *) cat >conftest.$ac_ext <<_ACEOF @@ -11031,9 +10973,10 @@ #include #include -void sigsegv_handler (int sig, struct sigcontext sc) +#include "$srcdir/src/fault-linux-m68k.c" +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (sc.cr2); + void *fault_address = (void *) (get_fault_addr (scp)); } int @@ -11063,12 +11006,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_linux_i386="guessing no" + sv_cv_fault_linux_m68k="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_linux_i386=no + sv_cv_fault_linux_m68k=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -11091,6 +11034,7 @@ # include #endif #include +#include "$srcdir/src/fault-linux-m68k.c" #include #include #if HAVE_MMAP_DEVZERO @@ -11114,9 +11058,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, struct sigcontext sc) +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (sc.cr2); + void *fault_address = (void *) (get_fault_addr (scp)); handler_called++; if (handler_called == 10) exit (4); @@ -11190,14 +11134,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_linux_i386=yes + sv_cv_fault_linux_m68k=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_linux_i386=no +sv_cv_fault_linux_m68k=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -11205,23 +11149,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_i386" >&5 -echo "${ECHO_T}$sv_cv_fault_linux_i386" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_m68k" >&5 +echo "${ECHO_T}$sv_cv_fault_linux_m68k" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to old Linux/i386 works" >&5 -echo $ECHO_N "checking whether a fault handler according to old Linux/i386 works... $ECHO_C" >&6; } -if test "${sv_cv_fault_linux_i386_old+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/PowerPC works" >&5 +echo $ECHO_N "checking whether a fault handler according to Linux/PowerPC works... $ECHO_C" >&6; } +if test "${sv_cv_fault_linux_powerpc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - i?86-*-linux2.[2-9]*) sv_cv_fault_linux_i386_old=yes ;; + *) cat >conftest.$ac_ext <<_ACEOF @@ -11232,10 +11176,10 @@ /* end confdefs.h. */ #include - -void sigsegv_handler (int sig, unsigned int more) +#include +void sigsegv_handler (int sig, struct sigcontext *scp) { - void *fault_address = (void *) (((unsigned long *) &more) [21]); + void *fault_address = (void *) (scp->regs->dar); } int @@ -11265,12 +11209,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_linux_i386_old="guessing no" + sv_cv_fault_linux_powerpc="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_linux_i386_old=no + sv_cv_fault_linux_powerpc=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -11292,7 +11236,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif - +#include #include #include #if HAVE_MMAP_DEVZERO @@ -11316,9 +11260,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, unsigned int more) +void sigsegv_handler (int sig, struct sigcontext *scp) { - void *fault_address = (void *) (((unsigned long *) &more) [21]); + void *fault_address = (void *) (scp->regs->dar); handler_called++; if (handler_called == 10) exit (4); @@ -11392,14 +11336,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_linux_i386_old=yes + sv_cv_fault_linux_powerpc=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_linux_i386_old=no +sv_cv_fault_linux_powerpc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -11407,23 +11351,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_i386_old" >&5 -echo "${ECHO_T}$sv_cv_fault_linux_i386_old" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_powerpc" >&5 +echo "${ECHO_T}$sv_cv_fault_linux_powerpc" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/m68k works" >&5 -echo $ECHO_N "checking whether a fault handler according to Linux/m68k works... $ECHO_C" >&6; } -if test "${sv_cv_fault_linux_m68k+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/HPPA works" >&5 +echo $ECHO_N "checking whether a fault handler according to Linux/HPPA works... $ECHO_C" >&6; } +if test "${sv_cv_fault_linux_hppa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - m68k-*-linux*) sv_cv_fault_linux_m68k=yes ;; + *) cat >conftest.$ac_ext <<_ACEOF @@ -11434,18 +11378,18 @@ /* end confdefs.h. */ #include -#include - #include "$srcdir/src/fault-linux-m68k.c" -void sigsegv_handler (int sig, int code, struct sigcontext *scp) + +void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) { - void *fault_address = (void *) (get_fault_addr (scp)); + void *fault_address = (void *) (sip->si_ptr); } int main () { struct sigaction action; - +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; ; return 0; } @@ -11468,12 +11412,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_linux_m68k="guessing no" + sv_cv_fault_linux_hppa="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_linux_m68k=no + sv_cv_fault_linux_hppa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -11495,8 +11439,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif -#include - #include "$srcdir/src/fault-linux-m68k.c" + #include #include #if HAVE_MMAP_DEVZERO @@ -11520,9 +11463,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, int code, struct sigcontext *scp) +void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) { - void *fault_address = (void *) (get_fault_addr (scp)); + void *fault_address = (void *) (sip->si_ptr); handler_called++; if (handler_called == 10) exit (4); @@ -11559,10 +11502,8 @@ exit (2); /* Install the SIGSEGV handler. */ sigemptyset(&action.sa_mask); - - action.sa_handler = (void (*) (int)) &sigsegv_handler; - action.sa_flags = 0; - +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); /* The first write access should invoke the handler and then complete. */ @@ -11596,14 +11537,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_linux_m68k=yes + sv_cv_fault_linux_hppa=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_linux_m68k=no +sv_cv_fault_linux_hppa=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -11611,23 +11552,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_m68k" >&5 -echo "${ECHO_T}$sv_cv_fault_linux_m68k" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_hppa" >&5 +echo "${ECHO_T}$sv_cv_fault_linux_hppa" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/PowerPC works" >&5 -echo $ECHO_N "checking whether a fault handler according to Linux/PowerPC works... $ECHO_C" >&6; } -if test "${sv_cv_fault_linux_powerpc+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to BSD works" >&5 +echo $ECHO_N "checking whether a fault handler according to BSD works... $ECHO_C" >&6; } +if test "${sv_cv_fault_bsd+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - powerpc*-*-linux*) sv_cv_fault_linux_powerpc=yes ;; + i?86-*-freebsd[4-9]*) sv_cv_fault_bsd=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -11638,10 +11579,10 @@ /* end confdefs.h. */ #include -#include -void sigsegv_handler (int sig, struct sigcontext *scp) + +void sigsegv_handler (int sig, int code, struct sigcontext *scp, void *addr) { - void *fault_address = (void *) (scp->regs->dar); + void *fault_address = (void *) (addr); } int @@ -11671,12 +11612,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_linux_powerpc="guessing no" + sv_cv_fault_bsd="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_linux_powerpc=no + sv_cv_fault_bsd=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -11698,7 +11639,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif -#include + #include #include #if HAVE_MMAP_DEVZERO @@ -11722,9 +11663,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, struct sigcontext *scp) +void sigsegv_handler (int sig, int code, struct sigcontext *scp, void *addr) { - void *fault_address = (void *) (scp->regs->dar); + void *fault_address = (void *) (addr); handler_called++; if (handler_called == 10) exit (4); @@ -11798,14 +11739,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_linux_powerpc=yes + sv_cv_fault_bsd=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_linux_powerpc=no +sv_cv_fault_bsd=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -11813,23 +11754,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_powerpc" >&5 -echo "${ECHO_T}$sv_cv_fault_linux_powerpc" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_bsd" >&5 +echo "${ECHO_T}$sv_cv_fault_bsd" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to Linux/HPPA works" >&5 -echo $ECHO_N "checking whether a fault handler according to Linux/HPPA works... $ECHO_C" >&6; } -if test "${sv_cv_fault_linux_hppa+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to IRIX works" >&5 +echo $ECHO_N "checking whether a fault handler according to IRIX works... $ECHO_C" >&6; } +if test "${sv_cv_fault_irix+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - hppa*-*-linux*) sv_cv_fault_linux_hppa=yes ;; + mips-sgi-irix6*) sv_cv_fault_irix=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -11841,17 +11782,16 @@ #include -void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (sip->si_ptr); + void *fault_address = (void *) ((unsigned long) scp->sc_badvaddr); } int main () { struct sigaction action; -action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO; + ; return 0; } @@ -11874,12 +11814,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_linux_hppa="guessing no" + sv_cv_fault_irix="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_linux_hppa=no + sv_cv_fault_irix=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -11925,9 +11865,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, siginfo_t *sip, void *ucp) +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (sip->si_ptr); + void *fault_address = (void *) ((unsigned long) scp->sc_badvaddr); handler_called++; if (handler_called == 10) exit (4); @@ -11964,8 +11904,10 @@ exit (2); /* Install the SIGSEGV handler. */ sigemptyset(&action.sa_mask); -action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO; + + action.sa_handler = (void (*) (int)) &sigsegv_handler; + action.sa_flags = 0; + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); /* The first write access should invoke the handler and then complete. */ @@ -11999,14 +11941,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_linux_hppa=yes + sv_cv_fault_irix=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_linux_hppa=no +sv_cv_fault_irix=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -12014,23 +11956,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_linux_hppa" >&5 -echo "${ECHO_T}$sv_cv_fault_linux_hppa" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_irix" >&5 +echo "${ECHO_T}$sv_cv_fault_irix" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to BSD works" >&5 -echo $ECHO_N "checking whether a fault handler according to BSD works... $ECHO_C" >&6; } -if test "${sv_cv_fault_bsd+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to HP-UX HPPA works" >&5 +echo $ECHO_N "checking whether a fault handler according to HP-UX HPPA works... $ECHO_C" >&6; } +if test "${sv_cv_fault_hpux_hppa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - i?86-*-freebsd[4-9]*) sv_cv_fault_bsd=yes ;; + hppa*-*-hpux11*) sv_cv_fault_hpux_hppa=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -12042,9 +11984,14 @@ #include -void sigsegv_handler (int sig, int code, struct sigcontext *scp, void *addr) +#define USE_64BIT_REGS(mc) \ + (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) +#define GET_CR21(mc) \ + (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) + +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (addr); + void *fault_address = (void *) (GET_CR21 (scp->sc_sl.sl_ss)); } int @@ -12074,12 +12021,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_bsd="guessing no" + sv_cv_fault_hpux_hppa="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_bsd=no + sv_cv_fault_hpux_hppa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -12102,6 +12049,11 @@ # include #endif +#define USE_64BIT_REGS(mc) \ + (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) +#define GET_CR21(mc) \ + (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) + #include #include #if HAVE_MMAP_DEVZERO @@ -12125,9 +12077,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, int code, struct sigcontext *scp, void *addr) +void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (addr); + void *fault_address = (void *) (GET_CR21 (scp->sc_sl.sl_ss)); handler_called++; if (handler_called == 10) exit (4); @@ -12201,14 +12153,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_bsd=yes + sv_cv_fault_hpux_hppa=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_bsd=no +sv_cv_fault_hpux_hppa=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -12216,23 +12168,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_bsd" >&5 -echo "${ECHO_T}$sv_cv_fault_bsd" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_hpux_hppa" >&5 +echo "${ECHO_T}$sv_cv_fault_hpux_hppa" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to IRIX works" >&5 -echo $ECHO_N "checking whether a fault handler according to IRIX works... $ECHO_C" >&6; } -if test "${sv_cv_fault_irix+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to OSF/1 Alpha works" >&5 +echo $ECHO_N "checking whether a fault handler according to OSF/1 Alpha works... $ECHO_C" >&6; } +if test "${sv_cv_fault_osf_alpha+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - mips-sgi-irix6*) sv_cv_fault_irix=yes ;; + alpha*-*-osf[4-9]* | alpha*-*-linux2.[4-9]*) sv_cv_fault_osf_alpha=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -12246,7 +12198,7 @@ void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) ((unsigned long) scp->sc_badvaddr); + void *fault_address = (void *) (scp->sc_traparg_a0); } int @@ -12276,12 +12228,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_irix="guessing no" + sv_cv_fault_osf_alpha="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_irix=no + sv_cv_fault_osf_alpha=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -12329,7 +12281,7 @@ int handler_called = 0; void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) ((unsigned long) scp->sc_badvaddr); + void *fault_address = (void *) (scp->sc_traparg_a0); handler_called++; if (handler_called == 10) exit (4); @@ -12403,14 +12355,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_irix=yes + sv_cv_fault_osf_alpha=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_irix=no +sv_cv_fault_osf_alpha=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -12418,23 +12370,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_irix" >&5 -echo "${ECHO_T}$sv_cv_fault_irix" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_osf_alpha" >&5 +echo "${ECHO_T}$sv_cv_fault_osf_alpha" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to HP-UX HPPA works" >&5 -echo $ECHO_N "checking whether a fault handler according to HP-UX HPPA works... $ECHO_C" >&6; } -if test "${sv_cv_fault_hpux_hppa+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to NetBSD Alpha works" >&5 +echo $ECHO_N "checking whether a fault handler according to NetBSD Alpha works... $ECHO_C" >&6; } +if test "${sv_cv_fault_netbsd_alpha+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - hppa*-*-hpux11*) sv_cv_fault_hpux_hppa=yes ;; + alpha*-*-osf[4-9]* | alpha-*-*bsd*) sv_cv_fault_netbsd_alpha=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -12445,15 +12397,10 @@ /* end confdefs.h. */ #include - -# define USE_64BIT_REGS(mc) \ - (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) -# define GET_CR21(mc) \ - (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) - +#include "$srcdir/src/fault-netbsd-alpha.c" void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (GET_CR21 (scp->sc_sl.sl_ss)); + void *fault_address = (void *) (get_fault_addr (scp)); } int @@ -12483,12 +12430,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_hpux_hppa="guessing no" + sv_cv_fault_netbsd_alpha="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_hpux_hppa=no + sv_cv_fault_netbsd_alpha=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -12510,12 +12457,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif - -# define USE_64BIT_REGS(mc) \ - (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) -# define GET_CR21(mc) \ - (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) - +#include "$srcdir/src/fault-netbsd-alpha.c" #include #include #if HAVE_MMAP_DEVZERO @@ -12541,7 +12483,7 @@ int handler_called = 0; void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (GET_CR21 (scp->sc_sl.sl_ss)); + void *fault_address = (void *) (get_fault_addr (scp)); handler_called++; if (handler_called == 10) exit (4); @@ -12615,14 +12557,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_hpux_hppa=yes + sv_cv_fault_netbsd_alpha=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_hpux_hppa=no +sv_cv_fault_netbsd_alpha=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -12630,23 +12572,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_hpux_hppa" >&5 -echo "${ECHO_T}$sv_cv_fault_hpux_hppa" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_netbsd_alpha" >&5 +echo "${ECHO_T}$sv_cv_fault_netbsd_alpha" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to OSF/1 Alpha works" >&5 -echo $ECHO_N "checking whether a fault handler according to OSF/1 Alpha works... $ECHO_C" >&6; } -if test "${sv_cv_fault_osf_alpha+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to AIX works" >&5 +echo $ECHO_N "checking whether a fault handler according to AIX works... $ECHO_C" >&6; } +if test "${sv_cv_fault_aix+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - alpha*-*-osf[4-9]* | alpha*-*-linux2.[4-9]*) sv_cv_fault_osf_alpha=yes ;; + *-*-aix[34]*) sv_cv_fault_aix=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -12660,7 +12602,7 @@ void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (scp->sc_traparg_a0); + void *fault_address = (void *) (scp->sc_jmpbuf.jmp_context.o_vaddr); } int @@ -12690,12 +12632,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_osf_alpha="guessing no" + sv_cv_fault_aix="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_osf_alpha=no + sv_cv_fault_aix=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -12743,7 +12685,7 @@ int handler_called = 0; void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (scp->sc_traparg_a0); + void *fault_address = (void *) (scp->sc_jmpbuf.jmp_context.o_vaddr); handler_called++; if (handler_called == 10) exit (4); @@ -12817,14 +12759,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_osf_alpha=yes + sv_cv_fault_aix=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_osf_alpha=no +sv_cv_fault_aix=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -12832,23 +12774,23 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_osf_alpha" >&5 -echo "${ECHO_T}$sv_cv_fault_osf_alpha" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_aix" >&5 +echo "${ECHO_T}$sv_cv_fault_aix" >&6; } - { echo "$as_me:$LINENO: checking whether a fault handler according to NetBSD Alpha works" >&5 -echo $ECHO_N "checking whether a fault handler according to NetBSD Alpha works... $ECHO_C" >&6; } -if test "${sv_cv_fault_netbsd_alpha+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to MacOSX/Darwin7 PowerPC works" >&5 +echo $ECHO_N "checking whether a fault handler according to MacOSX/Darwin7 PowerPC works... $ECHO_C" >&6; } +if test "${sv_cv_fault_macosdarwin7_ppc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - alpha*-*-osf[4-9]* | alpha-*-*bsd*) sv_cv_fault_netbsd_alpha=yes ;; + powerpc-*-darwin7*) sv_cv_fault_macosdarwin7_ppc=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -12859,17 +12801,18 @@ /* end confdefs.h. */ #include -#include "$srcdir/src/fault-netbsd-alpha.c" -void sigsegv_handler (int sig, int code, struct sigcontext *scp) +#include "$srcdir/src/fault-macosdarwin7-powerpc.c" +void sigsegv_handler (int sig, siginfo_t *sip, ucontext_t *ucp) { - void *fault_address = (void *) (get_fault_addr (scp)); + void *fault_address = (void *) (get_fault_addr (sip, ucp)); } int main () { struct sigaction action; - +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; ; return 0; } @@ -12892,12 +12835,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_netbsd_alpha="guessing no" + sv_cv_fault_macosdarwin7_ppc="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_netbsd_alpha=no + sv_cv_fault_macosdarwin7_ppc=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -12919,7 +12862,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif -#include "$srcdir/src/fault-netbsd-alpha.c" +#include "$srcdir/src/fault-macosdarwin7-powerpc.c" #include #include #if HAVE_MMAP_DEVZERO @@ -12943,9 +12886,9 @@ #endif unsigned long page; int handler_called = 0; -void sigsegv_handler (int sig, int code, struct sigcontext *scp) +void sigsegv_handler (int sig, siginfo_t *sip, ucontext_t *ucp) { - void *fault_address = (void *) (get_fault_addr (scp)); + void *fault_address = (void *) (get_fault_addr (sip, ucp)); handler_called++; if (handler_called == 10) exit (4); @@ -12982,10 +12925,8 @@ exit (2); /* Install the SIGSEGV handler. */ sigemptyset(&action.sa_mask); - - action.sa_handler = (void (*) (int)) &sigsegv_handler; - action.sa_flags = 0; - +action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO; sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); /* The first write access should invoke the handler and then complete. */ @@ -13019,14 +12960,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_netbsd_alpha=yes + sv_cv_fault_macosdarwin7_ppc=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_netbsd_alpha=no +sv_cv_fault_macosdarwin7_ppc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -13034,23 +12975,24 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_netbsd_alpha" >&5 -echo "${ECHO_T}$sv_cv_fault_netbsd_alpha" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_macosdarwin7_ppc" >&5 +echo "${ECHO_T}$sv_cv_fault_macosdarwin7_ppc" >&6; } +if test "$sv_cv_fault_macosdarwin7_ppc" != yes; then - { echo "$as_me:$LINENO: checking whether a fault handler according to AIX works" >&5 -echo $ECHO_N "checking whether a fault handler according to AIX works... $ECHO_C" >&6; } -if test "${sv_cv_fault_aix+set}" = set; then + { echo "$as_me:$LINENO: checking whether a fault handler according to MacOSX/Darwin5 PowerPC works" >&5 +echo $ECHO_N "checking whether a fault handler according to MacOSX/Darwin5 PowerPC works... $ECHO_C" >&6; } +if test "${sv_cv_fault_macosdarwin5_ppc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - *-*-aix*) sv_cv_fault_aix=yes ;; + powerpc-*-darwin5*) sv_cv_fault_macosdarwin5_ppc=yes ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -13061,10 +13003,10 @@ /* end confdefs.h. */ #include - +#include "$srcdir/src/fault-macosdarwin5-powerpc.c" void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (scp->sc_jmpbuf.jmp_context.o_vaddr); + void *fault_address = (void *) (get_fault_addr (scp)); } int @@ -13094,12 +13036,12 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - sv_cv_fault_aix="guessing no" + sv_cv_fault_macosdarwin5_ppc="guessing no" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_fault_aix=no + sv_cv_fault_macosdarwin5_ppc=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ @@ -13121,7 +13063,7 @@ #if HAVE_SYS_SIGNAL_H # include #endif - +#include "$srcdir/src/fault-macosdarwin5-powerpc.c" #include #include #if HAVE_MMAP_DEVZERO @@ -13147,7 +13089,7 @@ int handler_called = 0; void sigsegv_handler (int sig, int code, struct sigcontext *scp) { - void *fault_address = (void *) (scp->sc_jmpbuf.jmp_context.o_vaddr); + void *fault_address = (void *) (get_fault_addr (scp)); handler_called++; if (handler_called == 10) exit (4); @@ -13221,14 +13163,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_fault_aix=yes + sv_cv_fault_macosdarwin5_ppc=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_fault_aix=no +sv_cv_fault_macosdarwin5_ppc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -13236,9 +13178,10 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_fault_aix" >&5 -echo "${ECHO_T}$sv_cv_fault_aix" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_fault_macosdarwin5_ppc" >&5 +echo "${ECHO_T}$sv_cv_fault_macosdarwin5_ppc" >&6; } +fi @@ -13442,338 +13385,968 @@ echo "${ECHO_T}$sv_cv_fault_hurd" >&6; } - CFG_FAULT=fault-none.h - if test "$sv_cv_fault_aix" = yes; then - case "$host_cpu" in - powerpc* | rs6000) CFG_FAULT=fault-aix-powerpc.h ;; - *) CFG_FAULT=fault-aix.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_irix" = yes; then - case "$host_cpu" in - mips*) CFG_FAULT=fault-irix-mips.h ;; - *) CFG_FAULT=fault-irix.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_hpux_hppa" = yes; then - case "$host_cpu" in - hppa* | parisc*) CFG_FAULT=fault-hpux-hppa.h ;; - *) CFG_FAULT=fault-hpux.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_osf_alpha" = yes; then - case "$host_cpu" in - alpha*) CFG_FAULT=fault-osf-alpha.h ;; - *) CFG_FAULT=fault-osf.h ;; - esac +# End of MacOS X special casing. + ;; +esac + +CFG_HANDLER= +CFG_FAULT= +CFG_MACHFAULT= +FAULT_CONTEXT=void +FAULT_CONTEXT_INCLUDE= +FAULT_CONTEXT_INCLUDE2= +if test -z "$CFG_FAULT" && test "$sv_cv_fault_aix" = yes; then + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-aix3-powerpc.h ;; + *) CFG_FAULT=fault-aix3.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_irix" = yes; then + case "$host_cpu" in + mips*) CFG_FAULT=fault-irix-mips.h ;; + *) CFG_FAULT=fault-irix.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_hpux_hppa" = yes; then + case "$host_cpu" in + hppa* | parisc*) CFG_FAULT=fault-hpux-hppa.h ;; + *) CFG_FAULT=fault-hpux.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_osf_alpha" = yes; then + case "$host_cpu" in + alpha*) CFG_FAULT=fault-osf-alpha.h ;; + *) CFG_FAULT=fault-osf.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_netbsd_alpha" = yes; then + case "$host_cpu" in + alpha*) CFG_FAULT=fault-netbsd-alpha.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_i386" = yes; then + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-linux-i386.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_i386_old" = yes; then + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-linux-i386-old.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_powerpc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-linux-powerpc.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_hppa" = yes; then + case "$host_cpu" in + hppa* | parisc*) CFG_FAULT=fault-linux-hppa.h ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_hurd" = yes; then + case "$host_os" in + netbsd*) # A false positive. + ;; + *) + CFG_FAULT=fault-hurd.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_netbsd_alpha" = yes; then + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_bsd" = yes; then + case "$host_os" in + freebsd*) case "$host_cpu" in - alpha*) CFG_FAULT=fault-netbsd-alpha.h ;; + i?86 | x86_64) + CFG_FAULT=fault-freebsd-i386.h + FAULT_CONTEXT='struct sigcontext' + ;; + *) + CFG_FAULT=fault-bsd.h + FAULT_CONTEXT='void' + ;; esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_i386" = yes; then + ;; + *) + CFG_FAULT=fault-bsd.h + FAULT_CONTEXT='void' + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_posix" = yes; then + case "$host_os" in + openbsd*) case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-linux-i386.h ;; + i?86 | x86_64) CFG_FAULT=fault-openbsd-i386.h ;; + *) CFG_FAULT=fault-openbsd.h ;; esac FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_i386_old" = yes; then + ;; + linux*) case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-linux-i386-old.h ;; + ia64) + CFG_FAULT=fault-linux-ia64.h + FAULT_CONTEXT='struct sigcontext' + ;; esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_m68k" = yes; then + ;; + esac + if test -z "$CFG_FAULT"; then + case "$host_os" in + solaris*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-solaris-i386.h ;; + sparc*) CFG_FAULT=fault-solaris-sparc.h ;; + *) CFG_FAULT=fault-solaris.h ;; + esac + ;; + aix*) + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-aix5-powerpc.h ;; + *) CFG_FAULT=fault-aix5.h ;; + esac + ;; + netbsd*) + CFG_FAULT=fault-netbsd.h + ;; + *) + CFG_FAULT=fault-posix.h + ;; + esac + FAULT_CONTEXT='ucontext_t' + FAULT_CONTEXT_INCLUDE='#include ' + fi +fi +if test -z "$CFG_FAULT"; then + case "$host_os" in + macos* | darwin[6-9]* | darwin[1-9][0-9]*) case "$host_cpu" in - m68*) CFG_FAULT=fault-linux-m68k.h ;; + powerpc* | rs6000) + CFG_MACHFAULT=machfault-macos-powerpc.h + FAULT_CONTEXT='ppc_thread_state_t' + ;; + i?86 | x86_64) + CFG_MACHFAULT=machfault-macos-i386.h + FAULT_CONTEXT='i386_thread_state_t' + ;; esac + if test -n "$CFG_MACHFAULT"; then + CFG_HANDLER=handler-macos.c + FAULT_CONTEXT_INCLUDE='#include ' + FAULT_CONTEXT_INCLUDE2='#include ' + CFG_FAULT=fault-macos.h # nonexistent, just a dummy + fi + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_m68k" = yes; then + case "$host_cpu" in + m68*) + CFG_FAULT=fault-linux-m68k.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_powerpc" = yes; then - case "$host_cpu" in - powerpc* | rs6000) CFG_FAULT=fault-linux-powerpc.h ;; - esac + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_macosdarwin7_ppc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) + CFG_FAULT=fault-macosdarwin7-powerpc.h + FAULT_CONTEXT='ucontext_t' + FAULT_CONTEXT_INCLUDE='#include ' + FAULT_CONTEXT_INCLUDE2='#include ' + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_macosdarwin5_ppc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) + CFG_FAULT=fault-macosdarwin5-powerpc.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_hppa" = yes; then + ;; + esac +fi +if test -z "$CFG_FAULT"; then + case "$host_os" in + mingw* | cygwin*) + FAULT_CONTEXT='CONTEXT' + FAULT_CONTEXT_INCLUDE='#include ' + CFG_FAULT=fault-win32.h # nonexistent, just a dummy + ;; + esac +fi +if test -n "$CFG_FAULT"; then + sv_cv_have_sigsegv_recovery=yes +else + sv_cv_have_sigsegv_recovery=no + case "$host_os" in + linux*) case "$host_cpu" in - hppa* | parisc*) CFG_FAULT=fault-linux-hppa.h ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_hurd" = yes; then - case "$host_os" in - netbsd*) # A false positive. + alpha*) + CFG_FAULT=fault-linux-alpha.h + FAULT_CONTEXT='struct sigcontext' ;; - *) - CFG_FAULT=fault-hurd.h + arm* | strongarm* | xscale*) + CFG_FAULT=fault-linux-arm.h FAULT_CONTEXT='struct sigcontext' ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_bsd" = yes; then - case "$host_os" in - freebsd*) - case "$host_cpu" in - i?86 | x86_64) - CFG_FAULT=fault-freebsd-i386.h - FAULT_CONTEXT='struct sigcontext' - ;; - *) - CFG_FAULT=fault-bsd.h - FAULT_CONTEXT='void' - ;; - esac + cris) + CFG_FAULT=fault-linux-cris.h + FAULT_CONTEXT='struct sigcontext' ;; - *) - CFG_FAULT=fault-bsd.h - FAULT_CONTEXT='void' + mips*) + CFG_FAULT=fault-linux-mips.h + FAULT_CONTEXT='struct sigcontext' ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_posix" = yes; then - case "$host_os" in - openbsd*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-openbsd-i386.h ;; - *) CFG_FAULT=fault-openbsd.h ;; - esac + s390*) + CFG_FAULT=fault-linux-s390.h FAULT_CONTEXT='struct sigcontext' ;; - linux*) - case "$host_cpu" in - ia64) - CFG_FAULT=fault-linux-ia64.h - FAULT_CONTEXT='struct sigcontext' - ;; - esac + sh*) + CFG_FAULT=fault-linux-sh.h + FAULT_CONTEXT='struct sigcontext' ;; - esac - if test "$CFG_FAULT" = fault-none.h; then - case "$host_os" in - solaris*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-solaris-i386.h ;; - sparc*) CFG_FAULT=fault-solaris-sparc.h ;; - *) CFG_FAULT=fault-solaris.h ;; - esac - ;; - *) - CFG_FAULT=fault-posix.h - ;; - esac - FAULT_CONTEXT='ucontext_t' - FAULT_CONTEXT_INCLUDE='#include ' - fi - fi - if test "$CFG_FAULT" = fault-none.h; then - sv_cv_have_sigsegv_recovery=no - case "$host_os" in - linux*) - case "$host_cpu" in - alpha*) - CFG_FAULT=fault-linux-alpha.h - FAULT_CONTEXT='struct sigcontext' - ;; - arm* | strongarm* | xscale*) - CFG_FAULT=fault-linux-arm.h - FAULT_CONTEXT='struct sigcontext' - ;; - cris) - CFG_FAULT=fault-linux-cris.h - FAULT_CONTEXT='struct sigcontext' - ;; - mips*) - CFG_FAULT=fault-linux-mips.h - FAULT_CONTEXT='struct sigcontext' - ;; - s390*) - CFG_FAULT=fault-linux-s390.h - FAULT_CONTEXT='struct sigcontext' - ;; - sh*) - CFG_FAULT=fault-linux-sh.h - FAULT_CONTEXT='struct sigcontext' - ;; - sparc*) - CFG_FAULT=fault-linux-sparc.h - FAULT_CONTEXT='struct sigcontext' - ;; - x86_64) - CFG_FAULT=fault-linux-x86_64.h - FAULT_CONTEXT='struct sigcontext' - ;; - esac + sparc*) + CFG_FAULT=fault-linux-sparc.h + FAULT_CONTEXT='struct sigcontext' ;; - beos*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-beos-i386.h ;; - *) CFG_FAULT=fault-beos.h ;; - esac - FAULT_CONTEXT='struct vregs' + x86_64) + CFG_FAULT=fault-linux-x86_64.h + FAULT_CONTEXT='struct sigcontext' ;; esac - else - sv_cv_have_sigsegv_recovery=yes - fi + ;; + beos*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-beos-i386.h ;; + *) CFG_FAULT=fault-beos.h ;; + esac + FAULT_CONTEXT='struct vregs' + ;; + macos* | darwin*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-macos-i386.h ;; + esac + FAULT_CONTEXT='struct sigcontext' + ;; + esac +fi +{ echo "$as_me:$LINENO: checking for the fault handler specifics" >&5 +echo $ECHO_N "checking for the fault handler specifics... $ECHO_C" >&6; } +if test -n "$CFG_FAULT"; then + sv_cv_fault_include=$CFG_FAULT +else + if test -n "$CFG_MACHFAULT"; then + sv_cv_fault_include=$CFG_MACHFAULT + else + sv_cv_fault_include=none + fi +fi +{ echo "$as_me:$LINENO: result: $sv_cv_fault_include" >&5 +echo "${ECHO_T}$sv_cv_fault_include" >&6; } +if test -z "$CFG_FAULT"; then + CFG_FAULT=fault-none.h +fi - # How to longjmp out of a signal handler, in such a way that the - # alternate signal stack remains functional. - CFG_LEAVE=leave-none.c +cat >>confdefs.h <<_ACEOF +#define CFG_FAULT "$CFG_FAULT" +_ACEOF +if test -z "$CFG_MACHFAULT"; then + CFG_MACHFAULT=fault-none.h +fi +cat >>confdefs.h <<_ACEOF +#define CFG_MACHFAULT "$CFG_MACHFAULT" +_ACEOF - { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp" >&5 -echo $ECHO_N "checking whether a signal handler can be left through longjmp... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_longjmp+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - case "$host" in - *-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]*) sv_cv_leave_handler_longjmp=yes ;; - *) sv_cv_leave_handler_longjmp="guessing no" ;; - esac +{ echo "$as_me:$LINENO: checking if the system supports catching SIGSEGV" >&5 +echo $ECHO_N "checking if the system supports catching SIGSEGV... $ECHO_C" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_have_sigsegv_recovery" >&5 +echo "${ECHO_T}$sv_cv_have_sigsegv_recovery" >&6; } +if test $sv_cv_have_sigsegv_recovery != no; then + HAVE_SIGSEGV_RECOVERY=1 else - cat >conftest.$ac_ext <<_ACEOF + HAVE_SIGSEGV_RECOVERY=0 +fi - /* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -#include -#include -#if HAVE_SETRLIMIT -# include -# include -# include +{ echo "$as_me:$LINENO: checking for stack direction" >&5 +echo $ECHO_N "checking for stack direction... $ECHO_C" >&6; } +if test "${sv_cv_stack_direction_msg+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + case "$host_cpu" in + a29k | \ + alpha* | \ + arc | \ + arm* | strongarm* | xscale* | \ + avr | \ + c1 | c2 | c32 | c34 | c38 | \ + clipper | \ + cris | \ + d30v | \ + elxsi | \ + fr30 | \ + h8300 | \ + i?86 | x86_64 | \ + i860 | \ + ia64 | \ + m32r | \ + m68* | \ + m88k | \ + mcore | \ + mips* | \ + mmix | \ + mn10200 | \ + mn10300 | \ + ns32k | \ + pdp11 | \ + pj* | \ + powerpc* | rs6000 | \ + romp | \ + s390* | \ + sh* | \ + sparc* | \ + v850 | \ + vax | \ + xtensa) + sv_cv_stack_direction=-1 ;; + c4x | \ + dsp16xx | \ + i960 | \ + hppa* | parisc* | \ + stormy16 | \ + we32k) + sv_cv_stack_direction=1 ;; + *) + if test $cross_compiling = no; then + cat > conftest.c < +int +get_stack_direction () +{ + auto char dummy; + static char *dummyaddr = (char *)0; + if (dummyaddr != (char *)0) + return &dummy > dummyaddr ? 1 : &dummy < dummyaddr ? -1 : 0; + else + { + dummyaddr = &dummy; + { + int result = get_stack_direction (); + /* The next assignment avoids tail recursion elimination + (IRIX 6.4 CC). */ + dummyaddr = (char *)0; + return result; + } + } +} +int +main () +{ + printf ("%d\n", get_stack_direction ()); + return 0; +} +EOF + { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + sv_cv_stack_direction=`./conftest` + else + sv_cv_stack_direction=0 + fi + ;; + esac + case $sv_cv_stack_direction in + 1) sv_cv_stack_direction_msg="grows up";; + -1) sv_cv_stack_direction_msg="grows down";; + *) sv_cv_stack_direction_msg="unknown";; + esac + +fi +{ echo "$as_me:$LINENO: result: $sv_cv_stack_direction_msg" >&5 +echo "${ECHO_T}$sv_cv_stack_direction_msg" >&6; } + +cat >>confdefs.h <<_ACEOF +#define STACK_DIRECTION $sv_cv_stack_direction +_ACEOF + + +{ echo "$as_me:$LINENO: checking for PIOCMAP in sys/procfs.h" >&5 +echo $ECHO_N "checking for PIOCMAP in sys/procfs.h... $ECHO_C" >&6; } +if test "${sv_cv_procfsvma+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +int +main () +{ +int x = PIOCNMAP + PIOCMAP; prmap_t y; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + sv_cv_procfsvma=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + sv_cv_procfsvma=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ echo "$as_me:$LINENO: result: $sv_cv_procfsvma" >&5 +echo "${ECHO_T}$sv_cv_procfsvma" >&6; } + +for ac_func in mincore +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$ac_func || defined __stub___$ac_func +choke me +#endif + +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + eval "$as_ac_var=no" +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +fi +ac_res=`eval echo '${'$as_ac_var'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&6; } +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +CFG_STACKVMA= +if test $sv_cv_procfsvma = yes; then + CFG_STACKVMA=stackvma-procfs.c +else + case "$host_os" in + linux*) CFG_STACKVMA=stackvma-linux.c ;; + freebsd*) CFG_STACKVMA=stackvma-freebsd.c ;; + beos*) CFG_STACKVMA=stackvma-beos.c ;; + macos* | darwin*) CFG_STACKVMA=stackvma-mach.c ;; + esac +fi +if test -z "$CFG_STACKVMA" && test $ac_cv_func_mincore = yes; then + CFG_STACKVMA=stackvma-mincore.c +fi +if test -n "$CFG_STACKVMA"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_STACKVMA 1 +_ACEOF + +else + CFG_STACKVMA=stackvma-none.c +fi + +cat >>confdefs.h <<_ACEOF +#define CFG_STACKVMA "$CFG_STACKVMA" +_ACEOF + + + + + +for ac_func in getrlimit setrlimit +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$ac_func || defined __stub___$ac_func +choke me +#endif + +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + eval "$as_ac_var=no" +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +fi +ac_res=`eval echo '${'$as_ac_var'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&6; } +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + + + + + +for ac_func in sigaltstack +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +{ echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } +if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include #endif -jmp_buf mainloop; -sigset_t mainsigset; -int pass = 0; -void stackoverflow_handler (int sig) + +#undef $ac_func + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$ac_func || defined __stub___$ac_func +choke me +#endif + +int +main () { - pass++; - sigprocmask (SIG_SETMASK, &mainsigset, NULL); - { } - longjmp (mainloop, pass); +return $ac_func (); + ; + return 0; } -int recurse (int n) +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + eval "$as_ac_var=no" +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +fi +ac_res=`eval echo '${'$as_ac_var'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&6; } +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + if test "$ac_cv_func_sigaltstack" = yes; then + { echo "$as_me:$LINENO: checking for stack_t" >&5 +echo $ECHO_N "checking for stack_t... $ECHO_C" >&6; } +if test "${ac_cv_type_stack_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#if HAVE_SYS_SIGNAL_H +# include +#endif + + +typedef stack_t ac__type_new_; +int +main () { - if (n >= 0) - return n + recurse (n + 1); - else - return 0; +if ((ac__type_new_ *) 0) + return 0; +if (sizeof (ac__type_new_)) + return 0; + ; + return 0; } -int main () +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_type_stack_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_stack_t=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ echo "$as_me:$LINENO: result: $ac_cv_type_stack_t" >&5 +echo "${ECHO_T}$ac_cv_type_stack_t" >&6; } +if test $ac_cv_type_stack_t = yes; then + : +else + +cat >>confdefs.h <<\_ACEOF +#define stack_t struct sigaltstack +_ACEOF + + +fi + + fi + + { echo "$as_me:$LINENO: checking for working sigaltstack" >&5 +echo $ECHO_N "checking for working sigaltstack... $ECHO_C" >&6; } +if test "${sv_cv_sigaltstack+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + if test "$ac_cv_func_sigaltstack" = yes; then + case "$host_os" in + macos* | darwin[6-9]* | darwin[1-9][0-9]*) + # On MacOS X 10.2 or newer, just assume that if it compiles, it will + # work. If we were to perform the real test, 1 Crash Report dialog + # window would pop up. + cat >conftest.$ac_ext <<_ACEOF + + /* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +int +main () { - char mystack[16384]; - stack_t altstack; - struct sigaction action; - sigset_t emptyset; -#if defined HAVE_SETRLIMIT && defined RLIMIT_STACK - /* Before starting the endless recursion, try to be friendly to the user's - machine. On some Linux 2.2.x systems, there is no stack limit for user - processes at all. We don't want to kill such systems. */ - struct rlimit rl; - rl.rlim_cur = rl.rlim_max = 0x100000; /* 1 MB */ - setrlimit (RLIMIT_STACK, &rl); -#endif - /* Install the alternate stack. */ - altstack.ss_sp = mystack; - altstack.ss_size = sizeof (mystack); - altstack.ss_flags = 0; /* no SS_DISABLE */ - if (sigaltstack (&altstack, NULL) < 0) - exit (1); - /* Install the SIGSEGV handler. */ - sigemptyset (&action.sa_mask); - action.sa_handler = &stackoverflow_handler; - action.sa_flags = SA_ONSTACK; - sigaction (SIGSEGV, &action, (struct sigaction *) NULL); - sigaction (SIGBUS, &action, (struct sigaction *) NULL); - /* Save the current signal mask. */ - sigemptyset (&emptyset); - sigprocmask (SIG_BLOCK, &emptyset, &mainsigset); - /* Provoke two stack overflows in a row. */ - if (setjmp (mainloop) < 2) - { - recurse (0); - exit (2); - } - exit (0); +int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss); + ; + return 0; } _ACEOF -rm -f conftest$ac_exeext +rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_link") 2>&5 + (eval "$ac_link") 2>conftest.er1 ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (case "(($ac_try" in + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + sv_cv_sigaltstack="guessing yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + sv_cv_sigaltstack=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext + ;; + *) + if test "$cross_compiling" = yes; then + + case "$host_os" in + *) + cat >conftest.$ac_ext <<_ACEOF + + /* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +int +main () +{ +int x = SA_ONSTACK; stack_t ss; sigaltstack ((stack_t*)0, &ss); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_try") 2>&5 + (eval "$ac_link") 2>conftest.er1 ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - sv_cv_leave_handler_longjmp=yes + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + sv_cv_sigaltstack="guessing yes" else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -sv_cv_leave_handler_longjmp=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi - - - + sv_cv_sigaltstack=no fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_longjmp" >&6; } - - - - - - - { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp and sigaltstack" >&5 -echo $ECHO_N "checking whether a signal handler can be left through longjmp and sigaltstack... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_longjmp_sigaltstack+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - case "$host" in - *-*-freebsd*) sv_cv_leave_handler_longjmp_sigaltstack=yes ;; - *) sv_cv_leave_handler_longjmp_sigaltstack="guessing no" ;; - esac +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext + ;; + esac else cat >conftest.$ac_ext <<_ACEOF - /* confdefs.h. */ + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF @@ -13781,46 +14354,35 @@ #include #include -#include - -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif - +#if HAVE_SYS_SIGNAL_H +# include +#endif #if HAVE_SETRLIMIT # include # include # include #endif -jmp_buf mainloop; -sigset_t mainsigset; -int pass = 0; void stackoverflow_handler (int sig) { - pass++; - sigprocmask (SIG_SETMASK, &mainsigset, NULL); - { stack_t ss; - if (sigaltstack (NULL, &ss) >= 0) - { - ss.ss_flags &= ~SS_ONSTACK; - sigaltstack (&ss, NULL); - } - } - longjmp (mainloop, pass); + /* If we get here, the stack overflow was caught. */ + exit (0); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { char mystack[16384]; stack_t altstack; struct sigaction action; - sigset_t emptyset; #if defined HAVE_SETRLIMIT && defined RLIMIT_STACK /* Before starting the endless recursion, try to be friendly to the user's machine. On some Linux 2.2.x systems, there is no stack limit for user @@ -13841,16 +14403,9 @@ action.sa_flags = SA_ONSTACK; sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); - /* Save the current signal mask. */ - sigemptyset (&emptyset); - sigprocmask (SIG_BLOCK, &emptyset, &mainsigset); - /* Provoke two stack overflows in a row. */ - if (setjmp (mainloop) < 2) - { - recurse (0); - exit (2); - } - exit (0); + /* Provoke a stack overflow. */ + recurse (0); + exit (2); } _ACEOF rm -f conftest$ac_exeext @@ -13873,39 +14428,157 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_leave_handler_longjmp_sigaltstack=yes + sv_cv_sigaltstack=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_leave_handler_longjmp_sigaltstack=no +sv_cv_sigaltstack=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi + ;; + esac + else + sv_cv_sigaltstack=no + fi fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp_sigaltstack" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_longjmp_sigaltstack" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_sigaltstack" >&5 +echo "${ECHO_T}$sv_cv_sigaltstack" >&6; } + if test "$sv_cv_sigaltstack" != no; then +cat >>confdefs.h <<\_ACEOF +#define HAVE_WORKING_SIGALTSTACK 1 +_ACEOF + fi +{ echo "$as_me:$LINENO: checking if the system supports catching stack overflow" >&5 +echo $ECHO_N "checking if the system supports catching stack overflow... $ECHO_C" >&6; } +if test "${sv_cv_have_stack_overflow_recovery+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$CFG_MACHFAULT" != fault-none.h; then + sv_cv_have_stack_overflow_recovery=yes + else + if test "$sv_cv_sigaltstack" != no; then + sv_cv_have_stack_overflow_recovery=maybe + else + case "$host_os" in + beos*) sv_cv_have_stack_overflow_recovery=maybe ;; + mingw* | cygwin*) sv_cv_have_stack_overflow_recovery=yes ;; + *) sv_cv_have_stack_overflow_recovery=no ;; + esac + fi + fi + if test $sv_cv_have_stack_overflow_recovery = maybe; then + if test -n "$CFG_FAULT"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ - { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp and setcontext" >&5 -echo $ECHO_N "checking whether a signal handler can be left through longjmp and setcontext... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_longjmp_setcontext+set}" = set; then +#include "$srcdir/src/$CFG_FAULT" +#ifdef SIGSEGV_FAULT_HANDLER_ARGLIST +#ifdef SIGSEGV_FAULT_ADDRESS +xyzzy +#endif +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "xyzzy" >/dev/null 2>&1; then + condA=true +else + condA=false +fi +rm -f conftest* + + else + condA=false + fi + if test -n "$CFG_FAULT"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include "$srcdir/src/$CFG_FAULT" +#ifdef SIGSEGV_FAULT_HANDLER_ARGLIST +#ifdef SIGSEGV_FAULT_STACKPOINTER +xyzzy +#endif +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "xyzzy" >/dev/null 2>&1; then + condB=true +else + condB=false +fi +rm -f conftest* + + else + condB=false + fi + if test "$CFG_STACKVMA" != "stackvma-none.c"; then + condC=true + else + condC=false + fi + if { $condA && $condB; } || { $condA && $condC; } || { $condB && $condC; }; then + sv_cv_have_stack_overflow_recovery=yes + else + sv_cv_have_stack_overflow_recovery=no + fi + fi + +fi +{ echo "$as_me:$LINENO: result: $sv_cv_have_stack_overflow_recovery" >&5 +echo "${ECHO_T}$sv_cv_have_stack_overflow_recovery" >&6; } +if test $sv_cv_have_stack_overflow_recovery != no; then + HAVE_STACK_OVERFLOW_RECOVERY=1 +else + HAVE_STACK_OVERFLOW_RECOVERY=0 +fi + + +# How to longjmp out of a signal handler, in such a way that the +# alternate signal stack remains functional. + +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 2 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[6-9]* | darwin[1-9][0-9]*) ;; + *) + + + + + + { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp" >&5 +echo $ECHO_N "checking whether a signal handler can be left through longjmp... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_longjmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - *-*-irix* | *-*-solaris*) sv_cv_leave_handler_longjmp_setcontext=yes ;; - *) sv_cv_leave_handler_longjmp_setcontext="guessing no" ;; + *-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]*) sv_cv_leave_handler_longjmp=yes ;; + *) sv_cv_leave_handler_longjmp="guessing no" ;; esac else @@ -13920,10 +14593,6 @@ #include #include #include -#include -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif #if HAVE_SETRLIMIT # include @@ -13937,26 +14606,19 @@ { pass++; sigprocmask (SIG_SETMASK, &mainsigset, NULL); - { static int fl; - static ucontext_t uc; - fl = 0; - if (getcontext (&uc) >= 0) - if (fl == 0) - if (uc.uc_stack.ss_flags & SS_ONSTACK) - { - uc.uc_stack.ss_flags &= ~SS_ONSTACK; - fl = 1; - setcontext (&uc); - } - } + { } longjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { @@ -14016,14 +14678,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_leave_handler_longjmp_setcontext=yes + sv_cv_leave_handler_longjmp=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_leave_handler_longjmp_setcontext=no +sv_cv_leave_handler_longjmp=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -14031,27 +14693,24 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp_setcontext" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_longjmp_setcontext" >&6; } - +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_longjmp" >&6; } - # How to siglongjmp out of a signal handler, in such a way that the - # alternate signal stack remains functional. - { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp" >&5 -echo $ECHO_N "checking whether a signal handler can be left through siglongjmp... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_siglongjmp+set}" = set; then + { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp and sigaltstack" >&5 +echo $ECHO_N "checking whether a signal handler can be left through longjmp and sigaltstack... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_longjmp_sigaltstack+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - *-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]* | *-*-irix* | *-*-solaris*) sv_cv_leave_handler_siglongjmp=yes ;; - *) sv_cv_leave_handler_siglongjmp="guessing no" ;; + *-*-freebsd*) sv_cv_leave_handler_longjmp_sigaltstack=yes ;; + *) sv_cv_leave_handler_longjmp_sigaltstack="guessing no" ;; esac else @@ -14067,35 +14726,48 @@ #include #include +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + #if HAVE_SETRLIMIT # include # include # include #endif -sigjmp_buf mainloop; +jmp_buf mainloop; +sigset_t mainsigset; int pass = 0; void stackoverflow_handler (int sig) { pass++; - { } - siglongjmp (mainloop, pass); + sigprocmask (SIG_SETMASK, &mainsigset, NULL); + { stack_t ss; + if (sigaltstack (NULL, &ss) >= 0) + { + ss.ss_flags &= ~SS_ONSTACK; + sigaltstack (&ss, NULL); + } + } + longjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { char mystack[16384]; stack_t altstack; struct sigaction action; -#ifdef __BEOS__ - /* On BeOS, this would hang, burning CPU time. Better fail than hang. */ - exit (1); -#endif + sigset_t emptyset; #if defined HAVE_SETRLIMIT && defined RLIMIT_STACK /* Before starting the endless recursion, try to be friendly to the user's machine. On some Linux 2.2.x systems, there is no stack limit for user @@ -14116,8 +14788,11 @@ action.sa_flags = SA_ONSTACK; sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* Save the current signal mask. */ + sigemptyset (&emptyset); + sigprocmask (SIG_BLOCK, &emptyset, &mainsigset); /* Provoke two stack overflows in a row. */ - if (sigsetjmp (mainloop, 1) < 2) + if (setjmp (mainloop) < 2) { recurse (0); exit (2); @@ -14145,14 +14820,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_leave_handler_siglongjmp=yes + sv_cv_leave_handler_longjmp_sigaltstack=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_leave_handler_siglongjmp=no +sv_cv_leave_handler_longjmp_sigaltstack=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -14160,24 +14835,24 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp" >&6; } - - +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp_sigaltstack" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_longjmp_sigaltstack" >&6; } - { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp and sigaltstack" >&5 -echo $ECHO_N "checking whether a signal handler can be left through siglongjmp and sigaltstack... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_siglongjmp_sigaltstack+set}" = set; then + + + { echo "$as_me:$LINENO: checking whether a signal handler can be left through longjmp and setcontext" >&5 +echo $ECHO_N "checking whether a signal handler can be left through longjmp and setcontext... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_longjmp_setcontext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - *-*-freebsd*) sv_cv_leave_handler_siglongjmp_sigaltstack=yes ;; - *) sv_cv_leave_handler_siglongjmp_sigaltstack="guessing no" ;; + *-*-irix* | *-*-solaris*) sv_cv_leave_handler_longjmp_setcontext=yes ;; + *) sv_cv_leave_handler_longjmp_setcontext="guessing no" ;; esac else @@ -14192,46 +14867,54 @@ #include #include #include - -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif +#include +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif #if HAVE_SETRLIMIT # include # include # include #endif -sigjmp_buf mainloop; +jmp_buf mainloop; +sigset_t mainsigset; int pass = 0; void stackoverflow_handler (int sig) { pass++; - { stack_t ss; - if (sigaltstack (NULL, &ss) >= 0) + sigprocmask (SIG_SETMASK, &mainsigset, NULL); + { static int fl; + static ucontext_t uc; + fl = 0; + if (getcontext (&uc) >= 0) + if (fl == 0) + if (uc.uc_stack.ss_flags & SS_ONSTACK) { - ss.ss_flags &= ~SS_ONSTACK; - sigaltstack (&ss, NULL); + uc.uc_stack.ss_flags &= ~SS_ONSTACK; + fl = 1; + setcontext (&uc); } - } - siglongjmp (mainloop, pass); + } + longjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { char mystack[16384]; stack_t altstack; struct sigaction action; -#ifdef __BEOS__ - /* On BeOS, this would hang, burning CPU time. Better fail than hang. */ - exit (1); -#endif + sigset_t emptyset; #if defined HAVE_SETRLIMIT && defined RLIMIT_STACK /* Before starting the endless recursion, try to be friendly to the user's machine. On some Linux 2.2.x systems, there is no stack limit for user @@ -14252,8 +14935,11 @@ action.sa_flags = SA_ONSTACK; sigaction (SIGSEGV, &action, (struct sigaction *) NULL); sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* Save the current signal mask. */ + sigemptyset (&emptyset); + sigprocmask (SIG_BLOCK, &emptyset, &mainsigset); /* Provoke two stack overflows in a row. */ - if (sigsetjmp (mainloop, 1) < 2) + if (setjmp (mainloop) < 2) { recurse (0); exit (2); @@ -14281,14 +14967,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_leave_handler_siglongjmp_sigaltstack=yes + sv_cv_leave_handler_longjmp_setcontext=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_leave_handler_siglongjmp_sigaltstack=no +sv_cv_leave_handler_longjmp_setcontext=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -14296,24 +14982,38 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp_sigaltstack" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp_sigaltstack" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_longjmp_setcontext" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_longjmp_setcontext" >&6; } +# End of MacOS X special casing. + ;; +esac +# How to siglongjmp out of a signal handler, in such a way that the +# alternate signal stack remains functional. +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 2 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[6-9]* | darwin[1-9][0-9]*) ;; + *) - { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp and setcontext" >&5 -echo $ECHO_N "checking whether a signal handler can be left through siglongjmp and setcontext... $ECHO_C" >&6; } -if test "${sv_cv_leave_handler_siglongjmp_setcontext+set}" = set; then + + + + { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp" >&5 +echo $ECHO_N "checking whether a signal handler can be left through siglongjmp... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_siglongjmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then case "$host" in - - *) sv_cv_leave_handler_siglongjmp_setcontext="guessing no" ;; + *-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]* | *-*-irix* | *-*-solaris*) sv_cv_leave_handler_siglongjmp=yes ;; + *) sv_cv_leave_handler_siglongjmp="guessing no" ;; esac else @@ -14328,10 +15028,6 @@ #include #include #include -#include -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif #if HAVE_SETRLIMIT # include @@ -14343,26 +15039,19 @@ void stackoverflow_handler (int sig) { pass++; - { static int fl; - static ucontext_t uc; - fl = 0; - if (getcontext(&uc) >= 0) - if (fl == 0) - if (uc.uc_stack.ss_flags & SS_ONSTACK) - { - uc.uc_stack.ss_flags &= ~SS_ONSTACK; - fl = 1; - setcontext(&uc); - } - } + { } siglongjmp (mainloop, pass); } -int recurse (int n) +volatile int * recurse_1 (volatile int n, volatile int *p) { if (n >= 0) - return n + recurse (n + 1); - else - return 0; + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); } int main () { @@ -14422,14 +15111,14 @@ ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - sv_cv_leave_handler_siglongjmp_setcontext=yes + sv_cv_leave_handler_siglongjmp=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) -sv_cv_leave_handler_siglongjmp_setcontext=no +sv_cv_leave_handler_siglongjmp=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi @@ -14437,327 +15126,340 @@ fi -{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp_setcontext" >&5 -echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp_setcontext" >&6; } +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp" >&6; } - if test "$sv_cv_leave_handler_longjmp" != no; then - CFG_LEAVE=leave-nop.c - else - if test "$sv_cv_leave_handler_longjmp_sigaltstack" != no; then - CFG_LEAVE=leave-sigaltstack.c - else - if test "$sv_cv_leave_handler_longjmp_setcontext" != no; then - CFG_LEAVE=leave-setcontext.c - fi - fi - fi - case "$host_os" in - # On BeOS, the 6 tests fail because sigaltstack() doesn't exist. - # If one uses set_signal_stack() instead of sigaltstack(), the first - # test actually works. i.e. sv_cv_leave_handler_longjmp would be 'yes'. - beos*) - CFG_LEAVE=leave-nop.c - sv_cv_have_stack_overflow_recovery=yes - ;; - *) - if test "$sv_cv_sigaltstack" = no; then - sv_cv_have_stack_overflow_recovery=no - fi - ;; - esac - ;; -esac -{ echo "$as_me:$LINENO: checking if the system supports catching SIGSEGV" >&5 -echo $ECHO_N "checking if the system supports catching SIGSEGV... $ECHO_C" >&6; } -{ echo "$as_me:$LINENO: result: $sv_cv_have_sigsegv_recovery" >&5 -echo "${ECHO_T}$sv_cv_have_sigsegv_recovery" >&6; } -if test $sv_cv_have_sigsegv_recovery != no; then - HAVE_SIGSEGV_RECOVERY=1 -else - HAVE_SIGSEGV_RECOVERY=0 -fi -{ echo "$as_me:$LINENO: checking for stack direction" >&5 -echo $ECHO_N "checking for stack direction... $ECHO_C" >&6; } -if test "${sv_cv_stack_direction_msg+set}" = set; then + + { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp and sigaltstack" >&5 +echo $ECHO_N "checking whether a signal handler can be left through siglongjmp and sigaltstack... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_siglongjmp_sigaltstack+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - case "$host_cpu" in - a29k | \ - alpha* | \ - arc | \ - arm* | strongarm* | xscale* | \ - avr | \ - c1 | c2 | c32 | c34 | c38 | \ - clipper | \ - cris | \ - d30v | \ - elxsi | \ - fr30 | \ - h8300 | \ - i?86 | x86_64 | \ - i860 | \ - ia64 | \ - m32r | \ - m68* | \ - m88k | \ - mcore | \ - mips* | \ - mmix | \ - mn10200 | \ - mn10300 | \ - ns32k | \ - pdp11 | \ - pj* | \ - powerpc* | rs6000 | \ - romp | \ - s390* | \ - sh* | \ - sparc* | \ - v850 | \ - vax | \ - xtensa) - sv_cv_stack_direction=-1 ;; - c4x | \ - dsp16xx | \ - i960 | \ - hppa* | parisc* | \ - stormy16 | \ - we32k) - sv_cv_stack_direction=1 ;; - *) - if test $cross_compiling = no; then - cat > conftest.c < -int -get_stack_direction () -{ - auto char dummy; - static char *dummyaddr = (char *)0; - if (dummyaddr != (char *)0) - return &dummy > dummyaddr ? 1 : &dummy < dummyaddr ? -1 : 0; - else - { - dummyaddr = &dummy; - { - int result = get_stack_direction (); - /* The next assignment avoids tail recursion elimination - (IRIX 6.4 CC). */ - dummyaddr = (char *)0; - return result; - } - } -} -int -main () -{ - printf ("%d\n", get_stack_direction ()); - return 0; -} -EOF - { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } - sv_cv_stack_direction=`./conftest` - else - sv_cv_stack_direction=0 - fi - ;; - esac - case $sv_cv_stack_direction in - 1) sv_cv_stack_direction_msg="grows up";; - -1) sv_cv_stack_direction_msg="grows down";; - *) sv_cv_stack_direction_msg="unknown";; - esac - -fi -{ echo "$as_me:$LINENO: result: $sv_cv_stack_direction_msg" >&5 -echo "${ECHO_T}$sv_cv_stack_direction_msg" >&6; } - -cat >>confdefs.h <<_ACEOF -#define STACK_DIRECTION $sv_cv_stack_direction -_ACEOF - + if test "$cross_compiling" = yes; then + case "$host" in + *-*-freebsd*) sv_cv_leave_handler_siglongjmp_sigaltstack=yes ;; + *) sv_cv_leave_handler_siglongjmp_sigaltstack="guessing no" ;; + esac -if test "$CFG_STACKVMA" = detect; then - CFG_STACKVMA=stackvma-none.c - { echo "$as_me:$LINENO: checking for PIOCMAP in sys/procfs.h" >&5 -echo $ECHO_N "checking for PIOCMAP in sys/procfs.h... $ECHO_C" >&6; } -if test "${sv_cv_procfsvma+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 else + cat >conftest.$ac_ext <<_ACEOF - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include -int -main () + +#include +#include +#include + +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + +#if HAVE_SETRLIMIT +# include +# include +# include +#endif +sigjmp_buf mainloop; +int pass = 0; +void stackoverflow_handler (int sig) { -int x = PIOCNMAP + PIOCMAP; prmap_t y; - ; - return 0; + pass++; + { stack_t ss; + if (sigaltstack (NULL, &ss) >= 0) + { + ss.ss_flags &= ~SS_ONSTACK; + sigaltstack (&ss, NULL); + } + } + siglongjmp (mainloop, pass); +} +volatile int * recurse_1 (volatile int n, volatile int *p) +{ + if (n >= 0) + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); +} +int main () +{ + char mystack[16384]; + stack_t altstack; + struct sigaction action; +#ifdef __BEOS__ + /* On BeOS, this would hang, burning CPU time. Better fail than hang. */ + exit (1); +#endif +#if defined HAVE_SETRLIMIT && defined RLIMIT_STACK + /* Before starting the endless recursion, try to be friendly to the user's + machine. On some Linux 2.2.x systems, there is no stack limit for user + processes at all. We don't want to kill such systems. */ + struct rlimit rl; + rl.rlim_cur = rl.rlim_max = 0x100000; /* 1 MB */ + setrlimit (RLIMIT_STACK, &rl); +#endif + /* Install the alternate stack. */ + altstack.ss_sp = mystack; + altstack.ss_size = sizeof (mystack); + altstack.ss_flags = 0; /* no SS_DISABLE */ + if (sigaltstack (&altstack, NULL) < 0) + exit (1); + /* Install the SIGSEGV handler. */ + sigemptyset (&action.sa_mask); + action.sa_handler = &stackoverflow_handler; + action.sa_flags = SA_ONSTACK; + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); + sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* Provoke two stack overflows in a row. */ + if (sigsetjmp (mainloop, 1) < 2) + { + recurse (0); + exit (2); + } + exit (0); } _ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext +rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_link") 2>conftest.er1 + (eval "$ac_link") 2>&5 ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then - sv_cv_procfsvma=yes + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + sv_cv_leave_handler_siglongjmp_sigaltstack=yes else - echo "$as_me: failed program was:" >&5 + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - sv_cv_procfsvma=no +( exit $ac_status ) +sv_cv_leave_handler_siglongjmp_sigaltstack=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ - conftest$ac_exeext conftest.$ac_ext + fi -{ echo "$as_me:$LINENO: result: $sv_cv_procfsvma" >&5 -echo "${ECHO_T}$sv_cv_procfsvma" >&6; } - if test $sv_cv_procfsvma = yes; then - CFG_STACKVMA=stackvma-procfs.c - else - case "$host_os" in - darwin*|macos*) CFG_STACKVMA=stackvma-mach.c ;; - linux*) CFG_STACKVMA=stackvma-linux.c ;; - freebsd*) CFG_STACKVMA=stackvma-freebsd.c ;; - beos*) CFG_STACKVMA=stackvma-beos.c ;; - esac - fi -fi +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp_sigaltstack" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp_sigaltstack" >&6; } + + + + -{ echo "$as_me:$LINENO: checking if the system supplies the stack pointer" >&5 -echo $ECHO_N "checking if the system supplies the stack pointer... $ECHO_C" >&6; } -if test "${sv_cv_have_fault_stack_pointer+set}" = set; then + + { echo "$as_me:$LINENO: checking whether a signal handler can be left through siglongjmp and setcontext" >&5 +echo $ECHO_N "checking whether a signal handler can be left through siglongjmp and setcontext... $ECHO_C" >&6; } +if test "${sv_cv_leave_handler_siglongjmp_setcontext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + if test "$cross_compiling" = yes; then + case "$host" in + + *) sv_cv_leave_handler_siglongjmp_setcontext="guessing no" ;; + esac + +else + cat >conftest.$ac_ext <<_ACEOF + + /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include "$srcdir/src/$CFG_FAULT" -#ifdef SIGSEGV_FAULT_STACKPOINTER -xyzzy +#include +#include +#include +#include +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK #endif +#if HAVE_SETRLIMIT +# include +# include +# include +#endif +sigjmp_buf mainloop; +int pass = 0; +void stackoverflow_handler (int sig) +{ + pass++; + { static int fl; + static ucontext_t uc; + fl = 0; + if (getcontext(&uc) >= 0) + if (fl == 0) + if (uc.uc_stack.ss_flags & SS_ONSTACK) + { + uc.uc_stack.ss_flags &= ~SS_ONSTACK; + fl = 1; + setcontext(&uc); + } + } + siglongjmp (mainloop, pass); +} +volatile int * recurse_1 (volatile int n, volatile int *p) +{ + if (n >= 0) + *recurse_1 (n + 1, p) += n; + return p; +} +volatile int recurse (volatile int n) +{ + int sum = 0; + return *recurse_1 (n, &sum); +} +int main () +{ + char mystack[16384]; + stack_t altstack; + struct sigaction action; +#ifdef __BEOS__ + /* On BeOS, this would hang, burning CPU time. Better fail than hang. */ + exit (1); +#endif +#if defined HAVE_SETRLIMIT && defined RLIMIT_STACK + /* Before starting the endless recursion, try to be friendly to the user's + machine. On some Linux 2.2.x systems, there is no stack limit for user + processes at all. We don't want to kill such systems. */ + struct rlimit rl; + rl.rlim_cur = rl.rlim_max = 0x100000; /* 1 MB */ + setrlimit (RLIMIT_STACK, &rl); +#endif + /* Install the alternate stack. */ + altstack.ss_sp = mystack; + altstack.ss_size = sizeof (mystack); + altstack.ss_flags = 0; /* no SS_DISABLE */ + if (sigaltstack (&altstack, NULL) < 0) + exit (1); + /* Install the SIGSEGV handler. */ + sigemptyset (&action.sa_mask); + action.sa_handler = &stackoverflow_handler; + action.sa_flags = SA_ONSTACK; + sigaction (SIGSEGV, &action, (struct sigaction *) NULL); + sigaction (SIGBUS, &action, (struct sigaction *) NULL); + /* Provoke two stack overflows in a row. */ + if (sigsetjmp (mainloop, 1) < 2) + { + recurse (0); + exit (2); + } + exit (0); +} _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "xyzzy" >/dev/null 2>&1; then - sv_cv_have_fault_stack_pointer=yes +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + sv_cv_leave_handler_siglongjmp_setcontext=yes else - sv_cv_have_fault_stack_pointer=no -fi -rm -f conftest* - + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +( exit $ac_status ) +sv_cv_leave_handler_siglongjmp_setcontext=no fi -{ echo "$as_me:$LINENO: result: $sv_cv_have_fault_stack_pointer" >&5 -echo "${ECHO_T}$sv_cv_have_fault_stack_pointer" >&6; } - -{ echo "$as_me:$LINENO: checking if the virtual memory area for an address can be found" >&5 -echo $ECHO_N "checking if the virtual memory area for an address can be found... $ECHO_C" >&6; } -if test "$CFG_STACKVMA" != "stackvma-none.c"; then - { echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6; } -else - { echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6; } +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi -# Now we can pick a stack overflow detection heuristic. From best to worst: -# - stack pointer near bottom of stack -# - fault address near bottom of stack -# - fault address near stack pointer -case "$sv_cv_have_sigsegv_recovery:$sv_cv_have_fault_stack_pointer:$CFG_STACKVMA" in - yes:yes:stackvma-none.c) CFG_HEURISTICS=heur-ab.h ;; - *:*:stackvma-none.c) CFG_HEURISTICS=heur-none.h ;; - yes:*:*) CFG_HEURISTICS=heur-ac.h ;; - *:yes:*) CFG_HEURISTICS=heur-bc.h ;; -esac -{ echo "$as_me:$LINENO: checking if the system supports catching stack overflow" >&5 -echo $ECHO_N "checking if the system supports catching stack overflow... $ECHO_C" >&6; } -if test "${sv_cv_have_stack_overflow_recovery+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else -if test "$CFG_HEURISTICS" = heur-none.h; then - sv_cv_have_stack_overflow_recovery=no -else - sv_cv_have_stack_overflow_recovery=yes fi +{ echo "$as_me:$LINENO: result: $sv_cv_leave_handler_siglongjmp_setcontext" >&5 +echo "${ECHO_T}$sv_cv_leave_handler_siglongjmp_setcontext" >&6; } -fi -{ echo "$as_me:$LINENO: result: $sv_cv_have_stack_overflow_recovery" >&5 -echo "${ECHO_T}$sv_cv_have_stack_overflow_recovery" >&6; } -if test $sv_cv_have_stack_overflow_recovery != no; then - HAVE_STACK_OVERFLOW_RECOVERY=1 +# End of MacOS X special casing. + ;; +esac + +CFG_LEAVE= +if test "$sv_cv_leave_handler_longjmp" != no; then + CFG_LEAVE=leave-nop.c else - HAVE_STACK_OVERFLOW_RECOVERY=0 + if test "$sv_cv_leave_handler_longjmp_sigaltstack" != no; then + CFG_LEAVE=leave-sigaltstack.c + else + if test "$sv_cv_leave_handler_longjmp_setcontext" != no; then + CFG_LEAVE=leave-setcontext.c + fi + fi fi - - -if test $sv_cv_have_sigsegv_recovery = no \ - && test $sv_cv_have_stack_overflow_recovery = no; then - CFG_HANDLER=handler-none.c +case "$host_os" in + # On BeOS, the 6 tests fail because sigaltstack() doesn't exist. + # If one uses set_signal_stack() instead of sigaltstack(), the first + # test actually works. i.e. sv_cv_leave_handler_longjmp would be 'yes'. + beos*) CFG_LEAVE=leave-nop.c ;; +esac +if test -z "$CFG_LEAVE"; then + CFG_LEAVE=leave-none.c fi - -cat >>confdefs.h <<_ACEOF -#define CFG_HEURISTICS "$CFG_HEURISTICS" -_ACEOF - - -cat >>confdefs.h <<_ACEOF -#define CFG_SIGNALS "$CFG_SIGNALS" -_ACEOF - - -cat >>confdefs.h <<_ACEOF -#define CFG_FAULT "$CFG_FAULT" -_ACEOF - - cat >>confdefs.h <<_ACEOF #define CFG_LEAVE "$CFG_LEAVE" _ACEOF -cat >>confdefs.h <<_ACEOF -#define CFG_STACKVMA "$CFG_STACKVMA" -_ACEOF +case "$host_os" in + mingw* | cygwin*) CFG_HANDLER=handler-win32.c ;; + *) + if test -z "$CFG_HANDLER"; then + if test $sv_cv_have_sigsegv_recovery = no \ + && test $sv_cv_have_stack_overflow_recovery = no; then + CFG_HANDLER=handler-none.c + else + CFG_HANDLER=handler-unix.c + fi + fi + ;; +esac cat >>confdefs.h <<_ACEOF #define CFG_HANDLER "$CFG_HANDLER" @@ -14765,14 +15467,6 @@ - - - - - - - - { echo; echo "${term_bold}Build Parameters:${term_norm}"; } >& 6 @@ -15535,11 +16229,11 @@ AR!$AR$ac_delim RANLIB!$RANLIB$ac_delim LIBTOOL!$LIBTOOL$ac_delim +FAULT_CONTEXT!$FAULT_CONTEXT$ac_delim +FAULT_CONTEXT_INCLUDE!$FAULT_CONTEXT_INCLUDE$ac_delim +FAULT_CONTEXT_INCLUDE2!$FAULT_CONTEXT_INCLUDE2$ac_delim HAVE_SIGSEGV_RECOVERY!$HAVE_SIGSEGV_RECOVERY$ac_delim -HAVE_STACK_OVERFLOW_RECOVERY!$HAVE_STACK_OVERFLOW_RECOVERY$ac_delim -CFG_HEURISTICS!$CFG_HEURISTICS$ac_delim -CFG_SIGNALS!$CFG_SIGNALS$ac_delim -CFG_FAULT!$CFG_FAULT$ac_delim +CFG_STACKVMA!$CFG_STACKVMA$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then @@ -15581,17 +16275,15 @@ ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF -CFG_STACKVMA!$CFG_STACKVMA$ac_delim +HAVE_STACK_OVERFLOW_RECOVERY!$HAVE_STACK_OVERFLOW_RECOVERY$ac_delim CFG_LEAVE!$CFG_LEAVE$ac_delim CFG_HANDLER!$CFG_HANDLER$ac_delim -FAULT_CONTEXT!$FAULT_CONTEXT$ac_delim -FAULT_CONTEXT_INCLUDE!$FAULT_CONTEXT_INCLUDE$ac_delim RELOCATABLE!$RELOCATABLE$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 8; then + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 6; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 diff -rNu smalltalk-2.3.3/sigsegv/configure.ac smalltalk-2.3.4/sigsegv/configure.ac --- smalltalk-2.3.3/sigsegv/configure.ac 2007-02-06 17:30:48.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/configure.ac 2007-05-12 12:01:45.000000000 +0200 @@ -1,7 +1,7 @@ dnl Autoconf configuration for libsigsegv. dnl Process this file with autoconf to produce a configure script. dnl -dnl Copyright (C) 2002-2003 Bruno Haible +dnl Copyright (C) 2002-2006 Bruno Haible dnl dnl This program is free software; you can redistribute it and/or modify dnl it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ { echo; echo "${term_bold}Build Tools:${term_norm}"; } >& AS_MESSAGE_FD -AM_INIT_AUTOMAKE(libsigsegv, 2.2) +AM_INIT_AUTOMAKE(libsigsegv, 2.4) AM_CONFIG_HEADER(config.h) AC_PROG_CC @@ -69,9 +69,27 @@ { echo; echo "${term_bold}Optional Platform Environment:${term_norm}"; } >& AS_MESSAGE_FD -# Headers to be included with . +dnl Headers to be included with . On MacOS X (Darwin) one also +dnl needs . AC_CHECK_HEADERS([sys/signal.h]) +dnl List of signals that are sent when an invalid virtual memory address +dnl is accessed, or when the stack overflows. +case "$host_os" in + sunos4* | freebsd* | openbsd* | netbsd*) + CFG_SIGNALS=signals-bsd.h ;; + hpux*) + CFG_SIGNALS=signals-hpux.h ;; + macos* | darwin*) + CFG_SIGNALS=signals-macos.h ;; + gnu*) + CFG_SIGNALS=signals-hurd.h ;; + *) + CFG_SIGNALS=signals.h ;; +esac +AC_DEFINE_UNQUOTED(CFG_SIGNALS, "$CFG_SIGNALS", + [The name of the include file describing the fault signals.]) + # How to determine the memory page size. SV_GETPAGESIZE @@ -80,465 +98,414 @@ # some systems.) SV_MMAP_ANON -AC_CHECK_FUNCS([getrlimit setrlimit]) - -# The idea here is that some other OS than Unix may need -# some of the detection magic, which seems plausible -# especially for CFG_STACKVMA. -case "$host" in - i?86-*-mingw* | i?86-*-cygwin*) - FAULT_CONTEXT='CONTEXT' - FAULT_CONTEXT_INCLUDE='#include ' - CFG_HANDLER=handler-win32.c - CFG_STACKVMA=stackvma-none.c - CFG_FAULT=fault-none.h - CFG_LEAVE=leave-none.c - CFG_SIGNALS=signals.h - sv_cv_have_sigsegv_recovery=yes - sv_cv_have_stack_overflow_recovery=yes - ;; - - powerpc-*-macos* | powerpc-*-darwin*) - FAULT_CONTEXT='ppc_exception_state_t' - FAULT_CONTEXT_INCLUDE='#include ' - CFG_FAULT=machfault-macos-powerpc.h - CFG_HANDLER=handler-macos.c - CFG_LEAVE=leave-none.c - CFG_SIGNALS=signals.h - CFG_STACKVMA=detect - sv_cv_have_sigsegv_recovery=yes - ;; +# How to write a SIGSEGV handler with access to the fault address. +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 5 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[[6-9]]* | darwin[[1-9]][[0-9]]*) ;; *) - FAULT_CONTEXT=void - FAULT_CONTEXT_INCLUDE= - CFG_HANDLER=handler-unix.c - CFG_STACKVMA=detect - CFG_LEAVE=detect - CFG_SIGNALS=detect - - # Catching stack overflow requires an alternate signal stack. - # The old "install a guard page" trick would be unreliable, because - # we don't know where exactly to place the guard page. - SV_SIGALTSTACK - # List of signals that are sent when an invalid virtual memory address - # is accessed, or when the stack overflows. - case "$host_os" in - sunos4* | freebsd* | openbsd* | netbsd*) - CFG_SIGNALS=signals-bsd.h ;; - hpux*) - CFG_SIGNALS=signals-hpux.h ;; - gnu*) - CFG_SIGNALS=signals-hurd.h ;; - *) - CFG_SIGNALS=signals.h ;; - esac - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([POSIX], sv_cv_fault_posix, - [*-*-solaris2.[7-9] | i?86-*-linux2.[4-9]* | i?86-*-freebsd[4-9]* | alpha*-dec-osf[4-9]* | *-*-hpux11* | mips-sgi-irix6*], - [], - [int sig, siginfo_t *sip, void *ucp], - [sip->si_addr], - [action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO;]) - - SV_TRY_FAULT([Linux/i386], sv_cv_fault_linux_i386, [i?86-*-linux2.[2-9]*], - [#include ], - [int sig, struct sigcontext sc], - [sc.cr2]) - - SV_TRY_FAULT([old Linux/i386], sv_cv_fault_linux_i386_old, - [i?86-*-linux2.[2-9]*], - [], - [int sig, unsigned int more], - [((unsigned long *) &more) [21]]) - - SV_TRY_FAULT([Linux/m68k], sv_cv_fault_linux_m68k, [m68k-*-linux*], - [#include - #include "$srcdir/src/fault-linux-m68k.c"], - [int sig, int code, struct sigcontext *scp], - [get_fault_addr (scp)]) - - SV_TRY_FAULT([Linux/PowerPC], sv_cv_fault_linux_powerpc, [powerpc*-*-linux*], - [#include ], - [int sig, struct sigcontext *scp], - [scp->regs->dar]) - - SV_TRY_FAULT([Linux/HPPA], sv_cv_fault_linux_hppa, [hppa*-*-linux*], - [], - [int sig, siginfo_t *sip, void *ucp], - [sip->si_ptr], - [action.sa_sigaction = &sigsegv_handler; - action.sa_flags = SA_SIGINFO;]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([BSD], sv_cv_fault_bsd, [i?86-*-freebsd[4-9]*], - [], - [int sig, int code, struct sigcontext *scp, void *addr], - [addr]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([IRIX], sv_cv_fault_irix, [mips-sgi-irix6*], - [], - [int sig, int code, struct sigcontext *scp], - [(unsigned long) scp->sc_badvaddr]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([HP-UX HPPA], sv_cv_fault_hpux_hppa, [hppa*-*-hpux11*], - [ -# define USE_64BIT_REGS(mc) \ - (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) -# define GET_CR21(mc) \ - (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) - ], - [int sig, int code, struct sigcontext *scp], - [GET_CR21 (scp->sc_sl.sl_ss)]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([OSF/1 Alpha], sv_cv_fault_osf_alpha, - [alpha*-*-osf[4-9]* | alpha*-*-linux2.[4-9]*], - [], - [int sig, int code, struct sigcontext *scp], - [scp->sc_traparg_a0]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([NetBSD Alpha], sv_cv_fault_netbsd_alpha, - [alpha*-*-osf[4-9]* | alpha-*-*bsd*], - [#include "$srcdir/src/fault-netbsd-alpha.c"], - [int sig, int code, struct sigcontext *scp], - [get_fault_addr (scp)]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([AIX], sv_cv_fault_aix, [*-*-aix*], - [], - [int sig, int code, struct sigcontext *scp], - [scp->sc_jmpbuf.jmp_context.o_vaddr]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_FAULT([Hurd], sv_cv_fault_hurd, [], - [], - [int sig, int code, struct sigcontext *scp], - [code]) - - dnl Now determine the fault handler include file. - dnl We prefer the platform specific include files to the generic fault-posix.h - dnl because the former often defines SIGSEGV_FAULT_STACKPOINTER. - dnl Also we put the BSD test second-to-last, because the test may produce - dnl false positives. - dnl - dnl First the cases where the OS provides the fault address. - dnl - CFG_FAULT=fault-none.h - if test "$sv_cv_fault_aix" = yes; then - case "$host_cpu" in - powerpc* | rs6000) CFG_FAULT=fault-aix-powerpc.h ;; - *) CFG_FAULT=fault-aix.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_irix" = yes; then - case "$host_cpu" in - mips*) CFG_FAULT=fault-irix-mips.h ;; - *) CFG_FAULT=fault-irix.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_hpux_hppa" = yes; then - case "$host_cpu" in - hppa* | parisc*) CFG_FAULT=fault-hpux-hppa.h ;; - *) CFG_FAULT=fault-hpux.h ;; - esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_osf_alpha" = yes; then - case "$host_cpu" in - alpha*) CFG_FAULT=fault-osf-alpha.h ;; - *) CFG_FAULT=fault-osf.h ;; - esac +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([POSIX], sv_cv_fault_posix, + [*-*-solaris2.[7-9] | i?86-*-linux2.[4-9]* | i?86-*-freebsd[4-9]* | alpha*-dec-osf[4-9]* | *-*-hpux11* | mips-sgi-irix6*], + [], + [int sig, siginfo_t *sip, void *ucp], + [sip->si_addr], + [action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO;]) + +SV_TRY_FAULT([Linux/i386], sv_cv_fault_linux_i386, [i?86-*-linux2.[2-9]*], + [#include ], + [int sig, struct sigcontext sc], + [sc.cr2]) + +SV_TRY_FAULT([old Linux/i386], sv_cv_fault_linux_i386_old, + [i?86-*-linux2.[2-9]*], + [], + [int sig, unsigned int more], + [((unsigned long *) &more) [21]]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([Linux/m68k], sv_cv_fault_linux_m68k, [], + [#include +#include "$srcdir/src/fault-linux-m68k.c"], + [int sig, int code, struct sigcontext *scp], + [get_fault_addr (scp)]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([Linux/PowerPC], sv_cv_fault_linux_powerpc, [], + [#include ], + [int sig, struct sigcontext *scp], + [scp->regs->dar]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([Linux/HPPA], sv_cv_fault_linux_hppa, [], + [], + [int sig, siginfo_t *sip, void *ucp], + [sip->si_ptr], + [action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO;]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([BSD], sv_cv_fault_bsd, [i?86-*-freebsd[4-9]*], + [], + [int sig, int code, struct sigcontext *scp, void *addr], + [addr]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([IRIX], sv_cv_fault_irix, [mips-sgi-irix6*], + [], + [int sig, int code, struct sigcontext *scp], + [(unsigned long) scp->sc_badvaddr]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([HP-UX HPPA], sv_cv_fault_hpux_hppa, [hppa*-*-hpux11*], + [ +#define USE_64BIT_REGS(mc) \ + (((mc).ss_flags & SS_WIDEREGS) && ((mc).ss_flags & SS_NARROWISINVALID)) +#define GET_CR21(mc) \ + (USE_64BIT_REGS(mc) ? (mc).ss_wide.ss_64.ss_cr21 : (mc).ss_narrow.ss_cr21) +], + [int sig, int code, struct sigcontext *scp], + [GET_CR21 (scp->sc_sl.sl_ss)]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([OSF/1 Alpha], sv_cv_fault_osf_alpha, + [alpha*-*-osf[4-9]* | alpha*-*-linux2.[4-9]*], + [], + [int sig, int code, struct sigcontext *scp], + [scp->sc_traparg_a0]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([NetBSD Alpha], sv_cv_fault_netbsd_alpha, + [alpha*-*-osf[4-9]* | alpha-*-*bsd*], + [#include "$srcdir/src/fault-netbsd-alpha.c"], + [int sig, int code, struct sigcontext *scp], + [get_fault_addr (scp)]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([AIX], sv_cv_fault_aix, [*-*-aix[34]*], + [], + [int sig, int code, struct sigcontext *scp], + [scp->sc_jmpbuf.jmp_context.o_vaddr]) + +SV_TRY_FAULT([MacOSX/Darwin7 PowerPC], sv_cv_fault_macosdarwin7_ppc, + [powerpc-*-darwin7*], + [#include "$srcdir/src/fault-macosdarwin7-powerpc.c"], + [int sig, siginfo_t *sip, ucontext_t *ucp], + [get_fault_addr (sip, ucp)], + [action.sa_sigaction = &sigsegv_handler; + action.sa_flags = SA_SIGINFO;]) + +if test "$sv_cv_fault_macosdarwin7_ppc" != yes; then +SV_TRY_FAULT([MacOSX/Darwin5 PowerPC], sv_cv_fault_macosdarwin5_ppc, + [powerpc-*-darwin5*], + [#include "$srcdir/src/fault-macosdarwin5-powerpc.c"], + [int sig, int code, struct sigcontext *scp], + [get_fault_addr (scp)]) +fi + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_FAULT([Hurd], sv_cv_fault_hurd, [], + [], + [int sig, int code, struct sigcontext *scp], + [code]) + +# End of MacOS X special casing. + ;; +esac + +dnl Now determine the fault handler include file. +dnl We prefer the platform specific include files to the generic fault-posix.h +dnl because the former often defines SIGSEGV_FAULT_STACKPOINTER. +dnl Also we put the BSD test second-to-last, because the test may produce +dnl false positives. +CFG_HANDLER= +CFG_FAULT= +CFG_MACHFAULT= +FAULT_CONTEXT=void +FAULT_CONTEXT_INCLUDE= +FAULT_CONTEXT_INCLUDE2= +dnl +dnl First the cases where the OS provides the fault address. +dnl +if test -z "$CFG_FAULT" && test "$sv_cv_fault_aix" = yes; then + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-aix3-powerpc.h ;; + *) CFG_FAULT=fault-aix3.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_irix" = yes; then + case "$host_cpu" in + mips*) CFG_FAULT=fault-irix-mips.h ;; + *) CFG_FAULT=fault-irix.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_hpux_hppa" = yes; then + case "$host_cpu" in + hppa* | parisc*) CFG_FAULT=fault-hpux-hppa.h ;; + *) CFG_FAULT=fault-hpux.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_osf_alpha" = yes; then + case "$host_cpu" in + alpha*) CFG_FAULT=fault-osf-alpha.h ;; + *) CFG_FAULT=fault-osf.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_netbsd_alpha" = yes; then + case "$host_cpu" in + alpha*) CFG_FAULT=fault-netbsd-alpha.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_i386" = yes; then + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-linux-i386.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_i386_old" = yes; then + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-linux-i386-old.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_powerpc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-linux-powerpc.h ;; + esac + FAULT_CONTEXT='struct sigcontext' +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_hppa" = yes; then + case "$host_cpu" in + hppa* | parisc*) CFG_FAULT=fault-linux-hppa.h ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_hurd" = yes; then + case "$host_os" in + netbsd*) # A false positive. + ;; + *) + CFG_FAULT=fault-hurd.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_netbsd_alpha" = yes; then + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_bsd" = yes; then + case "$host_os" in + freebsd*) case "$host_cpu" in - alpha*) CFG_FAULT=fault-netbsd-alpha.h ;; + i?86 | x86_64) + CFG_FAULT=fault-freebsd-i386.h + FAULT_CONTEXT='struct sigcontext' + ;; + *) + CFG_FAULT=fault-bsd.h + FAULT_CONTEXT='void' + ;; esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_i386" = yes; then + ;; + *) + CFG_FAULT=fault-bsd.h + FAULT_CONTEXT='void' + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_posix" = yes; then + case "$host_os" in + openbsd*) case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-linux-i386.h ;; + i?86 | x86_64) CFG_FAULT=fault-openbsd-i386.h ;; + *) CFG_FAULT=fault-openbsd.h ;; esac FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_i386_old" = yes; then + ;; + linux*) case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-linux-i386-old.h ;; + ia64) + CFG_FAULT=fault-linux-ia64.h + FAULT_CONTEXT='struct sigcontext' + ;; esac - FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_m68k" = yes; then + ;; + esac + if test -z "$CFG_FAULT"; then + case "$host_os" in + solaris*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-solaris-i386.h ;; + sparc*) CFG_FAULT=fault-solaris-sparc.h ;; + *) CFG_FAULT=fault-solaris.h ;; + esac + ;; + aix*) + case "$host_cpu" in + powerpc* | rs6000) CFG_FAULT=fault-aix5-powerpc.h ;; + *) CFG_FAULT=fault-aix5.h ;; + esac + ;; + netbsd*) + CFG_FAULT=fault-netbsd.h + ;; + *) + CFG_FAULT=fault-posix.h + ;; + esac + FAULT_CONTEXT='ucontext_t' + FAULT_CONTEXT_INCLUDE='#include ' + fi +fi +if test -z "$CFG_FAULT"; then + case "$host_os" in + macos* | darwin[[6-9]]* | darwin[[1-9]][[0-9]]*) case "$host_cpu" in - m68*) CFG_FAULT=fault-linux-m68k.h ;; + powerpc* | rs6000) + CFG_MACHFAULT=machfault-macos-powerpc.h + FAULT_CONTEXT='ppc_thread_state_t' + ;; + i?86 | x86_64) + CFG_MACHFAULT=machfault-macos-i386.h + FAULT_CONTEXT='i386_thread_state_t' + ;; esac + if test -n "$CFG_MACHFAULT"; then + CFG_HANDLER=handler-macos.c + FAULT_CONTEXT_INCLUDE='#include ' + FAULT_CONTEXT_INCLUDE2='#include ' + CFG_FAULT=fault-macos.h # nonexistent, just a dummy + fi + ;; + esac +fi +dnl +dnl Next, the cases where there is a hairy CPU dependent way to get the +dnl fault address. +dnl +if test -z "$CFG_FAULT" && test "$sv_cv_fault_linux_m68k" = yes; then + case "$host_cpu" in + m68*) + CFG_FAULT=fault-linux-m68k.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_powerpc" = yes; then - case "$host_cpu" in - powerpc* | rs6000) CFG_FAULT=fault-linux-powerpc.h ;; - esac + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_macosdarwin7_ppc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) + CFG_FAULT=fault-macosdarwin7-powerpc.h + FAULT_CONTEXT='ucontext_t' + FAULT_CONTEXT_INCLUDE='#include ' + FAULT_CONTEXT_INCLUDE2='#include ' + ;; + esac +fi +if test -z "$CFG_FAULT" && test "$sv_cv_fault_macosdarwin5_ppc" = yes; then + case "$host_cpu" in + powerpc* | rs6000) + CFG_FAULT=fault-macosdarwin5-powerpc.h FAULT_CONTEXT='struct sigcontext' - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_linux_hppa" = yes; then + ;; + esac +fi +if test -z "$CFG_FAULT"; then + case "$host_os" in + mingw* | cygwin*) + FAULT_CONTEXT='CONTEXT' + FAULT_CONTEXT_INCLUDE='#include ' + CFG_FAULT=fault-win32.h # nonexistent, just a dummy + ;; + esac +fi +if test -n "$CFG_FAULT"; then + sv_cv_have_sigsegv_recovery=yes +else + sv_cv_have_sigsegv_recovery=no + dnl + dnl No way to get the fault address. But other information is available. + dnl + case "$host_os" in + linux*) case "$host_cpu" in - hppa* | parisc*) CFG_FAULT=fault-linux-hppa.h ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_hurd" = yes; then - case "$host_os" in - netbsd*) # A false positive. + alpha*) + CFG_FAULT=fault-linux-alpha.h + FAULT_CONTEXT='struct sigcontext' ;; - *) - CFG_FAULT=fault-hurd.h + arm* | strongarm* | xscale*) + CFG_FAULT=fault-linux-arm.h FAULT_CONTEXT='struct sigcontext' ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_bsd" = yes; then - case "$host_os" in - freebsd*) - case "$host_cpu" in - i?86 | x86_64) - CFG_FAULT=fault-freebsd-i386.h - FAULT_CONTEXT='struct sigcontext' - ;; - *) - CFG_FAULT=fault-bsd.h - FAULT_CONTEXT='void' - ;; - esac + cris) + CFG_FAULT=fault-linux-cris.h + FAULT_CONTEXT='struct sigcontext' ;; - *) - CFG_FAULT=fault-bsd.h - FAULT_CONTEXT='void' + mips*) + CFG_FAULT=fault-linux-mips.h + FAULT_CONTEXT='struct sigcontext' ;; - esac - fi - if test "$CFG_FAULT" = fault-none.h && test "$sv_cv_fault_posix" = yes; then - case "$host_os" in - openbsd*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-openbsd-i386.h ;; - *) CFG_FAULT=fault-openbsd.h ;; - esac + s390*) + CFG_FAULT=fault-linux-s390.h FAULT_CONTEXT='struct sigcontext' ;; - linux*) - case "$host_cpu" in - ia64) - CFG_FAULT=fault-linux-ia64.h - FAULT_CONTEXT='struct sigcontext' - ;; - esac + sh*) + CFG_FAULT=fault-linux-sh.h + FAULT_CONTEXT='struct sigcontext' ;; - esac - if test "$CFG_FAULT" = fault-none.h; then - case "$host_os" in - solaris*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-solaris-i386.h ;; - sparc*) CFG_FAULT=fault-solaris-sparc.h ;; - *) CFG_FAULT=fault-solaris.h ;; - esac - ;; - *) - CFG_FAULT=fault-posix.h - ;; - esac - FAULT_CONTEXT='ucontext_t' - FAULT_CONTEXT_INCLUDE='#include ' - fi - fi - dnl - dnl Next, the cases where there is a hairy CPU dependent way to get the - dnl fault address. - dnl - if test "$CFG_FAULT" = fault-none.h; then - sv_cv_have_sigsegv_recovery=no - dnl - dnl No way to get the fault address. But other information is available. - dnl - case "$host_os" in - linux*) - case "$host_cpu" in - alpha*) - CFG_FAULT=fault-linux-alpha.h - FAULT_CONTEXT='struct sigcontext' - ;; - arm* | strongarm* | xscale*) - CFG_FAULT=fault-linux-arm.h - FAULT_CONTEXT='struct sigcontext' - ;; - cris) - CFG_FAULT=fault-linux-cris.h - FAULT_CONTEXT='struct sigcontext' - ;; - mips*) - CFG_FAULT=fault-linux-mips.h - FAULT_CONTEXT='struct sigcontext' - ;; - s390*) - CFG_FAULT=fault-linux-s390.h - FAULT_CONTEXT='struct sigcontext' - ;; - sh*) - CFG_FAULT=fault-linux-sh.h - FAULT_CONTEXT='struct sigcontext' - ;; - sparc*) - CFG_FAULT=fault-linux-sparc.h - FAULT_CONTEXT='struct sigcontext' - ;; - x86_64) - CFG_FAULT=fault-linux-x86_64.h - FAULT_CONTEXT='struct sigcontext' - ;; - esac - ;; - beos*) - case "$host_cpu" in - i?86 | x86_64) CFG_FAULT=fault-beos-i386.h ;; - *) CFG_FAULT=fault-beos.h ;; - esac - FAULT_CONTEXT='struct vregs' + sparc*) + CFG_FAULT=fault-linux-sparc.h + FAULT_CONTEXT='struct sigcontext' + ;; + x86_64) + CFG_FAULT=fault-linux-x86_64.h + FAULT_CONTEXT='struct sigcontext' ;; esac - else - sv_cv_have_sigsegv_recovery=yes - fi - - # How to longjmp out of a signal handler, in such a way that the - # alternate signal stack remains functional. - CFG_LEAVE=leave-none.c - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_LONGJMP([], sv_cv_leave_handler_longjmp, - [*-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]*], - [], []) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_LONGJMP([ and sigaltstack], - sv_cv_leave_handler_longjmp_sigaltstack, - [*-*-freebsd*], - [ -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif - ], - [stack_t ss; - if (sigaltstack (NULL, &ss) >= 0) - { - ss.ss_flags &= ~SS_ONSTACK; - sigaltstack (&ss, NULL); - } - ]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_LONGJMP([ and setcontext], - sv_cv_leave_handler_longjmp_setcontext, - [*-*-irix* | *-*-solaris*], - [#include -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif - ], - [static int fl; - static ucontext_t uc; - fl = 0; - if (getcontext (&uc) >= 0) - if (fl == 0) - if (uc.uc_stack.ss_flags & SS_ONSTACK) - { - uc.uc_stack.ss_flags &= ~SS_ONSTACK; - fl = 1; - setcontext (&uc); - } - ]) - - # How to siglongjmp out of a signal handler, in such a way that the - # alternate signal stack remains functional. - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_SIGLONGJMP([], sv_cv_leave_handler_siglongjmp, - [*-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]* | *-*-irix* | *-*-solaris*], - [], []) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_SIGLONGJMP([ and sigaltstack], - sv_cv_leave_handler_siglongjmp_sigaltstack, - [*-*-freebsd*], - [ -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif - ], - [stack_t ss; - if (sigaltstack (NULL, &ss) >= 0) - { - ss.ss_flags &= ~SS_ONSTACK; - sigaltstack (&ss, NULL); - } - ]) - - dnl FIXME: Put in some more known values into the third argument. - SV_TRY_LEAVE_HANDLER_SIGLONGJMP([ and setcontext], - sv_cv_leave_handler_siglongjmp_setcontext, - [], - [#include -# ifndef SS_ONSTACK -# define SS_ONSTACK SA_ONSTACK -# endif - ], - [static int fl; - static ucontext_t uc; - fl = 0; - if (getcontext(&uc) >= 0) - if (fl == 0) - if (uc.uc_stack.ss_flags & SS_ONSTACK) - { - uc.uc_stack.ss_flags &= ~SS_ONSTACK; - fl = 1; - setcontext(&uc); - } - ]) - - if test "$sv_cv_leave_handler_longjmp" != no; then - CFG_LEAVE=leave-nop.c - else - if test "$sv_cv_leave_handler_longjmp_sigaltstack" != no; then - CFG_LEAVE=leave-sigaltstack.c - else - if test "$sv_cv_leave_handler_longjmp_setcontext" != no; then - CFG_LEAVE=leave-setcontext.c - fi - fi - fi - case "$host_os" in - # On BeOS, the 6 tests fail because sigaltstack() doesn't exist. - # If one uses set_signal_stack() instead of sigaltstack(), the first - # test actually works. i.e. sv_cv_leave_handler_longjmp would be 'yes'. - beos*) - CFG_LEAVE=leave-nop.c - sv_cv_have_stack_overflow_recovery=yes - ;; - *) - if test "$sv_cv_sigaltstack" = no; then - sv_cv_have_stack_overflow_recovery=no - fi - ;; - esac - ;; -esac + ;; + beos*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-beos-i386.h ;; + *) CFG_FAULT=fault-beos.h ;; + esac + FAULT_CONTEXT='struct vregs' + ;; + macos* | darwin*) + case "$host_cpu" in + i?86 | x86_64) CFG_FAULT=fault-macos-i386.h ;; + esac + FAULT_CONTEXT='struct sigcontext' + ;; + esac +fi +AC_MSG_CHECKING([for the fault handler specifics]) +if test -n "$CFG_FAULT"; then + sv_cv_fault_include=$CFG_FAULT +else + if test -n "$CFG_MACHFAULT"; then + sv_cv_fault_include=$CFG_MACHFAULT + else + sv_cv_fault_include=none + fi +fi +AC_MSG_RESULT([$sv_cv_fault_include]) +if test -z "$CFG_FAULT"; then + CFG_FAULT=fault-none.h +fi +AC_DEFINE_UNQUOTED(CFG_FAULT, "$CFG_FAULT", + [The name of the include file describing the fault handler.]) +if test -z "$CFG_MACHFAULT"; then + CFG_MACHFAULT=fault-none.h +fi +AC_DEFINE_UNQUOTED(CFG_MACHFAULT, "$CFG_MACHFAULT", + [The name of the include file describing the Mach fault handler.]) +AC_SUBST(FAULT_CONTEXT) +AC_SUBST(FAULT_CONTEXT_INCLUDE) +AC_SUBST(FAULT_CONTEXT_INCLUDE2) AC_MSG_CHECKING([if the system supports catching SIGSEGV]) AC_MSG_RESULT([$sv_cv_have_sigsegv_recovery]) @@ -549,6 +516,8 @@ fi AC_SUBST(HAVE_SIGSEGV_RECOVERY) +dnl The stackoverflow_context_t type depends on the CFG_FAULT include file. + dnl Stack direction. AC_CACHE_CHECK([for stack direction], sv_cv_stack_direction_msg, [ case "$host_cpu" in @@ -644,96 +613,265 @@ STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => spaghetti stack.]) -if test "$CFG_STACKVMA" = detect; then +dnl Determination of the stack's virtual memory area. +AC_CACHE_CHECK([for PIOCMAP in sys/procfs.h], sv_cv_procfsvma, [ + AC_TRY_LINK([#include ], + [int x = PIOCNMAP + PIOCMAP; prmap_t y;], + sv_cv_procfsvma=yes, sv_cv_procfsvma=no) +]) +AC_CHECK_FUNCS([mincore]) +CFG_STACKVMA= +if test $sv_cv_procfsvma = yes; then + CFG_STACKVMA=stackvma-procfs.c +else + case "$host_os" in + linux*) CFG_STACKVMA=stackvma-linux.c ;; + freebsd*) CFG_STACKVMA=stackvma-freebsd.c ;; + beos*) CFG_STACKVMA=stackvma-beos.c ;; + macos* | darwin*) CFG_STACKVMA=stackvma-mach.c ;; + esac +fi +if test -z "$CFG_STACKVMA" && test $ac_cv_func_mincore = yes; then + CFG_STACKVMA=stackvma-mincore.c +fi +if test -n "$CFG_STACKVMA"; then + AC_DEFINE(HAVE_STACKVMA, 1, + [Define if CFG_STACKVMA is set to a nontrivial source file.]) +else CFG_STACKVMA=stackvma-none.c - dnl Determination of the stack's virtual memory area. - AC_CACHE_CHECK([for PIOCMAP in sys/procfs.h], sv_cv_procfsvma, [ - AC_TRY_LINK([#include ], - [int x = PIOCNMAP + PIOCMAP; prmap_t y;], - sv_cv_procfsvma=yes, sv_cv_procfsvma=no) - ]) - if test $sv_cv_procfsvma = yes; then - CFG_STACKVMA=stackvma-procfs.c - else - case "$host_os" in - darwin*|macos*) CFG_STACKVMA=stackvma-mach.c ;; - linux*) CFG_STACKVMA=stackvma-linux.c ;; - freebsd*) CFG_STACKVMA=stackvma-freebsd.c ;; - beos*) CFG_STACKVMA=stackvma-beos.c ;; - esac - fi fi +AC_DEFINE_UNQUOTED(CFG_STACKVMA, "$CFG_STACKVMA", + [The name of the file determining the stack virtual memory area.]) +AC_SUBST(CFG_STACKVMA) + +AC_CHECK_FUNCS([getrlimit setrlimit]) -AC_CACHE_CHECK([if the system supplies the stack pointer], - [sv_cv_have_fault_stack_pointer], [ -AC_EGREP_CPP([xyzzy], [ +dnl Catching stack overflow requires an alternate signal stack. +dnl The old "install a guard page" trick would be unreliable, because +dnl we don't know where exactly to place the guard page. +SV_SIGALTSTACK + +AC_CACHE_CHECK([if the system supports catching stack overflow], + sv_cv_have_stack_overflow_recovery, +[ + dnl On Mach, it requires a machfault-*.h (see src/handler-macos.c). + dnl On Unix, it requires either sigaltstack() or the BeOS set_signal_stack() + dnl function, and on Unix it requires a fault-*.h or a stackvma-*.c with + dnl certain properties (see src/handler-unix.c). + if test "$CFG_MACHFAULT" != fault-none.h; then + sv_cv_have_stack_overflow_recovery=yes + else + if test "$sv_cv_sigaltstack" != no; then + sv_cv_have_stack_overflow_recovery=maybe + else + case "$host_os" in + beos*) sv_cv_have_stack_overflow_recovery=maybe ;; + mingw* | cygwin*) sv_cv_have_stack_overflow_recovery=yes ;; + *) sv_cv_have_stack_overflow_recovery=no ;; + esac + fi + fi + if test $sv_cv_have_stack_overflow_recovery = maybe; then + if test -n "$CFG_FAULT"; then + AC_EGREP_CPP([xyzzy], [ #include "$srcdir/src/$CFG_FAULT" +#ifdef SIGSEGV_FAULT_HANDLER_ARGLIST +#ifdef SIGSEGV_FAULT_ADDRESS +xyzzy +#endif +#endif +], [condA=true], [condA=false]) + else + condA=false + fi + if test -n "$CFG_FAULT"; then + AC_EGREP_CPP([xyzzy], [ +#include "$srcdir/src/$CFG_FAULT" +#ifdef SIGSEGV_FAULT_HANDLER_ARGLIST #ifdef SIGSEGV_FAULT_STACKPOINTER xyzzy #endif -], [sv_cv_have_fault_stack_pointer=yes], [sv_cv_have_fault_stack_pointer=no]) +#endif +], [condB=true], [condB=false]) + else + condB=false + fi + if test "$CFG_STACKVMA" != "stackvma-none.c"; then + condC=true + else + condC=false + fi + if { $condA && $condB; } || { $condA && $condC; } || { $condB && $condC; }; then + sv_cv_have_stack_overflow_recovery=yes + else + sv_cv_have_stack_overflow_recovery=no + fi + fi ]) - -AC_MSG_CHECKING([if the virtual memory area for an address can be found]) -if test "$CFG_STACKVMA" != "stackvma-none.c"; then - AC_MSG_RESULT(yes) +if test $sv_cv_have_stack_overflow_recovery != no; then + HAVE_STACK_OVERFLOW_RECOVERY=1 else - AC_MSG_RESULT(no) + HAVE_STACK_OVERFLOW_RECOVERY=0 fi +AC_SUBST(HAVE_STACK_OVERFLOW_RECOVERY) -# Now we can pick a stack overflow detection heuristic. From best to worst: -# - stack pointer near bottom of stack -# - fault address near bottom of stack -# - fault address near stack pointer -case "$sv_cv_have_sigsegv_recovery:$sv_cv_have_fault_stack_pointer:$CFG_STACKVMA" in - yes:yes:stackvma-none.c) CFG_HEURISTICS=heur-ab.h ;; - *:*:stackvma-none.c) CFG_HEURISTICS=heur-none.h ;; - yes:*:*) CFG_HEURISTICS=heur-ac.h ;; - *:yes:*) CFG_HEURISTICS=heur-bc.h ;; +# How to longjmp out of a signal handler, in such a way that the +# alternate signal stack remains functional. + +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 2 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[[6-9]]* | darwin[[1-9]][[0-9]]*) ;; + *) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_LONGJMP([], sv_cv_leave_handler_longjmp, + [*-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]*], + [], []) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_LONGJMP([ and sigaltstack], + sv_cv_leave_handler_longjmp_sigaltstack, + [*-*-freebsd*], + [ +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + ], + [stack_t ss; + if (sigaltstack (NULL, &ss) >= 0) + { + ss.ss_flags &= ~SS_ONSTACK; + sigaltstack (&ss, NULL); + } + ]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_LONGJMP([ and setcontext], + sv_cv_leave_handler_longjmp_setcontext, + [*-*-irix* | *-*-solaris*], + [#include +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + ], + [static int fl; + static ucontext_t uc; + fl = 0; + if (getcontext (&uc) >= 0) + if (fl == 0) + if (uc.uc_stack.ss_flags & SS_ONSTACK) + { + uc.uc_stack.ss_flags &= ~SS_ONSTACK; + fl = 1; + setcontext (&uc); + } + ]) + +# End of MacOS X special casing. + ;; esac -AC_CACHE_CHECK([if the system supports catching stack overflow], - [sv_cv_have_stack_overflow_recovery], [ -if test "$CFG_HEURISTICS" = heur-none.h; then - sv_cv_have_stack_overflow_recovery=no -else - sv_cv_have_stack_overflow_recovery=yes -fi -]) +# How to siglongjmp out of a signal handler, in such a way that the +# alternate signal stack remains functional. -if test $sv_cv_have_stack_overflow_recovery != no; then - HAVE_STACK_OVERFLOW_RECOVERY=1 +# On MacOS X 10.2 or newer, we don't need these tests, because we'll end up +# using handler-macos.c anyway. If we were to perform the tests, 2 Crash Report +# dialog windows would pop up. +case "$host_os" in + macos* | darwin[[6-9]]* | darwin[[1-9]][[0-9]]*) ;; + *) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_SIGLONGJMP([], sv_cv_leave_handler_siglongjmp, + [*-*-osf[4-9]* | *-*-hpux11* | *-*-linux2.[2-9]* | *-*-irix* | *-*-solaris*], + [], []) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_SIGLONGJMP([ and sigaltstack], + sv_cv_leave_handler_siglongjmp_sigaltstack, + [*-*-freebsd*], + [ +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + ], + [stack_t ss; + if (sigaltstack (NULL, &ss) >= 0) + { + ss.ss_flags &= ~SS_ONSTACK; + sigaltstack (&ss, NULL); + } + ]) + +dnl FIXME: Put in some more known values into the third argument. +SV_TRY_LEAVE_HANDLER_SIGLONGJMP([ and setcontext], + sv_cv_leave_handler_siglongjmp_setcontext, + [], + [#include +#ifndef SS_ONSTACK +#define SS_ONSTACK SA_ONSTACK +#endif + ], + [static int fl; + static ucontext_t uc; + fl = 0; + if (getcontext(&uc) >= 0) + if (fl == 0) + if (uc.uc_stack.ss_flags & SS_ONSTACK) + { + uc.uc_stack.ss_flags &= ~SS_ONSTACK; + fl = 1; + setcontext(&uc); + } + ]) + +# End of MacOS X special casing. + ;; +esac + +CFG_LEAVE= +if test "$sv_cv_leave_handler_longjmp" != no; then + CFG_LEAVE=leave-nop.c else - HAVE_STACK_OVERFLOW_RECOVERY=0 + if test "$sv_cv_leave_handler_longjmp_sigaltstack" != no; then + CFG_LEAVE=leave-sigaltstack.c + else + if test "$sv_cv_leave_handler_longjmp_setcontext" != no; then + CFG_LEAVE=leave-setcontext.c + fi + fi fi -AC_SUBST(HAVE_STACK_OVERFLOW_RECOVERY) - -if test $sv_cv_have_sigsegv_recovery = no \ - && test $sv_cv_have_stack_overflow_recovery = no; then - CFG_HANDLER=handler-none.c +case "$host_os" in + # On BeOS, the 6 tests fail because sigaltstack() doesn't exist. + # If one uses set_signal_stack() instead of sigaltstack(), the first + # test actually works. i.e. sv_cv_leave_handler_longjmp would be 'yes'. + beos*) CFG_LEAVE=leave-nop.c ;; +esac +if test -z "$CFG_LEAVE"; then + CFG_LEAVE=leave-none.c fi - -AC_DEFINE_UNQUOTED(CFG_HEURISTICS, "$CFG_HEURISTICS", - [The name of the include file describing the stack overflow detection heuristics.]) -AC_DEFINE_UNQUOTED(CFG_SIGNALS, "$CFG_SIGNALS", - [The name of the include file describing which signals should be trapped.]) -AC_DEFINE_UNQUOTED(CFG_FAULT, "$CFG_FAULT", - [The name of the include file describing the fault handler.]) AC_DEFINE_UNQUOTED(CFG_LEAVE, "$CFG_LEAVE", [The name of the file implementing sigsegv_reset_onstack_flag.]) -AC_DEFINE_UNQUOTED(CFG_STACKVMA, "$CFG_STACKVMA", - [The name of the file determining the stack virtual memory area.]) +AC_SUBST(CFG_LEAVE) + +case "$host_os" in + mingw* | cygwin*) CFG_HANDLER=handler-win32.c ;; + *) + if test -z "$CFG_HANDLER"; then + if test $sv_cv_have_sigsegv_recovery = no \ + && test $sv_cv_have_stack_overflow_recovery = no; then + CFG_HANDLER=handler-none.c + else + CFG_HANDLER=handler-unix.c + fi + fi + ;; +esac AC_DEFINE_UNQUOTED(CFG_HANDLER, "$CFG_HANDLER", [The name of the file implementing the handler functionality.]) - -AC_SUBST(CFG_HEURISTICS) -AC_SUBST(CFG_SIGNALS) -AC_SUBST(CFG_FAULT) -AC_SUBST(CFG_STACKVMA) -AC_SUBST(CFG_LEAVE) AC_SUBST(CFG_HANDLER) -AC_SUBST(FAULT_CONTEXT) -AC_SUBST(FAULT_CONTEXT_INCLUDE) { echo; echo "${term_bold}Build Parameters:${term_norm}"; } >& AS_MESSAGE_FD @@ -742,6 +880,7 @@ { echo; echo "${term_bold}Output Substitution:${term_norm}"; } >& AS_MESSAGE_FD +dnl AC_OUTPUT(Makefile) AC_OUTPUT([Makefile src/Makefile src/sigsegv.h tests/Makefile]) diff -rNu smalltalk-2.3.3/sigsegv/src/Makefile.am smalltalk-2.3.4/sigsegv/src/Makefile.am --- smalltalk-2.3.3/sigsegv/src/Makefile.am 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/Makefile.am 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ ## Makefile for libsigsegv/src. -## Copyright (C) 2002-2003 Bruno Haible +## Copyright (C) 2002-2006 Bruno Haible ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by @@ -13,7 +13,8 @@ ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software -## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +## USA. ## Process this file with automake to produce Makefile.in. @@ -21,10 +22,11 @@ RM = rm -f -noinst_LTLIBRARIES = libsigsegv.la +lib_LTLIBRARIES = libsigsegv.la noinst_HEADERS = \ - fault-aix.h fault-aix-powerpc.h fault-beos.h fault-beos-i386.h \ + fault.h fault-aix3.h fault-aix3-powerpc.h fault-aix5.h fault-aix5-powerpc.h \ + fault-beos.h fault-beos-i386.h \ fault-bsd.h fault-freebsd-i386.h \ fault-hpux.h fault-hpux-hppa.h fault-hurd.h fault-irix.h fault-irix-mips.h \ fault-linux.h fault-linux-alpha.h fault-linux-arm.h fault-linux-cris.h \ @@ -32,29 +34,30 @@ fault-linux-ia64.h fault-linux-m68k.h fault-linux-m68k.c fault-linux-mips.h \ fault-linux-powerpc.h fault-linux-s390.h fault-linux-sh.h \ fault-linux-sparc.h fault-linux-x86_64.h \ - fault-macos-i386.h fault-macos-powerpc.h fault-macos-powerpc.c \ - fault-netbsd-alpha.h fault-netbsd-alpha.c \ + fault-macos-i386.h \ + fault-macosdarwin5-powerpc.h fault-macosdarwin5-powerpc.c \ + fault-macosdarwin7-powerpc.h fault-macosdarwin7-powerpc.c \ + fault-netbsd.h fault-netbsd-alpha.h fault-netbsd-alpha.c \ fault-none.h \ fault-openbsd.h fault-openbsd-i386.h \ fault-osf.h fault-osf-alpha.h \ fault-posix.h fault-solaris.h fault-solaris-i386.h fault-solaris-sparc.h \ - machfault-macos-powerpc.h \ + machfault.h machfault-macos-i386.h machfault-macos-powerpc.h \ signals.h signals-bsd.h signals-hpux.h signals-hurd.h signals-macos.h \ - heur-none.h heur-ab.h heur-ac.h heur-bc.h \ leave.h \ stackvma.h EXTRA_DIST = \ - handler-none.c handler-macos.c handler-unix.c handler-win32.c \ - stackvma-none.c stackvma-linux.c stackvma-freebsd.c stackvma-procfs.c \ - stackvma-beos.c stackvma-mach.c \ + handler-none.c handler-unix.c handler-macos.c handler-win32.c \ + stackvma-none.c stackvma-simple.c stackvma-linux.c stackvma-freebsd.c \ + stackvma-procfs.c stackvma-beos.c stackvma-mach.c stackvma-mincore.c \ leave-none.c leave-nop.c leave-sigaltstack.c leave-setcontext.c \ sigsegv.h.msvc INCLUDES = -I. -I$(srcdir) DEFS = @DEFS@ -libsigsegv_la_SOURCES = handler.c stackvma.c leave.c dispatcher.c +libsigsegv_la_SOURCES = handler.c stackvma.c leave.c dispatcher.c version.c libsigsegv_la_LDFLAGS = -lc -no-undefined @@ -84,7 +87,8 @@ # Rules for "make dist". sigsegv.h.msvc : sigsegv.h.in - $(SED) -e 's/@''FAULT_CONTEXT_INCLUDE''@/#include /' \ + sed -e 's/@''FAULT_CONTEXT_INCLUDE''@/#include /' \ + -e 's/@''FAULT_CONTEXT_INCLUDE2''@//' \ -e 's/@''FAULT_CONTEXT''@/CONTEXT/' \ -e 's/@''HAVE_SIGSEGV_RECOVERY''@/1/' \ -e 's/@''HAVE_STACK_OVERFLOW_RECOVERY''@/1/' \ diff -rNu smalltalk-2.3.3/sigsegv/src/Makefile.in smalltalk-2.3.4/sigsegv/src/Makefile.in --- smalltalk-2.3.3/sigsegv/src/Makefile.in 2007-02-13 09:27:21.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/Makefile.in 2007-05-12 12:11:33.000000000 +0200 @@ -57,10 +57,18 @@ mkinstalldirs = $(install_sh) -d CONFIG_HEADER = $(top_builddir)/config.h CONFIG_CLEAN_FILES = sigsegv.h -LTLIBRARIES = $(noinst_LTLIBRARIES) +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; +am__installdirs = "$(DESTDIR)$(libdir)" +libLTLIBRARIES_INSTALL = $(INSTALL) +LTLIBRARIES = $(lib_LTLIBRARIES) libsigsegv_la_LIBADD = am_libsigsegv_la_OBJECTS = handler.lo stackvma.lo leave.lo \ - dispatcher.lo + dispatcher.lo version.lo libsigsegv_la_OBJECTS = $(am_libsigsegv_la_OBJECTS) DEFAULT_INCLUDES = -I. -I$(srcdir) -I$(top_builddir) depcomp = @@ -90,11 +98,8 @@ AWK = @AWK@ CC = @CC@ CCDEPMODE = @CCDEPMODE@ -CFG_FAULT = @CFG_FAULT@ CFG_HANDLER = @CFG_HANDLER@ -CFG_HEURISTICS = @CFG_HEURISTICS@ CFG_LEAVE = @CFG_LEAVE@ -CFG_SIGNALS = @CFG_SIGNALS@ CFG_STACKVMA = @CFG_STACKVMA@ CFLAGS = @CFLAGS@ CPP = @CPP@ @@ -110,6 +115,7 @@ EXEEXT = @EXEEXT@ FAULT_CONTEXT = @FAULT_CONTEXT@ FAULT_CONTEXT_INCLUDE = @FAULT_CONTEXT_INCLUDE@ +FAULT_CONTEXT_INCLUDE2 = @FAULT_CONTEXT_INCLUDE2@ GREP = @GREP@ HAVE_SIGSEGV_RECOVERY = @HAVE_SIGSEGV_RECOVERY@ HAVE_STACK_OVERFLOW_RECOVERY = @HAVE_STACK_OVERFLOW_RECOVERY@ @@ -185,9 +191,10 @@ target_alias = @target_alias@ AUTOMAKE_OPTIONS = 1.5 gnits no-dependencies RM = rm -f -noinst_LTLIBRARIES = libsigsegv.la +lib_LTLIBRARIES = libsigsegv.la noinst_HEADERS = \ - fault-aix.h fault-aix-powerpc.h fault-beos.h fault-beos-i386.h \ + fault.h fault-aix3.h fault-aix3-powerpc.h fault-aix5.h fault-aix5-powerpc.h \ + fault-beos.h fault-beos-i386.h \ fault-bsd.h fault-freebsd-i386.h \ fault-hpux.h fault-hpux-hppa.h fault-hurd.h fault-irix.h fault-irix-mips.h \ fault-linux.h fault-linux-alpha.h fault-linux-arm.h fault-linux-cris.h \ @@ -195,27 +202,28 @@ fault-linux-ia64.h fault-linux-m68k.h fault-linux-m68k.c fault-linux-mips.h \ fault-linux-powerpc.h fault-linux-s390.h fault-linux-sh.h \ fault-linux-sparc.h fault-linux-x86_64.h \ - fault-macos-i386.h fault-macos-powerpc.h fault-macos-powerpc.c \ - fault-netbsd-alpha.h fault-netbsd-alpha.c \ + fault-macos-i386.h \ + fault-macosdarwin5-powerpc.h fault-macosdarwin5-powerpc.c \ + fault-macosdarwin7-powerpc.h fault-macosdarwin7-powerpc.c \ + fault-netbsd.h fault-netbsd-alpha.h fault-netbsd-alpha.c \ fault-none.h \ fault-openbsd.h fault-openbsd-i386.h \ fault-osf.h fault-osf-alpha.h \ fault-posix.h fault-solaris.h fault-solaris-i386.h fault-solaris-sparc.h \ - machfault-macos-powerpc.h \ + machfault.h machfault-macos-i386.h machfault-macos-powerpc.h \ signals.h signals-bsd.h signals-hpux.h signals-hurd.h signals-macos.h \ - heur-none.h heur-ab.h heur-ac.h heur-bc.h \ leave.h \ stackvma.h EXTRA_DIST = \ - handler-none.c handler-macos.c handler-unix.c handler-win32.c \ - stackvma-none.c stackvma-linux.c stackvma-freebsd.c stackvma-procfs.c \ - stackvma-beos.c stackvma-mach.c \ + handler-none.c handler-unix.c handler-macos.c handler-win32.c \ + stackvma-none.c stackvma-simple.c stackvma-linux.c stackvma-freebsd.c \ + stackvma-procfs.c stackvma-beos.c stackvma-mach.c stackvma-mincore.c \ leave-none.c leave-nop.c leave-sigaltstack.c leave-setcontext.c \ sigsegv.h.msvc INCLUDES = -I. -I$(srcdir) -libsigsegv_la_SOURCES = handler.c stackvma.c leave.c dispatcher.c +libsigsegv_la_SOURCES = handler.c stackvma.c leave.c dispatcher.c version.c libsigsegv_la_LDFLAGS = -lc -no-undefined DISTCLEANFILES = sigsegv.h all: all-am @@ -253,17 +261,35 @@ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh sigsegv.h: $(top_builddir)/config.status $(srcdir)/sigsegv.h.in cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ +install-libLTLIBRARIES: $(lib_LTLIBRARIES) + @$(NORMAL_INSTALL) + test -z "$(libdir)" || $(mkdir_p) "$(DESTDIR)$(libdir)" + @list='$(lib_LTLIBRARIES)'; for p in $$list; do \ + if test -f $$p; then \ + f=$(am__strip_dir) \ + echo " $(LIBTOOL) --mode=install $(libLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) '$$p' '$(DESTDIR)$(libdir)/$$f'"; \ + $(LIBTOOL) --mode=install $(libLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) "$$p" "$(DESTDIR)$(libdir)/$$f"; \ + else :; fi; \ + done + +uninstall-libLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @set -x; list='$(lib_LTLIBRARIES)'; for p in $$list; do \ + p=$(am__strip_dir) \ + echo " $(LIBTOOL) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$p'"; \ + $(LIBTOOL) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$p"; \ + done -clean-noinstLTLIBRARIES: - -test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES) - @list='$(noinst_LTLIBRARIES)'; for p in $$list; do \ +clean-libLTLIBRARIES: + -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES) + @list='$(lib_LTLIBRARIES)'; for p in $$list; do \ dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ test "$$dir" != "$$p" || dir=.; \ echo "rm -f \"$${dir}/so_locations\""; \ rm -f "$${dir}/so_locations"; \ done libsigsegv.la: $(libsigsegv_la_OBJECTS) $(libsigsegv_la_DEPENDENCIES) - $(LINK) $(libsigsegv_la_LDFLAGS) $(libsigsegv_la_OBJECTS) $(libsigsegv_la_LIBADD) $(LIBS) + $(LINK) -rpath $(libdir) $(libsigsegv_la_LDFLAGS) $(libsigsegv_la_OBJECTS) $(libsigsegv_la_LIBADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) @@ -369,6 +395,9 @@ check: check-am all-am: Makefile $(LTLIBRARIES) $(HEADERS) installdirs: installdirs-local + for dir in "$(DESTDIR)$(libdir)"; do \ + test -z "$$dir" || $(mkdir_p) "$$dir"; \ + done install: install-am install-exec: install-exec-am install-data: install-data-am @@ -396,7 +425,7 @@ @echo "it deletes files that may require special tools to rebuild." clean: clean-am -clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \ +clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \ mostlyclean-am distclean: distclean-am @@ -416,7 +445,7 @@ install-data-am: install-data-local -install-exec-am: +install-exec-am: install-libLTLIBRARIES install-info: install-info-am @@ -441,19 +470,22 @@ ps-am: -uninstall-am: uninstall-info-am uninstall-local +uninstall-am: uninstall-info-am uninstall-libLTLIBRARIES \ + uninstall-local .PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ - clean-libtool clean-noinstLTLIBRARIES ctags distclean \ + clean-libLTLIBRARIES clean-libtool ctags distclean \ distclean-compile distclean-generic distclean-libtool \ distclean-tags distdir dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am \ install-data-local install-exec install-exec-am install-info \ - install-info-am install-man install-strip installcheck \ - installcheck-am installdirs installdirs-local maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-compile \ - mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ - tags uninstall uninstall-am uninstall-info-am uninstall-local + install-info-am install-libLTLIBRARIES install-man \ + install-strip installcheck installcheck-am installdirs \ + installdirs-local maintainer-clean maintainer-clean-generic \ + mostlyclean mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags uninstall \ + uninstall-am uninstall-info-am uninstall-libLTLIBRARIES \ + uninstall-local # Dependencies. @@ -477,7 +509,8 @@ # Rules for "make dist". sigsegv.h.msvc : sigsegv.h.in - $(SED) -e 's/@''FAULT_CONTEXT_INCLUDE''@/#include /' \ + sed -e 's/@''FAULT_CONTEXT_INCLUDE''@/#include /' \ + -e 's/@''FAULT_CONTEXT_INCLUDE2''@//' \ -e 's/@''FAULT_CONTEXT''@/CONTEXT/' \ -e 's/@''HAVE_SIGSEGV_RECOVERY''@/1/' \ -e 's/@''HAVE_STACK_OVERFLOW_RECOVERY''@/1/' \ diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-aix-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-aix-powerpc.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix-powerpc.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,20 +0,0 @@ -/* Fault handler information. AIX/PowerPC version. - Copyright (C) 2002 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "fault-aix.h" - -#define SIGSEGV_FAULT_STACKPOINTER scp->sc_jmpbuf.jmp_context.gpr[1] diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix.h smalltalk-2.3.4/sigsegv/src/fault-aix.h --- smalltalk-2.3.3/sigsegv/src/fault-aix.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,20 +0,0 @@ -/* Fault handler information. AIX version. - Copyright (C) 2002 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig, int code, struct sigcontext *scp -#define SIGSEGV_FAULT_ADDRESS scp->sc_jmpbuf.jmp_context.o_vaddr -#define SIGSEGV_FAULT_CONTEXT scp diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix3-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-aix3-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-aix3-powerpc.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix3-powerpc.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,20 @@ +/* Fault handler information. AIX3/PowerPC and AIX4/PowerPC version. + Copyright (C) 2002-2005 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-aix3.h" + +#define SIGSEGV_FAULT_STACKPOINTER scp->sc_jmpbuf.jmp_context.gpr[1] diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix3.h smalltalk-2.3.4/sigsegv/src/fault-aix3.h --- smalltalk-2.3.3/sigsegv/src/fault-aix3.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix3.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,20 @@ +/* Fault handler information. AIX 3 and AIX 4 version. + Copyright (C) 2002 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig, int code, struct sigcontext *scp +#define SIGSEGV_FAULT_ADDRESS scp->sc_jmpbuf.jmp_context.o_vaddr +#define SIGSEGV_FAULT_CONTEXT scp diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix5-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-aix5-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-aix5-powerpc.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix5-powerpc.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,20 @@ +/* Fault handler information. AIX5/PowerPC version. + Copyright (C) 2005 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-aix5.h" + +#define SIGSEGV_FAULT_STACKPOINTER ((ucontext_t *) ucp)->uc_mcontext.jmp_context.gpr[1] diff -rNu smalltalk-2.3.3/sigsegv/src/fault-aix5.h smalltalk-2.3.4/sigsegv/src/fault-aix5.h --- smalltalk-2.3.3/sigsegv/src/fault-aix5.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-aix5.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,18 @@ +/* Fault handler information. AIX 5 version. + Copyright (C) 2005 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-posix.h" diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macos-powerpc.c smalltalk-2.3.4/sigsegv/src/fault-macos-powerpc.c --- smalltalk-2.3.3/sigsegv/src/fault-macos-powerpc.c 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macos-powerpc.c 1970-01-01 01:00:00.000000000 +0100 @@ -1,124 +0,0 @@ -/* Fault handler information subroutine. MacOSX/PowerPC version. - * Taken from gcc-3.2/boehm-gc/os_dep.c. - * - * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers - * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. - * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved. - * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved. - * - * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED - * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. - * - * Permission is hereby granted to use or copy this program - * for any purpose, provided the above notices are retained on all copies. - * Permission to modify the code and to distribute modified code is granted, - * provided the above notices are retained, and a notice that the code was - * modified is included with the above copyright notice. - */ - -/* Decodes the machine instruction which was responsible for the sending of the - SIGBUS signal. Sadly this is the only way to find the faulting address - because the signal handler doesn't get it directly from the kernel (although - it is available on the Mach level, but dropped by the BSD personality before - it calls our signal handler...) - This code should be able to deal correctly with all PPCs starting from the - 601 up to and including the G4s (including Velocity Engine). */ -#define EXTRACT_OP1(iw) (((iw) & 0xFC000000) >> 26) -#define EXTRACT_OP2(iw) (((iw) & 0x000007FE) >> 1) -#define EXTRACT_REGA(iw) (((iw) & 0x001F0000) >> 16) -#define EXTRACT_REGB(iw) (((iw) & 0x03E00000) >> 21) -#define EXTRACT_REGC(iw) (((iw) & 0x0000F800) >> 11) -#define EXTRACT_DISP(iw) ((short *) &(iw))[1] - -static void * -get_fault_addr (struct sigcontext *scp) -{ - unsigned int instr = *((unsigned int *) scp->sc_ir); - unsigned int *regs = &((unsigned int *) scp->sc_regs)[2]; - int disp = 0; - int tmp; - unsigned int baseA = 0; - unsigned int baseB = 0; - unsigned int addr; - unsigned int alignmask = 0xFFFFFFFF; - - switch (EXTRACT_OP1 (instr)) - { - case 38: /* stb */ - case 39: /* stbu */ - case 54: /* stfd */ - case 55: /* stfdu */ - case 52: /* stfs */ - case 53: /* stfsu */ - case 44: /* sth */ - case 45: /* sthu */ - case 47: /* stmw */ - case 36: /* stw */ - case 37: /* stwu */ - tmp = EXTRACT_REGA (instr); - if (tmp > 0) - baseA = regs[tmp]; - disp = EXTRACT_DISP (instr); - break; - case 31: - switch (EXTRACT_OP2 (instr)) - { - case 86: /* dcbf */ - case 54: /* dcbst */ - case 1014: /* dcbz */ - case 247: /* stbux */ - case 215: /* stbx */ - case 759: /* stfdux */ - case 727: /* stfdx */ - case 983: /* stfiwx */ - case 695: /* stfsux */ - case 663: /* stfsx */ - case 918: /* sthbrx */ - case 439: /* sthux */ - case 407: /* sthx */ - case 661: /* stswx */ - case 662: /* stwbrx */ - case 150: /* stwcx. */ - case 183: /* stwux */ - case 151: /* stwx */ - case 135: /* stvebx */ - case 167: /* stvehx */ - case 199: /* stvewx */ - case 231: /* stvx */ - case 487: /* stvxl */ - tmp = EXTRACT_REGA (instr); - if (tmp > 0) - baseA = regs[tmp]; - baseB = regs[EXTRACT_REGC (instr)]; - /* Determine Altivec alignment mask. */ - switch (EXTRACT_OP2 (instr)) - { - case 167: /* stvehx */ - alignmask = 0xFFFFFFFE; - break; - case 199: /* stvewx */ - alignmask = 0xFFFFFFFC; - break; - case 231: /* stvx */ - case 487: /* stvxl */ - alignmask = 0xFFFFFFF0; - break; - } - break; - case 725: /* stswi */ - tmp = EXTRACT_REGA (instr); - if (tmp > 0) - baseA = regs[tmp]; - break; - default: /* ignore instruction */ - return (void *) 0; - } - break; - default: /* ignore instruction */ - return (void *) 0; - } - - addr = (baseA + baseB) + disp; - addr &= alignmask; - return (void *) addr; -} diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macos-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-macos-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-macos-powerpc.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macos-powerpc.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,26 +0,0 @@ -/* Fault handler information. MacOSX/PowerPC version. - Copyright (C) 2002-2003 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "fault-macos-powerpc.c" - -#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig, int code, struct sigcontext *scp -#define SIGSEGV_FAULT_ADDRESS (unsigned long) get_fault_addr (scp) -#define SIGSEGV_FAULT_CONTEXT scp -#if 0 -#define SIGSEGV_FAULT_STACKPOINTER (&((unsigned int *) scp->sc_regs)[2])[1] -#endif -#define SIGSEGV_FAULT_STACKPOINTER (scp->sc_regs ? ((unsigned int *) scp->sc_regs)[3] : scp->sc_sp) diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macosdarwin5-powerpc.c smalltalk-2.3.4/sigsegv/src/fault-macosdarwin5-powerpc.c --- smalltalk-2.3.3/sigsegv/src/fault-macosdarwin5-powerpc.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macosdarwin5-powerpc.c 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,124 @@ +/* Fault handler information subroutine. MacOSX/Darwin5/PowerPC version. + * Taken from gcc-3.2/boehm-gc/os_dep.c. + * + * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers + * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. + * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved. + * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved. + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED + * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * Permission is hereby granted to use or copy this program + * for any purpose, provided the above notices are retained on all copies. + * Permission to modify the code and to distribute modified code is granted, + * provided the above notices are retained, and a notice that the code was + * modified is included with the above copyright notice. + */ + +/* Decodes the machine instruction which was responsible for the sending of the + SIGBUS signal. Sadly this is the only way to find the faulting address + because the signal handler doesn't get it directly from the kernel (although + it is available on the Mach level, but dropped by the BSD personality before + it calls our signal handler...) + This code should be able to deal correctly with all PPCs starting from the + 601 up to and including the G4s (including Velocity Engine). */ +#define EXTRACT_OP1(iw) (((iw) & 0xFC000000) >> 26) +#define EXTRACT_OP2(iw) (((iw) & 0x000007FE) >> 1) +#define EXTRACT_REGA(iw) (((iw) & 0x001F0000) >> 16) +#define EXTRACT_REGB(iw) (((iw) & 0x03E00000) >> 21) +#define EXTRACT_REGC(iw) (((iw) & 0x0000F800) >> 11) +#define EXTRACT_DISP(iw) ((short *) &(iw))[1] + +static void * +get_fault_addr (struct sigcontext *scp) +{ + unsigned int instr = *((unsigned int *) scp->sc_ir); + unsigned int *regs = &((unsigned int *) scp->sc_regs)[2]; + int disp = 0; + int tmp; + unsigned int baseA = 0; + unsigned int baseB = 0; + unsigned int addr; + unsigned int alignmask = 0xFFFFFFFF; + + switch (EXTRACT_OP1 (instr)) + { + case 38: /* stb */ + case 39: /* stbu */ + case 54: /* stfd */ + case 55: /* stfdu */ + case 52: /* stfs */ + case 53: /* stfsu */ + case 44: /* sth */ + case 45: /* sthu */ + case 47: /* stmw */ + case 36: /* stw */ + case 37: /* stwu */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + disp = EXTRACT_DISP (instr); + break; + case 31: + switch (EXTRACT_OP2 (instr)) + { + case 86: /* dcbf */ + case 54: /* dcbst */ + case 1014: /* dcbz */ + case 247: /* stbux */ + case 215: /* stbx */ + case 759: /* stfdux */ + case 727: /* stfdx */ + case 983: /* stfiwx */ + case 695: /* stfsux */ + case 663: /* stfsx */ + case 918: /* sthbrx */ + case 439: /* sthux */ + case 407: /* sthx */ + case 661: /* stswx */ + case 662: /* stwbrx */ + case 150: /* stwcx. */ + case 183: /* stwux */ + case 151: /* stwx */ + case 135: /* stvebx */ + case 167: /* stvehx */ + case 199: /* stvewx */ + case 231: /* stvx */ + case 487: /* stvxl */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + baseB = regs[EXTRACT_REGC (instr)]; + /* Determine Altivec alignment mask. */ + switch (EXTRACT_OP2 (instr)) + { + case 167: /* stvehx */ + alignmask = 0xFFFFFFFE; + break; + case 199: /* stvewx */ + alignmask = 0xFFFFFFFC; + break; + case 231: /* stvx */ + case 487: /* stvxl */ + alignmask = 0xFFFFFFF0; + break; + } + break; + case 725: /* stswi */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + break; + default: /* ignore instruction */ + return (void *) 0; + } + break; + default: /* ignore instruction */ + return (void *) 0; + } + + addr = (baseA + baseB) + disp; + addr &= alignmask; + return (void *) addr; +} diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macosdarwin5-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-macosdarwin5-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-macosdarwin5-powerpc.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macosdarwin5-powerpc.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,26 @@ +/* Fault handler information. MacOSX/Darwin5/PowerPC version. + Copyright (C) 2002-2004 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-macosdarwin5-powerpc.c" + +#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig, int code, struct sigcontext *scp +#define SIGSEGV_FAULT_ADDRESS (unsigned long) get_fault_addr (scp) +#define SIGSEGV_FAULT_CONTEXT scp +#if 0 +#define SIGSEGV_FAULT_STACKPOINTER (&((unsigned int *) scp->sc_regs)[2])[1] +#endif +#define SIGSEGV_FAULT_STACKPOINTER (scp->sc_regs ? ((unsigned int *) scp->sc_regs)[3] : scp->sc_sp) diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macosdarwin7-powerpc.c smalltalk-2.3.4/sigsegv/src/fault-macosdarwin7-powerpc.c --- smalltalk-2.3.3/sigsegv/src/fault-macosdarwin7-powerpc.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macosdarwin7-powerpc.c 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,126 @@ +/* Fault handler information subroutine. MacOSX/Darwin7/PowerPC version. + * Taken from gcc-3.2/boehm-gc/os_dep.c. + * + * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers + * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. + * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved. + * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved. + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED + * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * Permission is hereby granted to use or copy this program + * for any purpose, provided the above notices are retained on all copies. + * Permission to modify the code and to distribute modified code is granted, + * provided the above notices are retained, and a notice that the code was + * modified is included with the above copyright notice. + */ + +#include + +/* Decodes the machine instruction which was responsible for the sending of the + SIGBUS signal. Sadly this is the only way to find the faulting address + because the signal handler doesn't get it directly from the kernel (although + it is available on the Mach level, but dropped by the BSD personality before + it calls our signal handler...) + This code should be able to deal correctly with all PPCs starting from the + 601 up to and including the G4s (including Velocity Engine). */ +#define EXTRACT_OP1(iw) (((iw) & 0xFC000000) >> 26) +#define EXTRACT_OP2(iw) (((iw) & 0x000007FE) >> 1) +#define EXTRACT_REGA(iw) (((iw) & 0x001F0000) >> 16) +#define EXTRACT_REGB(iw) (((iw) & 0x03E00000) >> 21) +#define EXTRACT_REGC(iw) (((iw) & 0x0000F800) >> 11) +#define EXTRACT_DISP(iw) ((short *) &(iw))[1] + +static void * +get_fault_addr (siginfo_t *sip, ucontext_t *ucp) +{ + unsigned int instr = *(unsigned int *) sip->si_addr; + unsigned int *regs = &ucp->uc_mcontext->ss.r0; /* r0..r31 */ + int disp = 0; + int tmp; + unsigned int baseA = 0; + unsigned int baseB = 0; + unsigned int addr; + unsigned int alignmask = 0xFFFFFFFF; + + switch (EXTRACT_OP1 (instr)) + { + case 38: /* stb */ + case 39: /* stbu */ + case 54: /* stfd */ + case 55: /* stfdu */ + case 52: /* stfs */ + case 53: /* stfsu */ + case 44: /* sth */ + case 45: /* sthu */ + case 47: /* stmw */ + case 36: /* stw */ + case 37: /* stwu */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + disp = EXTRACT_DISP (instr); + break; + case 31: + switch (EXTRACT_OP2 (instr)) + { + case 86: /* dcbf */ + case 54: /* dcbst */ + case 1014: /* dcbz */ + case 247: /* stbux */ + case 215: /* stbx */ + case 759: /* stfdux */ + case 727: /* stfdx */ + case 983: /* stfiwx */ + case 695: /* stfsux */ + case 663: /* stfsx */ + case 918: /* sthbrx */ + case 439: /* sthux */ + case 407: /* sthx */ + case 661: /* stswx */ + case 662: /* stwbrx */ + case 150: /* stwcx. */ + case 183: /* stwux */ + case 151: /* stwx */ + case 135: /* stvebx */ + case 167: /* stvehx */ + case 199: /* stvewx */ + case 231: /* stvx */ + case 487: /* stvxl */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + baseB = regs[EXTRACT_REGC (instr)]; + /* Determine Altivec alignment mask. */ + switch (EXTRACT_OP2 (instr)) + { + case 167: /* stvehx */ + alignmask = 0xFFFFFFFE; + break; + case 199: /* stvewx */ + alignmask = 0xFFFFFFFC; + break; + case 231: /* stvx */ + case 487: /* stvxl */ + alignmask = 0xFFFFFFF0; + break; + } + break; + case 725: /* stswi */ + tmp = EXTRACT_REGA (instr); + if (tmp > 0) + baseA = regs[tmp]; + break; + default: /* ignore instruction */ + return (void *) 0; + } + break; + default: /* ignore instruction */ + return (void *) 0; + } + + addr = (baseA + baseB) + disp; + addr &= alignmask; + return (void *) addr; +} diff -rNu smalltalk-2.3.3/sigsegv/src/fault-macosdarwin7-powerpc.h smalltalk-2.3.4/sigsegv/src/fault-macosdarwin7-powerpc.h --- smalltalk-2.3.3/sigsegv/src/fault-macosdarwin7-powerpc.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-macosdarwin7-powerpc.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,24 @@ +/* Fault handler information. MacOSX/Darwin7/PowerPC version. + Copyright (C) 2002-2004 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-macosdarwin7-powerpc.c" + +#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig, siginfo_t *sip, ucontext_t *ucp +#define SIGSEGV_FAULT_ADDRESS (unsigned long) get_fault_addr (sip, ucp) +#define SIGSEGV_FAULT_CONTEXT ucp +#define SIGSEGV_FAULT_ADDRESS_FROM_SIGINFO +#define SIGSEGV_FAULT_STACKPOINTER ucp->uc_mcontext->ss.r1 diff -rNu smalltalk-2.3.3/sigsegv/src/fault-netbsd.h smalltalk-2.3.4/sigsegv/src/fault-netbsd.h --- smalltalk-2.3.3/sigsegv/src/fault-netbsd.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault-netbsd.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,29 @@ +/* Fault handler information. NetBSD version. + Copyright (C) 2006 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "fault-posix.h" + +/* _UC_MACHINE_SP is a platform independent macro. + Defined in , see + http://cvsweb.netbsd.org/bsdweb.cgi/src/sys/arch/$arch/include/mcontext.h + Supported on alpha, amd64, i386, ia64, m68k, mips, powerpc, sparc since + NetBSD 2.0. + On i386, _UC_MACHINE_SP is the same as ->uc_mcontext.__gregs[_REG_UESP], + and apparently the same value as ->uc_mcontext.__gregs[_REG_ESP]. */ +#ifdef _UC_MACHINE_SP +#define SIGSEGV_FAULT_STACKPOINTER _UC_MACHINE_SP ((ucontext_t *) ucp) +#endif diff -rNu smalltalk-2.3.3/sigsegv/src/fault.h smalltalk-2.3.4/sigsegv/src/fault.h --- smalltalk-2.3.3/sigsegv/src/fault.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/fault.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,37 @@ +/* Fault handler information. + Copyright (C) 2002 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* The included file defines: + + SIGSEGV_FAULT_HANDLER_ARGLIST + is the argument list for the actual fault handler. + + SIGSEGV_FAULT_ADDRESS + is a macro for fetching the fault address. + + and if available (optional): + + SIGSEGV_FAULT_CONTEXT + is a macro giving a pointer to the entire fault context (i.e. + the register set etc.). + + SIGSEGV_FAULT_STACKPOINTER + is a macro for fetching the stackpointer at the moment the fault + occurred. + */ + +#include CFG_FAULT diff -rNu smalltalk-2.3.3/sigsegv/src/handler-macos.c smalltalk-2.3.4/sigsegv/src/handler-macos.c --- smalltalk-2.3.3/sigsegv/src/handler-macos.c 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/handler-macos.c 2007-05-12 12:01:46.000000000 +0200 @@ -26,7 +26,6 @@ # include #endif -#include #include #include #include @@ -39,17 +38,7 @@ #define SS_DISABLE SA_DISABLE #endif -/* Platform dependent: - Characteristics of the exception handler. */ -#include CFG_FAULT - -/* Platform dependent: - Determine the virtual memory area of a given address. */ -#include "stackvma.h" - -/* Platform dependent: - Determine if a fault is caused by a stack overflow. */ -#include CFG_HEURISTICS +#include "machfault.h" /* The following sources were used as a *reference* for this exception handling code: @@ -123,8 +112,8 @@ -1: called and failed */ static int mach_initialized = 0; -/* Communication area for the exception state. */ -static int is_stack_overflow; +/* Communication area for the exception state and thread state. */ +static SIGSEGV_THREAD_STATE_TYPE save_thread_state; /* Check for reentrant signals. */ static int emergency = -1; @@ -137,9 +126,19 @@ /* User's fault handler. */ static sigsegv_handler_t user_handler = (sigsegv_handler_t)NULL; -/* Our signal handler, which we use to get the thread state for running - on an alternate stack (we cannot longjmp while in the exception - handling thread, so we need to mimic what signals do!). */ +/* A handler that is called in the faulting thread. It terminates the thread. */ +static void +terminating_handler () +{ + /* Dump core. */ + raise (SIGSEGV); + + /* Seriously. */ + abort (); +} + +/* A handler that is called in the faulting thread, on an alternate stack. + It calls the user installed stack overflow handler. */ static void altstack_handler () { @@ -147,24 +146,20 @@ /* Check if it is plausibly a stack overflow, and the user installed a stack overflow handler. */ - if (is_stack_overflow && stk_user_handler) + if (stk_user_handler) { emergency++; /* Call user's handler. */ - (*stk_user_handler) (emergency, NULL); + (*stk_user_handler) (emergency, &save_thread_state); } - /* Else, dump core. */ - signal (SIGSEGV, SIG_DFL); - signal (SIGBUS, SIG_DFL); - raise (SIGSEGV); - - /* Seriously. */ - abort (); + /* Else, terminate the thread. */ + terminating_handler (); } -/* Handle an exception by invoking the user's fault handler. */ +/* Handle an exception by invoking the user's fault handler and/or forwarding + the duty to the previously installed handlers. */ kern_return_t catch_exception_raise (mach_port_t exception_port, mach_port_t thread, @@ -173,10 +168,13 @@ exception_data_t code, mach_msg_type_number_t code_count) { +#ifdef SIGSEGV_EXC_STATE_TYPE SIGSEGV_EXC_STATE_TYPE exc_state; +#endif SIGSEGV_THREAD_STATE_TYPE thread_state; mach_msg_type_number_t state_count; - unsigned long addr, sp; + unsigned long addr; + unsigned long sp; #ifdef DEBUG_EXCEPTION_HANDLING fprintf (stderr, "Exception: 0x%x Code: 0x%x 0x%x in catch....\n", @@ -186,6 +184,7 @@ #endif /* See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_get_state.html. */ +#ifdef SIGSEGV_EXC_STATE_TYPE state_count = SIGSEGV_EXC_STATE_COUNT; if (thread_get_state (thread, SIGSEGV_EXC_STATE_FLAVOR, (void *) &exc_state, &state_count) @@ -198,35 +197,44 @@ #endif return KERN_FAILURE; } +#endif state_count = SIGSEGV_THREAD_STATE_COUNT; if (thread_get_state (thread, SIGSEGV_THREAD_STATE_FLAVOR, (void *) &thread_state, &state_count) != KERN_SUCCESS) { + /* The thread is supposed to be suspended while the exception handler + is called. This shouldn't fail. */ #ifdef DEBUG_EXCEPTION_HANDLING fprintf (stderr, "thread_get_state failed for thread state\n"); #endif return KERN_FAILURE; } + addr = (unsigned long) (SIGSEGV_FAULT_ADDRESS (thread_state, exc_state)); + sp = (unsigned long) (SIGSEGV_STACK_POINTER (thread_state)); + /* Got the thread's state. Now extract the address that caused the - fault. */ - addr = (unsigned long) (SIGSEGV_FAULT_ADDRESS); - sp = (unsigned long) (SIGSEGV_FAULT_STACKPOINTER); - is_stack_overflow = IS_STACK_OVERFLOW; + fault and invoke the user's handler. */ + save_thread_state = thread_state; - if (is_stack_overflow) + /* If the fault address is near the stack pointer, it's a stack overflow. + Otherwise, treat it like a normal SIGSEGV. */ + if (addr <= sp + 4096 && sp <= addr + 4096) { #ifdef DEBUG_EXCEPTION_HANDLING fprintf (stderr, "Treating as stack overflow, sp = 0x%lx\n", (char *) sp); #endif -#if STACK_DIRECTION == 1 - SIGSEGV_FAULT_STACKPOINTER = stk_extra_stack + 256; -#else - SIGSEGV_FAULT_STACKPOINTER = + SIGSEGV_STACK_POINTER (thread_state) = +#if STACK_DIRECTION < 0 stk_extra_stack + stk_extra_stack_size - 256; +#else + stk_extra_stack + 256; #endif + /* Continue handling this fault in the faulting thread. (We cannot longjmp while + in the exception handling thread, so we need to mimic what signals do!) */ + SIGSEGV_PROGRAM_COUNTER (thread_state) = (unsigned long) altstack_handler; } else { @@ -236,20 +244,19 @@ #ifdef DEBUG_EXCEPTION_HANDLING fprintf (stderr, "Calling user handler, addr = 0x%lx\n", (char *) addr); #endif - done = (*user_handler) ((char *) addr, 1); + done = (*user_handler) ((void *) addr, 1); #ifdef DEBUG_EXCEPTION_HANDLING fprintf (stderr, "Back from user handler\n"); #endif if (done) return KERN_SUCCESS; } + SIGSEGV_PROGRAM_COUNTER (thread_state) = (unsigned long) terminating_handler; } - SIGSEGV_PROGRAM_COUNTER = (unsigned long) altstack_handler; - /* See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_set_state.html. */ if (thread_set_state (thread, SIGSEGV_THREAD_STATE_FLAVOR, - (void *) &thread_state, state_count) + (void *) &thread_state, state_count) != KERN_SUCCESS) { #ifdef DEBUG_EXCEPTION_HANDLING @@ -257,6 +264,7 @@ #endif return KERN_FAILURE; } + return KERN_SUCCESS; } @@ -345,12 +353,6 @@ pthread_attr_t attr; pthread_t thread; - int dummy; - signal (SIGSEGV, SIG_IGN); - signal (SIGBUS, SIG_IGN); - if (remember_stack_top (&dummy) == -1) - return -1; - self = mach_task_self (); /* Allocate a port on which the thread shall listen for exceptions. */ diff -rNu smalltalk-2.3.3/sigsegv/src/handler-unix.c smalltalk-2.3.4/sigsegv/src/handler-unix.c --- smalltalk-2.3.3/sigsegv/src/handler-unix.c 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/handler-unix.c 2007-05-12 12:01:46.000000000 +0200 @@ -17,8 +17,41 @@ #include "sigsegv.h" +/* On the average Unix platform, we define + + HAVE_SIGSEGV_RECOVERY + if there is a fault-*.h include file which defines + SIGSEGV_FAULT_HANDLER_ARGLIST and SIGSEGV_FAULT_ADDRESS. + + HAVE_STACK_OVERFLOW_RECOVERY + if HAVE_SIGALTSTACK is set and + at least two of the following are true: + A) There is a fault-*.h include file which defines + SIGSEGV_FAULT_HANDLER_ARGLIST and SIGSEGV_FAULT_ADDRESS. + B) There is a fault-*.h include file which defines + SIGSEGV_FAULT_HANDLER_ARGLIST and SIGSEGV_FAULT_STACKPOINTER. + C) There is a stackvma-*.c, other than stackvma-none.c, which + defines sigsegv_get_vma. + + Why? Obviously, to catch stack overflow, we need an alternate signal + stack; this requires kernel support. But we also need to distinguish + (with a reasonable confidence) a stack overflow from a regular SIGSEGV. + If we have A) and B), we use the + Heuristic AB: If the fault address is near the stack pointer, it's a + stack overflow. + If we have A) and C), we use the + Heuristic AC: If the fault address is near and beyond the bottom of + the stack's virtual memory area, it's a stack overflow. + If we have B) and C), we use the + Heuristic BC: If the stack pointer is near the bottom of the stack's + virtual memory area, it's a stack overflow. + This heuristic comes in two flavours: On OSes which let the stack's + VMA grow continuously, we determine the bottom by use of getrlimit(). + On OSes which preallocate the stack's VMA with its maximum size + (like BeOS), we use the stack's VMA directly. + */ + #include /* needed for NULL on SunOS4 */ -#include /* perror */ #include #include #if HAVE_SYS_SIGNAL_H @@ -31,25 +64,18 @@ #define SS_DISABLE SA_DISABLE #endif -#if HAVE_STACK_OVERFLOW_RECOVERY -static stackoverflow_handler_t stk_user_handler = (stackoverflow_handler_t)NULL; -static unsigned long stk_extra_stack; -static unsigned long stk_extra_stack_size; -#endif /* HAVE_STACK_OVERFLOW_RECOVERY */ - -#if HAVE_SIGSEGV_RECOVERY -/* User's SIGSEGV handler. */ -static sigsegv_handler_t user_handler = (sigsegv_handler_t)NULL; -#endif /* HAVE_SIGSEGV_RECOVERY */ +#include "fault.h" +#include CFG_SIGNALS +#if HAVE_STACK_OVERFLOW_RECOVERY -/* Platform dependent: - Characteristics of the signal handler. */ -#include CFG_FAULT +#include /* perror */ -/* Platform dependent: - Determining which signals should be trapped. */ -#include CFG_SIGNALS +#if HAVE_GETRLIMIT +# include +# include +# include /* declares struct rlimit */ +#endif /* Platform dependent: Determine the virtual memory area of a given address. */ @@ -59,69 +85,233 @@ Leaving a signal handler executing on the alternate stack. */ #include "leave.h" -/* Platform dependent: - Determine if a fault is caused by a stack overflow. */ -#include CFG_HEURISTICS +#if HAVE_STACKVMA -#ifndef SIGSEGV_FAULT_HANDLER_ARGLIST -#define SIGSEGV_FAULT_HANDLER_ARGLIST int sig -#endif +/* Address of the last byte belonging to the stack vma. */ +static unsigned long stack_top = 0; + +/* Needs to be called once only. */ +static void +remember_stack_top (void *some_variable_on_stack) +{ + struct vma_struct vma; + + if (sigsegv_get_vma ((unsigned long) some_variable_on_stack, &vma) >= 0) + stack_top = vma.end - 1; +} + +#endif /* HAVE_STACKVMA */ + +static stackoverflow_handler_t stk_user_handler = (stackoverflow_handler_t)NULL; +static unsigned long stk_extra_stack; +static unsigned long stk_extra_stack_size; + +#endif /* HAVE_STACK_OVERFLOW_RECOVERY */ + +#if HAVE_SIGSEGV_RECOVERY + +/* User's SIGSEGV handler. */ +static sigsegv_handler_t user_handler = (sigsegv_handler_t)NULL; + +#endif /* HAVE_SIGSEGV_RECOVERY */ -#ifndef SIGSEGV_FAULT_CONTEXT -#define SIGSEGV_FAULT_CONTEXT NULL -#endif /* Our SIGSEGV handler, with OS dependent argument list. */ + +#if HAVE_SIGSEGV_RECOVERY + static void sigsegv_handler (SIGSEGV_FAULT_HANDLER_ARGLIST) { -#if HAVE_SIGSEGV_RECOVERY void *address = (void *) (SIGSEGV_FAULT_ADDRESS); -#endif #if HAVE_STACK_OVERFLOW_RECOVERY - /* Did the user install a stack overflow handler? */ - if (stk_user_handler) +#if !(HAVE_STACKVMA || defined SIGSEGV_FAULT_STACKPOINTER) +#error "Insufficient heuristics for detecting a stack overflow. Either define CFG_STACKVMA and HAVE_STACKVMA correctly, or define SIGSEGV_FAULT_STACKPOINTER correctly, or undefine HAVE_STACK_OVERFLOW_RECOVERY!" +#endif + + /* Call user's handler. */ + if (user_handler && (*user_handler) (address, 0)) + { + /* Handler successful. */ + } + else { + /* Handler declined responsibility. */ -#if HAVE_SIGSEGV_RECOVERY - /* Call user's handler. If successful, exit. */ - if (user_handler && (*user_handler) (address, 0)) - return; -#endif /* HAVE_SIGSEGV_RECOVERY */ + /* Did the user install a stack overflow handler? */ + if (stk_user_handler) + { + /* See whether it was a stack overflow. If so, longjump away. */ +#ifdef SIGSEGV_FAULT_STACKPOINTER + unsigned long old_sp = (unsigned long) (SIGSEGV_FAULT_STACKPOINTER); +#ifdef __ia64 + unsigned long old_bsp = (unsigned long) (SIGSEGV_FAULT_BSP_POINTER); +#endif +#endif - /* Handler declined responsibility. */ +#if HAVE_STACKVMA + /* Were we able to determine the stack top? */ + if (stack_top) + { + /* Determine stack bounds. */ + struct vma_struct vma; + + if (sigsegv_get_vma (stack_top, &vma) >= 0) + { + /* Heuristic AC: If the fault_address is nearer to the stack + segment's [start,end] than to the previous segment, we + consider it a stack overflow. + In the case of IA-64, we know that the previous segment + is the up-growing bsp segment, and either of the two + stacks can overflow. */ + unsigned long addr = (unsigned long) address; - if (IS_STACK_OVERFLOW) - { - /* Call user's handler. */ +#ifdef __ia64 + if (addr >= vma.prev_end && addr <= vma.end - 1) +#else +#if STACK_DIRECTION < 0 + if (addr >= vma.start + ? (addr <= vma.end - 1) + : vma.is_near_this (addr, &vma)) +#else + if (addr <= vma.end - 1 + ? (addr >= vma.start) + : vma.is_near_this (addr, &vma)) +#endif +#endif +#else + /* Heuristic AB: If the fault address is near the stack pointer, + it's a stack overflow. */ + unsigned long addr = (unsigned long) address; + + if ((addr <= old_sp + 4096 && old_sp <= addr + 4096) +#ifdef __ia64 + || (addr <= old_bsp + 4096 && old_bsp <= addr + 4096) +#endif + ) + { + { +#endif + { #ifdef SIGSEGV_FAULT_STACKPOINTER - unsigned long old_sp = (unsigned long) SIGSEGV_FAULT_STACKPOINTER; - int emergency = - (old_sp >= stk_extra_stack - && old_sp <= stk_extra_stack + stk_extra_stack_size); + int emergency = + (old_sp >= stk_extra_stack + && old_sp <= stk_extra_stack + stk_extra_stack_size); + stackoverflow_context_t context = (SIGSEGV_FAULT_CONTEXT); #else - int emergency = 0; -#endif /* SIGSEGV_FAULT_STACKPOINTER */ + int emergency = 0; + stackoverflow_context_t context = (void *) 0; +#endif + /* Call user's handler. */ + (*stk_user_handler) (emergency, context); + } + } + } + } +#endif /* HAVE_STACK_OVERFLOW_RECOVERY */ - stackoverflow_context_t context = (SIGSEGV_FAULT_CONTEXT); - (*stk_user_handler) (emergency, context); + if (user_handler && (*user_handler) (address, 1)) + { + /* Handler successful. */ } + else + { + /* Handler declined responsibility for real. */ + + /* Remove ourselves and dump core. */ + SIGSEGV_FOR_ALL_SIGNALS (sig, signal (sig, SIG_DFL);) + } + +#if HAVE_STACK_OVERFLOW_RECOVERY } #endif /* HAVE_STACK_OVERFLOW_RECOVERY */ +} -#if HAVE_SIGSEGV_RECOVERY - /* Call user's handler again. If successful, exit. */ - if (user_handler && (*user_handler) (address, 1)) - return; -#endif /* HAVE_SIGSEGV_RECOVERY */ +#elif HAVE_STACK_OVERFLOW_RECOVERY - /* All handlers declined responsibility for real. */ +static void +#ifdef SIGSEGV_FAULT_STACKPOINTER +sigsegv_handler (SIGSEGV_FAULT_HANDLER_ARGLIST) +#else +sigsegv_handler (int sig) +#endif +{ +#if !((HAVE_GETRLIMIT && defined RLIMIT_STACK) || defined SIGSEGV_FAULT_STACKPOINTER) +#error "Insufficient heuristics for detecting a stack overflow. Either define SIGSEGV_FAULT_STACKPOINTER correctly, or undefine HAVE_STACK_OVERFLOW_RECOVERY!" +#endif + + /* Did the user install a handler? */ + if (stk_user_handler) + { + /* See whether it was a stack overflow. If so, longjump away. */ +#ifdef SIGSEGV_FAULT_STACKPOINTER + unsigned long old_sp = (unsigned long) (SIGSEGV_FAULT_STACKPOINTER); +#endif + + /* Were we able to determine the stack top? */ + if (stack_top) + { + /* Determine stack bounds. */ + struct vma_struct vma; + + if (sigsegv_get_vma (stack_top, &vma) >= 0) + { +#if HAVE_GETRLIMIT && defined RLIMIT_STACK + /* Heuristic BC: If the stack size has reached its maximal size, + and old_sp is near the low end, we consider it a stack + overflow. */ + struct rlimit rl; + + if (getrlimit (RLIMIT_STACK, &rl) >= 0) + { + unsigned long current_stack_size = vma.end - vma.start; + unsigned long max_stack_size = rl.rlim_cur; + if (current_stack_size <= max_stack_size + 4096 + && max_stack_size <= current_stack_size + 4096 +#else + { + if (1 +#endif +#ifdef SIGSEGV_FAULT_STACKPOINTER + /* Heuristic BC: If we know old_sp, and it is neither + near the low end, nor in the alternate stack, then + it's probably not a stack overflow. */ + && ((old_sp >= stk_extra_stack + && old_sp <= stk_extra_stack + stk_extra_stack_size) +#if STACK_DIRECTION < 0 + || (old_sp <= vma.start + 4096 + && vma.start <= old_sp + 4096)) +#else + || (old_sp <= vma.end + 4096 + && vma.end <= old_sp + 4096)) +#endif +#endif + ) + { +#ifdef SIGSEGV_FAULT_STACKPOINTER + int emergency = + (old_sp >= stk_extra_stack + && old_sp <= stk_extra_stack + stk_extra_stack_size); + stackoverflow_context_t context = (SIGSEGV_FAULT_CONTEXT); +#else + int emergency = 0; + stackoverflow_context_t context = (void *) 0; +#endif + /* Call user's handler. */ + (*stk_user_handler)(emergency,context); + } + } + } + } + } /* Remove ourselves and dump core. */ SIGSEGV_FOR_ALL_SIGNALS (sig, signal (sig, SIG_DFL);) } +#endif + static void install_for (int sig) @@ -223,12 +413,6 @@ int sigsegv_install_handler (sigsegv_handler_t handler) { -#if HAVE_STACK_OVERFLOW_RECOVERY - int dummy; - if (remember_stack_top (&dummy) == -1) - return -1; -#endif - #if HAVE_SIGSEGV_RECOVERY user_handler = handler; @@ -273,9 +457,15 @@ void *extra_stack, unsigned long extra_stack_size) { #if HAVE_STACK_OVERFLOW_RECOVERY - int dummy; - if (remember_stack_top (&dummy) == -1) - return -1; +#if HAVE_STACKVMA + if (!stack_top) + { + int dummy; + remember_stack_top (&dummy); + if (!stack_top) + return -1; + } +#endif stk_user_handler = handler; stk_extra_stack = (unsigned long) extra_stack; diff -rNu smalltalk-2.3.3/sigsegv/src/heur-ab.h smalltalk-2.3.4/sigsegv/src/heur-ab.h --- smalltalk-2.3.3/sigsegv/src/heur-ab.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/heur-ab.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,40 +0,0 @@ -/* Detecting stack overflow. Version for platforms which supply the - fault address and the stack pointer. - Copyright (C) 2003 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#ifdef __ia64 -#define IS_STACK_OVERFLOW \ - (is_stk_overflow ((unsigned long) SIGSEGV_FAULT_ADDRESS, \ - (unsigned long) SIGSEGV_FAULT_STACKPOINTER) \ - || is_stk_overflow ((unsigned long) SIGSEGV_FAULT_ADDRESS, \ - (unsigned long) SIGSEGV_FAULT_BSP_POINTER)) -#else -#define IS_STACK_OVERFLOW \ - is_stk_overflow ((unsigned long) SIGSEGV_FAULT_ADDRESS, \ - (unsigned long) SIGSEGV_FAULT_STACKPOINTER) -#endif - -static int is_stk_overflow (unsigned long addr, unsigned long sp) -{ - return (addr <= sp + 4096 && sp <= addr + 4096); -} - -static int -remember_stack_top (void *some_variable_on_stack) -{ - return 0; -} diff -rNu smalltalk-2.3.3/sigsegv/src/heur-ac.h smalltalk-2.3.4/sigsegv/src/heur-ac.h --- smalltalk-2.3.3/sigsegv/src/heur-ac.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/heur-ac.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,64 +0,0 @@ -/* Detecting stack overflow. Version for platforms which supply the - fault address and have sigsegv_get_vma. - Copyright (C) 2003 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -static unsigned long stack_top = 0; - -static int -remember_stack_top (void *some_variable_on_stack) -{ - struct vma_struct vma; - - if (stack_top) - return 0; - - /* Needs to be retrieved once only. */ - if (sigsegv_get_vma ((unsigned long) some_variable_on_stack, &vma) >= 0) - { - stack_top = vma.end - 1; - return 0; - } - else - return -1; -} - -#define IS_STACK_OVERFLOW \ - is_stk_overflow ((unsigned long) SIGSEGV_FAULT_ADDRESS) - -static int -is_stk_overflow (unsigned long addr) -{ - struct vma_struct vma; - - if (sigsegv_get_vma (stack_top, &vma) < 0) - return 0; - -#ifdef __ia64 - return (addr >= vma.prev_end && addr <= vma.end - 1); -#else -#if STACK_DIRECTION < 0 - return (addr >= vma.start - ? (addr <= vma.end - 1) - : (vma.start - addr < (vma.start - vma.prev_end) / 2)); -#else - return (addr <= vma.end - 1 - ? (addr >= vma.start) - : (addr - vma.end < (vma.next_start - vma.end) / 2)); -#endif -#endif -} - diff -rNu smalltalk-2.3.3/sigsegv/src/heur-bc.h smalltalk-2.3.4/sigsegv/src/heur-bc.h --- smalltalk-2.3.3/sigsegv/src/heur-bc.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/heur-bc.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,85 +0,0 @@ -/* Detecting stack overflow. Version for platforms which supply the - stack pointer and have sigsegv_get_vma. - Copyright (C) 2003 Bruno Haible - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#if HAVE_GETRLIMIT -# include -# include -# include /* declares struct rlimit */ -#endif - -/* Address of the last byte belonging to the stack vma. */ -static unsigned long stack_top = 0; - -static int -remember_stack_top (void *some_variable_on_stack) -{ - struct vma_struct vma; - - if (stack_top) - return 0; - - /* Needs to be retrieved once only. */ - if (sigsegv_get_vma ((unsigned long) some_variable_on_stack, &vma) >= 0) - { - stack_top = vma.end - 1; - return 0; - } - else - return -1; -} - -#define IS_STACK_OVERFLOW \ - is_stk_overflow ((unsigned long) (SIGSEGV_FAULT_STACKPOINTER)) - -static int -is_stk_overflow (int sp) -{ - struct vma_struct vma; - - if (sigsegv_get_vma (stack_top, &vma) < 0) - return 0; - -#if HAVE_GETRLIMIT && defined RLIMIT_STACK - { - /* Heuristic BC: If the stack size has reached its maximal size, - and sp is near the low end, we consider it a stack - overflow. */ - struct rlimit rl; - - if (getrlimit (RLIMIT_STACK, &rl) >= 0) - { - unsigned long current_stack_size = vma.end - vma.start; - unsigned long max_stack_size = rl.rlim_cur; - if (current_stack_size <= max_stack_size - 4096) - return 0; - } - } -#endif - - /* Heuristic BC: If we know sp, and it is neither - near the low end, nor in the alternate stack, then - it's probably not a stack overflow. */ - return (sp >= stk_extra_stack - && sp <= stk_extra_stack + stk_extra_stack_size) -#if STACK_DIRECTION < 0 - || (sp <= vma.start + 4096 && vma.start <= sp + 4096) -#else - || (sp <= vma.end + 4096 && vma.end <= sp + 4096) -#endif - ; -} diff -rNu smalltalk-2.3.3/sigsegv/src/heur-none.h smalltalk-2.3.4/sigsegv/src/heur-none.h --- smalltalk-2.3.3/sigsegv/src/heur-none.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/heur-none.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,23 +0,0 @@ -/* Detecting stack overflow. Version for platforms which do not - support catching stack overflows. - Copyright (C) 2003 Paolo Bonzini - - This program 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. - - This program 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 this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -static int -remember_stack_top (void *some_variable_on_stack) -{ - return 0; -} diff -rNu smalltalk-2.3.3/sigsegv/src/machfault-macos-i386.h smalltalk-2.3.4/sigsegv/src/machfault-macos-i386.h --- smalltalk-2.3.3/sigsegv/src/machfault-macos-i386.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/machfault-macos-i386.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,26 @@ +/* Fault handler information. MacOSX/i386 version. + Copyright (C) 2003-2004, 2006 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#define SIGSEGV_THREAD_STATE_TYPE i386_thread_state_t +#define SIGSEGV_THREAD_STATE_FLAVOR i386_THREAD_STATE +#define SIGSEGV_THREAD_STATE_COUNT i386_THREAD_STATE_COUNT +#define SIGSEGV_EXC_STATE_TYPE i386_exception_state_t +#define SIGSEGV_EXC_STATE_FLAVOR i386_EXCEPTION_STATE +#define SIGSEGV_EXC_STATE_COUNT i386_EXCEPTION_STATE_COUNT +#define SIGSEGV_FAULT_ADDRESS(thr_state,exc_state) (exc_state).faultvaddr +#define SIGSEGV_STACK_POINTER(thr_state) (thr_state).esp +#define SIGSEGV_PROGRAM_COUNTER(thr_state) (thr_state).eip diff -rNu smalltalk-2.3.3/sigsegv/src/machfault-macos-powerpc.h smalltalk-2.3.4/sigsegv/src/machfault-macos-powerpc.h --- smalltalk-2.3.3/sigsegv/src/machfault-macos-powerpc.h 2006-02-05 19:41:38.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/machfault-macos-powerpc.h 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Fault handler information. MacOSX/PowerPC version. - Copyright (C) 2003 Bruno Haible + Copyright (C) 2003-2004 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -15,12 +15,12 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ -#define SIGSEGV_EXC_STATE_TYPE ppc_exception_state_t -#define SIGSEGV_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE -#define SIGSEGV_EXC_STATE_COUNT PPC_EXCEPTION_STATE_COUNT -#define SIGSEGV_THREAD_STATE_TYPE ppc_thread_state_t -#define SIGSEGV_THREAD_STATE_FLAVOR PPC_THREAD_STATE -#define SIGSEGV_THREAD_STATE_COUNT PPC_THREAD_STATE_COUNT -#define SIGSEGV_FAULT_ADDRESS (exc_state).dar -#define SIGSEGV_FAULT_STACKPOINTER (thread_state).r1 -#define SIGSEGV_PROGRAM_COUNTER (thread_state).srr0 +#define SIGSEGV_EXC_STATE_TYPE ppc_exception_state_t +#define SIGSEGV_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE +#define SIGSEGV_EXC_STATE_COUNT PPC_EXCEPTION_STATE_COUNT +#define SIGSEGV_THREAD_STATE_TYPE ppc_thread_state_t +#define SIGSEGV_THREAD_STATE_FLAVOR PPC_THREAD_STATE +#define SIGSEGV_THREAD_STATE_COUNT PPC_THREAD_STATE_COUNT +#define SIGSEGV_FAULT_ADDRESS(thr_state,exc_state) (exc_state).dar +#define SIGSEGV_STACK_POINTER(thr_state) (thr_state).r1 +#define SIGSEGV_PROGRAM_COUNTER(thr_state) (thr_state).srr0 diff -rNu smalltalk-2.3.3/sigsegv/src/machfault.h smalltalk-2.3.4/sigsegv/src/machfault.h --- smalltalk-2.3.3/sigsegv/src/machfault.h 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/machfault.h 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,54 @@ +/* Fault handler information. + Copyright (C) 2004 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* The included file defines: + + SIGSEGV_EXC_STATE_TYPE + is a type containing state describing details of an exception, + excluding the thread state. + SIGSEGV_EXC_STATE_FLAVOR + is a macro expanding to a constant int value denoting the + SIGSEGV_EXC_STATE_TYPE type. + SIGSEGV_EXC_STATE_COUNT + is a macro expanding to the number of words of the + SIGSEGV_EXC_STATE_TYPE type. + + SIGSEGV_THREAD_STATE_TYPE + is a type containing the state of a (stopped or interrupted) thread. + SIGSEGV_THREAD_STATE_FLAVOR + is a macro expanding to a constant int value denoting the + SIGSEGV_THREAD_STATE_TYPE type. + SIGSEGV_THREAD_STATE_COUNT + is a macro expanding to the number of words of the + SIGSEGV_THREAD_STATE_TYPE type. + + SIGSEGV_FAULT_ADDRESS(thr_state, exc_state) + is a macro for fetching the fault address. + + SIGSEGV_STACK_POINTER(thr_state) + is a macro, expanding to an lvalue, for fetching the stackpointer at + the moment the fault occurred, and for setting the stackpointer in + effect when the thread continues. + + SIGSEGV_PROGRAM_COUNTER(thr_state) + is a macro, expanding to an lvalue, for fetching the program counter + (= instruction pointer) at the moment the fault occurred, and for + setting the program counter before letting the thread continue. + + */ + +#include CFG_MACHFAULT diff -rNu smalltalk-2.3.3/sigsegv/src/sigsegv.h.in smalltalk-2.3.4/sigsegv/src/sigsegv.h.in --- smalltalk-2.3.3/sigsegv/src/sigsegv.h.in 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/sigsegv.h.in 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Page fault handling library. - Copyright (C) 1998-1999, 2002 Bruno Haible + Copyright (C) 1998-1999, 2002, 2004-2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,6 +19,7 @@ #define _SIGSEGV_H @FAULT_CONTEXT_INCLUDE@ +@FAULT_CONTEXT_INCLUDE2@ /* HAVE_SIGSEGV_RECOVERY is defined if the system supports catching SIGSEGV. */ @@ -37,6 +38,9 @@ extern "C" { #endif +#define LIBSIGSEGV_VERSION 0x0204 /* version number: (major<<8) + minor */ +extern int libsigsegv_version; /* Likewise */ + /* -------------------------------------------------------------------------- */ /* diff -rNu smalltalk-2.3.3/sigsegv/src/sigsegv.h.msvc smalltalk-2.3.4/sigsegv/src/sigsegv.h.msvc --- smalltalk-2.3.3/sigsegv/src/sigsegv.h.msvc 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/sigsegv.h.msvc 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Page fault handling library. - Copyright (C) 1998-1999, 2002 Bruno Haible + Copyright (C) 1998-1999, 2002, 2004-2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,6 +20,7 @@ #include + /* HAVE_SIGSEGV_RECOVERY is defined if the system supports catching SIGSEGV. */ #if 1 @@ -37,6 +38,9 @@ extern "C" { #endif +#define LIBSIGSEGV_VERSION 0x0204 /* version number: (major<<8) + minor */ +extern int libsigsegv_version; /* Likewise */ + /* -------------------------------------------------------------------------- */ /* diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-beos.c smalltalk-2.3.4/sigsegv/src/stackvma-beos.c --- smalltalk-2.3.3/sigsegv/src/stackvma-beos.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-beos.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. BeOS version. - Copyright (C) 2002 Bruno Haible + Copyright (C) 2002, 2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,6 +18,8 @@ #include "stackvma.h" #include +#include "stackvma-simple.c" + int sigsegv_get_vma (unsigned long address, struct vma_struct *vma) { @@ -48,6 +50,7 @@ else vma->next_start = 0; #endif + vma->is_near_this = simple_is_near_this; return 0; } #if STACK_DIRECTION < 0 diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-freebsd.c smalltalk-2.3.4/sigsegv/src/stackvma-freebsd.c --- smalltalk-2.3.3/sigsegv/src/stackvma-freebsd.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-freebsd.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. FreeBSD version. - Copyright (C) 2002-2003 Bruno Haible + Copyright (C) 2002-2003, 2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,6 +18,15 @@ #include "stackvma.h" #include +#include "stackvma-simple.c" + +#if HAVE_MINCORE +# define sigsegv_get_vma mincore_get_vma +# define STATIC static +# include "stackvma-mincore.c" +# undef sigsegv_get_vma +#endif + int sigsegv_get_vma (unsigned long address, struct vma_struct *vma) { @@ -33,7 +42,7 @@ /* Open the current process' maps file. It describes one VMA per line. */ fp = fopen ("/proc/curproc/map", "r"); if (!fp) - return -1; + goto failed; #if STACK_DIRECTION < 0 prev_end = 0; @@ -72,8 +81,17 @@ vma->next_start = 0; #endif fclose (fp); + vma->is_near_this = simple_is_near_this; return 0; } fclose (fp); + failed: +#if HAVE_MINCORE + /* FreeBSD 6.[01] doesn't allow to distinguish unmapped pages from + mapped but swapped-out pages. See whether it's fixed. */ + if (!is_mapped (0)) + /* OK, mincore() appears to work as expected. */ + return mincore_get_vma (address, vma); +#endif return -1; } diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-linux.c smalltalk-2.3.4/sigsegv/src/stackvma-linux.c --- smalltalk-2.3.3/sigsegv/src/stackvma-linux.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-linux.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. Linux version. - Copyright (C) 2002 Bruno Haible + Copyright (C) 2002, 2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,6 +18,15 @@ #include "stackvma.h" #include +#include "stackvma-simple.c" + +#if HAVE_MINCORE +# define sigsegv_get_vma mincore_get_vma +# define STATIC static +# include "stackvma-mincore.c" +# undef sigsegv_get_vma +#endif + int sigsegv_get_vma (unsigned long address, struct vma_struct *vma) { @@ -31,7 +40,7 @@ /* Open the current process' maps file. It describes one VMA per line. */ fp = fopen ("/proc/self/maps", "r"); if (!fp) - return -1; + goto failed; #if STACK_DIRECTION < 0 prev = 0; @@ -53,6 +62,7 @@ vma->next_start = 0; #endif fclose (fp); + vma->is_near_this = simple_is_near_this; return 0; } #if STACK_DIRECTION < 0 @@ -60,5 +70,10 @@ #endif } fclose (fp); + failed: +#if HAVE_MINCORE + return mincore_get_vma (address, vma); +#else return -1; +#endif } diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-mach.c smalltalk-2.3.4/sigsegv/src/stackvma-mach.c --- smalltalk-2.3.3/sigsegv/src/stackvma-mach.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-mach.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. Mach version. - Copyright (C) 2003 Paolo Bonzini + Copyright (C) 2003, 2006 Paolo Bonzini This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -27,6 +27,8 @@ #include #endif +#include "stackvma-simple.c" + int sigsegv_get_vma (unsigned long req_address, struct vma_struct *vma) { @@ -59,13 +61,6 @@ &inheritance, &shared, &object_name, &offset) == KERN_SUCCESS); #endif -#if 0 - printf ("this vma = %x...%x, joined vmas = %x...%x prev_vma = %x...%x\n", - address, address + size, - join_address, join_address + join_size, - prev_address, prev_address + prev_size); -#endif - if (!more) { address = join_address + join_size; @@ -94,6 +89,7 @@ vma->start = join_address; vma->end = join_address + join_size; vma->prev_end = prev_address + prev_size; + vma->is_near_this = simple_is_near_this; return 0; } #else @@ -102,6 +98,7 @@ vma->start = prev_address; vma->end = prev_address + prev_size; vma->next_start = join_address; + vma->is_near_this = simple_is_near_this; return 0; } #endif @@ -113,6 +110,7 @@ vma->start = prev_address; vma->end = prev_address + prev_size; vma->next_start = ~0UL; + vma->is_near_this = simple_is_near_this; return 0; } #endif diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-mincore.c smalltalk-2.3.4/sigsegv/src/stackvma-mincore.c --- smalltalk-2.3.3/sigsegv/src/stackvma-mincore.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-mincore.c 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,267 @@ +/* Determine the virtual memory area of a given address. + Copyright (C) 2006 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* mincore() is a system call that allows to inquire the status of a + range of pages of virtual memory. In particular, it allows to inquire + whether a page is mapped at all. + As of 2006, mincore() is supported by: possible bits: + - Linux, since Linux 2.4 and glibc 2.2, 1 + - Solaris, since Solaris 9, 1 + - MacOS X, since MacOS X 10.3 (at least), 1 + - FreeBSD, since FreeBSD 6.0, MINCORE_{INCORE,REFERENCED,MODIFIED} + - NetBSD, since NetBSD 3.0 (at least), 1 + - OpenBSD, since OpenBSD 2.6 (at least), 1 + However, while the API allows to easily determine the bounds of mapped + virtual memory, it does not make it easy the bounds of _unmapped_ virtual + memory ranges. We try to work around this, but it may still be slow. */ + +#include "stackvma.h" +#include +#ifdef HAVE_UNISTD_H +# include +#endif +#include +#include + +/* Cache for getpagesize(). */ +static unsigned long pagesize; + +/* Initialize pagesize. */ +static void +init_pagesize (void) +{ +#if HAVE_GETPAGESIZE + pagesize = getpagesize (); +#elif HAVE_SYSCONF_PAGESIZE + pagesize = sysconf (_SC_PAGESIZE); +#else + pagesize = PAGESIZE; +#endif +} + +/* Test whether the page starting at ADDR is among the address range. + ADDR must be a multiple of pagesize. */ +static int +is_mapped (unsigned long addr) +{ + char vec[1]; + return mincore ((void *) addr, pagesize, vec) >= 0; +} + +/* Assuming that the page starting at ADDR is among the address range, + return the start of its virtual memory range. + ADDR must be a multiple of pagesize. */ +static unsigned long +mapped_range_start (unsigned long addr) +{ + /* Use a moderately sized VEC here, small enough that it fits on the stack + (without requiring malloc). */ + char vec[2048]; + unsigned long stepsize = sizeof (vec); + + for (;;) + { + unsigned long max_remaining; + + if (addr == 0) + return addr; + + max_remaining = addr / pagesize; + if (stepsize > max_remaining) + stepsize = max_remaining; + if (mincore ((void *) (addr - stepsize * pagesize), + stepsize * pagesize, vec) < 0) + /* Time to search in smaller steps. */ + break; + /* The entire range exists. Continue searching in large steps. */ + addr -= stepsize * pagesize; + } + for (;;) + { + unsigned long halfstepsize1; + unsigned long halfstepsize2; + + if (stepsize == 1) + return addr; + + /* Here we know that less than stepsize pages exist starting at addr. */ + halfstepsize1 = (stepsize + 1) / 2; + halfstepsize2 = stepsize / 2; + /* halfstepsize1 + halfstepsize2 = stepsize. */ + + if (mincore ((void *) (addr - halfstepsize1 * pagesize), + halfstepsize1 * pagesize, vec) < 0) + stepsize = halfstepsize1; + else + { + addr -= halfstepsize1 * pagesize; + stepsize = halfstepsize2; + } + } +} + +/* Assuming that the page starting at ADDR is among the address range, + return the end of its virtual memory range + 1. + ADDR must be a multiple of pagesize. */ +static unsigned long +mapped_range_end (unsigned long addr) +{ + /* Use a moderately sized VEC here, small enough that it fits on the stack + (without requiring malloc). */ + char vec[2048]; + unsigned long stepsize = sizeof (vec); + + addr += pagesize; + for (;;) + { + unsigned long max_remaining; + + if (addr == 0) /* wrapped around? */ + return addr; + + max_remaining = (- addr) / pagesize; + if (stepsize > max_remaining) + stepsize = max_remaining; + if (mincore ((void *) addr, stepsize * pagesize, vec) < 0) + /* Time to search in smaller steps. */ + break; + /* The entire range exists. Continue searching in large steps. */ + addr += stepsize * pagesize; + } + for (;;) + { + unsigned long halfstepsize1; + unsigned long halfstepsize2; + + if (stepsize == 1) + return addr; + + /* Here we know that less than stepsize pages exist starting at addr. */ + halfstepsize1 = (stepsize + 1) / 2; + halfstepsize2 = stepsize / 2; + /* halfstepsize1 + halfstepsize2 = stepsize. */ + + if (mincore ((void *) addr, halfstepsize1 * pagesize, vec) < 0) + stepsize = halfstepsize1; + else + { + addr += halfstepsize1 * pagesize; + stepsize = halfstepsize2; + } + } +} + +/* Determine whether an address range [ADDR1..ADDR2] is completely unmapped. + ADDR1 must be <= ADDR2. */ +static int +is_unmapped (unsigned long addr1, unsigned long addr2) +{ + unsigned long count; + unsigned long stepsize; + + /* Round addr1 down. */ + addr1 = (addr1 / pagesize) * pagesize; + /* Round addr2 up and turn it into an exclusive bound. */ + addr2 = ((addr2 / pagesize) + 1) * pagesize; + + /* This is slow: mincore() does not provide a way to determine the bounds + of the gaps directly. So we have to use mincore() on individual pages + over and over again. Only after we've verified that all pages are + unmapped, we know that the range is completely unmapped. + If we were to traverse the pages from bottom to top or from top to bottom, + it would be slow even in the average case. To speed up the search, we + exploit the fact that mapped memory ranges are larger than one page on + average, therefore we have good chances of hitting a mapped area if we + traverse only every second, or only fourth page, etc. This doesn't + decrease the worst-case runtime, only the average runtime. */ + count = (addr2 - addr1) / pagesize; + /* We have to test is_mapped (addr1 + i * pagesize) for 0 <= i < count. */ + for (stepsize = 1; stepsize < count; ) + stepsize = 2 * stepsize; + for (;;) + { + unsigned long addr_stepsize; + unsigned long i; + unsigned long addr; + + stepsize = stepsize / 2; + if (stepsize == 0) + break; + addr_stepsize = stepsize * pagesize; + for (i = stepsize, addr = addr1 + addr_stepsize; + i < count; + i += 2 * stepsize, addr += 2 * addr_stepsize) + /* Here addr = addr1 + i * pagesize. */ + if (is_mapped (addr)) + return 0; + } + return 1; +} + +#if STACK_DIRECTION < 0 + +/* Info about the gap between this VMA and the previous one. + addr must be < vma->start. */ +static int +mincore_is_near_this (unsigned long addr, struct vma_struct *vma) +{ + /* vma->start - addr <= (vma->start - vma->prev_end) / 2 + is mathematically equivalent to + vma->prev_end <= 2 * addr - vma->start + <==> is_unmapped (2 * addr - vma->start, vma->start - 1). + But be careful about overflow. */ + unsigned long testaddr = addr - (vma->start - addr); + if (testaddr > addr) /* overflow? */ + testaddr = 0; + return is_unmapped (testaddr, addr); +} + +#endif +#if STACK_DIRECTION > 0 + +/* Info about the gap between this VMA and the next one. + addr must be > vma->end - 1. */ +static int +mincore_is_near_this (unsigned long addr, struct vma_struct *vma) +{ + /* addr - vma->end < (vma->next_start - vma->end) / 2 + is mathematically equivalent to + vma->next_start > 2 * addr - vma->end + <==> is_unmapped (vma->end, 2 * addr - vma->end). + But be careful about overflow. */ + unsigned long testaddr = addr + (addr - vma->end); + if (testaddr < addr) /* overflow? */ + testaddr = ~0UL; + return is_unmapped (addr, testaddr); +} + +#endif + +#ifdef STATIC +STATIC +#endif +int +sigsegv_get_vma (unsigned long address, struct vma_struct *vma) +{ + if (pagesize == 0) + init_pagesize (); + address = (address / pagesize) * pagesize; + vma->start = mapped_range_start (address); + vma->end = mapped_range_end (address); + vma->is_near_this = mincore_is_near_this; + return 0; +} diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-procfs.c smalltalk-2.3.4/sigsegv/src/stackvma-procfs.c --- smalltalk-2.3.3/sigsegv/src/stackvma-procfs.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-procfs.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. - Copyright (C) 2002 Bruno Haible + Copyright (C) 2002, 2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -22,6 +22,15 @@ #include /* malloc, free */ #include /* PIOC*, prmap_t */ +#include "stackvma-simple.c" + +#if HAVE_MINCORE +# define sigsegv_get_vma mincore_get_vma +# define STATIC static +# include "stackvma-mincore.c" +# undef sigsegv_get_vma +#endif + int sigsegv_get_vma (unsigned long address, struct vma_struct *vma) { @@ -38,7 +47,7 @@ sprintf (fname,"/proc/%u", (unsigned int) getpid ()); fd = open (fname, O_RDONLY); if (fd < 0) - return -1; + goto failed; if (ioctl (fd, PIOCNMAP, &nmaps) < 0) goto fail2; @@ -72,6 +81,7 @@ #endif free (maps); close (fd); + vma->is_near_this = simple_is_near_this; return 0; } #if STACK_DIRECTION < 0 @@ -83,5 +93,10 @@ free (maps); fail2: close (fd); + failed: +#if HAVE_MINCORE + return mincore_get_vma (address, vma); +#else return -1; +#endif } diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma-simple.c smalltalk-2.3.4/sigsegv/src/stackvma-simple.c --- smalltalk-2.3.3/sigsegv/src/stackvma-simple.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma-simple.c 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,42 @@ +/* Determine the virtual memory area of a given address. + Copyright (C) 2006 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* This file contains the proximity test function for the simple cases, where + the OS has an API for enumerating the mapped ranges of virual memory. */ + +#if STACK_DIRECTION < 0 + +/* Info about the gap between this VMA and the previous one. + addr must be < vma->start. */ +static int +simple_is_near_this (unsigned long addr, struct vma_struct *vma) +{ + return (vma->start - addr <= (vma->start - vma->prev_end) / 2); +} + +#endif +#if STACK_DIRECTION > 0 + +/* Info about the gap between this VMA and the next one. + addr must be > vma->end - 1. */ +static int +simple_is_near_this (unsigned long addr, struct vma_struct *vma) +{ + return (addr - vma->end < (vma->next_start - vma->end) / 2); +} + +#endif diff -rNu smalltalk-2.3.3/sigsegv/src/stackvma.h smalltalk-2.3.4/sigsegv/src/stackvma.h --- smalltalk-2.3.3/sigsegv/src/stackvma.h 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/stackvma.h 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Determine the virtual memory area of a given address. - Copyright (C) 2002 Bruno Haible + Copyright (C) 2002, 2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -15,6 +15,9 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ +#ifndef _STACKVMA_H +#define _STACKVMA_H + /* Describes a virtual memory area, with some info about the gap between it and the next or previous virtual memory area. */ struct vma_struct @@ -22,9 +25,17 @@ unsigned long start; unsigned long end; #if STACK_DIRECTION < 0 + /* Info about the gap between this VMA and the previous one. + addr must be < vma->start. */ + int (*is_near_this) (unsigned long addr, struct vma_struct *vma); + /* Private field, not provided by all sigsegv_get_vma implementations. */ unsigned long prev_end; #endif #if STACK_DIRECTION > 0 + /* Info about the gap between this VMA and the next one. + addr must be > vma->end - 1. */ + int (*is_near_this) (unsigned long addr, struct vma_struct *vma); + /* Private field, not provided by all sigsegv_get_vma implementations. */ unsigned long next_start; #endif }; @@ -33,3 +44,5 @@ and returns 0. Returns -1 if it cannot be determined. This function is used to determine the stack extent when a fault occurs. */ extern int sigsegv_get_vma (unsigned long address, struct vma_struct *vma); + +#endif /* _STACKVMA_H */ diff -rNu smalltalk-2.3.3/sigsegv/src/version.c smalltalk-2.3.4/sigsegv/src/version.c --- smalltalk-2.3.3/sigsegv/src/version.c 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/src/version.c 2007-05-12 12:01:46.000000000 +0200 @@ -0,0 +1,20 @@ +/* Version number. + Copyright (C) 2005 Bruno Haible + + This program 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. + + This program 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 this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include "sigsegv.h" + +int libsigsegv_version = LIBSIGSEGV_VERSION; diff -rNu smalltalk-2.3.3/sigsegv/tests/Makefile.am smalltalk-2.3.4/sigsegv/tests/Makefile.am --- smalltalk-2.3.3/sigsegv/tests/Makefile.am 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/Makefile.am 2007-05-12 12:01:46.000000000 +0200 @@ -13,7 +13,8 @@ ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software -## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +## USA. ## Process this file with automake to produce Makefile.in. diff -rNu smalltalk-2.3.3/sigsegv/tests/Makefile.in smalltalk-2.3.4/sigsegv/tests/Makefile.in --- smalltalk-2.3.3/sigsegv/tests/Makefile.in 2007-02-13 09:27:22.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/Makefile.in 2007-05-12 12:11:33.000000000 +0200 @@ -101,11 +101,8 @@ AWK = @AWK@ CC = @CC@ CCDEPMODE = @CCDEPMODE@ -CFG_FAULT = @CFG_FAULT@ CFG_HANDLER = @CFG_HANDLER@ -CFG_HEURISTICS = @CFG_HEURISTICS@ CFG_LEAVE = @CFG_LEAVE@ -CFG_SIGNALS = @CFG_SIGNALS@ CFG_STACKVMA = @CFG_STACKVMA@ CFLAGS = @CFLAGS@ CPP = @CPP@ @@ -121,6 +118,7 @@ EXEEXT = @EXEEXT@ FAULT_CONTEXT = @FAULT_CONTEXT@ FAULT_CONTEXT_INCLUDE = @FAULT_CONTEXT_INCLUDE@ +FAULT_CONTEXT_INCLUDE2 = @FAULT_CONTEXT_INCLUDE2@ GREP = @GREP@ HAVE_SIGSEGV_RECOVERY = @HAVE_SIGSEGV_RECOVERY@ HAVE_STACK_OVERFLOW_RECOVERY = @HAVE_STACK_OVERFLOW_RECOVERY@ diff -rNu smalltalk-2.3.3/sigsegv/tests/sigsegv1.c smalltalk-2.3.4/sigsegv/tests/sigsegv1.c --- smalltalk-2.3.3/sigsegv/tests/sigsegv1.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/sigsegv1.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Test that the handler is called, with the right fault address. - Copyright (C) 2002-2005 Bruno Haible + Copyright (C) 2002-2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -43,7 +43,7 @@ void crasher (unsigned long p) { - *(int *) (p + 0x678) = 42; + *(volatile int *) (p + 0x678) = 42; } int diff -rNu smalltalk-2.3.3/sigsegv/tests/sigsegv2.c smalltalk-2.3.4/sigsegv/tests/sigsegv2.c --- smalltalk-2.3.3/sigsegv/tests/sigsegv2.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/sigsegv2.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Test the dispatcher. - Copyright (C) 2002-2005 Bruno Haible + Copyright (C) 2002-2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -116,13 +116,13 @@ mprotect ((void *) area3, 0x4000, PROT_READ); /* This access should call the handler. */ - ((int*)area2)[230] = 22; + ((volatile int *)area2)[230] = 22; /* This access should call the handler. */ - ((int*)area3)[412] = 33; + ((volatile int *)area3)[412] = 33; /* This access should not give a signal. */ - ((int*)area2)[135] = 22; + ((volatile int *)area2)[135] = 22; /* This access should call the handler. */ - ((int*)area1)[612] = 11; + ((volatile int *)area1)[612] = 11; barrier(); diff -rNu smalltalk-2.3.3/sigsegv/tests/stackoverflow1.c smalltalk-2.3.4/sigsegv/tests/stackoverflow1.c --- smalltalk-2.3.3/sigsegv/tests/stackoverflow1.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/stackoverflow1.c 2007-05-12 12:01:46.000000000 +0200 @@ -67,7 +67,7 @@ volatile int recurse (volatile int n) { - return *recurse_1 (n, (volatile int *) &n); + return *recurse_1 (n, &n); } int diff -rNu smalltalk-2.3.3/sigsegv/tests/stackoverflow2.c smalltalk-2.3.4/sigsegv/tests/stackoverflow2.c --- smalltalk-2.3.3/sigsegv/tests/stackoverflow2.c 2006-02-05 19:41:39.000000000 +0100 +++ smalltalk-2.3.4/sigsegv/tests/stackoverflow2.c 2007-05-12 12:01:46.000000000 +0200 @@ -1,5 +1,5 @@ /* Test that stack overflow and SIGSEGV are correctly distinguished. - Copyright (C) 2002-2005 Bruno Haible + Copyright (C) 2002-2006 Bruno Haible This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -95,7 +95,7 @@ volatile int recurse (volatile int n) { - return *recurse_1 (n, (volatile int *) &n); + return *recurse_1 (n, &n); } int @@ -159,7 +159,7 @@ recurse (0); printf ("no endless recursion?!\n"); exit (1); case 2: - *(int *) (page + 0x678) = 42; + *(volatile int *) (page + 0x678) = 42; break; case 3: break; diff -rNu smalltalk-2.3.3/sunit/SUnit.st smalltalk-2.3.4/sunit/SUnit.st --- smalltalk-2.3.3/sunit/SUnit.st 2006-02-05 19:41:41.000000000 +0100 +++ smalltalk-2.3.4/sunit/SUnit.st 2007-05-24 22:10:22.000000000 +0200 @@ -140,6 +140,13 @@ addAll: testCase resources; yourself]! +isLogging + ^true! + +logPolicy: aLogPolicy + self tests do: [ :each | + each isLogging ifTrue: [ each logPolicy: aLogPolicy ] ]! + name ^name! diff -rNu smalltalk-2.3.3/sunit/SUnitScript.st smalltalk-2.3.4/sunit/SUnitScript.st --- smalltalk-2.3.3/sunit/SUnitScript.st 2006-02-05 19:41:41.000000000 +0100 +++ smalltalk-2.3.4/sunit/SUnitScript.st 2007-05-24 22:10:22.000000000 +0200 @@ -201,4 +201,3 @@ self assert: suite tests size = 1 ! ! -(TestSuitesScriptTest->TestSuitesScriptTest buildSuite run) printNl! diff -rNu smalltalk-2.3.3/sunit/SUnitTests.st smalltalk-2.3.4/sunit/SUnitTests.st --- smalltalk-2.3.3/sunit/SUnitTests.st 2006-02-05 19:41:41.000000000 +0100 +++ smalltalk-2.3.4/sunit/SUnitTests.st 2007-05-24 22:10:22.000000000 +0200 @@ -434,5 +434,3 @@ collection := self resources. self assert: collection size = 1! ! -(SUnitTest -> SUnitTest buildSuite run) printNl! - diff -rNu smalltalk-2.3.3/tcp/Buffers.st smalltalk-2.3.4/tcp/Buffers.st --- smalltalk-2.3.3/tcp/Buffers.st 2006-02-05 19:41:41.000000000 +0100 +++ smalltalk-2.3.4/tcp/Buffers.st 2007-03-09 14:39:17.000000000 +0100 @@ -8,7 +8,7 @@ "====================================================================== | -| Copyright 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +| Copyright 1999, 2000, 2001, 2002, 2003, 2007 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | This file is part of GNU Smalltalk. @@ -111,7 +111,7 @@ "Answer the data that is in the buffer, and empty it." | contents | self basicAtEnd ifTrue: [ ^self species new: 0 ]. - contents := self copyFrom: ptr to: endPtr. + contents := self collection copyFrom: ptr to: endPtr. endPtr := ptr - 1. "Empty the buffer" ^contents ! diff -rNu smalltalk-2.3.3/tcp/ChangeLog smalltalk-2.3.4/tcp/ChangeLog --- smalltalk-2.3.3/tcp/ChangeLog 2006-12-13 09:57:17.000000000 +0100 +++ smalltalk-2.3.4/tcp/ChangeLog 2007-03-09 14:40:05.000000000 +0100 @@ -1,3 +1,7 @@ +2007-03-08 Paolo Bonzini + + * tcp/Buffers.st: Adjust for changes to Stream>>#copyFrom:. + 2006-12-13 Paolo Bonzini *** Version 2.3.1 released. diff -rNu smalltalk-2.3.3/tcp/Makefile.in smalltalk-2.3.4/tcp/Makefile.in --- smalltalk-2.3.3/tcp/Makefile.in 2007-02-13 09:25:27.000000000 +0100 +++ smalltalk-2.3.4/tcp/Makefile.in 2007-05-28 12:40:10.000000000 +0200 @@ -115,6 +115,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ diff -rNu smalltalk-2.3.3/tests/Makefile.am smalltalk-2.3.4/tests/Makefile.am --- smalltalk-2.3.3/tests/Makefile.am 2006-02-05 19:41:42.000000000 +0100 +++ smalltalk-2.3.4/tests/Makefile.am 2007-05-25 12:00:59.000000000 +0200 @@ -1,91 +1,10 @@ -TESTS = $(low_level_tests) $(benchmark_tests) $(ansi_tests) - -low_level_tests = arrays.st classes.st blocks.st \ - sets.st processes.st exceptions.st \ - intmath.st floatmath.st dates.st \ - objects.st strings.st chars.st objdump.st \ - delays.st geometry.st cobjects.st compiler.st \ - fileext.st mutate.st untrusted.st getopt.st \ - quit.st - -benchmark_tests = ackermann.st ary3.st except.st \ - fibo.st hash.st hash2.st heapsort.st \ - lists.st lists1.st lists2.st matrix.st \ - methcall.st nestedloop.st objinst.st \ - prodcons.st random-bench.st sieve.st strcat.st - -ansi_tests = \ - ArrayANSITest \ - ArrayFactoryANSITest \ - BagANSITest \ - BagFactoryANSITest \ - BooleanANSITest \ - ByteArrayANSITest \ - ByteArrayFactoryANSITest \ - CharacterANSITest \ - CharacterFactoryANSITest \ - DateAndTimeANSITest \ - DateAndTimeFactoryANSITest \ - DictionaryANSITest \ - DictionaryFactoryANSITest \ - DurationANSITest \ - DurationFactoryANSITest \ - DyadicValuableANSITest \ - ErrorANSITest \ - ErrorClassANSITest \ - ExceptionANSITest \ - ExceptionClassANSITest \ - ExceptionSetANSITest \ - FailedMessageANSITest \ - FileStreamFactoryANSITest \ - FloatANSITest \ - FloatCharacterizationANSITest \ - FractionANSITest \ - FractionFactoryANSITest \ - IdentityDictionaryANSITest \ - IdentityDictionaryFactoryANSITest \ - IntegerANSITest \ - IntervalANSITest \ - IntervalFactoryANSITest \ - MessageNotUnderstoodANSITest \ - MessageNotUnderstoodSelectorANSITest \ - MonadicBlockANSITest \ - NilANSITest \ - NiladicBlockANSITest \ - NotificationANSITest \ - NotificationClassANSITest \ - ObjectANSITest \ - ObjectClassANSITest \ - OrderedCollectionANSITest \ - OrderedCollectionFactoryANSITest \ - ReadFileStreamANSITest \ - ReadStreamANSITest \ - ReadStreamFactoryANSITest \ - ReadWriteStreamANSITest \ - ReadWriteStreamFactoryANSITest \ - ScaledDecimalANSITest \ - SelectorANSITest \ - SetANSITest \ - SetFactoryANSITest \ - SortedCollectionANSITest \ - SortedCollectionFactoryANSITest \ - StringANSITest \ - StringFactoryANSITest \ - SymbolANSITest \ - TranscriptANSITest \ - WarningANSITest \ - WarningClassANSITest \ - WriteFileStreamANSITest \ - WriteStreamANSITest \ - WriteStreamFactoryANSITest \ - ZeroDivideANSITest \ - ZeroDivideFactoryANSITest - -TESTS_ENVIRONMENT=$(srcdir)/run-test - nodist_check_DATA = gst.im +AUTOTEST = $(AUTOM4TE) --language=autotest +TESTSUITE = $(srcdir)/testsuite + dist_noinst_DATA = \ +local.at testsuite.at $(TESTSUITE) package.m4 \ ackermann.ok ackermann.st arrays.ok arrays.st ary3.ok ary3.st blocks.ok \ blocks.st chars.ok chars.st classes.ok classes.st cobjects.ok cobjects.st \ compiler.ok compiler.st dates.ok dates.st delays.ok delays.st except.ok \ @@ -100,13 +19,10 @@ sets.st sieve.ok sieve.st strcat.ok strcat.st strings.ok strings.st \ Ansi.st AnsiDB.st AnsiInit.st AnsiLoad.st AnsiRun.st -CLEANFILES = *.log *.diff gst.im - -EXTRA_DIST = run-test - -.PHONY: regress $(ansi_tests) +CLEANFILES = gst.im +DISTCLEANFILES = atconfig -$(ansi_tests): +.PHONY: regress regress: SMALLTALK_KERNEL="$(top_srcdir)/kernel/"; \ @@ -123,3 +39,22 @@ cd $(srcdir) && \ $$builddir/../gst -QSI $$builddir/gst.im AnsiLoad.st +$(srcdir)/package.m4: $(top_srcdir)/configure.ac + { \ + echo '# Signature of the current package.'; \ + echo 'm4_define([AT_PACKAGE_NAME], [@PACKAGE_NAME@])'; \ + echo 'm4_define([AT_PACKAGE_TARNAME], [@PACKAGE_TARNAME@])'; \ + echo 'm4_define([AT_PACKAGE_VERSION], [@PACKAGE_VERSION@])'; \ + echo 'm4_define([AT_PACKAGE_STRING], [@PACKAGE_STRING@])'; \ + echo 'm4_define([AT_PACKAGE_BUGREPORT], [@PACKAGE_BUGREPORT@])'; \ + } >'$(srcdir)/package.m4' + +check-local: atconfig $(TESTSUITE) + $(SHELL) '$(TESTSUITE)' $(TESTSUITEFLAGS) + +clean-local: + -$(SHELL) '$(TESTSUITE)' --clean + +$(TESTSUITE): $(srcdir)/testsuite.at $(srcdir)/package.m4 $(srcdir)/local.at + $(AUTOTEST) -I '$(srcdir)' -o $@.tmp $@.at + mv $@.tmp $@ diff -rNu smalltalk-2.3.3/tests/Makefile.in smalltalk-2.3.4/tests/Makefile.in --- smalltalk-2.3.3/tests/Makefile.in 2007-02-13 09:25:27.000000000 +0100 +++ smalltalk-2.3.4/tests/Makefile.in 2007-05-28 12:40:11.000000000 +0200 @@ -92,6 +92,7 @@ ATK_LIBS = @ATK_LIBS@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ +AUTOM4TE = @AUTOM4TE@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BLOX_IMPLEMENTATION = @BLOX_IMPLEMENTATION@ @@ -246,91 +247,11 @@ subdirs = @subdirs@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ -TESTS = $(low_level_tests) $(benchmark_tests) $(ansi_tests) -low_level_tests = arrays.st classes.st blocks.st \ - sets.st processes.st exceptions.st \ - intmath.st floatmath.st dates.st \ - objects.st strings.st chars.st objdump.st \ - delays.st geometry.st cobjects.st compiler.st \ - fileext.st mutate.st untrusted.st getopt.st \ - quit.st - -benchmark_tests = ackermann.st ary3.st except.st \ - fibo.st hash.st hash2.st heapsort.st \ - lists.st lists1.st lists2.st matrix.st \ - methcall.st nestedloop.st objinst.st \ - prodcons.st random-bench.st sieve.st strcat.st - -ansi_tests = \ - ArrayANSITest \ - ArrayFactoryANSITest \ - BagANSITest \ - BagFactoryANSITest \ - BooleanANSITest \ - ByteArrayANSITest \ - ByteArrayFactoryANSITest \ - CharacterANSITest \ - CharacterFactoryANSITest \ - DateAndTimeANSITest \ - DateAndTimeFactoryANSITest \ - DictionaryANSITest \ - DictionaryFactoryANSITest \ - DurationANSITest \ - DurationFactoryANSITest \ - DyadicValuableANSITest \ - ErrorANSITest \ - ErrorClassANSITest \ - ExceptionANSITest \ - ExceptionClassANSITest \ - ExceptionSetANSITest \ - FailedMessageANSITest \ - FileStreamFactoryANSITest \ - FloatANSITest \ - FloatCharacterizationANSITest \ - FractionANSITest \ - FractionFactoryANSITest \ - IdentityDictionaryANSITest \ - IdentityDictionaryFactoryANSITest \ - IntegerANSITest \ - IntervalANSITest \ - IntervalFactoryANSITest \ - MessageNotUnderstoodANSITest \ - MessageNotUnderstoodSelectorANSITest \ - MonadicBlockANSITest \ - NilANSITest \ - NiladicBlockANSITest \ - NotificationANSITest \ - NotificationClassANSITest \ - ObjectANSITest \ - ObjectClassANSITest \ - OrderedCollectionANSITest \ - OrderedCollectionFactoryANSITest \ - ReadFileStreamANSITest \ - ReadStreamANSITest \ - ReadStreamFactoryANSITest \ - ReadWriteStreamANSITest \ - ReadWriteStreamFactoryANSITest \ - ScaledDecimalANSITest \ - SelectorANSITest \ - SetANSITest \ - SetFactoryANSITest \ - SortedCollectionANSITest \ - SortedCollectionFactoryANSITest \ - StringANSITest \ - StringFactoryANSITest \ - SymbolANSITest \ - TranscriptANSITest \ - WarningANSITest \ - WarningClassANSITest \ - WriteFileStreamANSITest \ - WriteStreamANSITest \ - WriteStreamFactoryANSITest \ - ZeroDivideANSITest \ - ZeroDivideFactoryANSITest - -TESTS_ENVIRONMENT = $(srcdir)/run-test nodist_check_DATA = gst.im +AUTOTEST = $(AUTOM4TE) --language=autotest +TESTSUITE = $(srcdir)/testsuite dist_noinst_DATA = \ +local.at testsuite.at $(TESTSUITE) package.m4 \ ackermann.ok ackermann.st arrays.ok arrays.st ary3.ok ary3.st blocks.ok \ blocks.st chars.ok chars.st classes.ok classes.st cobjects.ok cobjects.st \ compiler.ok compiler.st dates.ok dates.st delays.ok delays.st except.ok \ @@ -345,8 +266,8 @@ sets.st sieve.ok sieve.st strcat.ok strcat.st strings.ok strings.st \ Ansi.st AnsiDB.st AnsiInit.st AnsiLoad.st AnsiRun.st -CLEANFILES = *.log *.diff gst.im -EXTRA_DIST = run-test +CLEANFILES = gst.im +DISTCLEANFILES = atconfig all: all-am .SUFFIXES: @@ -396,79 +317,6 @@ CTAGS: -check-TESTS: $(TESTS) - @failed=0; all=0; xfail=0; xpass=0; skip=0; \ - srcdir=$(srcdir); export srcdir; \ - list='$(TESTS)'; \ - if test -n "$$list"; then \ - for tst in $$list; do \ - if test -f ./$$tst; then dir=./; \ - elif test -f $$tst; then dir=; \ - else dir="$(srcdir)/"; fi; \ - if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \ - all=`expr $$all + 1`; \ - case " $(XFAIL_TESTS) " in \ - *" $$tst "*) \ - xpass=`expr $$xpass + 1`; \ - failed=`expr $$failed + 1`; \ - echo "XPASS: $$tst"; \ - ;; \ - *) \ - echo "PASS: $$tst"; \ - ;; \ - esac; \ - elif test $$? -ne 77; then \ - all=`expr $$all + 1`; \ - case " $(XFAIL_TESTS) " in \ - *" $$tst "*) \ - xfail=`expr $$xfail + 1`; \ - echo "XFAIL: $$tst"; \ - ;; \ - *) \ - failed=`expr $$failed + 1`; \ - echo "FAIL: $$tst"; \ - ;; \ - esac; \ - else \ - skip=`expr $$skip + 1`; \ - echo "SKIP: $$tst"; \ - fi; \ - done; \ - if test "$$failed" -eq 0; then \ - if test "$$xfail" -eq 0; then \ - banner="All $$all tests passed"; \ - else \ - banner="All $$all tests behaved as expected ($$xfail expected failures)"; \ - fi; \ - else \ - if test "$$xpass" -eq 0; then \ - banner="$$failed of $$all tests failed"; \ - else \ - banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \ - fi; \ - fi; \ - dashes="$$banner"; \ - skipped=""; \ - if test "$$skip" -ne 0; then \ - skipped="($$skip tests were not run)"; \ - test `echo "$$skipped" | wc -c` -le `echo "$$banner" | wc -c` || \ - dashes="$$skipped"; \ - fi; \ - report=""; \ - if test "$$failed" -ne 0 && test -n "$(PACKAGE_BUGREPORT)"; then \ - report="Please report to $(PACKAGE_BUGREPORT)"; \ - test `echo "$$report" | wc -c` -le `echo "$$banner" | wc -c` || \ - dashes="$$report"; \ - fi; \ - dashes=`echo "$$dashes" | sed s/./=/g`; \ - echo "$$dashes"; \ - echo "$$banner"; \ - test -z "$$skipped" || echo "$$skipped"; \ - test -z "$$report" || echo "$$report"; \ - echo "$$dashes"; \ - test "$$failed" -eq 0; \ - else :; fi - distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ @@ -498,7 +346,7 @@ done check-am: all-am $(MAKE) $(AM_MAKEFLAGS) $(nodist_check_DATA) - $(MAKE) $(AM_MAKEFLAGS) check-TESTS + $(MAKE) $(AM_MAKEFLAGS) check-local check: check-am all-am: Makefile $(DATA) installdirs: @@ -523,13 +371,14 @@ distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am -clean-am: clean-generic clean-libtool mostlyclean-am +clean-am: clean-generic clean-libtool clean-local mostlyclean-am distclean: distclean-am -rm -f Makefile @@ -573,10 +422,10 @@ uninstall-am: uninstall-info-am -.PHONY: all all-am check check-TESTS check-am clean clean-generic \ - clean-libtool distclean distclean-generic distclean-libtool \ - distdir dvi dvi-am html html-am info info-am install \ - install-am install-data install-data-am install-exec \ +.PHONY: all all-am check check-am check-local clean clean-generic \ + clean-libtool clean-local distclean distclean-generic \ + distclean-libtool distdir dvi dvi-am html html-am info info-am \ + install install-am install-data install-data-am install-exec \ install-exec-am install-info install-info-am install-man \ install-strip installcheck installcheck-am installdirs \ maintainer-clean maintainer-clean-generic mostlyclean \ @@ -584,9 +433,7 @@ uninstall uninstall-am uninstall-info-am -.PHONY: regress $(ansi_tests) - -$(ansi_tests): +.PHONY: regress regress: SMALLTALK_KERNEL="$(top_srcdir)/kernel/"; \ @@ -602,6 +449,26 @@ builddir=`pwd` && \ cd $(srcdir) && \ $$builddir/../gst -QSI $$builddir/gst.im AnsiLoad.st + +$(srcdir)/package.m4: $(top_srcdir)/configure.ac + { \ + echo '# Signature of the current package.'; \ + echo 'm4_define([AT_PACKAGE_NAME], [@PACKAGE_NAME@])'; \ + echo 'm4_define([AT_PACKAGE_TARNAME], [@PACKAGE_TARNAME@])'; \ + echo 'm4_define([AT_PACKAGE_VERSION], [@PACKAGE_VERSION@])'; \ + echo 'm4_define([AT_PACKAGE_STRING], [@PACKAGE_STRING@])'; \ + echo 'm4_define([AT_PACKAGE_BUGREPORT], [@PACKAGE_BUGREPORT@])'; \ + } >'$(srcdir)/package.m4' + +check-local: atconfig $(TESTSUITE) + $(SHELL) '$(TESTSUITE)' $(TESTSUITEFLAGS) + +clean-local: + -$(SHELL) '$(TESTSUITE)' --clean + +$(TESTSUITE): $(srcdir)/testsuite.at $(srcdir)/package.m4 $(srcdir)/local.at + $(AUTOTEST) -I '$(srcdir)' -o $@.tmp $@.at + mv $@.tmp $@ # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: diff -rNu smalltalk-2.3.3/tests/compiler.ok smalltalk-2.3.4/tests/compiler.ok --- smalltalk-2.3.3/tests/compiler.ok 2006-02-05 19:41:42.000000000 +0100 +++ smalltalk-2.3.4/tests/compiler.ok 2007-05-12 13:25:52.000000000 +0200 @@ -21,3 +21,7 @@ Execution begins... returned value is 'No crashes' +compiler.st:114: parse error, expected '!' + +Execution begins... +returned value is 2 diff -rNu smalltalk-2.3.3/tests/compiler.st smalltalk-2.3.4/tests/compiler.st --- smalltalk-2.3.3/tests/compiler.st 2006-02-05 19:41:42.000000000 +0100 +++ smalltalk-2.3.4/tests/compiler.st 2007-03-28 08:36:55.000000000 +0200 @@ -108,3 +108,10 @@ ^'foo'! ! ^BugTest c! + +"The lexer crashed on this because it returned a SYMBOL_LITERAL with + -123 in the ival. This gives a parse error..." +^#-123! + +"... this does not." +^#(#-123) size! diff -rNu smalltalk-2.3.3/tests/floatmath.ok smalltalk-2.3.4/tests/floatmath.ok --- smalltalk-2.3.3/tests/floatmath.ok 2007-01-29 09:24:06.000000000 +0100 +++ smalltalk-2.3.4/tests/floatmath.ok 2007-05-25 12:41:39.000000000 +0200 @@ -201,7 +201,7 @@ returned value is Array new: 2 "<0>" Execution begins... -returned value is Float +returned value is Float class Execution begins... true->10000000000000000.0 diff -rNu smalltalk-2.3.3/tests/floatmath.st smalltalk-2.3.4/tests/floatmath.st --- smalltalk-2.3.3/tests/floatmath.st 2007-01-29 09:24:06.000000000 +0100 +++ smalltalk-2.3.4/tests/floatmath.st 2007-05-25 12:41:40.000000000 +0200 @@ -162,26 +162,31 @@ "Fun with printing" -!Float methodsFor: 'testing'! +!Float class methodsFor: 'testing'! -test - (((Behavior evaluate: self printString) = self) -> self) printNl. +test: bytes + | b f | + b := Memory bigEndian ifTrue: [ bytes reverse ] ifFalse: [ bytes ]. + f := self new: b size. + 1 to: f size do: [ :i | f at: i put: (b at: i) ]. + (true->f) printNl. + ^f ! ! -1d16 test! -1e16 test! -1.2345d16 test! -1.2345e16 test! -1.25 test! -10.0 test! -(20 - 2.2325251) test! -0.12345 test! -0.12345d-8 test! -0.12345e-8 test! -0.83205029433784 test! -0.832050294337844 test! -0.55470019622523 test! -0.554700196225229 test! +FloatD test: #[0 128 224 55 121 195 65 67] ! +FloatE test: #[202 27 14 90] ! +FloatD test: #[0 72 224 37 219 237 69 67] ! +FloatE test: #[217 110 47 90] ! +FloatD test: #[0 0 0 0 0 0 244 63] ! +FloatD test: #[0 0 0 0 0 0 36 64] ! +FloatD test: #[57 0 44 60 121 196 49 64] ! +FloatD test: #[123 242 176 80 107 154 191 63] ! +FloatD test: #[78 250 91 111 99 53 21 62] ! +FloatE test: #[27 171 169 48] ! +FloatD test: #[191 220 89 240 39 160 234 63] ! +FloatD test: #[227 220 89 240 39 160 234 63] ! +FloatD test: #[157 232 59 160 26 192 225 63] ! +FloatD test: #[148 232 59 160 26 192 225 63] ! "Fun with rounding" diff -rNu smalltalk-2.3.3/tests/geometry.ok smalltalk-2.3.4/tests/geometry.ok --- smalltalk-2.3.3/tests/geometry.ok 2006-02-05 19:40:59.000000000 +0100 +++ smalltalk-2.3.4/tests/geometry.ok 2007-05-24 14:36:12.000000000 +0200 @@ -36,10 +36,10 @@ returned value is Point new "<0>" Execution begins... -'A dist: B = '136.014705087354 +'A dist: B = '136.0147050873544 'C dotProduct: D = '20000 'C grid: D = '150@250 -'C normal = '-0.832050294337844@0.554700196225229 +'C normal = '-0.8320502943378438@0.5547001962252292 'C truncatedGrid: D = '150@200 '175@300 transpose = '300@175 returned value is Point new "<0>" diff -rNu smalltalk-2.3.3/tests/local.at smalltalk-2.3.4/tests/local.at --- smalltalk-2.3.3/tests/local.at 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/tests/local.at 2007-05-24 22:10:25.000000000 +0200 @@ -0,0 +1,76 @@ +dnl Local Autotest macros for GNU Smalltalk. +dnl +dnl Copyright (C) 2007 Free Software Foundation, Inc. +dnl +dnl This program is free software; you can redistribute it and/or modify +dnl it under the terms of the GNU General Public License as published by +dnl the Free Software Foundation; either version 2, or (at your option) +dnl any later version. +dnl +dnl This program is distributed in the hope that it will be useful, +dnl but WITHOUT ANY WARRANTY; without even the implied warranty of +dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +dnl GNU General Public License for more details. +dnl +dnl You should have received a copy of the GNU General Public License +dnl along with this program; if not, write to the Free Software +dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +dnl 02111-1307, USA. + +dnl AT_CHECK_GST([COMMAND-LINE], [IMAGE], [DIR], [STDOUT], [STDERR]) +dnl ---------------------------------------------------------------- +m4_define([AT_CHECK_GST], [ + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I m4_ifval([$2], [$2], [$abs_top_builddir/gst.im])" ;; + *) GST="$AUTOTEST_PATH/gst m4_ifval([$2], [-I $2])" ;; + esac + + AT_CHECK([cd m4_ifval([$3], [$3], [$abs_top_builddir]) && $GST $1], 0, [$4], [$5]) +]) + +dnl AT_DIFF_TEST([FILE], [XFAILS]) +dnl ------------------------------ +m4_define([AT_DIFF_TEST], [ + AT_SETUP([$1]) + AT_KEYWORDS([base]) + $2 + cat $abs_srcdir/m4_bpatsubst([$1], [\.st$], [.ok]) > expout + AT_CHECK_GST([-r $1 2>&1], [], [$abs_srcdir], [expout]) + AT_CLEANUP +]) + +dnl AT_PACKAGE_TEST([PACKAGE], [XFAILS]) +dnl ------------------------------------ +m4_define([AT_PACKAGE_TEST], [ + AT_SETUP([$1]) + AT_KEYWORDS([m4_if([$1], [SUnit], [], [SUnit ])SUnit]) + $2 + AT_CHECK_GST([-f $abs_top_srcdir/scripts/Test.st -p $1], [], [], [ignore]) + AT_CLEANUP +]) + +dnl AT_OPTIONAL_PACKAGE_TEST([PACKAGE], [XFAILS]) +dnl --------------------------------------------- +dnl Returns exit code 77 (skip) if the package cannot be loaded. +m4_define([AT_OPTIONAL_PACKAGE_TEST], [ + AT_SETUP([$1]) + AT_KEYWORDS([$1 SUnit]) + $2 + AT_CHECK_GST([-f $abs_top_srcdir/scripts/Test.st -p $1 + ret=$? + case $ret in + 2) exit 77 ;; + 0|1) exit $ret ;; + esac], [], [], [ignore]) + AT_CLEANUP +]) + +dnl AT_ANSI_TEST([PACKAGE], [XFAILS]) +dnl --------------------------------- +m4_define([AT_ANSI_TEST], [ + AT_SETUP([$1]) + AT_KEYWORDS([ANSI SUnit]) + $2 + AT_CHECK_GST([-f $abs_srcdir/AnsiRun.st $1], [$abs_builddir/gst.im], [], [ignore]) + AT_CLEANUP +]) diff -rNu smalltalk-2.3.3/tests/package.m4 smalltalk-2.3.4/tests/package.m4 --- smalltalk-2.3.3/tests/package.m4 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/tests/package.m4 2007-05-28 12:42:50.000000000 +0200 @@ -0,0 +1,6 @@ +# Signature of the current package. +m4_define([AT_PACKAGE_NAME], [GNU Smalltalk]) +m4_define([AT_PACKAGE_TARNAME], [smalltalk]) +m4_define([AT_PACKAGE_VERSION], [2.3.4]) +m4_define([AT_PACKAGE_STRING], [GNU Smalltalk 2.3.4]) +m4_define([AT_PACKAGE_BUGREPORT], [help-smalltalk@gnu.org]) diff -rNu smalltalk-2.3.3/tests/run-test smalltalk-2.3.4/tests/run-test --- smalltalk-2.3.3/tests/run-test 2006-02-05 19:41:43.000000000 +0100 +++ smalltalk-2.3.4/tests/run-test 1970-01-01 01:00:00.000000000 +0100 @@ -1,29 +0,0 @@ -#!/bin/sh - -: ${srcdir=.} -builddir=`pwd` -base=`basename $1` -top_builddir=`pwd`/.. - -cd $srcdir -case $1 in - *.st) - base=`echo $base | sed 's/\.st$//' ` - build_base=${builddir}/$base - - $top_builddir/gst -rI $top_builddir/gst.im ${base}.st > $build_base.log 2>&1 - ERROR_CODE=$? - - if test $ERROR_CODE = 0; then - diff -c ${base}.ok $build_base.log > $build_base.diff && rm $build_base.diff - else - exit $ERROR_CODE - fi - ;; - - *Test) - grep ^$base $builddir/ANSI.log > /dev/null 2>&1 && rm $builddir/ANSI.log - $top_builddir/gst -QI $builddir/gst.im AnsiRun.st -a $base >> $builddir/ANSI.log 2>&1 - exit $? - ;; -esac diff -rNu smalltalk-2.3.3/tests/testsuite smalltalk-2.3.4/tests/testsuite --- smalltalk-2.3.3/tests/testsuite 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/tests/testsuite 2007-05-28 12:42:52.000000000 +0200 @@ -0,0 +1,9120 @@ +#! /bin/sh +# +# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software +# Foundation, Inc. +# This test suite is free software; the Free Software Foundation gives +# unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# CDPATH. +$as_unset CDPATH + + +if test "x$CONFIG_SHELL" = x; then + if (eval ":") 2>/dev/null; then + as_have_required=yes +else + as_have_required=no +fi + + if test $as_have_required = yes && (eval ": +(as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=\$LINENO + as_lineno_2=\$LINENO + test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && + test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } +") 2> /dev/null; then + : +else + as_candidate_shells= + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + case $as_dir in + /*) + for as_base in sh bash ksh sh5; do + as_candidate_shells="$as_candidate_shells $as_dir/$as_base" + done;; + esac +done +IFS=$as_save_IFS + + + for as_shell in $as_candidate_shells $SHELL; do + # Try only shells that exist, to save several forks. + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { ("$as_shell") 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +_ASEOF +}; then + CONFIG_SHELL=$as_shell + as_have_required=yes + if { "$as_shell" 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +(as_func_return () { + (exit $1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = "$1" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test $exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } + +_ASEOF +}; then + break +fi + +fi + + done + + if test "x$CONFIG_SHELL" != x; then + for as_var in BASH_ENV ENV + do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + done + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + + if test $as_have_required = no; then + echo This script requires a shell more modern than all the + echo shells that I found on your system. Please install a + echo modern shell, or manually run the script under such a + echo shell if you do have one. + { (exit 1); exit 1; } +fi + + +fi + +fi + + + +(eval "as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0") || { + echo No shell found that supports shell functions. + echo Please tell autoconf@gnu.org about your system, + echo including any error possibly output before this + echo message +} + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, and appends + # trailing '-' during substitution so that $LINENO is not a special + # case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir +fi +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + + +SHELL=${CONFIG_SHELL-/bin/sh} + +# How were we run? +at_cli_args="$@" + +# Load the config file. +for at_file in atconfig atlocal +do + test -r $at_file || continue + . ./$at_file || { echo "$as_me: error: invalid content: $at_file" >&2 + { (exit 1); exit 1; }; } +done + +# Autoconf <=2.59b set at_top_builddir instead of at_top_build_prefix: +: ${at_top_build_prefix=$at_top_builddir} + +# atconfig delivers names relative to the directory the test suite is +# in, but the groups themselves are run in testsuite-dir/group-dir. +if test -n "$at_top_srcdir"; then + builddir=../.. + for at_dir in srcdir top_srcdir top_build_prefix + do + at_val=`eval echo '${'at_$at_dir'}'` + eval "$at_dir=\$at_val/../.." + done +fi + +# Not all shells have the 'times' builtin; the subshell is needed to make +# sure we discard the 'times: not found' message from the shell. +at_times_p=false +(times) >/dev/null 2>&1 && at_times_p=: + +# CLI Arguments to pass to the debugging scripts. +at_debug_args= +# -e sets to true +at_errexit_p=false +# Shall we be verbose? +at_verbose=: +at_quiet=echo + +# Shall we keep the debug scripts? Must be `:' when the suite is +# run by a debug script, so that the script doesn't remove itself. +at_debug_p=false +# Display help message? +at_help_p=false +# Display the version message? +at_version_p=false +# List test groups? +at_list_p=false +# Test groups to run +at_groups= + +# The directory we are in. +at_dir=`pwd` +# The directory the whole suite works in. +# Should be absolutely to let the user `cd' at will. +at_suite_dir=$at_dir/$as_me.dir +# The file containing the suite. +at_suite_log=$at_dir/$as_me.log +# The file containing the location of the last AT_CHECK. +at_check_line_file=$at_suite_dir/at-check-line +# The file containing the exit status of the last command. +at_status_file=$at_suite_dir/at-status +# The files containing the output of the tested commands. +at_stdout=$at_suite_dir/at-stdout +at_stder1=$at_suite_dir/at-stder1 +at_stderr=$at_suite_dir/at-stderr +# The file containing dates. +at_times_file=$at_suite_dir/at-times + +# List of the tested programs. +at_tested='../gst' +# List of the all the test groups. +at_groups_all=' banner-1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 banner-2 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 banner-3 41 42 banner-4 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 banner-5 108 109 110 111 112' +# As many question marks as there are digits in the last test group number. +# Used to normalize the test group numbers so that `ls' lists them in +# numerical order. +at_format='???' +# Description of all the test groups. +at_help_all="1;testsuite.at:27;arrays.st;base; +2;testsuite.at:28;classes.st;base; +3;testsuite.at:29;blocks.st;base; +4;testsuite.at:30;sets.st;base; +5;testsuite.at:31;processes.st;base; +6;testsuite.at:32;exceptions.st;base; +7;testsuite.at:33;intmath.st;base; +8;testsuite.at:34;floatmath.st;base; +9;testsuite.at:35;dates.st;base; +10;testsuite.at:36;objects.st;base; +11;testsuite.at:37;strings.st;base; +12;testsuite.at:38;chars.st;base; +13;testsuite.at:39;objdump.st;base; +14;testsuite.at:40;delays.st;base; +15;testsuite.at:41;geometry.st;base; +16;testsuite.at:42;cobjects.st;base; +17;testsuite.at:43;compiler.st;base; +18;testsuite.at:44;fileext.st;base; +19;testsuite.at:45;mutate.st;base; +20;testsuite.at:46;untrusted.st;base; +21;testsuite.at:47;getopt.st;base; +22;testsuite.at:48;quit.st;base; +23;testsuite.at:51;ackermann.st;base; +24;testsuite.at:52;ary3.st;base; +25;testsuite.at:53;except.st;base; +26;testsuite.at:54;fibo.st;base; +27;testsuite.at:55;hash.st;base; +28;testsuite.at:56;hash2.st;base; +29;testsuite.at:57;heapsort.st;base; +30;testsuite.at:58;lists.st;base; +31;testsuite.at:59;lists1.st;base; +32;testsuite.at:60;lists2.st;base; +33;testsuite.at:61;matrix.st;base; +34;testsuite.at:62;methcall.st;base; +35;testsuite.at:63;nestedloop.st;base; +36;testsuite.at:64;objinst.st;base; +37;testsuite.at:65;prodcons.st;base; +38;testsuite.at:66;random-bench.st;base; +39;testsuite.at:67;sieve.st;base; +40;testsuite.at:68;strcat.st;base; +41;testsuite.at:71;SUnit;SUnit; +42;testsuite.at:72;Parser;SUnit SUnit; +43;testsuite.at:75;ArrayANSITest;ANSI SUnit; +44;testsuite.at:76;ArrayFactoryANSITest;ANSI SUnit; +45;testsuite.at:77;BagANSITest;ANSI SUnit; +46;testsuite.at:78;BagFactoryANSITest;ANSI SUnit; +47;testsuite.at:79;BooleanANSITest;ANSI SUnit; +48;testsuite.at:80;ByteArrayANSITest;ANSI SUnit; +49;testsuite.at:81;ByteArrayFactoryANSITest;ANSI SUnit; +50;testsuite.at:82;CharacterANSITest;ANSI SUnit; +51;testsuite.at:83;CharacterFactoryANSITest;ANSI SUnit; +52;testsuite.at:84;DateAndTimeANSITest;ANSI SUnit; +53;testsuite.at:85;DateAndTimeFactoryANSITest;ANSI SUnit; +54;testsuite.at:86;DictionaryANSITest;ANSI SUnit; +55;testsuite.at:87;DictionaryFactoryANSITest;ANSI SUnit; +56;testsuite.at:88;DurationANSITest;ANSI SUnit; +57;testsuite.at:89;DurationFactoryANSITest;ANSI SUnit; +58;testsuite.at:90;DyadicValuableANSITest;ANSI SUnit; +59;testsuite.at:91;ErrorANSITest;ANSI SUnit; +60;testsuite.at:92;ErrorClassANSITest;ANSI SUnit; +61;testsuite.at:93;ExceptionANSITest;ANSI SUnit; +62;testsuite.at:94;ExceptionClassANSITest;ANSI SUnit; +63;testsuite.at:95;ExceptionSetANSITest;ANSI SUnit; +64;testsuite.at:96;FailedMessageANSITest;ANSI SUnit; +65;testsuite.at:97;FileStreamFactoryANSITest;ANSI SUnit; +66;testsuite.at:98;FloatANSITest;ANSI SUnit; +67;testsuite.at:99;FloatCharacterizationANSITest;ANSI SUnit; +68;testsuite.at:100;FractionANSITest;ANSI SUnit; +69;testsuite.at:101;FractionFactoryANSITest;ANSI SUnit; +70;testsuite.at:102;IdentityDictionaryANSITest;ANSI SUnit; +71;testsuite.at:103;IdentityDictionaryFactoryANSITest;ANSI SUnit; +72;testsuite.at:104;IntegerANSITest;ANSI SUnit; +73;testsuite.at:105;IntervalANSITest;ANSI SUnit; +74;testsuite.at:106;IntervalFactoryANSITest;ANSI SUnit; +75;testsuite.at:107;MessageNotUnderstoodANSITest;ANSI SUnit; +76;testsuite.at:108;MessageNotUnderstoodSelectorANSITest;ANSI SUnit; +77;testsuite.at:109;MonadicBlockANSITest;ANSI SUnit; +78;testsuite.at:110;NilANSITest;ANSI SUnit; +79;testsuite.at:111;NiladicBlockANSITest;ANSI SUnit; +80;testsuite.at:112;NotificationANSITest;ANSI SUnit; +81;testsuite.at:113;NotificationClassANSITest;ANSI SUnit; +82;testsuite.at:114;ObjectANSITest;ANSI SUnit; +83;testsuite.at:115;ObjectClassANSITest;ANSI SUnit; +84;testsuite.at:116;OrderedCollectionANSITest;ANSI SUnit; +85;testsuite.at:117;OrderedCollectionFactoryANSITest;ANSI SUnit; +86;testsuite.at:118;ReadFileStreamANSITest;ANSI SUnit; +87;testsuite.at:119;ReadStreamANSITest;ANSI SUnit; +88;testsuite.at:120;ReadStreamFactoryANSITest;ANSI SUnit; +89;testsuite.at:121;ReadWriteStreamANSITest;ANSI SUnit; +90;testsuite.at:122;ReadWriteStreamFactoryANSITest;ANSI SUnit; +91;testsuite.at:123;ScaledDecimalANSITest;ANSI SUnit; +92;testsuite.at:124;SelectorANSITest;ANSI SUnit; +93;testsuite.at:125;SetANSITest;ANSI SUnit; +94;testsuite.at:126;SetFactoryANSITest;ANSI SUnit; +95;testsuite.at:127;SortedCollectionANSITest;ANSI SUnit; +96;testsuite.at:128;SortedCollectionFactoryANSITest;ANSI SUnit; +97;testsuite.at:129;StringANSITest;ANSI SUnit; +98;testsuite.at:130;StringFactoryANSITest;ANSI SUnit; +99;testsuite.at:131;SymbolANSITest;ANSI SUnit; +100;testsuite.at:132;TranscriptANSITest;ANSI SUnit; +101;testsuite.at:133;WarningANSITest;ANSI SUnit; +102;testsuite.at:134;WarningClassANSITest;ANSI SUnit; +103;testsuite.at:135;WriteFileStreamANSITest;ANSI SUnit; +104;testsuite.at:136;WriteStreamANSITest;ANSI SUnit; +105;testsuite.at:137;WriteStreamFactoryANSITest;ANSI SUnit; +106;testsuite.at:138;ZeroDivideANSITest;ANSI SUnit; +107;testsuite.at:139;ZeroDivideFactoryANSITest;ANSI SUnit; +108;testsuite.at:142;Continuations;SUnit SUnit; +109;testsuite.at:143;DhbNumericalMethods;SUnit SUnit; +110;testsuite.at:144;GDBM;GDBM SUnit; +111;testsuite.at:145;MD5;SUnit SUnit; +112;testsuite.at:146;ZLib;ZLib SUnit; +" + +at_prev= +for at_option +do + # If the previous option needs an argument, assign it. + if test -n "$at_prev"; then + at_option=$at_prev=$at_option + at_prev= + fi + + case $at_option in + *=*) at_optarg=`expr "x$at_option" : 'x[^=]*=\(.*\)'` ;; + *) at_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $at_option in + --help | -h ) + at_help_p=: + ;; + + --list | -l ) + at_list_p=: + ;; + + --version | -V ) + at_version_p=: + ;; + + --clean | -c ) + test -d "$at_suite_dir" && + find "$at_suite_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; + rm -f -r "$at_suite_dir" "$at_suite_log" + exit 0 + ;; + + --debug | -d ) + at_debug_p=: + ;; + + --errexit | -e ) + at_debug_p=: + at_errexit_p=: + ;; + + --verbose | -v ) + at_verbose=echo; at_quiet=: + ;; + + --trace | -x ) + at_traceon='set -x'; at_traceoff='set +x' + ;; + + [0-9] | [0-9][0-9] | [0-9][0-9][0-9] | [0-9][0-9][0-9][0-9]) + at_groups="$at_groups$at_option " + ;; + + # Ranges + [0-9]- | [0-9][0-9]- | [0-9][0-9][0-9]- | [0-9][0-9][0-9][0-9]-) + at_range_start=`echo $at_option |tr -d X-` + at_range=`echo " $at_groups_all " | \ + sed -e 's/^.* \('$at_range_start' \)/\1/'` + at_groups="$at_groups$at_range " + ;; + + -[0-9] | -[0-9][0-9] | -[0-9][0-9][0-9] | -[0-9][0-9][0-9][0-9]) + at_range_end=`echo $at_option |tr -d X-` + at_range=`echo " $at_groups_all " | \ + sed -e 's/\( '$at_range_end'\) .*$/\1/'` + at_groups="$at_groups$at_range " + ;; + + [0-9]-[0-9] | [0-9]-[0-9][0-9] | [0-9]-[0-9][0-9][0-9] | \ + [0-9]-[0-9][0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9] | \ + [0-9][0-9]-[0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9][0-9][0-9] | \ + [0-9][0-9][0-9]-[0-9][0-9][0-9] | \ + [0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] | \ + [0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] ) + at_range_start=`expr $at_option : '\(.*\)-'` + at_range_end=`expr $at_option : '.*-\(.*\)'` + if test $at_range_start -gt $at_range_end; then + at_tmp=$at_range_end + at_range_end=$at_range_start + at_range_start=$at_tmp + fi + at_range=`echo " $at_groups_all " | \ + sed -e 's/^.*\( '$at_range_start' \)/\1/' \ + -e 's/\( '$at_range_end'\) .*$/\1/'` + at_groups="$at_groups$at_range " + ;; + + # Keywords. + --keywords | -k ) + at_prev=--keywords + ;; + --keywords=* ) + at_groups_selected=$at_help_all + at_save_IFS=$IFS + IFS=, + set X $at_optarg + shift + IFS=$at_save_IFS + for at_keyword + do + at_invert= + case $at_keyword in + '!'*) + at_invert="-v" + at_keyword=`expr "X$at_keyword" : 'X!\(.*\)'` + ;; + esac + # It is on purpose that we match the test group titles too. + at_groups_selected=`echo "$at_groups_selected" | + grep -i $at_invert "^[1-9][^;]*;.*[; ]$at_keyword[ ;]"` + done + at_groups_selected=`echo "$at_groups_selected" | sed 's/;.*//'` + # Smash the newlines. + at_groups="$at_groups`echo $at_groups_selected` " + ;; + + *=*) + at_envvar=`expr "x$at_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$at_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $at_envvar" >&2 + { (exit 1); exit 1; }; } + at_value=`echo "$at_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$at_envvar='$at_value'" + export $at_envvar + # Propagate to debug scripts. + at_debug_args="$at_debug_args $at_envvar='$at_value'" + ;; + + *) echo "$as_me: invalid option: $at_option" >&2 + echo "Try \`$0 --help' for more information." >&2 + exit 1 + ;; + esac +done + +# Selected test groups. +if test -z "$at_groups"; then + at_groups=$at_groups_all +else + # Sort the tests, removing duplicates: + at_groups=`echo $at_groups | tr ' ' "$as_nl" | sort -nu` + # and add banners. (Passing at_groups_all is tricky--see the comment + # starting with "Passing at_groups is tricky.") + at_groups=`echo "$at_groups$as_nl $at_groups_all" | + awk 'BEGIN { FS = "@" } # Effectively switch off field splitting. + /^$/ { next } # Ignore the empty line. + !/ / { groups++; selected[$ 0] = 1; next } + # The last line, containing at_groups_all. + { + n = split($ 0, a, " ") + # If there are several tests, select their banners: + if (groups > 1) { + for (i = 1; i <= n; i++) { + if (a[i] ~ /^banner-/) + banner = a[i] + else if (banner != "" && selected[a[i]] == 1) + selected[banner] = 1 + } + } + for (i = 1; i <= n; i++) + if (selected[a[i]] == 1) + list = list " " a[i] + print list + }'` +fi + +# Help message. +if $at_help_p; then + cat <<_ATEOF +Usage: $0 [OPTION]... [VARIABLE=VALUE]... [TESTS] + +Run all the tests, or the selected TESTS, given by numeric ranges, and +save a detailed log file. Upon failure, create debugging scripts. + +You should not change environment variables unless explicitly passed +as command line arguments. Set \`AUTOTEST_PATH' to select the executables +to exercise. Each relative directory is expanded as build and source +directories relatively to the top level of this distribution. E.g., + + $ $0 AUTOTEST_PATH=bin + +possibly amounts into + + PATH=/tmp/foo-1.0/bin:/src/foo-1.0/bin:\$PATH +_ATEOF +cat <<_ATEOF + +Operation modes: + -h, --help print the help message, then exit + -V, --version print version number, then exit + -c, --clean remove all the files this test suite might create and exit + -l, --list describes all the tests, or the selected TESTS +_ATEOF +cat <<_ATEOF + +Execution tuning: + -k, --keywords=KEYWORDS + select the tests matching all the comma-separated KEYWORDS + multiple \`-k' accumulate; prefixed \`!' negates a KEYWORD + -e, --errexit abort as soon as a test fails; implies --debug + -v, --verbose force more detailed output + default for debugging scripts + -d, --debug inhibit clean up and top-level logging + default for debugging scripts + -x, --trace enable tests shell tracing +_ATEOF +cat <<_ATEOF + +Report bugs to . +_ATEOF + exit 0 +fi + +# List of tests. +if $at_list_p; then + cat <<_ATEOF +GNU Smalltalk 2.3.4 test suite test groups: + + NUM: FILE-NAME:LINE TEST-GROUP-NAME + KEYWORDS + +_ATEOF + # Passing at_groups is tricky. We cannot use it to form a literal string + # or regexp because of the limitation of AIX awk. And Solaris' awk + # doesn't grok more than 99 fields in a record, so we have to use `split'. + echo "$at_groups$as_nl$at_help_all" | + awk 'BEGIN { FS = ";" } + NR == 1 { + for (n = split($ 0, a, " "); n; n--) selected[a[n]] = 1 + next + } + { + if (selected[$ 1]) { + printf " %3d: %-18s %s\n", $ 1, $ 2, $ 3 + if ($ 4) printf " %s\n", $ 4 + } + }' + exit 0 +fi +if $at_version_p; then + echo "$as_me (GNU Smalltalk 2.3.4)" + cat <<\_ACEOF + +Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software +Foundation, Inc. +This test suite is free software; the Free Software Foundation gives +unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi + +# Don't take risks: use only absolute directories in PATH. +# +# For stand-alone test suites, AUTOTEST_PATH is relative to `.'. +# +# For embedded test suites, AUTOTEST_PATH is relative to the top level +# of the package. Then expand it into build/src parts, since users +# may create executables in both places. +AUTOTEST_PATH=`echo $AUTOTEST_PATH | sed "s&:&$PATH_SEPARATOR&g"` +at_path= +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $AUTOTEST_PATH $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -n "$at_path" && at_path=$at_path$PATH_SEPARATOR +case $as_dir in + [\\/]* | ?:[\\/]* ) + at_path=$at_path$as_dir + ;; + * ) + if test -z "$at_top_build_prefix"; then + # Stand-alone test suite. + at_path=$at_path$as_dir + else + # Embedded test suite. + at_path=$at_path$at_top_build_prefix$as_dir$PATH_SEPARATOR + at_path=$at_path$at_top_srcdir/$as_dir + fi + ;; +esac +done +IFS=$as_save_IFS + + +# Now build and simplify PATH. +# +# There might be directories that don't exist, but don't redirect +# builtins' (eg., cd) stderr directly: Ultrix's sh hates that. +PATH= +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $at_path +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_dir=`(cd "$as_dir" && pwd) 2>/dev/null` +test -d "$as_dir" || continue +case $PATH in + $as_dir | \ + $as_dir$PATH_SEPARATOR* | \ + *$PATH_SEPARATOR$as_dir | \ + *$PATH_SEPARATOR$as_dir$PATH_SEPARATOR* ) ;; + + '') PATH=$as_dir ;; + *) PATH=$PATH$PATH_SEPARATOR$as_dir ;; +esac +done +IFS=$as_save_IFS + +export PATH + +# Setting up the FDs. +# 5 is the log file. Not to be overwritten if `-d'. + +if $at_debug_p; then + at_suite_log=/dev/null +else + : >"$at_suite_log" +fi +exec 5>>"$at_suite_log" + +# Banners and logs. +cat <<\_ASBOX +## ------------------------------- ## +## GNU Smalltalk 2.3.4 test suite. ## +## ------------------------------- ## +_ASBOX +{ + cat <<\_ASBOX +## ------------------------------- ## +## GNU Smalltalk 2.3.4 test suite. ## +## ------------------------------- ## +_ASBOX + echo + + echo "$as_me: command line was:" + echo " $ $0 $at_cli_args" + echo + + # Try to find a few ChangeLogs in case it might help determining the + # exact version. Use the relative dir: if the top dir is a symlink, + # find will not follow it (and options to follow the links are not + # portable), which would result in no output here. + if test -n "$at_top_srcdir"; then + cat <<\_ASBOX +## ----------- ## +## ChangeLogs. ## +## ----------- ## +_ASBOX + echo + for at_file in `find "$at_top_srcdir" -name ChangeLog -print` + do + echo "$as_me: $at_file:" + sed 's/^/| /;10q' $at_file + echo + done + + { +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done +IFS=$as_save_IFS + +} + echo + fi + + # Contents of the config files. + for at_file in atconfig atlocal + do + test -r $at_file || continue + echo "$as_me: $at_file:" + sed 's/^/| /' $at_file + echo + done + + cat <<\_ASBOX +## ---------------- ## +## Tested programs. ## +## ---------------- ## +_ASBOX + echo +} >&5 + +# Report what programs are being tested. +for at_program in : $at_tested +do + test "$at_program" = : && continue + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -f "$as_dir/$at_program" && break +done +IFS=$as_save_IFS + + if test -f "$as_dir/$at_program"; then + { + echo "$at_srcdir/testsuite.at:23: $as_dir/$at_program --version" + "$as_dir/$at_program" --version + echo + } >&5 2>&1 + else + { { echo "$as_me:$LINENO: error: cannot find $at_program" >&5 +echo "$as_me: error: cannot find $at_program" >&2;} + { (exit 1); exit 1; }; } + fi +done + +{ + cat <<\_ASBOX +## ------------------ ## +## Running the tests. ## +## ------------------ ## +_ASBOX +} >&5 + +at_start_date=`date` +at_start_time=`date +%s 2>/dev/null` +echo "$as_me: starting at: $at_start_date" >&5 +at_xpass_list= +at_xfail_list= +at_pass_list= +at_fail_list= +at_skip_list= +at_group_count=0 + +# Create the master directory if it doesn't already exist. +test -d "$at_suite_dir" || + mkdir "$at_suite_dir" || + { { echo "$as_me:$LINENO: error: cannot create '$at_suite_dir'" >&5 +echo "$as_me: error: cannot create '$at_suite_dir'" >&2;} + { (exit 1); exit 1; }; } + +# Can we diff with `/dev/null'? DU 5.0 refuses. +if diff /dev/null /dev/null >/dev/null 2>&1; then + at_devnull=/dev/null +else + at_devnull=$at_suite_dir/devnull + >"$at_devnull" +fi + +# Use `diff -u' when possible. +if at_diff=`diff -u "$at_devnull" "$at_devnull" 2>&1` && test -z "$at_diff" +then + at_diff='diff -u' +else + at_diff=diff +fi + + +for at_group in $at_groups +do + # Be sure to come back to the top test directory. + cd "$at_suite_dir" + + case $at_group in + banner-*) + at_group_log=$at_suite_log + ;; + + *) + at_group_normalized=$at_group + + while :; do + case $at_group_normalized in #( + $at_format*) break;; + esac + at_group_normalized=0$at_group_normalized + done + + + # Create a fresh directory for the next test group, and enter. + at_group_dir=$at_suite_dir/$at_group_normalized + at_group_log=$at_group_dir/$as_me.log + if test -d "$at_group_dir"; then + find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; + rm -fr "$at_group_dir" + fi + # Be tolerant if the above `rm' was not able to remove the directory. + { as_dir=$at_group_dir + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 +echo "$as_me: error: cannot create directory $as_dir" >&2;} + { (exit 1); exit 1; }; }; } + cd $at_group_dir + ;; + esac + + echo 0 > "$at_status_file" + + # Clearly separate the test groups when verbose. + test $at_group_count != 0 && $at_verbose + + # In verbose mode, append to the log file *and* show on + # the standard output; in quiet mode only write to the log + if test $at_verbose = echo; then + at_tee_pipe='tee -a "$at_group_log"' + else + at_tee_pipe='cat >> "$at_group_log"' + fi + + case $at_group in + + banner-1 ) # Banner 1. testsuite.at:26 + cat <<\_ATEOF + +Regression tests. + +_ATEOF + ;; + + 1 ) # 1. testsuite.at:27: arrays.st + at_setup_line='testsuite.at:27' + at_desc="arrays.st" + $at_quiet $ECHO_N " 1: arrays.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "1. testsuite.at:27: testing ..." + $at_traceon + + + + cat $abs_srcdir/arrays.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:27: cd \$abs_srcdir && \$GST -r arrays.st 2>&1" +echo testsuite.at:27 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r arrays.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r arrays.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r arrays.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:27: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 2 ) # 2. testsuite.at:28: classes.st + at_setup_line='testsuite.at:28' + at_desc="classes.st" + $at_quiet $ECHO_N " 2: classes.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "2. testsuite.at:28: testing ..." + $at_traceon + + + + cat $abs_srcdir/classes.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:28: cd \$abs_srcdir && \$GST -r classes.st 2>&1" +echo testsuite.at:28 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r classes.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r classes.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r classes.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:28: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 3 ) # 3. testsuite.at:29: blocks.st + at_setup_line='testsuite.at:29' + at_desc="blocks.st" + $at_quiet $ECHO_N " 3: blocks.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "3. testsuite.at:29: testing ..." + $at_traceon + + + + cat $abs_srcdir/blocks.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:29: cd \$abs_srcdir && \$GST -r blocks.st 2>&1" +echo testsuite.at:29 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r blocks.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r blocks.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r blocks.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:29: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 4 ) # 4. testsuite.at:30: sets.st + at_setup_line='testsuite.at:30' + at_desc="sets.st" + $at_quiet $ECHO_N " 4: sets.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "4. testsuite.at:30: testing ..." + $at_traceon + + + + cat $abs_srcdir/sets.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:30: cd \$abs_srcdir && \$GST -r sets.st 2>&1" +echo testsuite.at:30 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r sets.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r sets.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r sets.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:30: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 5 ) # 5. testsuite.at:31: processes.st + at_setup_line='testsuite.at:31' + at_desc="processes.st" + $at_quiet $ECHO_N " 5: processes.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "5. testsuite.at:31: testing ..." + $at_traceon + + + + cat $abs_srcdir/processes.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:31: cd \$abs_srcdir && \$GST -r processes.st 2>&1" +echo testsuite.at:31 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r processes.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r processes.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r processes.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:31: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 6 ) # 6. testsuite.at:32: exceptions.st + at_setup_line='testsuite.at:32' + at_desc="exceptions.st" + $at_quiet $ECHO_N " 6: exceptions.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "6. testsuite.at:32: testing ..." + $at_traceon + + + + cat $abs_srcdir/exceptions.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:32: cd \$abs_srcdir && \$GST -r exceptions.st 2>&1" +echo testsuite.at:32 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r exceptions.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r exceptions.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r exceptions.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:32: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 7 ) # 7. testsuite.at:33: intmath.st + at_setup_line='testsuite.at:33' + at_desc="intmath.st" + $at_quiet $ECHO_N " 7: intmath.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "7. testsuite.at:33: testing ..." + $at_traceon + + + + cat $abs_srcdir/intmath.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:33: cd \$abs_srcdir && \$GST -r intmath.st 2>&1" +echo testsuite.at:33 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r intmath.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r intmath.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r intmath.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:33: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 8 ) # 8. testsuite.at:34: floatmath.st + at_setup_line='testsuite.at:34' + at_desc="floatmath.st" + $at_quiet $ECHO_N " 8: floatmath.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "8. testsuite.at:34: testing ..." + $at_traceon + + + + cat $abs_srcdir/floatmath.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:34: cd \$abs_srcdir && \$GST -r floatmath.st 2>&1" +echo testsuite.at:34 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r floatmath.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r floatmath.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r floatmath.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:34: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 9 ) # 9. testsuite.at:35: dates.st + at_setup_line='testsuite.at:35' + at_desc="dates.st" + $at_quiet $ECHO_N " 9: dates.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "9. testsuite.at:35: testing ..." + $at_traceon + + + + cat $abs_srcdir/dates.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:35: cd \$abs_srcdir && \$GST -r dates.st 2>&1" +echo testsuite.at:35 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r dates.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r dates.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r dates.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:35: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 10 ) # 10. testsuite.at:36: objects.st + at_setup_line='testsuite.at:36' + at_desc="objects.st" + $at_quiet $ECHO_N " 10: objects.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "10. testsuite.at:36: testing ..." + $at_traceon + + + + cat $abs_srcdir/objects.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:36: cd \$abs_srcdir && \$GST -r objects.st 2>&1" +echo testsuite.at:36 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r objects.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r objects.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r objects.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:36: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 11 ) # 11. testsuite.at:37: strings.st + at_setup_line='testsuite.at:37' + at_desc="strings.st" + $at_quiet $ECHO_N " 11: strings.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "11. testsuite.at:37: testing ..." + $at_traceon + + + + cat $abs_srcdir/strings.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:37: cd \$abs_srcdir && \$GST -r strings.st 2>&1" +echo testsuite.at:37 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r strings.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r strings.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r strings.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:37: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 12 ) # 12. testsuite.at:38: chars.st + at_setup_line='testsuite.at:38' + at_desc="chars.st" + $at_quiet $ECHO_N " 12: chars.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "12. testsuite.at:38: testing ..." + $at_traceon + + + + cat $abs_srcdir/chars.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:38: cd \$abs_srcdir && \$GST -r chars.st 2>&1" +echo testsuite.at:38 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r chars.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r chars.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r chars.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:38: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 13 ) # 13. testsuite.at:39: objdump.st + at_setup_line='testsuite.at:39' + at_desc="objdump.st" + $at_quiet $ECHO_N " 13: objdump.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "13. testsuite.at:39: testing ..." + $at_traceon + + + + cat $abs_srcdir/objdump.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:39: cd \$abs_srcdir && \$GST -r objdump.st 2>&1" +echo testsuite.at:39 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r objdump.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r objdump.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r objdump.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:39: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 14 ) # 14. testsuite.at:40: delays.st + at_setup_line='testsuite.at:40' + at_desc="delays.st" + $at_quiet $ECHO_N " 14: delays.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "14. testsuite.at:40: testing ..." + $at_traceon + + + + cat $abs_srcdir/delays.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:40: cd \$abs_srcdir && \$GST -r delays.st 2>&1" +echo testsuite.at:40 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r delays.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r delays.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r delays.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:40: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 15 ) # 15. testsuite.at:41: geometry.st + at_setup_line='testsuite.at:41' + at_desc="geometry.st" + $at_quiet $ECHO_N " 15: geometry.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "15. testsuite.at:41: testing ..." + $at_traceon + + + + cat $abs_srcdir/geometry.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:41: cd \$abs_srcdir && \$GST -r geometry.st 2>&1" +echo testsuite.at:41 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r geometry.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r geometry.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r geometry.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:41: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 16 ) # 16. testsuite.at:42: cobjects.st + at_setup_line='testsuite.at:42' + at_desc="cobjects.st" + $at_quiet $ECHO_N " 16: cobjects.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "16. testsuite.at:42: testing ..." + $at_traceon + + + + cat $abs_srcdir/cobjects.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:42: cd \$abs_srcdir && \$GST -r cobjects.st 2>&1" +echo testsuite.at:42 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r cobjects.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r cobjects.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r cobjects.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:42: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 17 ) # 17. testsuite.at:43: compiler.st + at_setup_line='testsuite.at:43' + at_desc="compiler.st" + $at_quiet $ECHO_N " 17: compiler.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "17. testsuite.at:43: testing ..." + $at_traceon + + + + cat $abs_srcdir/compiler.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:43: cd \$abs_srcdir && \$GST -r compiler.st 2>&1" +echo testsuite.at:43 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r compiler.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r compiler.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r compiler.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:43: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 18 ) # 18. testsuite.at:44: fileext.st + at_setup_line='testsuite.at:44' + at_desc="fileext.st" + $at_quiet $ECHO_N " 18: fileext.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "18. testsuite.at:44: testing ..." + $at_traceon + + + + cat $abs_srcdir/fileext.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:44: cd \$abs_srcdir && \$GST -r fileext.st 2>&1" +echo testsuite.at:44 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r fileext.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r fileext.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r fileext.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:44: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 19 ) # 19. testsuite.at:45: mutate.st + at_setup_line='testsuite.at:45' + at_desc="mutate.st" + $at_quiet $ECHO_N " 19: mutate.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "19. testsuite.at:45: testing ..." + $at_traceon + + + + cat $abs_srcdir/mutate.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:45: cd \$abs_srcdir && \$GST -r mutate.st 2>&1" +echo testsuite.at:45 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r mutate.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r mutate.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r mutate.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:45: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 20 ) # 20. testsuite.at:46: untrusted.st + at_setup_line='testsuite.at:46' + at_desc="untrusted.st" + $at_quiet $ECHO_N " 20: untrusted.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "20. testsuite.at:46: testing ..." + $at_traceon + + + + cat $abs_srcdir/untrusted.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:46: cd \$abs_srcdir && \$GST -r untrusted.st 2>&1" +echo testsuite.at:46 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r untrusted.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r untrusted.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r untrusted.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:46: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 21 ) # 21. testsuite.at:47: getopt.st + at_setup_line='testsuite.at:47' + at_desc="getopt.st" + $at_quiet $ECHO_N " 21: getopt.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "21. testsuite.at:47: testing ..." + $at_traceon + + + + cat $abs_srcdir/getopt.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:47: cd \$abs_srcdir && \$GST -r getopt.st 2>&1" +echo testsuite.at:47 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r getopt.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r getopt.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r getopt.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:47: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 22 ) # 22. testsuite.at:48: quit.st + at_setup_line='testsuite.at:48' + at_desc="quit.st" + $at_quiet $ECHO_N " 22: quit.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "22. testsuite.at:48: testing ..." + $at_traceon + + + + cat $abs_srcdir/quit.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:48: cd \$abs_srcdir && \$GST -r quit.st 2>&1" +echo testsuite.at:48 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r quit.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r quit.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r quit.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:48: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + + banner-2 ) # Banner 2. testsuite.at:50 + cat <<\_ATEOF + +Other simple tests. + +_ATEOF + ;; + + 23 ) # 23. testsuite.at:51: ackermann.st + at_setup_line='testsuite.at:51' + at_desc="ackermann.st" + $at_quiet $ECHO_N " 23: ackermann.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "23. testsuite.at:51: testing ..." + $at_traceon + + + + cat $abs_srcdir/ackermann.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:51: cd \$abs_srcdir && \$GST -r ackermann.st 2>&1" +echo testsuite.at:51 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r ackermann.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r ackermann.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r ackermann.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:51: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 24 ) # 24. testsuite.at:52: ary3.st + at_setup_line='testsuite.at:52' + at_desc="ary3.st" + $at_quiet $ECHO_N " 24: ary3.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "24. testsuite.at:52: testing ..." + $at_traceon + + + + cat $abs_srcdir/ary3.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:52: cd \$abs_srcdir && \$GST -r ary3.st 2>&1" +echo testsuite.at:52 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r ary3.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r ary3.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r ary3.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:52: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 25 ) # 25. testsuite.at:53: except.st + at_setup_line='testsuite.at:53' + at_desc="except.st" + $at_quiet $ECHO_N " 25: except.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "25. testsuite.at:53: testing ..." + $at_traceon + + + + cat $abs_srcdir/except.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:53: cd \$abs_srcdir && \$GST -r except.st 2>&1" +echo testsuite.at:53 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r except.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r except.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r except.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:53: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 26 ) # 26. testsuite.at:54: fibo.st + at_setup_line='testsuite.at:54' + at_desc="fibo.st" + $at_quiet $ECHO_N " 26: fibo.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "26. testsuite.at:54: testing ..." + $at_traceon + + + + cat $abs_srcdir/fibo.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:54: cd \$abs_srcdir && \$GST -r fibo.st 2>&1" +echo testsuite.at:54 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r fibo.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r fibo.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r fibo.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:54: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 27 ) # 27. testsuite.at:55: hash.st + at_setup_line='testsuite.at:55' + at_desc="hash.st" + $at_quiet $ECHO_N " 27: hash.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "27. testsuite.at:55: testing ..." + $at_traceon + + + + cat $abs_srcdir/hash.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:55: cd \$abs_srcdir && \$GST -r hash.st 2>&1" +echo testsuite.at:55 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r hash.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r hash.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r hash.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:55: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 28 ) # 28. testsuite.at:56: hash2.st + at_setup_line='testsuite.at:56' + at_desc="hash2.st" + $at_quiet $ECHO_N " 28: hash2.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "28. testsuite.at:56: testing ..." + $at_traceon + + + + cat $abs_srcdir/hash2.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:56: cd \$abs_srcdir && \$GST -r hash2.st 2>&1" +echo testsuite.at:56 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r hash2.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r hash2.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r hash2.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:56: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 29 ) # 29. testsuite.at:57: heapsort.st + at_setup_line='testsuite.at:57' + at_desc="heapsort.st" + $at_quiet $ECHO_N " 29: heapsort.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "29. testsuite.at:57: testing ..." + $at_traceon + + + + cat $abs_srcdir/heapsort.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:57: cd \$abs_srcdir && \$GST -r heapsort.st 2>&1" +echo testsuite.at:57 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r heapsort.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r heapsort.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r heapsort.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:57: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 30 ) # 30. testsuite.at:58: lists.st + at_setup_line='testsuite.at:58' + at_desc="lists.st" + $at_quiet $ECHO_N " 30: lists.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "30. testsuite.at:58: testing ..." + $at_traceon + + + + cat $abs_srcdir/lists.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:58: cd \$abs_srcdir && \$GST -r lists.st 2>&1" +echo testsuite.at:58 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r lists.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r lists.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r lists.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:58: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 31 ) # 31. testsuite.at:59: lists1.st + at_setup_line='testsuite.at:59' + at_desc="lists1.st" + $at_quiet $ECHO_N " 31: lists1.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "31. testsuite.at:59: testing ..." + $at_traceon + + + + cat $abs_srcdir/lists1.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:59: cd \$abs_srcdir && \$GST -r lists1.st 2>&1" +echo testsuite.at:59 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r lists1.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r lists1.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r lists1.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:59: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 32 ) # 32. testsuite.at:60: lists2.st + at_setup_line='testsuite.at:60' + at_desc="lists2.st" + $at_quiet $ECHO_N " 32: lists2.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "32. testsuite.at:60: testing ..." + $at_traceon + + + + cat $abs_srcdir/lists2.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:60: cd \$abs_srcdir && \$GST -r lists2.st 2>&1" +echo testsuite.at:60 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r lists2.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r lists2.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r lists2.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:60: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 33 ) # 33. testsuite.at:61: matrix.st + at_setup_line='testsuite.at:61' + at_desc="matrix.st" + $at_quiet $ECHO_N " 33: matrix.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "33. testsuite.at:61: testing ..." + $at_traceon + + + + cat $abs_srcdir/matrix.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:61: cd \$abs_srcdir && \$GST -r matrix.st 2>&1" +echo testsuite.at:61 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r matrix.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r matrix.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r matrix.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:61: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 34 ) # 34. testsuite.at:62: methcall.st + at_setup_line='testsuite.at:62' + at_desc="methcall.st" + $at_quiet $ECHO_N " 34: methcall.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "34. testsuite.at:62: testing ..." + $at_traceon + + + + cat $abs_srcdir/methcall.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:62: cd \$abs_srcdir && \$GST -r methcall.st 2>&1" +echo testsuite.at:62 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r methcall.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r methcall.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r methcall.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:62: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 35 ) # 35. testsuite.at:63: nestedloop.st + at_setup_line='testsuite.at:63' + at_desc="nestedloop.st" + $at_quiet $ECHO_N " 35: nestedloop.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "35. testsuite.at:63: testing ..." + $at_traceon + + + + cat $abs_srcdir/nestedloop.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:63: cd \$abs_srcdir && \$GST -r nestedloop.st 2>&1" +echo testsuite.at:63 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r nestedloop.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r nestedloop.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r nestedloop.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:63: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 36 ) # 36. testsuite.at:64: objinst.st + at_setup_line='testsuite.at:64' + at_desc="objinst.st" + $at_quiet $ECHO_N " 36: objinst.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "36. testsuite.at:64: testing ..." + $at_traceon + + + + cat $abs_srcdir/objinst.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:64: cd \$abs_srcdir && \$GST -r objinst.st 2>&1" +echo testsuite.at:64 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r objinst.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r objinst.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r objinst.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:64: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 37 ) # 37. testsuite.at:65: prodcons.st + at_setup_line='testsuite.at:65' + at_desc="prodcons.st" + $at_quiet $ECHO_N " 37: prodcons.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "37. testsuite.at:65: testing ..." + $at_traceon + + + + cat $abs_srcdir/prodcons.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:65: cd \$abs_srcdir && \$GST -r prodcons.st 2>&1" +echo testsuite.at:65 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r prodcons.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r prodcons.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r prodcons.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:65: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 38 ) # 38. testsuite.at:66: random-bench.st + at_setup_line='testsuite.at:66' + at_desc="random-bench.st" + $at_quiet $ECHO_N " 38: random-bench.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "38. testsuite.at:66: testing ..." + $at_traceon + + + + cat $abs_srcdir/random-bench.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:66: cd \$abs_srcdir && \$GST -r random-bench.st 2>&1" +echo testsuite.at:66 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r random-bench.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r random-bench.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r random-bench.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:66: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 39 ) # 39. testsuite.at:67: sieve.st + at_setup_line='testsuite.at:67' + at_desc="sieve.st" + $at_quiet $ECHO_N " 39: sieve.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "39. testsuite.at:67: testing ..." + $at_traceon + + + + cat $abs_srcdir/sieve.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:67: cd \$abs_srcdir && \$GST -r sieve.st 2>&1" +echo testsuite.at:67 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r sieve.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r sieve.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r sieve.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:67: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 40 ) # 40. testsuite.at:68: strcat.st + at_setup_line='testsuite.at:68' + at_desc="strcat.st" + $at_quiet $ECHO_N " 40: strcat.st $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "40. testsuite.at:68: testing ..." + $at_traceon + + + + cat $abs_srcdir/strcat.ok > expout + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:68: cd \$abs_srcdir && \$GST -r strcat.st 2>&1" +echo testsuite.at:68 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_srcdir && $GST -r strcat.st 2>&1" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_srcdir && $GST -r strcat.st 2>&1 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_srcdir && $GST -r strcat.st 2>&1 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +$at_diff expout "$at_stdout" || at_failed=: +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:68: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + + banner-3 ) # Banner 3. testsuite.at:70 + cat <<\_ATEOF + +Basic packages. + +_ATEOF + ;; + + 41 ) # 41. testsuite.at:71: SUnit + at_setup_line='testsuite.at:71' + at_desc="SUnit" + $at_quiet $ECHO_N " 41: SUnit $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "41. testsuite.at:71: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:71: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p SUnit" +echo testsuite.at:71 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p SUnit" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p SUnit ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p SUnit ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:71: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 42 ) # 42. testsuite.at:72: Parser + at_setup_line='testsuite.at:72' + at_desc="Parser" + $at_quiet $ECHO_N " 42: Parser $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "42. testsuite.at:72: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:72: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p Parser" +echo testsuite.at:72 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Parser" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Parser ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Parser ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:72: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + + banner-4 ) # Banner 4. testsuite.at:74 + cat <<\_ATEOF + +ANSI compliancy tests. + +_ATEOF + ;; + + 43 ) # 43. testsuite.at:75: ArrayANSITest + at_setup_line='testsuite.at:75' + at_desc="ArrayANSITest" + $at_quiet $ECHO_N " 43: ArrayANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "43. testsuite.at:75: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:75: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ArrayANSITest" +echo testsuite.at:75 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:75: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 44 ) # 44. testsuite.at:76: ArrayFactoryANSITest + at_setup_line='testsuite.at:76' + at_desc="ArrayFactoryANSITest" + $at_quiet $ECHO_N " 44: ArrayFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "44. testsuite.at:76: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:76: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ArrayFactoryANSITest" +echo testsuite.at:76 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ArrayFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:76: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 45 ) # 45. testsuite.at:77: BagANSITest + at_setup_line='testsuite.at:77' + at_desc="BagANSITest" + $at_quiet $ECHO_N " 45: BagANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "45. testsuite.at:77: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:77: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st BagANSITest" +echo testsuite.at:77 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:77: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 46 ) # 46. testsuite.at:78: BagFactoryANSITest + at_setup_line='testsuite.at:78' + at_desc="BagFactoryANSITest" + $at_quiet $ECHO_N " 46: BagFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "46. testsuite.at:78: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:78: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st BagFactoryANSITest" +echo testsuite.at:78 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BagFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:78: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 47 ) # 47. testsuite.at:79: BooleanANSITest + at_setup_line='testsuite.at:79' + at_desc="BooleanANSITest" + $at_quiet $ECHO_N " 47: BooleanANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "47. testsuite.at:79: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:79: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st BooleanANSITest" +echo testsuite.at:79 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BooleanANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BooleanANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st BooleanANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:79: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 48 ) # 48. testsuite.at:80: ByteArrayANSITest + at_setup_line='testsuite.at:80' + at_desc="ByteArrayANSITest" + $at_quiet $ECHO_N " 48: ByteArrayANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "48. testsuite.at:80: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:80: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ByteArrayANSITest" +echo testsuite.at:80 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:80: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 49 ) # 49. testsuite.at:81: ByteArrayFactoryANSITest + at_setup_line='testsuite.at:81' + at_desc="ByteArrayFactoryANSITest" + $at_quiet $ECHO_N " 49: ByteArrayFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "49. testsuite.at:81: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:81: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ByteArrayFactoryANSITest" +echo testsuite.at:81 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ByteArrayFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:81: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 50 ) # 50. testsuite.at:82: CharacterANSITest + at_setup_line='testsuite.at:82' + at_desc="CharacterANSITest" + $at_quiet $ECHO_N " 50: CharacterANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "50. testsuite.at:82: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:82: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st CharacterANSITest" +echo testsuite.at:82 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:82: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 51 ) # 51. testsuite.at:83: CharacterFactoryANSITest + at_setup_line='testsuite.at:83' + at_desc="CharacterFactoryANSITest" + $at_quiet $ECHO_N " 51: CharacterFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "51. testsuite.at:83: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:83: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st CharacterFactoryANSITest" +echo testsuite.at:83 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st CharacterFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:83: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 52 ) # 52. testsuite.at:84: DateAndTimeANSITest + at_setup_line='testsuite.at:84' + at_desc="DateAndTimeANSITest" + $at_quiet $ECHO_N " 52: DateAndTimeANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "52. testsuite.at:84: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:84: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DateAndTimeANSITest" +echo testsuite.at:84 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:84: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 53 ) # 53. testsuite.at:85: DateAndTimeFactoryANSITest + at_setup_line='testsuite.at:85' + at_desc="DateAndTimeFactoryANSITest" + $at_quiet $ECHO_N " 53: DateAndTimeFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "53. testsuite.at:85: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:85: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DateAndTimeFactoryANSITest" +echo testsuite.at:85 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DateAndTimeFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:85: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 54 ) # 54. testsuite.at:86: DictionaryANSITest + at_setup_line='testsuite.at:86' + at_desc="DictionaryANSITest" + $at_quiet $ECHO_N " 54: DictionaryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "54. testsuite.at:86: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:86: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DictionaryANSITest" +echo testsuite.at:86 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:86: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 55 ) # 55. testsuite.at:87: DictionaryFactoryANSITest + at_setup_line='testsuite.at:87' + at_desc="DictionaryFactoryANSITest" + $at_quiet $ECHO_N " 55: DictionaryFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "55. testsuite.at:87: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:87: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DictionaryFactoryANSITest" +echo testsuite.at:87 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DictionaryFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:87: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 56 ) # 56. testsuite.at:88: DurationANSITest + at_setup_line='testsuite.at:88' + at_desc="DurationANSITest" + $at_quiet $ECHO_N " 56: DurationANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "56. testsuite.at:88: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:88: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DurationANSITest" +echo testsuite.at:88 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:88: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 57 ) # 57. testsuite.at:89: DurationFactoryANSITest + at_setup_line='testsuite.at:89' + at_desc="DurationFactoryANSITest" + $at_quiet $ECHO_N " 57: DurationFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "57. testsuite.at:89: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:89: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DurationFactoryANSITest" +echo testsuite.at:89 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DurationFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:89: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 58 ) # 58. testsuite.at:90: DyadicValuableANSITest + at_setup_line='testsuite.at:90' + at_desc="DyadicValuableANSITest" + $at_quiet $ECHO_N " 58: DyadicValuableANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "58. testsuite.at:90: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:90: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st DyadicValuableANSITest" +echo testsuite.at:90 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DyadicValuableANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DyadicValuableANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st DyadicValuableANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:90: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 59 ) # 59. testsuite.at:91: ErrorANSITest + at_setup_line='testsuite.at:91' + at_desc="ErrorANSITest" + $at_quiet $ECHO_N " 59: ErrorANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "59. testsuite.at:91: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:91: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ErrorANSITest" +echo testsuite.at:91 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:91: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 60 ) # 60. testsuite.at:92: ErrorClassANSITest + at_setup_line='testsuite.at:92' + at_desc="ErrorClassANSITest" + $at_quiet $ECHO_N " 60: ErrorClassANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "60. testsuite.at:92: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:92: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ErrorClassANSITest" +echo testsuite.at:92 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorClassANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorClassANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ErrorClassANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:92: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 61 ) # 61. testsuite.at:93: ExceptionANSITest + at_setup_line='testsuite.at:93' + at_desc="ExceptionANSITest" + $at_quiet $ECHO_N " 61: ExceptionANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "61. testsuite.at:93: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:93: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ExceptionANSITest" +echo testsuite.at:93 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:93: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 62 ) # 62. testsuite.at:94: ExceptionClassANSITest + at_setup_line='testsuite.at:94' + at_desc="ExceptionClassANSITest" + $at_quiet $ECHO_N " 62: ExceptionClassANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "62. testsuite.at:94: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:94: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ExceptionClassANSITest" +echo testsuite.at:94 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionClassANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionClassANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionClassANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:94: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 63 ) # 63. testsuite.at:95: ExceptionSetANSITest + at_setup_line='testsuite.at:95' + at_desc="ExceptionSetANSITest" + $at_quiet $ECHO_N " 63: ExceptionSetANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "63. testsuite.at:95: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:95: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ExceptionSetANSITest" +echo testsuite.at:95 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionSetANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionSetANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ExceptionSetANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:95: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 64 ) # 64. testsuite.at:96: FailedMessageANSITest + at_setup_line='testsuite.at:96' + at_desc="FailedMessageANSITest" + $at_quiet $ECHO_N " 64: FailedMessageANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "64. testsuite.at:96: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:96: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FailedMessageANSITest" +echo testsuite.at:96 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FailedMessageANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FailedMessageANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FailedMessageANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:96: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 65 ) # 65. testsuite.at:97: FileStreamFactoryANSITest + at_setup_line='testsuite.at:97' + at_desc="FileStreamFactoryANSITest" + $at_quiet $ECHO_N " 65: FileStreamFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "65. testsuite.at:97: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:97: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FileStreamFactoryANSITest" +echo testsuite.at:97 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FileStreamFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FileStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FileStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:97: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 66 ) # 66. testsuite.at:98: FloatANSITest + at_setup_line='testsuite.at:98' + at_desc="FloatANSITest" + $at_quiet $ECHO_N " 66: FloatANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "66. testsuite.at:98: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:98: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FloatANSITest" +echo testsuite.at:98 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:98: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 67 ) # 67. testsuite.at:99: FloatCharacterizationANSITest + at_setup_line='testsuite.at:99' + at_desc="FloatCharacterizationANSITest" + $at_quiet $ECHO_N " 67: FloatCharacterizationANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "67. testsuite.at:99: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:99: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FloatCharacterizationANSITest" +echo testsuite.at:99 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatCharacterizationANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatCharacterizationANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FloatCharacterizationANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:99: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 68 ) # 68. testsuite.at:100: FractionANSITest + at_setup_line='testsuite.at:100' + at_desc="FractionANSITest" + $at_quiet $ECHO_N " 68: FractionANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "68. testsuite.at:100: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:100: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FractionANSITest" +echo testsuite.at:100 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:100: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 69 ) # 69. testsuite.at:101: FractionFactoryANSITest + at_setup_line='testsuite.at:101' + at_desc="FractionFactoryANSITest" + $at_quiet $ECHO_N " 69: FractionFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "69. testsuite.at:101: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:101: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st FractionFactoryANSITest" +echo testsuite.at:101 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st FractionFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:101: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 70 ) # 70. testsuite.at:102: IdentityDictionaryANSITest + at_setup_line='testsuite.at:102' + at_desc="IdentityDictionaryANSITest" + $at_quiet $ECHO_N " 70: IdentityDictionaryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "70. testsuite.at:102: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:102: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st IdentityDictionaryANSITest" +echo testsuite.at:102 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:102: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 71 ) # 71. testsuite.at:103: IdentityDictionaryFactoryANSITest + at_setup_line='testsuite.at:103' + at_desc="IdentityDictionaryFactoryANSITest" + $at_quiet $ECHO_N " 71: IdentityDictionaryFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "71. testsuite.at:103: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:103: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st IdentityDictionaryFactoryANSITest" +echo testsuite.at:103 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IdentityDictionaryFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:103: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 72 ) # 72. testsuite.at:104: IntegerANSITest + at_setup_line='testsuite.at:104' + at_desc="IntegerANSITest" + $at_quiet $ECHO_N " 72: IntegerANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "72. testsuite.at:104: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:104: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st IntegerANSITest" +echo testsuite.at:104 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntegerANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntegerANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntegerANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:104: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 73 ) # 73. testsuite.at:105: IntervalANSITest + at_setup_line='testsuite.at:105' + at_desc="IntervalANSITest" + $at_quiet $ECHO_N " 73: IntervalANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "73. testsuite.at:105: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:105: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st IntervalANSITest" +echo testsuite.at:105 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:105: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 74 ) # 74. testsuite.at:106: IntervalFactoryANSITest + at_setup_line='testsuite.at:106' + at_desc="IntervalFactoryANSITest" + $at_quiet $ECHO_N " 74: IntervalFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "74. testsuite.at:106: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:106: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st IntervalFactoryANSITest" +echo testsuite.at:106 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st IntervalFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:106: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 75 ) # 75. testsuite.at:107: MessageNotUnderstoodANSITest + at_setup_line='testsuite.at:107' + at_desc="MessageNotUnderstoodANSITest" + $at_quiet $ECHO_N " 75: MessageNotUnderstoodANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "75. testsuite.at:107: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:107: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st MessageNotUnderstoodANSITest" +echo testsuite.at:107 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:107: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 76 ) # 76. testsuite.at:108: MessageNotUnderstoodSelectorANSITest + at_setup_line='testsuite.at:108' + at_desc="MessageNotUnderstoodSelectorANSITest" + $at_quiet $ECHO_N " 76: MessageNotUnderstoodSelectorANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "76. testsuite.at:108: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:108: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st MessageNotUnderstoodSelectorANSITest" +echo testsuite.at:108 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodSelectorANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodSelectorANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MessageNotUnderstoodSelectorANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:108: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 77 ) # 77. testsuite.at:109: MonadicBlockANSITest + at_setup_line='testsuite.at:109' + at_desc="MonadicBlockANSITest" + $at_quiet $ECHO_N " 77: MonadicBlockANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "77. testsuite.at:109: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:109: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st MonadicBlockANSITest" +echo testsuite.at:109 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MonadicBlockANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MonadicBlockANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st MonadicBlockANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:109: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 78 ) # 78. testsuite.at:110: NilANSITest + at_setup_line='testsuite.at:110' + at_desc="NilANSITest" + $at_quiet $ECHO_N " 78: NilANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "78. testsuite.at:110: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:110: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st NilANSITest" +echo testsuite.at:110 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NilANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NilANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NilANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:110: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 79 ) # 79. testsuite.at:111: NiladicBlockANSITest + at_setup_line='testsuite.at:111' + at_desc="NiladicBlockANSITest" + $at_quiet $ECHO_N " 79: NiladicBlockANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "79. testsuite.at:111: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:111: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st NiladicBlockANSITest" +echo testsuite.at:111 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NiladicBlockANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NiladicBlockANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NiladicBlockANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:111: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 80 ) # 80. testsuite.at:112: NotificationANSITest + at_setup_line='testsuite.at:112' + at_desc="NotificationANSITest" + $at_quiet $ECHO_N " 80: NotificationANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "80. testsuite.at:112: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:112: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st NotificationANSITest" +echo testsuite.at:112 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:112: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 81 ) # 81. testsuite.at:113: NotificationClassANSITest + at_setup_line='testsuite.at:113' + at_desc="NotificationClassANSITest" + $at_quiet $ECHO_N " 81: NotificationClassANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "81. testsuite.at:113: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:113: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st NotificationClassANSITest" +echo testsuite.at:113 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationClassANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationClassANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st NotificationClassANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:113: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 82 ) # 82. testsuite.at:114: ObjectANSITest + at_setup_line='testsuite.at:114' + at_desc="ObjectANSITest" + $at_quiet $ECHO_N " 82: ObjectANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "82. testsuite.at:114: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:114: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ObjectANSITest" +echo testsuite.at:114 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:114: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 83 ) # 83. testsuite.at:115: ObjectClassANSITest + at_setup_line='testsuite.at:115' + at_desc="ObjectClassANSITest" + $at_quiet $ECHO_N " 83: ObjectClassANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "83. testsuite.at:115: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:115: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ObjectClassANSITest" +echo testsuite.at:115 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectClassANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectClassANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ObjectClassANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:115: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 84 ) # 84. testsuite.at:116: OrderedCollectionANSITest + at_setup_line='testsuite.at:116' + at_desc="OrderedCollectionANSITest" + $at_quiet $ECHO_N " 84: OrderedCollectionANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "84. testsuite.at:116: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:116: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st OrderedCollectionANSITest" +echo testsuite.at:116 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:116: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 85 ) # 85. testsuite.at:117: OrderedCollectionFactoryANSITest + at_setup_line='testsuite.at:117' + at_desc="OrderedCollectionFactoryANSITest" + $at_quiet $ECHO_N " 85: OrderedCollectionFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "85. testsuite.at:117: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:117: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st OrderedCollectionFactoryANSITest" +echo testsuite.at:117 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st OrderedCollectionFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:117: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 86 ) # 86. testsuite.at:118: ReadFileStreamANSITest + at_setup_line='testsuite.at:118' + at_desc="ReadFileStreamANSITest" + $at_quiet $ECHO_N " 86: ReadFileStreamANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "86. testsuite.at:118: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:118: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ReadFileStreamANSITest" +echo testsuite.at:118 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadFileStreamANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadFileStreamANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadFileStreamANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:118: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 87 ) # 87. testsuite.at:119: ReadStreamANSITest + at_setup_line='testsuite.at:119' + at_desc="ReadStreamANSITest" + $at_quiet $ECHO_N " 87: ReadStreamANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "87. testsuite.at:119: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:119: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ReadStreamANSITest" +echo testsuite.at:119 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:119: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 88 ) # 88. testsuite.at:120: ReadStreamFactoryANSITest + at_setup_line='testsuite.at:120' + at_desc="ReadStreamFactoryANSITest" + $at_quiet $ECHO_N " 88: ReadStreamFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "88. testsuite.at:120: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:120: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ReadStreamFactoryANSITest" +echo testsuite.at:120 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:120: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 89 ) # 89. testsuite.at:121: ReadWriteStreamANSITest + at_setup_line='testsuite.at:121' + at_desc="ReadWriteStreamANSITest" + $at_quiet $ECHO_N " 89: ReadWriteStreamANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "89. testsuite.at:121: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:121: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ReadWriteStreamANSITest" +echo testsuite.at:121 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:121: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 90 ) # 90. testsuite.at:122: ReadWriteStreamFactoryANSITest + at_setup_line='testsuite.at:122' + at_desc="ReadWriteStreamFactoryANSITest" + $at_quiet $ECHO_N " 90: ReadWriteStreamFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "90. testsuite.at:122: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:122: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ReadWriteStreamFactoryANSITest" +echo testsuite.at:122 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ReadWriteStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:122: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 91 ) # 91. testsuite.at:123: ScaledDecimalANSITest + at_setup_line='testsuite.at:123' + at_desc="ScaledDecimalANSITest" + $at_quiet $ECHO_N " 91: ScaledDecimalANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "91. testsuite.at:123: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:123: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ScaledDecimalANSITest" +echo testsuite.at:123 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ScaledDecimalANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ScaledDecimalANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ScaledDecimalANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:123: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 92 ) # 92. testsuite.at:124: SelectorANSITest + at_setup_line='testsuite.at:124' + at_desc="SelectorANSITest" + $at_quiet $ECHO_N " 92: SelectorANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "92. testsuite.at:124: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:124: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SelectorANSITest" +echo testsuite.at:124 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SelectorANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SelectorANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SelectorANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:124: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 93 ) # 93. testsuite.at:125: SetANSITest + at_setup_line='testsuite.at:125' + at_desc="SetANSITest" + $at_quiet $ECHO_N " 93: SetANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "93. testsuite.at:125: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:125: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SetANSITest" +echo testsuite.at:125 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:125: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 94 ) # 94. testsuite.at:126: SetFactoryANSITest + at_setup_line='testsuite.at:126' + at_desc="SetFactoryANSITest" + $at_quiet $ECHO_N " 94: SetFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "94. testsuite.at:126: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:126: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SetFactoryANSITest" +echo testsuite.at:126 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SetFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:126: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 95 ) # 95. testsuite.at:127: SortedCollectionANSITest + at_setup_line='testsuite.at:127' + at_desc="SortedCollectionANSITest" + $at_quiet $ECHO_N " 95: SortedCollectionANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "95. testsuite.at:127: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:127: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SortedCollectionANSITest" +echo testsuite.at:127 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:127: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 96 ) # 96. testsuite.at:128: SortedCollectionFactoryANSITest + at_setup_line='testsuite.at:128' + at_desc="SortedCollectionFactoryANSITest" + $at_quiet $ECHO_N " 96: SortedCollectionFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "96. testsuite.at:128: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:128: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SortedCollectionFactoryANSITest" +echo testsuite.at:128 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SortedCollectionFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:128: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 97 ) # 97. testsuite.at:129: StringANSITest + at_setup_line='testsuite.at:129' + at_desc="StringANSITest" + $at_quiet $ECHO_N " 97: StringANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "97. testsuite.at:129: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:129: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st StringANSITest" +echo testsuite.at:129 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:129: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 98 ) # 98. testsuite.at:130: StringFactoryANSITest + at_setup_line='testsuite.at:130' + at_desc="StringFactoryANSITest" + $at_quiet $ECHO_N " 98: StringFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "98. testsuite.at:130: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:130: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st StringFactoryANSITest" +echo testsuite.at:130 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st StringFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:130: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 99 ) # 99. testsuite.at:131: SymbolANSITest + at_setup_line='testsuite.at:131' + at_desc="SymbolANSITest" + $at_quiet $ECHO_N " 99: SymbolANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "99. testsuite.at:131: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:131: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st SymbolANSITest" +echo testsuite.at:131 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SymbolANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SymbolANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st SymbolANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:131: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 100 ) # 100. testsuite.at:132: TranscriptANSITest + at_setup_line='testsuite.at:132' + at_desc="TranscriptANSITest" + $at_quiet $ECHO_N "100: TranscriptANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "100. testsuite.at:132: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:132: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st TranscriptANSITest" +echo testsuite.at:132 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st TranscriptANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st TranscriptANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st TranscriptANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:132: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 101 ) # 101. testsuite.at:133: WarningANSITest + at_setup_line='testsuite.at:133' + at_desc="WarningANSITest" + $at_quiet $ECHO_N "101: WarningANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "101. testsuite.at:133: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:133: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st WarningANSITest" +echo testsuite.at:133 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:133: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 102 ) # 102. testsuite.at:134: WarningClassANSITest + at_setup_line='testsuite.at:134' + at_desc="WarningClassANSITest" + $at_quiet $ECHO_N "102: WarningClassANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "102. testsuite.at:134: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:134: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st WarningClassANSITest" +echo testsuite.at:134 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningClassANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningClassANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WarningClassANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:134: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 103 ) # 103. testsuite.at:135: WriteFileStreamANSITest + at_setup_line='testsuite.at:135' + at_desc="WriteFileStreamANSITest" + $at_quiet $ECHO_N "103: WriteFileStreamANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "103. testsuite.at:135: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:135: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st WriteFileStreamANSITest" +echo testsuite.at:135 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteFileStreamANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteFileStreamANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteFileStreamANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:135: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 104 ) # 104. testsuite.at:136: WriteStreamANSITest + at_setup_line='testsuite.at:136' + at_desc="WriteStreamANSITest" + $at_quiet $ECHO_N "104: WriteStreamANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "104. testsuite.at:136: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:136: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st WriteStreamANSITest" +echo testsuite.at:136 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:136: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 105 ) # 105. testsuite.at:137: WriteStreamFactoryANSITest + at_setup_line='testsuite.at:137' + at_desc="WriteStreamFactoryANSITest" + $at_quiet $ECHO_N "105: WriteStreamFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "105. testsuite.at:137: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:137: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st WriteStreamFactoryANSITest" +echo testsuite.at:137 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st WriteStreamFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:137: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 106 ) # 106. testsuite.at:138: ZeroDivideANSITest + at_setup_line='testsuite.at:138' + at_desc="ZeroDivideANSITest" + $at_quiet $ECHO_N "106: ZeroDivideANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "106. testsuite.at:138: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:138: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ZeroDivideANSITest" +echo testsuite.at:138 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:138: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 107 ) # 107. testsuite.at:139: ZeroDivideFactoryANSITest + at_setup_line='testsuite.at:139' + at_desc="ZeroDivideFactoryANSITest" + $at_quiet $ECHO_N "107: ZeroDivideFactoryANSITest $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "107. testsuite.at:139: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst -I $abs_builddir/gst.im" ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:139: cd \$abs_top_builddir && \$GST -f \$abs_srcdir/AnsiRun.st ZeroDivideFactoryANSITest" +echo testsuite.at:139 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideFactoryANSITest" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideFactoryANSITest ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_srcdir/AnsiRun.st ZeroDivideFactoryANSITest ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:139: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + + banner-5 ) # Banner 5. testsuite.at:141 + cat <<\_ATEOF + +Other packages. + +_ATEOF + ;; + + 108 ) # 108. testsuite.at:142: Continuations + at_setup_line='testsuite.at:142' + at_desc="Continuations" + $at_quiet $ECHO_N "108: Continuations $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "108. testsuite.at:142: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:142: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p Continuations" +echo testsuite.at:142 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Continuations" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Continuations ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p Continuations ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:142: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 109 ) # 109. testsuite.at:143: DhbNumericalMethods + at_setup_line='testsuite.at:143' + at_desc="DhbNumericalMethods" + $at_quiet $ECHO_N "109: DhbNumericalMethods $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "109. testsuite.at:143: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:143: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p DhbNumericalMethods" +echo testsuite.at:143 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p DhbNumericalMethods" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p DhbNumericalMethods ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p DhbNumericalMethods ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:143: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 110 ) # 110. testsuite.at:144: GDBM + at_setup_line='testsuite.at:144' + at_desc="GDBM" + $at_quiet $ECHO_N "110: GDBM $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "110. testsuite.at:144: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:144: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p GDBM + ret=\$? + case \$ret in + 2) exit 77 ;; + 0|1) exit \$ret ;; + esac" +echo testsuite.at:144 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + echo 'Not enabling shell tracing (command contains an embedded newline)' +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p GDBM + ret=$? + case $ret in + 2) exit 77 ;; + 0|1) exit $ret ;; + esac ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p GDBM + ret=$? + case $ret in + 2) exit 77 ;; + 0|1) exit $ret ;; + esac ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:144: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 111 ) # 111. testsuite.at:145: MD5 + at_setup_line='testsuite.at:145' + at_desc="MD5" + $at_quiet $ECHO_N "111: MD5 $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "111. testsuite.at:145: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:145: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p MD5" +echo testsuite.at:145 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + case "cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p MD5" in + *' +'*) echo 'Not enabling shell tracing (command contains an embedded newline)' ;; + *) at_trace_this=yes ;; + esac +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p MD5 ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p MD5 ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:145: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + 112 ) # 112. testsuite.at:146: ZLib + at_setup_line='testsuite.at:146' + at_desc="ZLib" + $at_quiet $ECHO_N "112: ZLib $ECHO_C" + at_xfail=no + echo "# -*- compilation -*-" >> "$at_group_log" + ( + echo "112. testsuite.at:146: testing ..." + $at_traceon + + + + + case $AUTOTEST_PATH in + tests) GST="$abs_top_builddir/gst -I $abs_top_builddir/gst.im" ;; + *) GST="$AUTOTEST_PATH/gst " ;; + esac + + $at_traceoff +echo "$at_srcdir/testsuite.at:146: cd \$abs_top_builddir && \$GST -f \$abs_top_srcdir/scripts/Test.st -p ZLib + ret=\$? + case \$ret in + 2) exit 77 ;; + 0|1) exit \$ret ;; + esac" +echo testsuite.at:146 >"$at_check_line_file" + +at_trace_this= +if test -n "$at_traceon"; then + echo 'Not enabling shell tracing (command contains an embedded newline)' +fi + +if test -n "$at_trace_this"; then + ( $at_traceon; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p ZLib + ret=$? + case $ret in + 2) exit 77 ;; + 0|1) exit $ret ;; + esac ) >"$at_stdout" 2>"$at_stder1" + at_status=$? + grep '^ *+' "$at_stder1" >&2 + grep -v '^ *+' "$at_stder1" >"$at_stderr" +else + ( :; cd $abs_top_builddir && $GST -f $abs_top_srcdir/scripts/Test.st -p ZLib + ret=$? + case $ret in + 2) exit 77 ;; + 0|1) exit $ret ;; + esac ) >"$at_stdout" 2>"$at_stderr" + at_status=$? +fi + +at_failed=false +$at_diff "$at_devnull" "$at_stderr" || at_failed=: +echo stdout:; cat "$at_stdout" +case $at_status in + 77) echo 77 > "$at_status_file"; exit 77;; + 0) ;; + *) echo "$at_srcdir/testsuite.at:146: exit code was $at_status, expected 0" + at_failed=:;; +esac +if $at_failed; then + + + echo 1 > "$at_status_file" + exit 1 +fi + +$at_traceon + + + $at_traceoff + $at_times_p && times >"$at_times_file" + ) 5>&1 2>&1 | eval $at_tee_pipe + at_status=`cat "$at_status_file"` + ;; + + + * ) + echo "$as_me: no such test group: $at_group" >&2 + continue + ;; + esac + + # Be sure to come back to the suite directory, in particular + # since below we might `rm' the group directory we are in currently. + cd "$at_suite_dir" + + case $at_group in + banner-*) ;; + *) + if test ! -f "$at_check_line_file"; then + sed "s/^ */$as_me: warning: /" <<_ATEOF + A failure happened in a test group before any test could be + run. This means that test suite is improperly designed. Please + report this failure to . +_ATEOF + echo "$at_setup_line" >"$at_check_line_file" + fi + at_group_count=`expr 1 + $at_group_count` + $at_verbose $ECHO_N "$at_group. $at_setup_line: $ECHO_C" + echo $ECHO_N "$at_group. $at_setup_line: $ECHO_C" >> "$at_group_log" + case $at_xfail:$at_status in + yes:0) + at_msg="UNEXPECTED PASS" + at_xpass_list="$at_xpass_list $at_group" + at_errexit=$at_errexit_p + ;; + no:0) + at_msg="ok" + at_pass_list="$at_pass_list $at_group" + at_errexit=false + ;; + *:77) + at_msg='skipped ('`cat "$at_check_line_file"`')' + at_skip_list="$at_skip_list $at_group" + at_errexit=false + ;; + yes:*) + at_msg='expected failure ('`cat "$at_check_line_file"`')' + at_xfail_list="$at_xfail_list $at_group" + at_errexit=false + ;; + no:*) + at_msg='FAILED ('`cat "$at_check_line_file"`')' + at_fail_list="$at_fail_list $at_group" + at_errexit=$at_errexit_p + ;; + esac + # Make sure there is a separator even with long titles. + echo " $at_msg" + at_log_msg="$at_group. $at_desc ($at_setup_line): $at_msg" + case $at_status in + 0|77) + # $at_times_file is only available if the group succeeded. + # We're not including the group log, so the success message + # is written in the global log separately. But we also + # write to the group log in case they're using -d. + if test -f "$at_times_file"; then + at_log_msg="$at_log_msg ("`sed 1d "$at_times_file"`')' + rm -f "$at_times_file" + fi + echo "$at_log_msg" >> "$at_group_log" + echo "$at_log_msg" >&5 + + # Cleanup the group directory, unless the user wants the files. + if $at_debug_p ; then + { + echo "#! /bin/sh" + echo 'test "${ZSH_VERSION+set}" = set && alias -g '\''${1+"$@"}'\''='\''"$@"'\''' + echo "cd '$at_dir'" + echo 'exec ${CONFIG_SHELL-'"$SHELL"'}' "$0" \ + '-v -d' "$at_debug_args" "$at_group" '${1+"$@"}' + echo 'exit 1' + } >$at_group_dir/run + chmod +x $at_group_dir/run + + elif test -d "$at_group_dir"; then + find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; + rm -fr "$at_group_dir" + fi + ;; + *) + # Upon failure, include the log into the testsuite's global + # log. The failure message is written in the group log. It + # is later included in the global log. + echo "$at_log_msg" >> "$at_group_log" + + # Upon failure, keep the group directory for autopsy, and + # create the debugging script. + { + echo "#! /bin/sh" + echo 'test "${ZSH_VERSION+set}" = set && alias -g '\''${1+"$@"}'\''='\''"$@"'\''' + echo "cd '$at_dir'" + echo 'exec ${CONFIG_SHELL-'"$SHELL"'}' "$0" \ + '-v -d' "$at_debug_args" "$at_group" '${1+"$@"}' + echo 'exit 1' + } >$at_group_dir/run + chmod +x $at_group_dir/run + + $at_errexit && break + ;; + esac + ;; + esac +done + +# Back to the top directory. +cd "$at_dir" + +# Compute the duration of the suite. +at_stop_date=`date` +at_stop_time=`date +%s 2>/dev/null` +echo "$as_me: ending at: $at_stop_date" >&5 +case $at_start_time,$at_stop_time in + [0-9]*,[0-9]*) + at_duration_s=`expr $at_stop_time - $at_start_time` + at_duration_m=`expr $at_duration_s / 60` + at_duration_h=`expr $at_duration_m / 60` + at_duration_s=`expr $at_duration_s % 60` + at_duration_m=`expr $at_duration_m % 60` + at_duration="${at_duration_h}h ${at_duration_m}m ${at_duration_s}s" + echo "$as_me: test suite duration: $at_duration" >&5 + ;; +esac + +# Wrap up the test suite with summary statistics. +at_skip_count=`set dummy $at_skip_list; shift; echo $#` +at_fail_count=`set dummy $at_fail_list; shift; echo $#` +at_xpass_count=`set dummy $at_xpass_list; shift; echo $#` +at_xfail_count=`set dummy $at_xfail_list; shift; echo $#` + +at_run_count=`expr $at_group_count - $at_skip_count` +at_unexpected_count=`expr $at_xpass_count + $at_fail_count` +at_total_fail_count=`expr $at_xfail_count + $at_fail_count` + +echo +cat <<\_ASBOX +## ------------- ## +## Test results. ## +## ------------- ## +_ASBOX +echo +{ + echo + cat <<\_ASBOX +## ------------- ## +## Test results. ## +## ------------- ## +_ASBOX + echo +} >&5 + +if test $at_run_count = 1; then + at_result="1 test" + at_were=was +else + at_result="$at_run_count tests" + at_were=were +fi +if $at_errexit_p && test $at_unexpected_count != 0; then + if test $at_xpass_count = 1; then + at_result="$at_result $at_were run, one passed" + else + at_result="$at_result $at_were run, one failed" + fi + at_result="$at_result unexpectedly and inhibited subsequent tests." +else + # Don't you just love exponential explosion of the number of cases? + case $at_xpass_count:$at_fail_count:$at_xfail_count in + # So far, so good. + 0:0:0) at_result="$at_result $at_were successful." ;; + 0:0:*) at_result="$at_result behaved as expected." ;; + + # Some unexpected failures + 0:*:0) at_result="$at_result $at_were run, +$at_fail_count failed unexpectedly." ;; + + # Some failures, both expected and unexpected + 0:*:1) at_result="$at_result $at_were run, +$at_total_fail_count failed ($at_xfail_count expected failure)." ;; + 0:*:*) at_result="$at_result $at_were run, +$at_total_fail_count failed ($at_xfail_count expected failures)." ;; + + # No unexpected failures, but some xpasses + *:0:*) at_result="$at_result $at_were run, +$at_xpass_count passed unexpectedly." ;; + + # No expected failures, but failures and xpasses + *:1:0) at_result="$at_result $at_were run, +$at_unexpected_count did not behave as expected ($at_fail_count unexpected failure)." ;; + *:*:0) at_result="$at_result $at_were run, +$at_unexpected_count did not behave as expected ($at_fail_count unexpected failures)." ;; + + # All of them. + *:*:1) at_result="$at_result $at_were run, +$at_xpass_count passed unexpectedly, +$at_total_fail_count failed ($at_xfail_count expected failure)." ;; + *:*:*) at_result="$at_result $at_were run, +$at_xpass_count passed unexpectedly, +$at_total_fail_count failed ($at_xfail_count expected failures)." ;; + esac + + if test $at_skip_count = 0 && test $at_run_count -gt 1; then + at_result="All $at_result" + fi +fi + +# Now put skips in the mix. +case $at_skip_count in + 0) ;; + 1) at_result="$at_result +1 test was skipped." ;; + *) at_result="$at_result +$at_skip_count tests were skipped." ;; +esac + +if test $at_unexpected_count = 0; then + echo "$at_result" + echo "$at_result" >&5 +else + echo "ERROR: $at_result" >&2 + echo "ERROR: $at_result" >&5 + { + echo + cat <<\_ASBOX +## ------------------------ ## +## Summary of the failures. ## +## ------------------------ ## +_ASBOX + + # Summary of failed and skipped tests. + if test $at_fail_count != 0; then + echo "Failed tests:" + $SHELL "$0" $at_fail_list --list + echo + fi + if test $at_skip_count != 0; then + echo "Skipped tests:" + $SHELL "$0" $at_skip_list --list + echo + fi + if test $at_xpass_count != 0; then + echo "Unexpected passes:" + $SHELL "$0" $at_xpass_list --list + echo + fi + if test $at_fail_count != 0; then + cat <<\_ASBOX +## ---------------------- ## +## Detailed failed tests. ## +## ---------------------- ## +_ASBOX + echo + for at_group in $at_fail_list + do + at_group_normalized=$at_group + + while :; do + case $at_group_normalized in #( + $at_format*) break;; + esac + at_group_normalized=0$at_group_normalized + done + + cat "$at_suite_dir/$at_group_normalized/$as_me.log" + echo + done + echo + fi + if test -n "$at_top_srcdir"; then + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## ${at_top_build_prefix}config.log ## +_ASBOX + sed 's/^/| /' ${at_top_build_prefix}config.log + echo + fi + } >&5 + + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## $as_me.log was created. ## +_ASBOX + + echo + echo "Please send \`${at_testdir+${at_testdir}/}$as_me.log' and all information you think might help:" + echo + echo " To: " + echo " Subject: [GNU Smalltalk 2.3.4] $as_me:$at_fail_list${at_fail_list:+ failed${at_xpass_list:+,}}$at_xpass_list${at_xpass_list:+ passed unexpectedly}" + echo + if test $at_debug_p = false; then + echo + echo 'You may investigate any problem if you feel able to do so, in which' + echo 'case the test suite provides a good starting point. Its output may' + echo "be found below \`${at_testdir+${at_testdir}/}$as_me.dir'." + echo + fi + exit 1 +fi + +exit 0 + + + diff -rNu smalltalk-2.3.3/tests/testsuite.at smalltalk-2.3.4/tests/testsuite.at --- smalltalk-2.3.3/tests/testsuite.at 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/tests/testsuite.at 2007-05-25 11:46:23.000000000 +0200 @@ -0,0 +1,146 @@ +## Autotest testsuite for GNU Smalltalk. + +# Copyright (C) 2007 Free Software Foundation, Inc. +# +# This program 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. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +m4_include([package.m4]) +m4_include([local.at]) + +AT_INIT +AT_TESTED(../gst) + +AT_BANNER([Regression tests.]) +AT_DIFF_TEST([arrays.st]) +AT_DIFF_TEST([classes.st]) +AT_DIFF_TEST([blocks.st]) +AT_DIFF_TEST([sets.st]) +AT_DIFF_TEST([processes.st]) +AT_DIFF_TEST([exceptions.st]) +AT_DIFF_TEST([intmath.st]) +AT_DIFF_TEST([floatmath.st]) +AT_DIFF_TEST([dates.st]) +AT_DIFF_TEST([objects.st]) +AT_DIFF_TEST([strings.st]) +AT_DIFF_TEST([chars.st]) +AT_DIFF_TEST([objdump.st]) +AT_DIFF_TEST([delays.st]) +AT_DIFF_TEST([geometry.st]) +AT_DIFF_TEST([cobjects.st]) +AT_DIFF_TEST([compiler.st]) +AT_DIFF_TEST([fileext.st]) +AT_DIFF_TEST([mutate.st]) +AT_DIFF_TEST([untrusted.st]) +AT_DIFF_TEST([getopt.st]) +AT_DIFF_TEST([quit.st]) + +AT_BANNER([Other simple tests.]) +AT_DIFF_TEST([ackermann.st]) +AT_DIFF_TEST([ary3.st]) +AT_DIFF_TEST([except.st]) +AT_DIFF_TEST([fibo.st]) +AT_DIFF_TEST([hash.st]) +AT_DIFF_TEST([hash2.st]) +AT_DIFF_TEST([heapsort.st]) +AT_DIFF_TEST([lists.st]) +AT_DIFF_TEST([lists1.st]) +AT_DIFF_TEST([lists2.st]) +AT_DIFF_TEST([matrix.st]) +AT_DIFF_TEST([methcall.st]) +AT_DIFF_TEST([nestedloop.st]) +AT_DIFF_TEST([objinst.st]) +AT_DIFF_TEST([prodcons.st]) +AT_DIFF_TEST([random-bench.st]) +AT_DIFF_TEST([sieve.st]) +AT_DIFF_TEST([strcat.st]) + +AT_BANNER([Basic packages.]) +AT_PACKAGE_TEST([SUnit]) +AT_PACKAGE_TEST([Parser]) + +AT_BANNER([ANSI compliancy tests.]) +AT_ANSI_TEST([ArrayANSITest]) +AT_ANSI_TEST([ArrayFactoryANSITest]) +AT_ANSI_TEST([BagANSITest]) +AT_ANSI_TEST([BagFactoryANSITest]) +AT_ANSI_TEST([BooleanANSITest]) +AT_ANSI_TEST([ByteArrayANSITest]) +AT_ANSI_TEST([ByteArrayFactoryANSITest]) +AT_ANSI_TEST([CharacterANSITest]) +AT_ANSI_TEST([CharacterFactoryANSITest]) +AT_ANSI_TEST([DateAndTimeANSITest]) +AT_ANSI_TEST([DateAndTimeFactoryANSITest]) +AT_ANSI_TEST([DictionaryANSITest]) +AT_ANSI_TEST([DictionaryFactoryANSITest]) +AT_ANSI_TEST([DurationANSITest]) +AT_ANSI_TEST([DurationFactoryANSITest]) +AT_ANSI_TEST([DyadicValuableANSITest]) +AT_ANSI_TEST([ErrorANSITest]) +AT_ANSI_TEST([ErrorClassANSITest]) +AT_ANSI_TEST([ExceptionANSITest]) +AT_ANSI_TEST([ExceptionClassANSITest]) +AT_ANSI_TEST([ExceptionSetANSITest]) +AT_ANSI_TEST([FailedMessageANSITest]) +AT_ANSI_TEST([FileStreamFactoryANSITest]) +AT_ANSI_TEST([FloatANSITest]) +AT_ANSI_TEST([FloatCharacterizationANSITest]) +AT_ANSI_TEST([FractionANSITest]) +AT_ANSI_TEST([FractionFactoryANSITest]) +AT_ANSI_TEST([IdentityDictionaryANSITest]) +AT_ANSI_TEST([IdentityDictionaryFactoryANSITest]) +AT_ANSI_TEST([IntegerANSITest]) +AT_ANSI_TEST([IntervalANSITest]) +AT_ANSI_TEST([IntervalFactoryANSITest]) +AT_ANSI_TEST([MessageNotUnderstoodANSITest]) +AT_ANSI_TEST([MessageNotUnderstoodSelectorANSITest]) +AT_ANSI_TEST([MonadicBlockANSITest]) +AT_ANSI_TEST([NilANSITest]) +AT_ANSI_TEST([NiladicBlockANSITest]) +AT_ANSI_TEST([NotificationANSITest]) +AT_ANSI_TEST([NotificationClassANSITest]) +AT_ANSI_TEST([ObjectANSITest]) +AT_ANSI_TEST([ObjectClassANSITest]) +AT_ANSI_TEST([OrderedCollectionANSITest]) +AT_ANSI_TEST([OrderedCollectionFactoryANSITest]) +AT_ANSI_TEST([ReadFileStreamANSITest]) +AT_ANSI_TEST([ReadStreamANSITest]) +AT_ANSI_TEST([ReadStreamFactoryANSITest]) +AT_ANSI_TEST([ReadWriteStreamANSITest]) +AT_ANSI_TEST([ReadWriteStreamFactoryANSITest]) +AT_ANSI_TEST([ScaledDecimalANSITest]) +AT_ANSI_TEST([SelectorANSITest]) +AT_ANSI_TEST([SetANSITest]) +AT_ANSI_TEST([SetFactoryANSITest]) +AT_ANSI_TEST([SortedCollectionANSITest]) +AT_ANSI_TEST([SortedCollectionFactoryANSITest]) +AT_ANSI_TEST([StringANSITest]) +AT_ANSI_TEST([StringFactoryANSITest]) +AT_ANSI_TEST([SymbolANSITest]) +AT_ANSI_TEST([TranscriptANSITest]) +AT_ANSI_TEST([WarningANSITest]) +AT_ANSI_TEST([WarningClassANSITest]) +AT_ANSI_TEST([WriteFileStreamANSITest]) +AT_ANSI_TEST([WriteStreamANSITest]) +AT_ANSI_TEST([WriteStreamFactoryANSITest]) +AT_ANSI_TEST([ZeroDivideANSITest]) +AT_ANSI_TEST([ZeroDivideFactoryANSITest]) + +AT_BANNER([Other packages.]) +AT_PACKAGE_TEST([Continuations]) +AT_PACKAGE_TEST([DhbNumericalMethods]) +AT_OPTIONAL_PACKAGE_TEST([GDBM]) +AT_PACKAGE_TEST([MD5]) +AT_OPTIONAL_PACKAGE_TEST([ZLib]) diff -rNu smalltalk-2.3.3/unsupported/echo.st smalltalk-2.3.4/unsupported/echo.st --- smalltalk-2.3.3/unsupported/echo.st 1970-01-01 01:00:00.000000000 +0100 +++ smalltalk-2.3.4/unsupported/echo.st 2006-02-05 19:41:43.000000000 +0100 @@ -0,0 +1,23 @@ +Object subclass: #EchoMain + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Language-Implementation'! + +!EchoMain class methodsFor: 'foo'! + +update: aspect + aspect == #returnFromSnapshot ifTrue: [ + Smalltalk arguments = #('--repl') ifFalse: [ + self main: Smalltalk arguments. + ObjectMemory quit ] ]! + +main: argv + "I love Java!" + argv + do: [ :a| Transcript nextPutAll: a] + separatedBy: [ Transcript nextPutAll: ' ']. + Transcript nl! ! + +ObjectMemory addDependent: EchoMain. +ObjectMemory snapshot: 'echo.im'!