Pharo10

.github/workflows/build.yml

@@ -16,12 +16,16 @@ on:
 jobs:
   build:
     runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        smalltalk: [ Pharo64-11, Pharo64-10, Pharo64-9.0 ]
+    name: ${{ matrix.smalltalk }}
     steps:
       - uses: actions/checkout@v2
       - uses: hpi-swa/setup-smalltalkCI@v1
         id: smalltalkci
         with:
-          smalltalk-version: Pharo64-9.0
-      - run: smalltalkci -s ${{ steps.smalltalkci.outputs.smalltalk-version }}
+          smalltalk-image: ${{ matrix.smalltalk }}
+      - run: smalltalkci -s ${{ matrix.smalltalk }}
         shell: bash
         timeout-minutes: 15

source/SnapDump-Core-Tests/SDCoreTests.class.st

@@ -25,6 +25,19 @@ SDCoreTests >> store [
 	^ self filesystemStore
 ]
 
+{ #category : #tests }
+SDCoreTests >> testEmergencyHandler [ 
+
+	| emergency exception |
+	handler emergencyHandler: [ :em :ex |
+		emergency := em.
+		exception := ex.
+		nil ].
+	handler handleException: 1.
+	self assert: emergency class equals: MessageNotUnderstood.
+	self assert: exception equals: 1
+]
+
 { #category : #tests }
 SDCoreTests >> testProject [
 

source/SnapDump-Core/SDException.class.st

@@ -105,9 +105,9 @@ SDException >> initializeExceptionProperties [
 ]
 
 { #category : #initialization }
-SDException >> initializeFromClassName: aName method: aSmalltalkMethod [
+SDException >> initializeFromClassName: aName receiver: aReceiver method: aSmalltalkMethod [
 
-	exceptionSignalerClassName := aSmalltalkMethod classBinding value asString.
+	exceptionSignalerClassName := aReceiver class name asString.
 	exceptionSignalerSelector :=  aSmalltalkMethod selector asString.
 	exceptionClassName := aName
 ]

source/SnapDump-Core/SDMemorySnapshot.class.st

@@ -33,10 +33,8 @@ SDMemorySnapshot >> initialize [
 
 { #category : #'as yet unclassified' }
 SDMemorySnapshot >> serializeContextOn: stream [
-	| serializer |
 
-	serializer := FLSerializer newDefault.
-	serializer
+	FLSerializer 
 		serialize: context
 		on: stream
 ]
@@ -52,7 +50,9 @@ SDMemorySnapshot >> setContext: aContext exceptionClassName: exceptionClassName
 	self
 		exception:
 			(SDException new
-				initializeFromClassName: exceptionClassName method: method;
+				initializeFromClassName: exceptionClassName 
+				receiver: aContext receiver 
+				method: method;
 				yourself)
 ]
 

source/SnapDump-Core/SDSnapshot.class.st

@@ -202,6 +202,11 @@ SDSnapshot >> metaFields [
 	^ self basicMetaFields asOrderedCollection
 ]
 
+{ #category : #private }
+SDSnapshot >> metaProperties [
+	^ self metaFields collect: [ :field | field -> (self perform: field asSymbol) ] as: Dictionary
+]
+
 { #category : #initialization }
 SDSnapshot >> newVersion [
 

source/SnapDump-Core/SnapDump.class.st

@@ -18,11 +18,6 @@ SnapDump class >> applyConfiguration: aConfig [
 	self current applyConfiguration: aConfig
 ]
 
-{ #category : #'as yet unclassified' }
-SnapDump class >> beOfType: aSymbol [
-	self deprecated: 'beOfType: is unnecessary now. Just remove calls to this method'
-]
-
 { #category : #'as yet unclassified' }
 SnapDump class >> configuration [
 	<cinicStep>
@@ -42,7 +37,7 @@ SnapDump class >> current [
 { #category : #'as yet unclassified' }
 SnapDump class >> hackUIManager [
 	UIManager compile: 'logError: anError
-		SnapDump current handleException: anError.
+		SnapDump handleException: anError.
 		super logError: anError'
 ]
 

source/SnapDump-Handler/SDHandler.class.st

@@ -3,7 +3,8 @@ Class {
 	#superclass : #SnapDump,
 	#instVars : [
 		'project',
-		'version'
+		'version',
+		'emergencyHandler'
 	],
 	#category : #'SnapDump-Handler'
 }
@@ -38,21 +39,45 @@ SDHandler >> applyConfiguration: aConfig [
 
 ]
 
+{ #category : #accessing }
+SDHandler >> defaultEmergencyHandler [
+	^ [ :emergency :exception | 
+		"if we run inside a test case raise the error"
+		CurrentExecutionEnvironment value isTest ifTrue: [ emergency pass ].
+
+		Transcript show: 'Error ', emergency description asString, ' happened while report error ', exception description asString.
+		nil ].
+]
+
+{ #category : #accessing }
+SDHandler >> emergencyHandler [
+
+	^ emergencyHandler ifNil: [ 
+		emergencyHandler := self defaultEmergencyHandler ]
+]
+
+{ #category : #accessing }
+SDHandler >> emergencyHandler: anObject [
+
+	emergencyHandler := anObject
+]
+
 { #category : #services }
 SDHandler >> handleException: exception [
-	Transcript show: 'SnapDump: exception to report: ', exception description asString; cr.
+
 	store ifNil: [ 
 		Transcript show: 'SnapDump store is not set up. Ignoring exception sends!!!'; cr.
 		^ nil ].
-	^ [ self handleSnapshot: exception asSnapshot ]
+	^ [ 
+		Transcript show: 'SnapDump: exception to report: ', exception description asString; cr.
+		self handleSnapshot: exception asSnapshot ]
 		on: Error 
-		do: [ :err | 
-			"if we run inside a test case raise the error"
-			CurrentExecutionEnvironment value isTest ifTrue: [ err pass ].
-			"if an error occurrs while reporting an error there is nothing
-			we can do"
-			Transcript show: 'Error ', err description asString, ' happened while report error ', exception description asString.
-			nil]
+		do: [ :emergency | 
+			"if an error occurrs while reporting an error we call the 
+			emergeny handler with the original exception and "
+			self emergencyHandler
+				value: emergency 
+				value: exception ]
 
 ]
 

source/SnapDump-Handler/SnapDump.extension.st

@@ -1,10 +1,5 @@
 Extension { #name : #SnapDump }
 
-{ #category : #'*SnapDump-Handler' }
-SnapDump class >> beHandler [
-	self deprecated: 'handlers are always present now. This call is not necessary anymore'
-]
-
 { #category : #'*SnapDump-Handler' }
 SnapDump class >> handleException: exception [
 	^ self handler handleException: exception 

source/SnapDump-UI/SDSnapshot.extension.st

@@ -1,26 +1,5 @@
 Extension { #name : #SDSnapshot }
 
-{ #category : #'*SnapDump-UI' }
-SDSnapshot >> gtInspectorSnapshotIn: composite [
-	<gtInspectorPresentationOrder: 100>
-	composite table
-		title: [ 'Fields' ];
-		display: [ self metaFields  ];
-		column: 'Field' evaluated: [:s | s capitalized ];
-		column: 'Value' evaluated: [:s | self perform: s ];
-		addAction: (GLMGenericAction new
-			action: [ :table | self openDebugger. table update ]; 
-			iconName: #smallOpenIcon;
-			title: 'Open Snapshot' translated;
-			shouldShowTitle: true);
-		addAction: (GLMGenericAction new
-			action: [ :table | self remove. table update ]; 
-			iconName: #glamorousCancel;
-			title: 'Remove Snapshot' translated;
-			shouldShowTitle: true)
-
-]
-
 { #category : #'*SnapDump-UI' }
 SDSnapshot >> openStackTrace [
 	UIManager default edit: (

source/SnapDump-UI/SDSnapshotPresenter.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #SDSnapshotPresenter,
-	#superclass : #ComposablePresenter,
+	#superclass : #SpPresenter,
 	#instVars : [
 		'menu',
 		'meta',
@@ -9,19 +9,18 @@ Class {
 	#category : #'SnapDump-UI'
 }
 
-{ #category : #specs }
-SDSnapshotPresenter class >> defaultSpec [
+{ #category : #layout }
+SDSnapshotPresenter class >> defaultLayout [
 	<spec: #default>
 
-	^ SpecLayout composed
-		newRow: [ :c | c add: #menu ] origin: 0@0 corner: [email protected];
-		newRow: [ :c | c add: #meta ] origin: [email protected] corner: 1@1 ;
+	^ SpBoxLayout newTopToBottom 
+		add: #meta;
 		yourself
 ]
 
 { #category : #initialization }
 SDSnapshotPresenter >> initializeWidgets [
-	menu := MenuPresenter new
+	menu := SpMenuPresenter new
 		addGroup: [ :group | 
 			group
 				addItem: [ :item | 
@@ -47,9 +46,9 @@ SDSnapshotPresenter >> initializeWidgets [
 						icon: (self iconNamed: #transcript);
 						action: [ snapshot ifNotNil: [snapshot openStackTrace] ] ].		
 					].
-	menu applyTo: self.
-	meta := self newMultiColumnList 
-		displayBlock: [ :key | { key . (Text fromString: (snapshot perform: key) printString) }  ]
+	"menu applyTo: self."
+	meta := self newList 
+		display: [ :key | key , ': ', (Text fromString: (snapshot perform: key) printString)  ]
 ]
 
 { #category : #'as yet unclassified' }

source/SnapDump-UI/SnapDump.extension.st

@@ -1,8 +1,9 @@
 Extension { #name : #SnapDump }
 
 { #category : #'*SnapDump-UI' }
-SnapDump class >> ui [ 
-	^ SnapDumpUI new 
-		snapDump: self client;
-		openWithSpec
+SnapDump class >> ui [
+
+	^ SnapDumpUI new
+		  snapDump: self client;
+		  open
 ]