--- a/Behavior.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Behavior.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#Behavior
- instanceVariableNames:'superclass flags methodDictionary lookupObject instSize'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames: 'superclass flags methodDictionary lookupObject instSize'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Classes'
!
!Behavior class methodsFor:'documentation'!
@@ -815,6 +815,48 @@
!Behavior class methodsFor:'helpers'!
+classesSortedByLoadOrder2:aCollectionOfClasses
+ "return a copy of the given collection of classes, which is sorted
+ by inheritance and superclass-of-any-private class.
+ This is the optimal order for loading, and the required order for compilation.
+
+ This is an alternate algorithm showing cycles"
+
+ |classes orderedTuples|
+
+ orderedTuples := OrderedCollection new:classes size.
+ aCollectionOfClasses do:[:eachClass|
+ |sharedPools|
+ orderedTuples add:(Array with:eachClass with:eachClass superclass).
+ sharedPools := eachClass sharedPools.
+ sharedPools notEmptyOrNil ifTrue:[
+ orderedTuples add:((OrderedCollection with:eachClass) addAll:sharedPools).
+ ].
+ eachClass allPrivateClasses do:[:eachPrivateClass| |superClassOwner|
+ superClassOwner := eachPrivateClass superclass.
+ "take care of classes inheriting from nil or ProtoObject"
+ superClassOwner isBehavior ifTrue:[
+ superClassOwner := superClassOwner owningClassOrYourself.
+ ].
+ orderedTuples add:(Array with:eachPrivateClass with:superClassOwner).
+ sharedPools := eachPrivateClass sharedPools.
+ sharedPools notEmptyOrNil ifTrue:[
+ orderedTuples add:((OrderedCollection with:eachPrivateClass) addAll:sharedPools).
+ ].
+ ].
+ ].
+
+ "I am only interested in my classes"
+ ^ orderedTuples topologicalSort intersect:aCollectionOfClasses.
+
+ "
+ Class classesSortedByLoadOrder:stx_libbasic compiled_classes_common
+ Class classesSortedByLoadOrder2:stx_libbasic compiled_classes_common
+ Class classesSortedByLoadOrder:stx_libjava compiled_classes_common
+ Class classesSortedByLoadOrder2:stx_libjava compiled_classes_common
+ "
+!
+
classesSortedByLoadOrder:someClasses
"return a copy of the given collection of classes, which is sorted
by inheritance and superclass-of-any-private class.
@@ -850,19 +892,23 @@
].
"second: the subset with all those having no private classes,
- or having private classes, whose superclasses are NOT in the remaining set"
+ or having private classes, whose superclasses are NOT in the remaining set,
+ or having private classes which do not use a shared pool in the remaining set"
thoseWhichCanBeLoadedNow :=
thoseWithOtherSuperclasses
reject:[:eachClass |
- eachClass allPrivateClasses contains:[:eachPrivateClass| |superClassesOwner|
+ eachClass allPrivateClasses contains:[:eachPrivateClass|
+ |superClassesOwner sharedPools|
superClassesOwner := eachPrivateClass superclass.
"take care of classes inheriting from nil or ProtoObject"
superClassesOwner isBehavior ifTrue:[
superClassesOwner := superClassesOwner owningClassOrYourself.
].
- superClassesOwner ~~ eachClass
- and:[remaining includes:superClassesOwner]
+ sharedPools := eachPrivateClass sharedPools.
+ (superClassesOwner ~~ eachClass
+ and:[remaining includes:superClassesOwner])
+ or:[remaining includesAny:sharedPools]
].
].
@@ -880,7 +926,7 @@
].
].
remaining removeAllFoundIn:thoseWhichCanBeLoadedNow.
- classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow asArray sort:[:a :b | a name < b name]).
+ classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow sort:[:a :b | a name < b name]).
].
^ classesInLoadOrder
@@ -888,6 +934,7 @@
Class classesSortedByLoadOrder:(Smalltalk allClassesInPackage:'stx:libbasic')
Class classesSortedByLoadOrder:(Smalltalk allClassesInPackage:'stx:libbasic3')
Class classesSortedByLoadOrder:(Smalltalk allClassesInPackage:'stx:libwidg')
+ Class classesSortedByLoadOrder:(Smalltalk allClassesInPackage:'stx:libjava')
"
"Created: / 14-09-2006 / 11:21:25 / cg"
@@ -4958,10 +5005,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.339 2013-04-17 20:24:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.339 2013-04-17 20:24:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
! !
--- a/Block.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Block.st Tue Apr 23 14:27:19 2013 +0100
@@ -519,8 +519,10 @@
!
ifError:handlerBlock
- "same as onError: - for squeak compatibility.
- Notice, that the handlerBlock may take 0,1 or 2 args.
+ "squeak compatibility:
+ Evaluate the recevier block and return its value, if no error occurs.
+ If an error is raised, return the value from handlerBlock.
+ The handlerBlock may take 0,1 or 2 args.
(1 arg -> the exception;
2 args -> the errorString and the erronous receiver)"
@@ -3117,11 +3119,11 @@
!Block class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.194 2013-04-15 14:44:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.195 2013-04-19 09:36:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.194 2013-04-15 14:44:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.195 2013-04-19 09:36:13 cg Exp $'
! !
--- a/Filename.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Filename.st Tue Apr 23 14:27:19 2013 +0100
@@ -2862,7 +2862,7 @@
[self renameTo:newName]
on:(OperatingSystem errorSignal)
do:[:ex |
- ex signal == OperatingSystem fileNotFoundErrorSignal ifTrue:[
+ ex creator == OperatingSystem fileNotFoundErrorSignal ifTrue:[
ex reject
].
self copyTo:newName.
@@ -5937,11 +5937,11 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.389 2013-04-01 00:55:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.390 2013-04-19 09:40:34 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.389 2013-04-01 00:55:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.390 2013-04-19 09:40:34 cg Exp $'
! !
--- a/GenericException.st Fri Apr 19 09:38:48 2013 +0200
+++ b/GenericException.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#GenericException
- instanceVariableNames:'signal parameter messageText suspendedContext raiseContext
+ instanceVariableNames: 'signal parameter messageText suspendedContext raiseContext
handlerContext rejected originator proceedable'
- classVariableNames:'StrictRaising'
- poolDictionaries:''
- category:'Kernel-Exceptions'
+ classVariableNames: 'StrictRaising'
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions'
!
GenericException class instanceVariableNames:'NotifierString'
@@ -169,6 +169,7 @@
"
! !
+
!GenericException class methodsFor:'initialization'!
initialize
@@ -179,6 +180,7 @@
"Modified: / 17-11-2010 / 17:53:13 / cg"
! !
+
!GenericException class methodsFor:'instance creation'!
new
@@ -200,18 +202,18 @@
! !
-
!GenericException class methodsFor:'Compatibility-Squeak'!
signal
"raise a signal proceedable or nonproceedable (whichever is right).
- The argument is used as messageText."
+ ANSI compatibility."
^ self raiseSignal
"Created: / 20-11-2006 / 14:00:09 / cg"
! !
+
!GenericException class methodsFor:'accessing'!
errorString
@@ -237,6 +239,7 @@
NotifierString := aString
! !
+
!GenericException class methodsFor:'backward compatibility'!
abortingEmergencyHandler
@@ -288,6 +291,7 @@
^ NoHandlerError notifyingEmergencyHandlerForUserProcesses
! !
+
!GenericException class methodsFor:'child signal creation'!
newSignal
@@ -321,6 +325,7 @@
"Created: / 23.7.1999 / 20:12:43 / stefan"
! !
+
!GenericException class methodsFor:'converting'!
, anExceptionHandler
@@ -329,6 +334,7 @@
^ SignalSet with:self with:anExceptionHandler
! !
+
!GenericException class methodsFor:'misc ui support'!
iconInBrowserSymbol
@@ -337,6 +343,7 @@
^ #exceptionClassBrowserIcon
! !
+
!GenericException class methodsFor:'printing'!
description
@@ -374,6 +381,7 @@
"Created: / 10-02-2011 / 12:28:51 / cg"
! !
+
!GenericException class methodsFor:'queries'!
accepts:aSignal
@@ -486,7 +494,7 @@
|signal|
- signal := anException signal.
+ signal := anException creator.
self == signal ifTrue:[^ true]. "quick check"
anException isNotification ifTrue:[^ false]. "speed up queries by not traversing the parent chain"
@@ -529,6 +537,7 @@
"Modified: / 23.7.1999 / 16:15:38 / stefan"
! !
+
!GenericException class methodsFor:'raising'!
raise
@@ -858,13 +867,16 @@
!
signalWith:messageText
- "ANSI compatibility"
+ "raise a signal proceedable or nonproceedable (whichever is right).
+ The argument is used as messageText.
+ ANSI compatibility."
<resource: #skipInDebuggersWalkBack>
self raiseErrorString:messageText
! !
+
!GenericException class methodsFor:'save evaluation'!
catch:aBlock
@@ -1051,6 +1063,7 @@
"Modified: / 07-12-2006 / 17:05:35 / cg"
! !
+
!GenericException class methodsFor:'testing'!
isControlInterrupt
@@ -1118,11 +1131,16 @@
^ self restartDo:alternativeBlock
!
-signalWith:messageText
- self messageText:messageText.
+signalWith:messageTextArg
+ "raise a signal proceedable or nonproceedable (whichever is right).
+ The argument is used as messageText.
+ ANSI compatibility."
+
+ self messageText:messageTextArg.
^ self raise
! !
+
!GenericException methodsFor:'Compatibility-Dolphin'!
stackTrace:numberOfFrames
@@ -1149,12 +1167,14 @@
"
! !
+
!GenericException methodsFor:'Compatibility-Squeak'!
signalerContext
^ self suspendedContext
! !
+
!GenericException methodsFor:'Compatibility-V''Age'!
exitWith:value
@@ -1163,6 +1183,7 @@
"Created: / 28-08-2010 / 14:43:23 / cg"
! !
+
!GenericException methodsFor:'accessing'!
catchInDebugger
@@ -1383,7 +1404,11 @@
!
signal
- "return the signal, that caused the exception"
+ "return the signal, that caused the exception.
+ Warning and notice: in ANSI, signal means: raise;
+ here and in old VW, it is the accessor to create.
+ This will change in the near future; please use #creator to get
+ the creator."
^ signal ? self class
@@ -1412,6 +1437,7 @@
"Modified: / 2.3.1998 / 12:20:43 / stefan"
! !
+
!GenericException methodsFor:'copying'!
postCopy
@@ -1430,6 +1456,7 @@
"Created: / 2.3.1998 / 12:30:06 / stefan"
! !
+
!GenericException methodsFor:'default actions'!
defaultAction
@@ -1499,6 +1526,7 @@
in:suspendedContext.
! !
+
!GenericException methodsFor:'default values'!
defaultResumeValue
@@ -1509,6 +1537,7 @@
^ nil
! !
+
!GenericException methodsFor:'handler actions'!
exit
@@ -1835,6 +1864,7 @@
self return:value
! !
+
!GenericException methodsFor:'printing & storing'!
description
@@ -1876,6 +1906,7 @@
aStream nextPutAll:self description
! !
+
!GenericException methodsFor:'private'!
checkProceedable
@@ -1981,7 +2012,7 @@
because it tries to raise e.g. AbortOperationRequest even if it has bee invoked
by e.g. NoHandlerError"
- (ex1 signal == signal) ifTrue:[
+ (ex1 creator == signal) ifTrue:[
"the same exception that has been cought by a default action is raised again.
don't recurse"
^ self noHandler.
@@ -2030,6 +2061,7 @@
"Modified: / 10-08-2010 / 09:26:14 / cg"
! !
+
!GenericException methodsFor:'raising'!
raise
@@ -2246,6 +2278,7 @@
"Created: / 10-08-2010 / 09:50:54 / cg"
! !
+
!GenericException methodsFor:'setup'!
setSignal:aSignal
@@ -2294,6 +2327,7 @@
originator := anOriginator.
! !
+
!GenericException methodsFor:'testing'!
isError
@@ -2310,14 +2344,15 @@
^ false
! !
+
!GenericException class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.136 2013-04-17 18:22:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.137 2013-04-19 09:41:15 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.136 2013-04-17 18:22:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.137 2013-04-19 09:41:15 cg Exp $'
!
version_HG
--- a/Method.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Method.st Tue Apr 23 14:27:19 2013 +0100
@@ -2689,7 +2689,9 @@
|myClass myProjectDefinition|
- myClass := self mclass theNonMetaclass.
+ myClass := self mclass.
+ myClass isNil ifTrue:[^ false].
+ myClass := myClass theNonMetaclass.
^ myClass notNil
and:[ package ~= myClass package
and:[ (myProjectDefinition := myClass projectDefinitionClass) notNil
@@ -3841,11 +3843,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.409 2013-04-14 12:37:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.410 2013-04-18 13:24:30 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.409 2013-04-14 12:37:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.410 2013-04-18 13:24:30 cg Exp $'
!
version_HG
--- a/MiniDebugger.st Fri Apr 19 09:38:48 2013 +0200
+++ b/MiniDebugger.st Tue Apr 23 14:27:19 2013 +0100
@@ -141,7 +141,7 @@
^ self
enter:ex returnableSuspendedContext
- withMessage:(ex signal name,': ',ex descriptionForDebugger)
+ withMessage:(ex creator name,': ',ex descriptionForDebugger)
mayProceed:(ex mayProceed).
!
@@ -955,10 +955,10 @@
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.83 2013-03-26 14:20:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.84 2013-04-19 09:40:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.83 2013-03-26 14:20:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.84 2013-04-19 09:40:36 cg Exp $'
! !
--- a/NoHandlerError.st Fri Apr 19 09:38:48 2013 +0200
+++ b/NoHandlerError.st Tue Apr 23 14:27:19 2013 +0100
@@ -160,7 +160,7 @@
(for example, segv in primitive code could show things
on the C-level ..)
"
- ex signal openDebuggerOnException:ex.
+ ex creator openDebuggerOnException:ex.
"if we arrive here, the debugger did proceed.
the value returned by #openDebuggerOnException: is the exceptions value ..."
@@ -254,8 +254,8 @@
^ [:ex |
|str printedException|
- ex signal == NoHandlerError ifTrue:[
- printedException := ex unhandledException.
+ ex creator == NoHandlerError ifTrue:[
+ printedException := ex exception.
] ifFalse:[
printedException := ex
].
@@ -264,7 +264,7 @@
"/ allow user to choose between proceeding or aborting
"/ but never dump that information to the file.
- printedException signal == Object userInterruptSignal ifTrue:[
+ printedException creator == Object userInterruptSignal ifTrue:[
(self confirm:'abort current action ?') ifTrue:[
AbortOperationRequest raise
].
@@ -282,7 +282,7 @@
str cr.
str nextPutLine:('** Error: ' , printedException description).
- str nextPutLine:('** Signal: ' , printedException signal printString).
+ str nextPutLine:('** Signal: ' , printedException creator printString).
str nextPutLine:('** Parameter: ' , printedException parameter printString).
str nextPutLine:('** Process: ' , Processor activeProcess printString).
str nextPutLine:('** Backtrace:').
@@ -329,8 +329,8 @@
^ [:ex |
|str printedException doMail emergencyMailReceiver pipe|
- ex signal == NoHandlerError ifTrue:[
- printedException := ex unhandledException.
+ ex creator == NoHandlerError ifTrue:[
+ printedException := ex exception.
] ifFalse:[
printedException := ex
].
@@ -339,7 +339,7 @@
"/ allow user to choose between proceeding or aborting
"/ but never dump that information to the file.
- printedException signal == UserInterrupt ifTrue:[
+ printedException creator == UserInterrupt ifTrue:[
(self confirm:'abort current action ?') ifTrue:[
AbortOperationRequest raise
].
@@ -372,7 +372,7 @@
str nextPutLine:('Time: ' , Timestamp now printString).
str nextPutLine:('Error: ', printedException description).
- str nextPutLine:('Signal: ', printedException signal printString).
+ str nextPutLine:('Signal: ', printedException creator printString).
str nextPutLine:('Parameter: ', printedException parameter printString).
str nextPutLine:('Process: ', Processor activeProcess printString).
str nextPutLine:'Backtrace:'.
@@ -421,9 +421,9 @@
message := ex descriptionForDebugger.
- (ex signal == NoHandlerError
- and:[(ControlInterrupt handles:ex unhandledException)
- and:[(ControlInterrupt ~~ ex unhandledException signal) ]]) ifTrue:[
+ (ex creator == NoHandlerError
+ and:[(ControlInterrupt handles:ex exception)
+ and:[(ControlInterrupt ~~ ex exception creator) ]]) ifTrue:[
"/ go directly into the debugger ...
^ Debugger
enter:ex returnableSuspendedContext
@@ -462,8 +462,8 @@
Processor activeProcessIsSystemProcess ifTrue:[
'EmergencyHandler [info]: exception cought: ' errorPrint.
- ex signal == NoHandlerError ifTrue:[
- theException := ex unhandledException.
+ ex creator == NoHandlerError ifTrue:[
+ theException := ex exception.
] ifFalse:[
theException := ex
].
@@ -472,9 +472,9 @@
] ifFalse:[
message := ex descriptionForDebugger.
- (ex signal == NoHandlerError
- and:[ (ControlInterrupt handles:ex unhandledException)
- and:[ (ControlInterrupt ~~ ex unhandledException signal) ]]) ifTrue:[
+ (ex creator == NoHandlerError
+ and:[ (ControlInterrupt handles:ex exception)
+ and:[ (ControlInterrupt ~~ ex exception creator) ]]) ifTrue:[
"/ go directly into the debugger ...
^ Debugger
enter:ex returnableSuspendedContext
@@ -503,14 +503,24 @@
!NoHandlerError methodsFor:'accessing'!
+exception
+ "the original exception, which was responsible for this.
+ ANSI compatibility"
+
+ ^ parameter
+!
+
originalSignal
"return the signal/exception which was originally raised.
- For noHandler, that is my unhandled signal; for others, thats the exception itself."
+ For noHandler, that is my unhandled signal; for others, that's the exception itself."
^ parameter originalSignal.
!
unhandledException
+ "the original exception, which was responsible for this.
+ Obsolete: use #exception for ANSI comatibility."
+
^ parameter
! !
@@ -567,11 +577,11 @@
!NoHandlerError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NoHandlerError.st,v 1.20 2013-03-26 14:20:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NoHandlerError.st,v 1.21 2013-04-19 08:39:04 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NoHandlerError.st,v 1.20 2013-03-26 14:20:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NoHandlerError.st,v 1.21 2013-04-19 08:39:04 cg Exp $'
! !
--- a/Notification.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Notification.st Tue Apr 23 14:27:19 2013 +0100
@@ -197,7 +197,7 @@
|signal|
- signal := anException signal.
+ signal := anException creator.
self == signal ifTrue:[^ true]. "quick check"
anException isNotification ifFalse:[^ false]. "speed up non-queries by not traversing the parent chain"
@@ -375,11 +375,11 @@
!Notification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.28 2013-03-25 13:57:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.29 2013-04-19 08:41:19 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.28 2013-03-25 13:57:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.29 2013-04-19 08:41:19 cg Exp $'
! !
--- a/Number.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Number.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
ArithmeticValue subclass:#Number
- instanceVariableNames:''
- classVariableNames:'DecimalPointCharacter DecimalPointCharacterForPrinting
+ instanceVariableNames: ''
+ classVariableNames: 'DecimalPointCharacter DecimalPointCharacterForPrinting
DecimalPointCharacters DecimalPointCharactersForReading'
- poolDictionaries:''
- category:'Magnitude-Numbers'
+ poolDictionaries: ''
+ category: 'Magnitude-Numbers'
!
!Number class methodsFor:'documentation'!
@@ -53,6 +53,7 @@
"
! !
+
!Number class methodsFor:'instance creation'!
fastFromString:aString
@@ -371,19 +372,26 @@
(character-) aStream.
Returns nil if aStream contains no valid number."
- ^ Scanner scanNumberFrom:aStream
-"/ ^ Compiler evaluate:aStream compile:false "/ self readFrom:aStream.
+ ^ [
+ Scanner scanNumberFrom:aStream.
+ ] on:Error do:[:ex|
+ nil
+ ].
"
Number readSmalltalkSyntaxFrom:'99d'
Number readSmalltalkSyntaxFrom:'99.00d'
- Number readSmalltalkSyntaxFrom:(ReadStream on:'54.32e-01')
- Number readSmalltalkSyntaxFrom:(ReadStream on:'12345678901234567890')
- Number readSmalltalkSyntaxFrom:(ReadStream on:'16rAAAAFFFFAAAAFFFF')
- Number readSmalltalkSyntaxFrom:(ReadStream on:'(1/10)')
- Number readFrom:(ReadStream on:'(1/10)')
- Number readSmalltalkSyntaxFrom:(ReadStream on:'+00000123.45')
- Number readFrom:(ReadStream on:'+00000123.45')
+ Number readSmalltalkSyntaxFrom:'54.32e-01'
+ Number readSmalltalkSyntaxFrom:'12345678901234567890'
+ Number readSmalltalkSyntaxFrom:'16rAAAAFFFFAAAAFFFF'
+ Number readSmalltalkSyntaxFrom:'(1/10)'
+
+ Number readSmalltalkSyntaxFrom:'(1/0)'
+
+ Number readFrom:'(1/3)'
+ Number readFrom:'(-1/3)'
+ Number readSmalltalkSyntaxFrom:'+00000123.45'
+ Number readFrom:'+00000123.45'
|s|
s := ReadStream on:'2.'.
@@ -544,6 +552,7 @@
^ self subclassResponsibility
! !
+
!Number class methodsFor:'error reporting'!
raise:aSignalSymbolOrErrorClass receiver:someNumber selector:sel arg:arg errorString:text
@@ -696,6 +705,7 @@
"Modified: / 14.4.1998 / 18:47:47 / cg"
! !
+
!Number class methodsFor:'queries'!
isAbstract
@@ -713,6 +723,7 @@
^(self - aNumber) abs < accuracy
! !
+
!Number methodsFor:'*grease-core'!
greaseInteger
@@ -886,6 +897,7 @@
"
! !
+
!Number methodsFor:'converting'!
% aNumber
@@ -1044,6 +1056,7 @@
"
! !
+
!Number methodsFor:'converting-times'!
days
@@ -1121,6 +1134,7 @@
"Created: / 05-09-2011 / 11:17:59 / cg"
! !
+
!Number methodsFor:'intervals'!
downTo:stop
@@ -1157,6 +1171,7 @@
"
! !
+
!Number methodsFor:'iteration'!
timesRepeat:aBlock
@@ -1171,6 +1186,7 @@
]
! !
+
!Number methodsFor:'mathematical functions'!
conjugated
@@ -1314,6 +1330,7 @@
"
! !
+
!Number methodsFor:'measurement values'!
maxValue
@@ -1330,6 +1347,7 @@
^ self
! !
+
!Number methodsFor:'printing & storing'!
printOn:aStream paddedWith:padCharacter to:size base:radix
@@ -1504,6 +1522,7 @@
^ self printString
! !
+
!Number methodsFor:'taylor series'!
arcSin_withAccuracy:epsilon
@@ -2037,6 +2056,7 @@
"
! !
+
!Number methodsFor:'testing'!
isDivisibleBy:aNumber
@@ -2085,6 +2105,7 @@
"Modified: 18.7.1996 / 12:40:49 / cg"
! !
+
!Number methodsFor:'tracing'!
traceInto:aRequestor level:level from:referrer
@@ -2095,6 +2116,7 @@
! !
+
!Number methodsFor:'trigonometric'!
arcCos
@@ -2249,6 +2271,7 @@
"/ ^ (exp - nexp) / (exp + nexp)
! !
+
!Number methodsFor:'truncation & rounding'!
detentBy: detent atMultiplesOf: grid snap: snap
@@ -2325,9 +2348,10 @@
!Number class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.137 2012/11/05 16:48:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.141 2013-04-19 15:07:39 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.137 2012/11/05 16:48:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.141 2013-04-19 15:07:39 stefan Exp $'
! !
+
--- a/Object.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Object.st Tue Apr 23 14:27:19 2013 +0100
@@ -681,7 +681,6 @@
"
! !
-
!Object methodsFor:'accessing'!
_at:index
@@ -4407,13 +4406,13 @@
].
Smalltalk isStandAloneApp ifTrue:[
- (ex signal == NoHandlerError and:[HaltInterrupt handles:ex unhandledException]) ifTrue:[
+ (ex creator == NoHandlerError and:[HaltInterrupt handles:ex exception]) ifTrue:[
"/ 'Halt ignored' infoPrintCR.
^ nil
].
"don't output the message, if the exception is a UserInterrupt (CTRL-C)"
- (ex signal == NoHandlerError
- and:[ex unhandledException signal == UserInterrupt]) ifTrue:[
+ (ex creator == NoHandlerError
+ and:[ex exception creator == UserInterrupt]) ifTrue:[
ex description errorPrintCR.
OperatingSystem exit:130.
].
@@ -4481,8 +4480,8 @@
].
"don't output the message, if the exception is a UserInterrupt (CTRL-C)"
- (ex signal == NoHandlerError
- and:[ex unhandledException signal == UserInterrupt]) ifTrue:[
+ (ex creator == NoHandlerError
+ and:[ex exception creator == UserInterrupt]) ifTrue:[
OperatingSystem exit:130.
].
msgString errorPrintCR.
@@ -7436,7 +7435,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?: selector
@@ -9656,11 +9654,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.715 2013-04-02 15:47:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.716 2013-04-19 09:34:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.715 2013-04-02 15:47:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.716 2013-04-19 09:34:51 cg Exp $'
!
version_SVN
--- a/PeekableStream.st Fri Apr 19 09:38:48 2013 +0200
+++ b/PeekableStream.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
Stream subclass:#PeekableStream
- instanceVariableNames:''
- classVariableNames:'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal
+ instanceVariableNames: ''
+ classVariableNames: 'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal
CurrentSourceContainerQuery'
- poolDictionaries:''
- category:'Streams'
+ poolDictionaries: ''
+ category: 'Streams'
!
!PeekableStream class methodsFor:'documentation'!
@@ -46,6 +46,7 @@
"
! !
+
!PeekableStream class methodsFor:'initialization'!
initialize
@@ -64,6 +65,7 @@
"Modified: / 23-10-2006 / 16:34:41 / cg"
! !
+
!PeekableStream class methodsFor:'Signal constants'!
currentFileInDirectoryQuerySignal
@@ -100,6 +102,7 @@
"Modified: / 23-10-2006 / 16:32:49 / cg"
! !
+
!PeekableStream class methodsFor:'queries'!
currentFileInDirectory
@@ -118,6 +121,7 @@
"Modified: / 23-10-2006 / 16:33:40 / cg"
! !
+
!PeekableStream methodsFor:'chunk input/output'!
nextChunk
@@ -219,6 +223,7 @@
^ theString
! !
+
!PeekableStream methodsFor:'fileIn'!
fileIn
@@ -260,6 +265,7 @@
"Modified: / 13.11.2001 / 10:14:04 / cg"
! !
+
!PeekableStream methodsFor:'positioning'!
skipAny:skipCollection
@@ -362,6 +368,7 @@
"
! !
+
!PeekableStream methodsFor:'private fileIn'!
basicFileInNotifying:someone passChunk:passChunk
@@ -516,6 +523,7 @@
"/ self halt.
! !
+
!PeekableStream methodsFor:'reading'!
nextDecimalInteger
@@ -761,6 +769,7 @@
"Modified: 4.1.1997 / 23:38:05 / cg"
! !
+
!PeekableStream methodsFor:'reading-strings'!
nextAlphaNumericWord
@@ -895,14 +904,15 @@
"Modified: 15.5.1996 / 17:51:42 / cg"
! !
+
!PeekableStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PeekableStream.st,v 1.42 2013-03-19 13:15:55 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PeekableStream.st,v 1.44 2013-04-19 09:39:39 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/PeekableStream.st,v 1.42 2013-03-19 13:15:55 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PeekableStream.st,v 1.44 2013-04-19 09:39:39 cg Exp $'
!
version_HG
--- a/ProceedError.st Fri Apr 19 09:38:48 2013 +0200
+++ b/ProceedError.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Warning subclass:#ProceedError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!ProceedError class methodsFor:'documentation'!
@@ -53,6 +53,7 @@
! !
+
!ProceedError class methodsFor:'initialization'!
initialize
@@ -66,13 +67,14 @@
! !
+
!ProceedError methodsFor:'default actions'!
defaultAction
"make proceeding from a non-proceedable raise a warning for now.
This will change in future revisions"
- ('WARNING: signal <', parameter signal printString, '> has been raised nonproceedable') errorPrintCR.
+ ('WARNING: signal <', parameter creator printString, '> has been raised nonproceedable') errorPrintCR.
(' by: ', parameter suspendedContext printString) errorPrintCR.
(' ', suspendedContext printString , ' tries to proceed.') errorPrintCR.
(' This will be an error in future ST/X versions.') errorPrintCR.
@@ -94,17 +96,16 @@
"
! !
+
!ProceedError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProceedError.st,v 1.5 2003/08/29 19:14:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProceedError.st,v 1.6 2013-04-19 08:40:03 cg Exp $'
!
version_SVN
^ '$Id: ProceedError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
ProceedError initialize!
-
-
-
--- a/Process.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Process.st Tue Apr 23 14:27:19 2013 +0100
@@ -1625,36 +1625,36 @@
|block|
(block := startBlock) notNil ifTrue:[
- "/
- "/ just for your convenience ...
- "/
- name isNil ifTrue:[
- name := '(' , block displayString , ')'
- ].
- restartable ~~ true ifTrue:[startBlock := nil].
+ "/
+ "/ just for your convenience ...
+ "/
+ name isNil ifTrue:[
+ name := '(' , block displayString , ')'
+ ].
+ restartable ~~ true ifTrue:[startBlock := nil].
- [
- "/
- "/ handle Process-Termination, Process-Restart and Abort
- "/
- CoughtSignals handle:[:ex |
- ex signal == RestartProcessRequest ifTrue:[
- ex restart
- ].
- ex return
- ] do:[
- exceptionHandlerSet isNil ifTrue:[
- exceptionHandlerSet := ExceptionHandlerSet new.
- ].
- "/
- "/ block is the one which received the fork some time ago...
- "/
- exceptionHandlerSet handleDo:block
- ]
- ] ensure:[self terminateNoSignal].
+ [
+ "/
+ "/ handle Process-Termination, Process-Restart and Abort
+ "/
+ CoughtSignals handle:[:ex |
+ ex creator == RestartProcessRequest ifTrue:[
+ ex restart
+ ].
+ ex return
+ ] do:[
+ exceptionHandlerSet isNil ifTrue:[
+ exceptionHandlerSet := ExceptionHandlerSet new.
+ ].
+ "/
+ "/ block is the one which received the fork some time ago...
+ "/
+ exceptionHandlerSet handleDo:block
+ ]
+ ] ensure:[self terminateNoSignal].
] ifFalse:[
- "is this artificial restriction useful ?"
- self error:'a process cannot be started twice' mayProceed:true
+ "is this artificial restriction useful ?"
+ self error:'a process cannot be started twice' mayProceed:true
]
"Modified: / 17.11.2001 / 16:45:32 / cg"
@@ -1759,48 +1759,48 @@
|wasBlocked|
Processor activeProcess ~~ self ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- [
- state == #osWait ifTrue:[
- self terminateNoSignal.
- ^ self.
- ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ state == #osWait ifTrue:[
+ self terminateNoSignal.
+ ^ self.
+ ].
- "if the receiver had no chance to execute yet,
- it can be shot down without a signal"
+ "if the receiver had no chance to execute yet,
+ it can be shot down without a signal"
- self suspendedContext isNil ifTrue:[
- self terminateNoSignal.
- ^ self
- ]
- ] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
- ].
+ self suspendedContext isNil ifTrue:[
+ self terminateNoSignal.
+ ^ self
+ ]
+ ] ensure:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
+ ].
- "register an interrupt action and resume that process"
- self interruptWith:[
- NoHandlerError handle:[:ex |
- ex parameter signal == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
- ].
+ "register an interrupt action and resume that process"
+ self interruptWith:[
+ NoHandlerError handle:[:ex |
+ ex exception creator == TerminateProcessRequest ifTrue:[
+ ex return.
+ ].
+ ex reject.
+ ] do:[
+ TerminateProcessRequest raise.
+ ].
+ self terminateNoSignal.
+ ].
] ifFalse:[
- "terminating myself"
+ "terminating myself"
- NoHandlerError handle:[:ex |
- ex parameter signal == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
+ NoHandlerError handle:[:ex |
+ ex exception creator == TerminateProcessRequest ifTrue:[
+ ex return.
+ ].
+ ex reject.
+ ] do:[
+ TerminateProcessRequest raise.
+ ].
+ self terminateNoSignal.
]
"Modified: / 24.8.1998 / 18:29:46 / cg"
@@ -2069,11 +2069,12 @@
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.178 2013-01-28 13:43:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.179 2013-04-19 09:35:37 cg Exp $'
!
version_SVN
^ '§ Id: Process.st 10643 2011-06-08 21:53:07Z vranyj1 §'
! !
+
Process initialize!
--- a/ProcessorScheduler.st Fri Apr 19 09:38:48 2013 +0200
+++ b/ProcessorScheduler.st Tue Apr 23 14:27:19 2013 +0100
@@ -815,8 +815,8 @@
"avoid confusion if entered twice"
dispatching == true ifTrue:[
- 'Processor [info]: already in dispatch' infoPrintCR.
- ^ self
+ 'Processor [info]: already in dispatch' infoPrintCR.
+ ^ self
].
dispatching := true.
@@ -828,21 +828,21 @@
dispatchAction := [self dispatch].
handlerAction := [:ex |
- ('Processor [info]: ignored signal (', ex signal printString, ')') infoPrintCR.
- ex return
- ].
+ ('Processor [info]: ignored signal (', ex creator printString, ')') infoPrintCR.
+ ex return
+ ].
ignoredSignals := SignalSet
- with:TerminateProcessRequest
- with:RecursionError
- with:AbortAllOperationRequest.
+ with:TerminateProcessRequest
+ with:RecursionError
+ with:AbortAllOperationRequest.
"/
"/ I made this an extra call to dispatch; this allows recompilation
"/ of the dispatch-handling code in the running system.
"/
[dispatching] whileTrue:[
- ignoredSignals handle:handlerAction do:dispatchAction
+ ignoredSignals handle:handlerAction do:dispatchAction
].
"/ we arrive here in standalone Apps,
@@ -2801,28 +2801,26 @@
].
n := blocksToEvaluate size.
- n > 0 ifTrue:[
- 1 to:n do:[:index |
- |block p|
-
- block := blocksToEvaluate at:index.
- p := processes at:index.
- (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
- block value
+ 1 to:n do:[:index |
+ |block p|
+
+ block := blocksToEvaluate at:index.
+ p := processes at:index.
+ (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+ block value
+ ] ifFalse:[
+ p isDead ifTrue:[
+
+ "/ a timedBlock for a process which has already terminated
+ "/ issue a warning and do not execute it.
+ "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ and thereby could block the whole smalltalk system.
+ "/ For this reason is it IGNORED here.)
+
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+ ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
] ifFalse:[
- p isDead ifTrue:[
-
- "/ a timedBlock for a process which has already terminated
- "/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
- "/ and thereby could block the whole smalltalk system.
- "/ For this reason is it IGNORED here.)
-
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
- ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
- ] ifFalse:[
- p interruptWith:block
- ]
+ p interruptWith:block
]
]
]
@@ -3363,11 +3361,11 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.267 2013-03-25 16:48:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.268 2013-04-19 09:35:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.267 2013-03-25 16:48:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.268 2013-04-19 09:35:49 cg Exp $'
! !
--- a/ProjectDefinition.st Fri Apr 19 09:38:48 2013 +0200
+++ b/ProjectDefinition.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#ProjectDefinition
- instanceVariableNames:''
- classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType
+ instanceVariableNames: ''
+ classVariableNames: 'LibraryType GUIApplicationType NonGUIApplicationType
PackagesBeingLoaded Verbose AbbrevDictionary AccessLock'
- poolDictionaries:''
- category:'System-Support-Projects'
+ poolDictionaries: ''
+ category: 'System-Support-Projects'
!
ProjectDefinition class instanceVariableNames:'safeForOverwrittenMethods extensionOverwriteInfo projectIsLoaded'
@@ -27,10 +27,10 @@
!
Object subclass:#AbbrevEntry
- instanceVariableNames:'className fileName category numClassInstVars'
- classVariableNames:''
- poolDictionaries:''
- privateIn:ProjectDefinition
+ instanceVariableNames: 'className fileName category numClassInstVars'
+ classVariableNames: ''
+ poolDictionaries: ''
+ privateIn: ProjectDefinition
!
!ProjectDefinition class methodsFor:'documentation'!
@@ -90,6 +90,7 @@
"
! !
+
!ProjectDefinition class methodsFor:'instance creation'!
definitionClassForMonticelloPackage:aMonicelloPackagename
@@ -231,6 +232,7 @@
"Modified: / 17-08-2006 / 17:24:23 / cg"
! !
+
!ProjectDefinition class methodsFor:'accessing'!
directory
@@ -1141,6 +1143,7 @@
"Modified: / 08-08-2011 / 14:59:45 / cg"
! !
+
!ProjectDefinition class methodsFor:'class initialization'!
initialize
@@ -1262,6 +1265,7 @@
"Modified: / 20-08-2011 / 23:32:32 / cg"
! !
+
!ProjectDefinition class methodsFor:'code generation'!
applicationIconFileName_code
@@ -1972,6 +1976,7 @@
"Created: / 23-08-2006 / 14:27:32 / cg"
! !
+
!ProjectDefinition class methodsFor:'description'!
excludedFromPreRequisites
@@ -2085,6 +2090,7 @@
"Modified: / 17-08-2006 / 19:57:46 / cg"
! !
+
!ProjectDefinition class methodsFor:'description - actions'!
postLoadAction
@@ -2113,6 +2119,9 @@
!ProjectDefinition class methodsFor:'description - classes'!
additionalClassNamesAndAttributes
+ "a List of classes, that belong to the project, but may not be included
+ in the image (someone may have removed it by purpose)"
+
^ #()
"Created: / 21-08-2006 / 19:53:04 / cg"
@@ -2148,6 +2157,7 @@
"Created: / 23-01-2007 / 19:08:27 / cg"
! !
+
!ProjectDefinition class methodsFor:'description - compilation'!
additionalBaseAddressDefinition_bc_dot_mak
@@ -2965,6 +2975,7 @@
"Modified: / 17-08-2006 / 19:46:29 / cg"
! !
+
!ProjectDefinition class methodsFor:'file generation'!
apspecFilename
@@ -3472,6 +3483,7 @@
"Created: / 07-09-2006 / 17:07:00 / cg"
! !
+
!ProjectDefinition class methodsFor:'file mappings'!
autopackage_default_dot_apspec_mappings
@@ -3757,72 +3769,49 @@
replaceAny:':' with:$_
! !
+
!ProjectDefinition class methodsFor:'file mappings support'!
classNamesByCategory
"answer a dictionary
category -> classNames topological sorted"
- |pivateClassesOf sorter classes classNames mapping|
+ |classes classNames mapping|
mapping := Dictionary new.
- classes := self compiled_classes_common.
- pivateClassesOf := IdentityDictionary new.
- classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
-
- sorter := [:a :b |
- "/ a must come before b iff:
- "/ b is a subclass of a
- "/ b has a private class which is a subclass of a
- "/ b is using the sharedPool, a
-
- |mustComeBefore pivateClassesOfB|
-
- mustComeBefore := (a isSharedPool and:[(b sharedPoolNames includes: a name)]).
- mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
- mustComeBefore ifFalse:[
- pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
- pivateClassesOfB do:[:eachClassInB |
- mustComeBefore := mustComeBefore or:[(a isSharedPool and:[(eachClassInB sharedPoolNames includes: a name)])].
- mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
- ].
+ classes := Class classesSortedByLoadOrder:self compiled_classes_common.
+ classNames := classes collect:[:eachClass| eachClass name].
+ self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
+ (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
+ classNames add:nm.
].
- mustComeBefore
- ].
-
- classes topologicalSort:sorter.
+ ].
+ mapping at:'COMMON' put:classNames.
+
OperatingSystem knownPlatformNames do:[:platformID |
- |prefix depClasses depClassNames|
-
- prefix := platformID asUppercase.
- depClasses := self compiled_classesForArchitecture:platformID.
- depClasses notEmpty ifTrue:[
- (self compiled_classNamesForPlatform:platformID)
- select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
- thenDo:[:nm | Transcript showCR:nm].
- (depClasses includes:nil) ifTrue:[
- (Dialog confirm:'Dependencies (and therefore build-order) might be incorrect\(some classes are not present; see Transcript).\\Continue anyway ?' withCRs)
+ |platformClasses platformClassNames|
+
+ platformClasses := self compiled_classesForPlatform:platformID.
+ platformClasses notEmpty ifTrue:[
+ (platformClasses contains:[:each| each isNil or:[each isLoaded not]]) ifTrue:[
+ "win32 classes are not present in linux..."
+ Transcript show:'Missing classes for platform: '. Transcript showCR:platformID.
+ platformClassNames := self compiled_classNamesForPlatform:platformID.
+ platformClassNames
+ select:[:nm | |cls| cls := Smalltalk classNamed:nm. cls isNil or:[cls isLoaded not]]
+ thenDo:[:nm | Transcript tab; showCR:nm].
+ (Dialog confirm:('Dependencies (and therefore build-order) might be incorrect\(some classes for platform ''%1'' are not present or autoloaded; see Transcript).\\Continue anyway without recomputing the order for this platform''s classes?' withCRs bindWith:platformID))
ifFalse:[
AbortOperationRequest raise.
].
- depClassNames := self compiled_classNamesForPlatform:platformID.
] ifFalse:[
- depClasses topologicalSort:sorter.
- depClassNames := depClasses collect:[:eachClass| eachClass name].
+ classes := Class classesSortedByLoadOrder:platformClasses.
+ platformClassNames := platformClasses collect:[:eachClass| eachClass name].
].
- mapping at:prefix put:depClassNames.
+ mapping at:platformID asUppercase put:platformClassNames.
].
-
- classNames := classes collect:[:eachClass| eachClass name].
- self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
- (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- classNames add:nm.
- ].
- ].
-
- mapping at:'COMMON' put:classNames.
].
^ mapping
@@ -3835,7 +3824,6 @@
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 25-11-2011 / 16:41:47 / cg"
- "Modified: / 18-04-2013 / 21:27:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commonSymbolsFlag
@@ -4464,6 +4452,7 @@
^ self subProjectMakeCallsUsing:'call vcmake %1 %2'.
! !
+
!ProjectDefinition class methodsFor:'file templates'!
autopackage_default_dot_apspec
@@ -4903,6 +4892,7 @@
"Modified: / 04-09-2012 / 11:45:49 / cg"
! !
+
!ProjectDefinition class methodsFor:'loading'!
ensureFullyLoaded
@@ -5074,6 +5064,7 @@
"Modified: / 20-11-2012 / 23:06:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ProjectDefinition class methodsFor:'misc ui support'!
iconInBrowserSymbol
@@ -5088,6 +5079,7 @@
^ super iconInBrowserSymbol
! !
+
!ProjectDefinition class methodsFor:'private'!
abbrevs
@@ -5293,9 +5285,11 @@
"Modified: / 09-08-2006 / 18:02:28 / fm"
!
-compiled_classesForArchitecture:arch
+
+
+compiled_classesForPlatform:arch
^ (self compiled_classNamesForPlatform:arch)
- collect:[:eachName | (Smalltalk at:eachName asSymbol) ]
+ collect:[:eachName | (Smalltalk classNamed:eachName)]
"
stx_libbasic compiled_classesForArchitecture:#win32
@@ -5314,8 +5308,8 @@
collect:[:eachName |
|cls|
- cls := (Smalltalk at:eachName asSymbol).
- cls isBehavior ifFalse:[
+ cls := Smalltalk classNamed:eachName.
+ cls isNil ifTrue:[
self warn:('Missing/invalid class: %1\\%2'
bindWith:eachName
with:('Warning: The class is skipped in the list of compiled classes.' allBold)) withCRs.
@@ -5695,6 +5689,7 @@
"Created: / 03-06-2011 / 17:01:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ProjectDefinition class methodsFor:'private-extension handling'!
extensionOverwriteInfo
@@ -5832,6 +5827,7 @@
^ safeForOverwrittenMethods ? #()
! !
+
!ProjectDefinition class methodsFor:'private-loading'!
checkPrerequisitesForLoading
@@ -6353,6 +6349,7 @@
]
! !
+
!ProjectDefinition class methodsFor:'private-prerequisites'!
addReferencesToClassesFromGlobalsIn:aSetOfClasses to:usedClassReasons
@@ -6794,19 +6791,21 @@
|requiredPackageReasons|
requiredPackageReasons := Dictionary new.
classesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass|
- (requiredPackageReasons at:usedClass package ifAbsentPut:[OrderedSet new])
+ (requiredPackageReasons at:usedClass package ifAbsentPut:[Set new])
addAll:reasonsPerClass.
].
+ "sort, to avoid differences from one generation to the next one"
requiredPackageReasons
].
mandatoryPackageReasons := packageExtractionBlock value:mandatoryClassesForLoadingWithReasons.
+
referencedPackageReasons := packageExtractionBlock value:referencedClassesWithReasons.
"and map extension method invocations to packages and collect the reasons"
referencedMethodsWithReasons keysAndValuesDo:[:usedMethod :reasonsPerMethod |
- (referencedPackageReasons at:usedMethod package ifAbsentPut:[OrderedSet new])
- addAll:reasonsPerMethod
+ (referencedPackageReasons at:usedMethod package ifAbsentPut:[Set new])
+ addAll:reasonsPerMethod.
].
ignoredPackages := Set
@@ -6814,6 +6813,8 @@
with:PackageId noProjectID.
referencedPackageReasons removeAllKeys:ignoredPackages ifAbsent:[].
+ "sort, to avoid differences from one generation to the next one"
+ referencedPackageReasons keysAndValuesDo:[:eachPackageId :eachReasons | referencedPackageReasons at:eachPackageId put:eachReasons asSortedCollection].
"don't put classes from subProjects into the required list"
ignoredPackages addAll:(self siblingsAreSubProjects
@@ -6821,6 +6822,8 @@
ifFalse:[ self searchForSubProjects ]) asSet.
mandatoryPackageReasons removeAllKeys:ignoredPackages ifAbsent:[].
+ "sort, to avoid differences from one generation to the next one"
+ mandatoryPackageReasons keysAndValuesDo:[:eachPackageId :eachReasons | mandatoryPackageReasons at:eachPackageId put:eachReasons asSortedCollection].
^ Array
with:mandatoryPackageReasons
@@ -6838,6 +6841,7 @@
"Created: / 06-09-2011 / 08:29:37 / cg"
! !
+
!ProjectDefinition class methodsFor:'queries'!
allClassNames
@@ -7221,6 +7225,7 @@
^ self subclassResponsibility
! !
+
!ProjectDefinition class methodsFor:'queries-privacy'!
showClassDocumentationOf:aClass
@@ -7234,6 +7239,7 @@
"Created: / 05-11-2007 / 16:44:16 / cg"
! !
+
!ProjectDefinition class methodsFor:'sanity checks'!
validateDescription
@@ -7395,6 +7401,7 @@
"Created: / 05-03-2012 / 12:18:45 / cg"
! !
+
!ProjectDefinition class methodsFor:'testing'!
isApplicationDefinition
@@ -7432,6 +7439,7 @@
"Modified: / 08-02-2011 / 10:03:49 / cg"
! !
+
!ProjectDefinition::AbbrevEntry methodsFor:'accessing'!
category
@@ -7461,14 +7469,15 @@
"Created: / 18-08-2011 / 14:18:37 / cg"
! !
+
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.457 2013-04-16 16:11:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.459 2013-04-19 11:34:39 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.457 2013-04-16 16:11:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.459 2013-04-19 11:34:39 stefan Exp $'
!
version_HG
--- a/QuerySignal.st Fri Apr 19 09:38:48 2013 +0200
+++ b/QuerySignal.st Tue Apr 23 14:27:19 2013 +0100
@@ -414,7 +414,7 @@
|signal|
- signal := anException signal.
+ signal := anException creator.
self == signal ifTrue:[^ true]. "quick check"
anException isNotification ifFalse:[^ false]. "speed up non-queries by not traversing the parent chain"
@@ -510,9 +510,10 @@
!QuerySignal class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/QuerySignal.st,v 1.45 2011-07-29 17:59:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/QuerySignal.st,v 1.46 2013-04-19 08:41:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/QuerySignal.st,v 1.45 2011-07-29 17:59:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/QuerySignal.st,v 1.46 2013-04-19 08:41:25 cg Exp $'
! !
+
--- a/RecursiveExceptionError.st Fri Apr 19 09:38:48 2013 +0200
+++ b/RecursiveExceptionError.st Tue Apr 23 14:27:19 2013 +0100
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Error subclass:#RecursiveExceptionError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!RecursiveExceptionError class methodsFor:'documentation'!
@@ -47,6 +47,7 @@
! !
+
!RecursiveExceptionError class methodsFor:'initialization'!
initialize
@@ -60,6 +61,7 @@
! !
+
!RecursiveExceptionError class methodsFor:'queries'!
mayProceed
@@ -69,17 +71,26 @@
! !
+
+!RecursiveExceptionError methodsFor:'accessing'!
+
+exception
+ "the original exception, which was responsible for this.
+ ANSI compatibility"
+
+ ^ parameter
+! !
+
+
!RecursiveExceptionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/RecursiveExceptionError.st,v 1.5 2005/09/30 13:37:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RecursiveExceptionError.st,v 1.6 2013-04-19 08:40:19 cg Exp $'
!
version_SVN
^ '$Id: RecursiveExceptionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
RecursiveExceptionError initialize!
-
-
-
--- a/Signal.st Fri Apr 19 09:38:48 2013 +0200
+++ b/Signal.st Tue Apr 23 14:27:19 2013 +0100
@@ -169,6 +169,14 @@
"Modified: / 4.8.1999 / 08:10:09 / stefan"
! !
+!Signal methodsFor:'Compatibility-ANSI'!
+
+signalWith:messageText
+ "ANSI compatibility"
+
+ self raiseErrorString:messageText
+! !
+
!Signal methodsFor:'Compatibility-VW'!
messageText:aString
@@ -447,7 +455,7 @@
|signal|
- signal := anException signal.
+ signal := anException creator.
self == signal ifTrue:[^ true]. "quick check"
anException isNotification ifTrue:[^ false]. "speed up queries by not traversing the parent chain"
@@ -793,12 +801,6 @@
raiseWith:aParameter in:aContext
"Modified: / 10-08-2010 / 10:03:05 / cg"
-!
-
-signalWith:messageText
- "ANSI compatibility"
-
- self raiseErrorString:messageText
! !
!Signal methodsFor:'save evaluation'!
@@ -978,10 +980,10 @@
!Signal class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.110 2013-03-26 14:20:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.111 2013-04-19 08:41:12 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.110 2013-03-26 14:20:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.111 2013-04-19 08:41:12 cg Exp $'
! !