Add 'osmo-st-core/' from commit '9e0df13ec7f54813129f5f9851cb233445455608'
git-subtree-dir: osmo-st-core git-subtree-mainline:65bcdcb12b
git-subtree-split:9e0df13ec7
This commit is contained in:
commit
b31b45c939
|
@ -0,0 +1,2 @@
|
|||
*.sw?
|
||||
fileout.st
|
|
@ -0,0 +1,73 @@
|
|||
"
|
||||
(C) 2011 by Holger Hans Peter Freyther
|
||||
All Rights Reserved
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, 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 Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
"
|
||||
|
||||
Object subclass: Dispatcher [
|
||||
| queue dispatch quit |
|
||||
<category: 'OsmoCore-Core'>
|
||||
<comment: 'I run tasks from the same context.'>
|
||||
|
||||
Dispatcher class >> instance [
|
||||
<category: 'singleton'>
|
||||
^ Smalltalk at: #OsmoDispatcher ifAbsentPut: [Dispatcher new].
|
||||
]
|
||||
|
||||
Dispatcher class >> new [
|
||||
<category: 'private'>
|
||||
^ super new
|
||||
initialize;
|
||||
addToBeFinalized;
|
||||
yourself
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'private'>
|
||||
quit := false.
|
||||
queue := SharedQueue new.
|
||||
dispatch := [
|
||||
Processor activeProcess name: 'OsmoDispatcher'.
|
||||
[quit]
|
||||
whileFalse: [
|
||||
self dispatch]
|
||||
] forkAt: Processor highIOPriority.
|
||||
]
|
||||
|
||||
dispatchBlock: aBlock [
|
||||
<category: 'insert'>
|
||||
queue nextPut: aBlock.
|
||||
]
|
||||
|
||||
dispatch [
|
||||
| block sem |
|
||||
block := queue next.
|
||||
sem := Semaphore new.
|
||||
|
||||
"Run the code in a new process as the debugger might terminate this
|
||||
and then the dispatcher would not dispatch anymore. Use a Semaphore
|
||||
to make sure we keep on processing items in order."
|
||||
[[
|
||||
block on: Error do: [:error |
|
||||
error logException: ('dispatch failed on "', block printString, '".') area: #core.
|
||||
]] ensure: [sem signal]] fork.
|
||||
|
||||
sem wait.
|
||||
]
|
||||
]
|
||||
|
||||
Eval [
|
||||
Dispatcher instance.
|
||||
]
|
|
@ -0,0 +1,40 @@
|
|||
"
|
||||
Test the Pharo extensions.
|
||||
"
|
||||
|
||||
TestCase subclass: StringFormatTest [
|
||||
<category: 'OsmoCore-Pharo-Tests'>
|
||||
|
||||
testExpandMacros [
|
||||
| str |
|
||||
str := 'Bla<n>' expandMacros.
|
||||
self assert: str = ('Bla', Character nl asString).
|
||||
|
||||
str := 'Bla<t>' expandMacros.
|
||||
self assert: str = ('Bla', Character tab asString).
|
||||
]
|
||||
|
||||
testExpandWithMacro [
|
||||
| str |
|
||||
str := 'Bla Bla <1p>' expandMacrosWith: 10.
|
||||
self assert: str = 'Bla Bla 10'.
|
||||
|
||||
str := 'Bla Bla <1s>' expandMacrosWith: 10 asString.
|
||||
self assert: str = 'Bla Bla 10'.
|
||||
]
|
||||
|
||||
testExpandMacrosTrue [
|
||||
| str |
|
||||
str := 'Should be true=<1?true:false>' expandMacrosWith: true.
|
||||
self assert: str = 'Should be true=true'.
|
||||
|
||||
str := 'Should be false=<1?tue:false>' expandMacrosWith: false.
|
||||
self assert: str = 'Should be false=false'.
|
||||
]
|
||||
|
||||
testExpandMacros2 [
|
||||
| str |
|
||||
str := 'Bla Bla <1p> <2s>' expandMacrosWith: 10 with: '20'.
|
||||
self assert: str = 'Bla Bla 10 20'.
|
||||
]
|
||||
]
|
|
@ -0,0 +1,84 @@
|
|||
"This is from Pharo 1.4. It is MIT licensed"
|
||||
|
||||
String extend [
|
||||
|
||||
expandMacros [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
^self expandMacrosWithArguments: #()
|
||||
]
|
||||
|
||||
expandMacrosWith: anObject [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
^self expandMacrosWithArguments: (Array with: anObject)
|
||||
]
|
||||
|
||||
expandMacrosWith: anObject with: anotherObject [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
^self
|
||||
expandMacrosWithArguments: (Array with: anObject with: anotherObject)
|
||||
]
|
||||
|
||||
expandMacrosWith: anObject with: anotherObject with: thirdObject [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
^self expandMacrosWithArguments: (Array
|
||||
with: anObject
|
||||
with: anotherObject
|
||||
with: thirdObject)
|
||||
]
|
||||
|
||||
expandMacrosWith: anObject with: anotherObject with: thirdObject with: fourthObject [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
^self expandMacrosWithArguments: (Array
|
||||
with: anObject
|
||||
with: anotherObject
|
||||
with: thirdObject
|
||||
with: fourthObject)
|
||||
]
|
||||
|
||||
expandMacrosWithArguments: anArray [
|
||||
<category: '*PharoCompat'>
|
||||
"From Pharo, for Phexample/OsmoCore, MIT license"
|
||||
| newStream readStream char index |
|
||||
newStream := (String new: self size) writeStream.
|
||||
readStream := self readStream.
|
||||
[ readStream atEnd ] whileFalse:
|
||||
[ char := readStream next.
|
||||
char == $<
|
||||
ifTrue:
|
||||
[ | nextChar |
|
||||
nextChar := readStream next asUppercase.
|
||||
nextChar == $N ifTrue: [ newStream nl ].
|
||||
nextChar == $T ifTrue: [ newStream tab ].
|
||||
nextChar isDigit ifTrue:
|
||||
[ index := nextChar digitValue.
|
||||
|
||||
[ readStream atEnd or: [ (nextChar := readStream next asUppercase) isDigit not ] ] whileFalse: [ index := index * 10 + nextChar digitValue ] ].
|
||||
nextChar == $? ifTrue:
|
||||
[ | trueString falseString |
|
||||
trueString := readStream upTo: $:.
|
||||
falseString := readStream upTo: $>.
|
||||
readStream position: readStream position - 1.
|
||||
newStream nextPutAll: ((anArray at: index)
|
||||
ifTrue: [ trueString ]
|
||||
ifFalse: [ falseString ]) ].
|
||||
nextChar == $P ifTrue: [ newStream nextPutAll: (anArray at: index) printString ].
|
||||
nextChar == $S ifTrue: [ newStream nextPutAll: (anArray at: index) ].
|
||||
readStream skipTo: $> ]
|
||||
ifFalse:
|
||||
[ newStream nextPut: (char == $%
|
||||
ifTrue: [ readStream next ]
|
||||
ifFalse: [ char ]) ] ].
|
||||
^ newStream contents
|
||||
]
|
||||
]
|
||||
|
||||
Object extend [
|
||||
deprecated: aString [
|
||||
"Compat for pharo. Use it to indicate deprecated functions"
|
||||
]
|
||||
]
|
|
@ -0,0 +1,47 @@
|
|||
"
|
||||
(C) 2011 by Holger Hans Peter Freyther
|
||||
All Rights Reserved
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, 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 Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
"
|
||||
|
||||
Osmo.LogArea subclass: LogAreaTimer [
|
||||
<category: 'OsmoCore-Logging'>
|
||||
|
||||
LogAreaTimer class [
|
||||
areaName [ ^ #timer ]
|
||||
areaDescription [ ^ 'Timer related' ]
|
||||
default [
|
||||
^ self new
|
||||
enabled: true;
|
||||
minLevel: Osmo.LogLevel debug;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
Osmo.LogArea subclass: LogAreaCore [
|
||||
<category: 'OsmoCore-Logging'>
|
||||
|
||||
LogAreaCore class [
|
||||
areaName [ ^ #core ]
|
||||
areaDescription [ ^ 'Core related things' ]
|
||||
default [
|
||||
^ self new
|
||||
enabled: true;
|
||||
minLevel: Osmo.LogLevel debug;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
]
|
|
@ -0,0 +1,18 @@
|
|||
|
||||
GST_PACKAGE = gst-package
|
||||
GST_CONVERT = gst-convert
|
||||
|
||||
CONVERT_RULES = -r'Osmo.LogManager->LogManager' \
|
||||
-r'Osmo.LogArea->LogArea' \
|
||||
-r'Osmo.LogLevel->LogLevel' \
|
||||
-r'DateTime->DateAndTime' \
|
||||
-r'(Duration milliseconds: ``@args1) -> (Duration milliSeconds: ``@args1)'
|
||||
|
||||
|
||||
all:
|
||||
$(GST_PACKAGE) --test package.xml
|
||||
|
||||
convert:
|
||||
$(GST_CONVERT) $(CONVERT_RULES) -F squeak -f gst \
|
||||
-o fileout.st compat_for_pharo.st LogArea.st Dispatcher.st Timer.st Tests.st \
|
||||
changes_for_pharo.st
|
|
@ -0,0 +1,66 @@
|
|||
"
|
||||
(C) 2011 by Holger Hans Peter Freyther
|
||||
All Rights Reserved
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, 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 Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
"
|
||||
|
||||
TestCase subclass: DispatcherTest [
|
||||
<category: 'OsmoCore-Tests'>
|
||||
|
||||
testDispatcher [
|
||||
| sem |
|
||||
sem := Semaphore new.
|
||||
|
||||
self assert: sem signals = 0.
|
||||
"Force a debugger or some abortion? And a log message"
|
||||
OsmoDispatcher dispatchBlock: [123 unknownMessageForSmallInteger].
|
||||
OsmoDispatcher dispatchBlock: [Processor activeProcess terminate].
|
||||
OsmoDispatcher dispatchBlock: [sem signal].
|
||||
self assert: sem signals = 1.
|
||||
]
|
||||
]
|
||||
|
||||
TestCase subclass: TimerTest [
|
||||
<category: 'OsmoCore-Tests'>
|
||||
|
||||
testTimer [
|
||||
| sem now |
|
||||
now := DateTime now.
|
||||
sem := Semaphore new.
|
||||
TimerScheduler instance scheduleInSeconds: 2 block: [
|
||||
sem signal.
|
||||
].
|
||||
|
||||
sem wait.
|
||||
self assert: (DateTime now - now) asSeconds >= 2.
|
||||
]
|
||||
|
||||
testCancel [
|
||||
| timer1 timer2 fire1 sem block |
|
||||
sem := Semaphore new.
|
||||
block := [sem signal].
|
||||
|
||||
|
||||
fire1 := TimerScheduler instance scheduleInSeconds: 5 block: block.
|
||||
timer1 := TimerScheduler instance scheduleInSeconds: 3 block: block.
|
||||
timer2 := TimerScheduler instance scheduleInSeconds: 2 block: block.
|
||||
|
||||
timer2 cancel.
|
||||
timer1 cancel.
|
||||
|
||||
sem wait.
|
||||
self assert: sem signals = 0
|
||||
]
|
||||
]
|
|
@ -0,0 +1,159 @@
|
|||
"
|
||||
(C) 2011 by Holger Hans Peter Freyther
|
||||
All Rights Reserved
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, 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 Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
"
|
||||
|
||||
Object subclass: Timer [
|
||||
| schedule timeout block |
|
||||
|
||||
<category: 'OsmoCore-Timer'>
|
||||
<comment: 'This is a receipt for an active timer'>
|
||||
|
||||
Timer class >> on: aSchedule [
|
||||
<category: 'creation'>
|
||||
^ self new
|
||||
schedule: aSchedule;
|
||||
yourself
|
||||
]
|
||||
|
||||
timeout [
|
||||
<category: 'accessing'>
|
||||
^ timeout
|
||||
]
|
||||
|
||||
schedule: aSchedule [
|
||||
<category: 'creation'>
|
||||
schedule := aSchedule.
|
||||
]
|
||||
|
||||
timeout: aTimeout [
|
||||
<category: 'creation'>
|
||||
timeout := aTimeout.
|
||||
]
|
||||
|
||||
block: aBlock [
|
||||
<category: 'creation'>
|
||||
block := aBlock
|
||||
]
|
||||
|
||||
fire [
|
||||
<category: 'execution'>
|
||||
block value
|
||||
]
|
||||
|
||||
cancel [
|
||||
<category: 'management'>
|
||||
"Remember that the timer is gone."
|
||||
schedule := nil.
|
||||
block := nil.
|
||||
]
|
||||
|
||||
isCanceled [
|
||||
<category: 'management'>
|
||||
^ schedule == nil.
|
||||
]
|
||||
]
|
||||
|
||||
Object subclass: TimerScheduler [
|
||||
| queue sem loop quit processExited |
|
||||
<category: 'OsmoCore-Timer'>
|
||||
<comment: 'I can help to fire things at the right time. Right now I
|
||||
only work on seconds granularity because Time has no direct access to
|
||||
milliseconds. Also I run a loop every second. I should use a Semaphore to
|
||||
signal the process about a change of the closest time but it might be a
|
||||
bit difficult to do this race free.'>
|
||||
|
||||
TimerScheduler class >> instance [
|
||||
<category: 'singleton'>
|
||||
^ Smalltalk at: #OsmoTimeScheduler ifAbsentPut: [TimerScheduler new].
|
||||
]
|
||||
|
||||
|
||||
TimerScheduler class >> new [
|
||||
<category: 'private'>
|
||||
^ super new
|
||||
initialize;
|
||||
addToBeFinalized;
|
||||
yourself
|
||||
]
|
||||
|
||||
finalize [
|
||||
<category: 'private'>
|
||||
quit := true.
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'private'>
|
||||
queue := SortedCollection sortBlock: [:a :b | a timeout < b timeout].
|
||||
sem := Semaphore forMutualExclusion.
|
||||
quit := false.
|
||||
self startLoop.
|
||||
]
|
||||
|
||||
startLoop [
|
||||
<category: 'creation'>
|
||||
|
||||
processExited := Semaphore new.
|
||||
loop := [[Processor activeProcess name: 'Osmo Timers'.
|
||||
self runTimers
|
||||
] ensure: [processExited signal. loop := nil]] fork
|
||||
]
|
||||
|
||||
scheduleInSeconds: aDelay block: aBlock [
|
||||
| sched |
|
||||
<category: 'schedule'>
|
||||
sched := (Timer on: self)
|
||||
block: aBlock;
|
||||
timeout: (DateTime now + (Duration milliseconds: 1000 * aDelay));
|
||||
yourself.
|
||||
|
||||
sem critical: [
|
||||
queue add: sched.
|
||||
].
|
||||
|
||||
^ sched
|
||||
]
|
||||
|
||||
runTimers [
|
||||
<category: 'delay_loop'>
|
||||
|
||||
[quit] whileFalse: [ | now |
|
||||
(Delay forSeconds: 1) wait.
|
||||
now := DateTime now.
|
||||
OsmoDispatcher dispatchBlock: [self fireTimers: now].
|
||||
]
|
||||
]
|
||||
|
||||
fireTimers: now [
|
||||
<category: 'private'>
|
||||
|
||||
"Now execute the timers. One way or another this is crazy. If we have
|
||||
a long blocking application or a deadlock the timer queue will get
|
||||
stuck. But if we run this in a new process a later process might be run
|
||||
before this process, changing the order of the timers."
|
||||
"Only this process will remove items, this is why we can check isEmpty
|
||||
without having the lock"
|
||||
[queue isEmpty or: [queue first timeout > now]] whileFalse: [ | each |
|
||||
each := sem critical: [queue removeFirst].
|
||||
each isCanceled ifFalse: [
|
||||
[each fire] on: Error do: [:e |
|
||||
e logException:
|
||||
('Execution of timer failed: ', e messageText) area: #timer.
|
||||
]].
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
TimerScheduler extend [
|
||||
TimerScheduler class >> initialize [
|
||||
<category: 'loading'>
|
||||
"Pharo requires us to do some post-processing"
|
||||
Smalltalk addToStartUpList: self.
|
||||
Smalltalk addToShutDownList: self.
|
||||
^self instance.
|
||||
]
|
||||
|
||||
TimerScheduler class >> startUp [
|
||||
Smalltalk at: #OsmoTimeScheduler ifPresent: [:timer | timer doStartUp].
|
||||
]
|
||||
|
||||
TimerScheduler class >> shutDown: quitting [
|
||||
Smalltalk at: #OsmoTimeScheduler ifPresent: [:timer | timer doShutDown].
|
||||
]
|
||||
|
||||
doShutDown [
|
||||
<category: 'PharoHacks'>
|
||||
loop ifNil: [^self].
|
||||
quit := true.
|
||||
processExited wait.
|
||||
Transcript nextPutAll: 'Stopped the TimerScheduler process'; cr.
|
||||
]
|
||||
|
||||
doStartUp [
|
||||
<category: 'PharoHacks'>
|
||||
loop ifNotNil: [^self error: 'The loop should have vanished'].
|
||||
Transcript nextPutAll: 'Starting the TimerScheduler loop again'; cr.
|
||||
quit := false.
|
||||
self startLoop.
|
||||
]
|
||||
]
|
||||
|
||||
Dispatcher class extend [
|
||||
initialize [
|
||||
^ self instance
|
||||
]
|
||||
]
|
|
@ -0,0 +1,16 @@
|
|||
"This is to be easily loadable on Pharo 1.4 and up"
|
||||
|
||||
Object extend [
|
||||
addToBeFinalized [
|
||||
<category: '*OsmoCore'>
|
||||
"No idea how to implement it"
|
||||
]
|
||||
]
|
||||
|
||||
Semaphore extend [
|
||||
signals [
|
||||
<category: '*OsmoCore'>
|
||||
"Used in our testcase"
|
||||
^ excessSignals
|
||||
]
|
||||
]
|
|
@ -0,0 +1,18 @@
|
|||
<package>
|
||||
<name>OsmoCore</name>
|
||||
<namespace>Osmo</namespace>
|
||||
<prereq>OsmoLogging</prereq>
|
||||
|
||||
<filein>GSTExtensions.st</filein>
|
||||
<filein>LogArea.st</filein>
|
||||
<filein>Dispatcher.st</filein>
|
||||
<filein>Timer.st</filein>
|
||||
|
||||
<test>
|
||||
<sunit>Osmo.DispatcherTest</sunit>
|
||||
<sunit>Osmo.TimerTest</sunit>
|
||||
<filein>Tests.st</filein>
|
||||
<sunit>Osmo.StringFormatTest</sunit>
|
||||
<filein>ExtensionTest.st</filein>
|
||||
</test>
|
||||
</package>
|
Reference in New Issue