Merge branch 'Pharo9.0' of github.com:pharo-project/pharo into Pharo9.0

src/Athens-Cairo/AthensCairoSurface.class.st

@@ -342,9 +342,12 @@ AthensCairoSurface class >> primImage: aFormat width: aWidth height: aHeight [
 
 { #category : #private }
 AthensCairoSurface class >> primImageFromData: data width: width height: height pitch: stride [
+
+	"CAIRO_FORMAT_ARGB32 -> 0"
+
 	^ self ffiCall: #(AthensCairoSurface cairo_image_surface_create_for_data (
 		void *data,
-		CAIRO_FORMAT_ARGB32,
+		0,
 		int width,
 		int height,
 		int stride) )

src/Calypso-SystemPlugins-Reflectivity-Browser-Tests/ClyInstallMetaLinkPresenterTest.class.st

@@ -0,0 +1,142 @@
+Class {
+	#name : #ClyInstallMetaLinkPresenterTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'node',
+		'metalink',
+		'metalink2',
+		'breakpoint',
+		'executionCounter',
+		'watchpoint'
+	],
+	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Tests-Metalinks'
+}
+
+{ #category : #'helper methods' }
+ClyInstallMetaLinkPresenterTest >> dummyMethod [
+	self
+]
+
+{ #category : #'helper methods' }
+ClyInstallMetaLinkPresenterTest >> nodeInRealMethod [
+	^(self class >> #dummyMethod) ast statements first
+]
+
+{ #category : #running }
+ClyInstallMetaLinkPresenterTest >> presenterForMetalinkInstallation [
+	^ClyMetaLinkInstallationPresenter onNode: node forInstallation:  true
+]
+
+{ #category : #running }
+ClyInstallMetaLinkPresenterTest >> presenterForMetalinkUninstallation [
+	^ ClyMetaLinkInstallationPresenter onNode: node forInstallation: false
+]
+
+{ #category : #running }
+ClyInstallMetaLinkPresenterTest >> setUp [
+	super setUp.
+	MetaLink uninstallAll.
+	node := RBTemporaryNode named: 'test'.
+	metalink := MetaLink new.
+	metalink2 := MetaLink new.
+	breakpoint := MetaLink new metaObject: Break; yourself.
+	executionCounter := MetaLink new metaObject: ExecutionCounter new; yourself.
+	watchpoint := MetaLink new metaObject: Watchpoint new; yourself.
+	node propertyAt: #links put: {metalink. breakpoint. executionCounter. watchpoint} asOrderedCollection 
+
+]
+
+{ #category : #running }
+ClyInstallMetaLinkPresenterTest >> tearDown [
+	metalink uninstall.
+	metalink2 uninstall.
+	super tearDown
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testInstallSelectedMetalink [
+	|presenter list|
+	presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation:  true.
+	list := presenter metalinkListPresenter.
+	list clickItem: 1.
+	self deny: self nodeInRealMethod hasLinks.
+	presenter installSelectedMetalink.
+	self assert: self nodeInRealMethod hasLinks.
+	self assert: self nodeInRealMethod links asArray first identicalTo: list items first 
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testInstallSelectedMetalinkActionButton [
+	|presenter list|
+	presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation:  true.
+	list := presenter metalinkListPresenter.
+	list clickItem: 1.	
+	self deny: self nodeInRealMethod hasLinks.
+	presenter toolbarButtons first execute.
+	self assert: self nodeInRealMethod hasLinks.
+	self assert: self nodeInRealMethod links asArray first identicalTo: list items first 
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testRelevantMetalinksForInstallation [
+	|links|
+	links := self presenterForMetalinkInstallation allRelevantMetaLinks.
+	self assert: links size >= 2.
+	self assertCollection: links includesAll: { metalink. metalink2 }.
+	self denyCollection: links includesAll: { breakpoint. watchpoint. executionCounter  }.
+
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testRelevantMetalinksForUninstallation [
+	| links |
+	links := self presenterForMetalinkUninstallation allRelevantMetaLinks.
+	self assert: links size equals: 1.
+	self assertCollection: links hasSameElements: { metalink }
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testToolbarButtonsCollectionSize [
+	self assert: self presenterForMetalinkInstallation toolbarButtons size equals: 2.
+	self assert: self presenterForMetalinkUninstallation toolbarButtons size equals: 2.
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testToolbarButtonsForMetalinkInstallation [
+	|toolbarButtons|
+	toolbarButtons := self presenterForMetalinkInstallation toolbarButtons.
+	self assert: toolbarButtons first label equals: 'Install'.
+	self assert: toolbarButtons last label equals: 'Cancel'.
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testToolbarButtonsForMetalinkUninstallation [
+	|toolbarButtons|
+	toolbarButtons := self presenterForMetalinkUninstallation toolbarButtons.
+	self assert: toolbarButtons first label equals: 'Uninstall'.
+	self assert: toolbarButtons last label equals: 'Cancel'.
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testUninstallSelectedMetalink [
+	|presenter list|
+	self nodeInRealMethod link: metalink.
+	presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation:  false.
+	list := presenter metalinkListPresenter.
+	list clickItem: 1.
+	self assert: self nodeInRealMethod hasLinks.
+	presenter uninstallSelectedMetalink.
+	self deny: self nodeInRealMethod hasLinks
+]
+
+{ #category : #tests }
+ClyInstallMetaLinkPresenterTest >> testUninstallSelectedMetalinkActionButton [
+	|presenter list|
+	self nodeInRealMethod link: metalink.
+	presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation:  false.
+	list := presenter metalinkListPresenter.
+	list clickItem: 1.	
+	self assert: self nodeInRealMethod hasLinks.
+	presenter toolbarButtons first execute.
+	self deny: self nodeInRealMethod hasLinks
+]

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddBreakpointCommand.class.st

@@ -7,7 +7,7 @@ My subclasses should implement single method:
 "
 Class {
 	#name : #ClyAddBreakpointCommand,
-	#superclass : #ClyMetalinkCommand,
+	#superclass : #ClyDebuggingCommand,
 	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Breakpoints'
 }
 

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddExecutionCounterCommand.class.st

@@ -3,7 +3,7 @@ I am a command to install execution counter into given method or source node
 "
 Class {
 	#name : #ClyAddExecutionCounterCommand,
-	#superclass : #ClyMetalinkCommand,
+	#superclass : #ClyDebuggingCommand,
 	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-ExecutionCounters'
 }
 

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddWatchpointCommand.class.st

@@ -3,7 +3,7 @@ I am a command to install watchpoint into the given method or source node
 "
 Class {
 	#name : #ClyAddWatchpointCommand,
-	#superclass : #ClyMetalinkCommand,
+	#superclass : #ClyDebuggingCommand,
 	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Watchpoints'
 }
 

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingCommand.class.st

@@ -0,0 +1,43 @@
+"
+I am a base class for commands which add/remove metalinks into given method or source node
+"
+Class {
+	#name : #ClyDebuggingCommand,
+	#superclass : #SycSourceCodeCommand,
+	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands'
+}
+
+{ #category : #activation }
+ClyDebuggingCommand class >> contextMenuOrder [
+	<classAnnotationDependency>
+	self subclassResponsibility
+]
+
+{ #category : #testing }
+ClyDebuggingCommand class >> isAbstract [
+	^self = ClyDebuggingCommand 
+]
+
+{ #category : #activation }
+ClyDebuggingCommand class >> methodContextMenuActivation [
+	<classAnnotation>
+
+	^CmdContextMenuActivation 
+		byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethod asCalypsoItemContext
+]
+
+{ #category : #activation }
+ClyDebuggingCommand class >> methodEditorLeftBarMenuActivation [
+	<classAnnotation>
+
+	^CmdTextLeftBarMenuActivation 
+		byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext
+]
+
+{ #category : #activation }
+ClyDebuggingCommand class >> sourceCodeMenuActivation [
+	<classAnnotation>
+
+	^SycDebuggingMenuActivation 
+		byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext
+]

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkMenuGroup.class.st → src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingMenuGroup.class.st

@@ -2,17 +2,17 @@
 I am menu group to arrange together all metalink related commands (breakpoints, counters, watchpoints)
 "
 Class {
-	#name : #ClyMetalinkMenuGroup,
+	#name : #ClyDebuggingMenuGroup,
 	#superclass : #CmdMenuGroup,
 	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands'
 }
 
 { #category : #testing }
-ClyMetalinkMenuGroup >> isInlined [
+ClyDebuggingMenuGroup >> isInlined [
 	^true
 ]
 
 { #category : #accessing }
-ClyMetalinkMenuGroup >> order [
+ClyDebuggingMenuGroup >> order [
 	^1.5
 ]

src/Calypso-SystemPlugins-Reflectivity-Browser/ClyInstallMetaLinkCommand.class.st

@@ -0,0 +1,29 @@
+"
+I am a command to install metalinks on the selected method or one of its ast nodes.
+I open a small browser to choose which metalink to install among existing metalink instances.
+"
+Class {
+	#name : #ClyInstallMetaLinkCommand,
+	#superclass : #ClyDebuggingCommand,
+	#category : #'Calypso-SystemPlugins-Reflectivity-Browser-Metalinks'
+}
+
+{ #category : #activation }
+ClyInstallMetaLinkCommand class >> contextMenuOrder [
+	^100
+]
+
+{ #category : #accessing }
+ClyInstallMetaLinkCommand >> defaultMenuIconName [
+	^#smallObjects
+]
+
+{ #category : #accessing }
+ClyInstallMetaLinkCommand >> defaultMenuItemName [
+	^'Install MetaLink...'
+]
+
+{ #category : #execution }
+ClyInstallMetaLinkCommand >> execute [
+	ClyMetaLinkInstallationPresenter openInstallerOnNode: sourceNode
+]