smalltalk
/
osmo-st-all
Archived
1
0
Fork 0

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:
Holger Hans Peter Freyther 2014-06-04 15:45:02 +02:00
commit b31b45c939
11 changed files with 562 additions and 0 deletions

2
osmo-st-core/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.sw?
fileout.st

View File

@ -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.
]

View File

@ -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'.
]
]

View File

@ -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"
]
]

47
osmo-st-core/LogArea.st Normal file
View File

@ -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
]
]
]

18
osmo-st-core/Makefile Normal file
View File

@ -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

66
osmo-st-core/Tests.st Normal file
View File

@ -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
]
]

159
osmo-st-core/Timer.st Normal file
View File

@ -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.
]].
]
]
]

View File

@ -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
]
]

View File

@ -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
]
]

18
osmo-st-core/package.xml Normal file
View File

@ -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>