Skip to content

Commit

Permalink
Merge pull request #5 from noha/master
Browse files Browse the repository at this point in the history
Initial import from smalltalkhub
  • Loading branch information
noha authored Jul 7, 2017
2 parents 6316f0b + b6eb122 commit f184c6b
Show file tree
Hide file tree
Showing 381 changed files with 2,113 additions and 0 deletions.
3 changes: 3 additions & 0 deletions repository/.filetree
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{"packageExtension" : ".package",
"propertyFileExtension" : ".json",
"Metadata" : "false" }
5 changes: 5 additions & 0 deletions repository/Beacon-Core-GT.package/.filetree
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{
"separateMethodMetaAndSource" : false,
"noMethodMetaData" : true,
"useCypressPropertiesFile" : true
}
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtExampleEmpty
<gtExample>
<label: 'Empty'>

^ self new
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
*Beacon-Core-GT
gtInspectorAnnouncementsIn: composite context: aGTContext
<gtInspectorPresentationOrder: 30>
self announcer gtInspectorAnnouncementsIn: composite context: aGTContext
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
*Beacon-Core-GT
gtInspectorSubscriptionsIn: composite
<gtInspectorPresentationOrder: 30>
self announcer gtInspectorSubscriptionsIn: composite
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{
"name" : "Beacon"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtExampleEmpty
<gtExample>
<label: 'Empty'>

^ self new
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
*Beacon-Core-GT
gtDisplayOn: stream
self printOneLineOn: stream
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtOneLineIn: composite
<gtInspectorPresentationOrder: 0>
composite text
title: 'One line';
display: [ self printOneLineString ]
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{
"name" : "BeaconSignal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtExampleEmpty
<gtExample>
<label: 'Empty'>

^ self new
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
*Beacon-Core-GT
gtInspectorStackIn: composite
<gtInspectorPresentationOrder: 0>
composite fastTable
title: 'Stack';
display: [ self stack ];
column: 'Class' evaluated: [:each | each parents first methodClass ];
column: 'Method' evaluated: [:each | each parents first selector];
column: 'Code' evaluated: [:each | each formattedCode]
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{
"name" : "ExceptionSignal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtExampleEmpty
<gtExample>
<label: 'Empty'>

^ self new
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
*beacon-core-gt
gtInspectorGroupedIn: composite
<gtInspectorPresentationOrder: 1>
composite fastTable
title: 'Grouped';
display: [ (self recordings reverse groupedBy: [ :each | each class ]) associations ];
column: 'Class' evaluated: [ :each | each key ];
column: 'Instances' evaluated: [ :each | each value size ];
send: [ :each | each value ]
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
*beacon-core-gt
gtInspectorRecordingsIn: composite
<gtInspectorPresentationOrder: 0>
| live |
live := true.
composite fastTable
title: 'Recordings';
display: [ self recordings reverse ];
column: 'Timestamp' evaluated: [ :each | each timestamp asString ] width: 80;
column: 'Process' evaluated: [ :each | each processId asString ];
column: 'Type' evaluated: [ :each | each name ] width: 80;
column: 'Contents' evaluated: [ :each | String streamContents: [ :s | each printOneLineContentsOn: s ] ];
showOnly: 50;
" beMultiple;"
updateOn: Announcement from: [ self announcer ];
selectionAct: [ :table |
recordings := self recordings \ table selection.
table update ]
icon: GLMUIThemeExtraIcons glamorousRemove
entitled: 'Remove';
act: [ :table |
self reset.
table update ]
icon: GLMUIThemeExtraIcons glamorousRemove
entitled: 'Remove all';
dynamicActions: [ :t |
{
GLMGenericAction new
action: [ t unregisterFromAllAnnouncements. t pane updateToolbar ];
icon: GLMUIThemeExtraIcons glamorousRedCircle;
title: 'Stop' .
GLMGenericAction new
action: [ t pane update ];
icon: GLMUIThemeExtraIcons glamorousGreenCircle;
title: 'Play' }]
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{
"name" : "MemoryLogger"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtExampleMethodStackSignal
<gtExample>
<label: 'MethodStackSignal'>

^ MethodStackSignal new
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
*Beacon-Core-GT
gtInspectorStackIn: composite
<gtInspectorPresentationOrder: 0>
composite list
title: 'Stack';
display: [ self stack ]
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{
"name" : "ThisContextSignal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
SystemOrganization addCategory: #'Beacon-Core-GT'!
Empty file.
1 change: 1 addition & 0 deletions repository/Beacon-Core-GT.package/monticello.meta/package
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
(name 'Beacon-Core-GT')
1 change: 1 addition & 0 deletions repository/Beacon-Core-GT.package/properties.json
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
{ }
5 changes: 5 additions & 0 deletions repository/Beacon-Core-Tests.package/.filetree
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{
"separateMethodMetaAndSource" : false,
"noMethodMetaData" : true,
"useCypressPropertiesFile" : true
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A CustomStreamLoggerTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
tests
testLoggingAffectsTheStream
| loggedResult |
loggedResult := String streamContents: [ :stream |
(CustomStreamLogger with: stream)
runDuring: [
StringSignal emit: 'This is a message' ] ].
self assert: loggedResult lines size = 1
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "PhilippeBack 4/27/2017 00:13",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "CustomStreamLoggerTest",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
This signal is solely used for testing purposes.
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "TudorGirba 6/9/2014 01:10",
"super" : "BeaconSignal",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "DummySignal",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A MemoryLoggerTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
testing
testRecordOneSignal
| logger |
logger := MemoryLogger new
runDuring: [ StringSignal emit: 'test' ].
self assert: logger recordings size = 1.
self assert: logger recordings first message = 'test'
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
testing
testRecordTwoSignalsInTheRightOrder
| logger |
logger := MemoryLogger new
runDuring: [
StringSignal emit: 'test1'.
StringSignal emit: 'test2' ].
self assert: logger recordings size = 2.
self assert: logger recordings first message = 'test1'.
self assert: logger recordings last message = 'test2'
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
testing
testRunDuringStopsAtTheEnd
| logger |
logger := MemoryLogger new.
logger runDuring: [
self assert: logger isRunning ].
self assert: logger isRunning not
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
testing
testStartForMultipleSignals
| logger |
logger := MemoryLogger new.
logger runFor: StringSignal, MethodStackSignal during: [
StringSignal emit: 'This should be recorded.'.
MethodStackSignal emit.
DummySignal new emit ].
self assert: logger recordings size equals: 2
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
testing
testStartForOnlyOneSignal
| logger |
logger := MemoryLogger new.
logger runFor: StringSignal during: [
StringSignal emit: 'This should be recorded.'.
MethodStackSignal emit ].
self assert: logger recordings size equals: 1
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
{
"commentStamp" : "PhilippeBack 4/27/2017 00:13",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [
"previousRecordings"
],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "MemoryLoggerTest",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A CurrentStackSignalTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
testing
testRemovesIrrelevantStackEntriesFromOnTop
| signal |
signal := MethodStackSignal emit.
self assert: signal stack first = thisContext stack first method asRingDefinition
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "<historical>",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "MethodStackSignalTest",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A SignalLoggerTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
tests
testStartingTwiceDoesNotRegisterTwice
| initialNumberOfSubscriptions |
initialNumberOfSubscriptions := Beacon instance announcer numberOfSubscriptions.
SignalLogger resetInstance.
SignalLogger start.
SignalLogger start.
self
assert: Beacon instance announcer numberOfSubscriptions
equals: initialNumberOfSubscriptions + 1.
SignalLogger stop.
self
assert: Beacon instance announcer numberOfSubscriptions
equals: initialNumberOfSubscriptions
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "PhilippeBack 4/27/2017 00:14",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "SignalLoggerTest",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A SignalTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
as yet unclassified
testTimestampByDefault
| before signal after |
before := DateAndTime now.
signal := BeaconSignal new.
after := DateAndTime now.
self assert: before <= signal timestamp.
self assert: after >= signal timestamp.

Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "<historical>",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "SignalTest",
"type" : "normal"
}
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A WrapperSignalTest is xxxxxxxxx.
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
tests
testAsBeaconSignalDoesNotAffectAnExistingSignal
| signal |
signal := StringSignal new.
self assert: signal asBeaconSignal = signal
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
tests
testAsBeaconSignalTransformsIntoWrapperSignal
self assert: (42 asBeaconSignal isKindOf: WrapperSignal).
self assert: 42 asBeaconSignal target equals: 42.
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
{
"commentStamp" : "<historical>",
"super" : "TestCase",
"category" : "Beacon-Core-Tests",
"classinstvars" : [ ],
"pools" : [ ],
"classvars" : [ ],
"instvars" : [ ],
"name" : "WrapperSignalTest",
"type" : "normal"
}
Loading

0 comments on commit f184c6b

Please sign in to comment.