A setup can run a second time

source/Canopy-Core-Tests/CanopyAccessorTest.class.st

@@ -146,3 +146,41 @@ CanopyAccessorTest >> testValueWriteRaisesControlledErrorWhenNoWriteSelector [
 	accessor now raises the same kind of controlled error for the opposite direction."
 	self should: [ CanopyAccessor new value: 5 ] raise: Error
 ]
+
+{ #category : 'as yet unclassified' }
+CanopyAccessorTest >> testTheSameDeclarationMergedAgainIsNotAConflict [
+	"The narrow case that lets a class register itself twice: same object, same selectors.
+	There is nothing to merge, so nothing happens - as opposed to the two cases below, where
+	two different things want the same place and the conflict is real."
+	| object left right |
+	object := CanopyRootTestObject new.
+	left := CanopyAccessor new object: object; readSelector: #one; yourself.
+	right := CanopyAccessor new object: object; readSelector: #one; yourself.
+	self shouldnt: [ left merge: right ] raise: Error
+]
+
+{ #category : 'as yet unclassified' }
+CanopyAccessorTest >> testTwoAccessorsOnDifferentObjectsStillConflict [
+	"Two objects that are equal but not the same declare two different things."
+	| left right |
+	left := CanopyAccessor new object: CanopyRootTestObject new; readSelector: #one; yourself.
+	right := CanopyAccessor new object: CanopyRootTestObject new; readSelector: #one; yourself.
+	self should: [ left merge: right ] raise: Error
+]
+
+{ #category : 'as yet unclassified' }
+CanopyAccessorTest >> testTwoAccessorsReadingThroughDifferentSelectorsStillConflict [
+	| object left right |
+	object := CanopyRootTestObject new.
+	left := CanopyAccessor new object: object; readSelector: #one; yourself.
+	right := CanopyAccessor new object: object; readSelector: #printString; yourself.
+	self should: [ left merge: right ] raise: Error
+]
+
+{ #category : 'as yet unclassified' }
+CanopyAccessorTest >> testTwoAccessorsThatDeclareNothingStillConflict [
+	"Two empty accessors are not one declaration made twice - they are no declaration at all,
+	and CanopyMergeTest has said so since 2026-07-21. Written down here too, because it is the
+	one case the repeat-tolerance above must not swallow."
+	self should: [ CanopyAccessor new merge: CanopyAccessor new ] raise: Error
+]

source/Canopy-Core-Tests/CanopyDomainTest.class.st

@@ -141,6 +141,20 @@ CanopyDomainTest >> testRegisterSystemMetricsRegistersImageAndVirtualMachineDoma
 		ensure: [ Canopy reset ]
 ]
 
+{ #category : 'as yet unclassified' }
+CanopyDomainTest >> testRegisterSystemMetricsTwiceLeavesTheSameTree [
+	"An image can reach its setup a second time - a REPL that stops the server and starts it
+	again, a test that exercises the deployment path. This used to raise 'conflict': every
+	class merges its declarations into the same node, and a leaf bound to a live object
+	refused to merge with a second one, even when the second one said exactly the same."
+	[ Canopy registerSystemMetrics.
+	Canopy registerSystemMetrics.
+	self assert: Canopy domainNames asArray equals: #( #pharo ).
+	self assertCollection: (Canopy / #pharo) keys asArray hasSameElements: #( #image #virtualMachine ).
+	self assert: (Canopy / #pharo / #virtualMachine / #memorySize) value isNumber ]
+		ensure: [ Canopy reset ]
+]
+
 { #category : 'as yet unclassified' }
 CanopyDomainTest >> testRegisterVirtualMachineMetricsRegistersTheVirtualMachineHalfUnderPharo [
 	"See testRegisterImageMetricsRegistersTheImageHalfUnderPharo - the same for the other half."
@@ -157,3 +171,27 @@ CanopyDomainTest >> testSlashOnLeafRaisesError [
 	root at: #leaf put: (CanopyCell new value: 42).
 	self should: [ (root / #leaf) / #anything ] raise: Error
 ]
+
+{ #category : 'as yet unclassified' }
+CanopyDomainTest >> testUseNewInstanceDuringPutsThePreviousTreeBack [
+	"What a test needs that has to register domains of its own, and what #reset alone does not
+	give: the tree that was there before comes back. These test classes travel into the server
+	images, and AGTestRunnerHandler runs any suite in the image it is asked for over /health -
+	a #reset there takes the tree the server is serving and nothing says so.
+
+	Reset at both ends, and the leading one is not decoration: this test has to put something
+	into the ambient tree to have something to get back, and the very leak it would otherwise
+	leave behind is what it exists to prevent."
+	| before during |
+	[ Canopy reset.
+	before := Canopy instance.
+	before at: #somethingTheServerServes put: (CanopyCell new value: 1).
+	Canopy useNewInstanceDuring: [
+		during := Canopy instance.
+		Canopy registerDomainNamed: #mine with: CanopyBranchNode new ].
+	self deny: during identicalTo: before.
+	self assert: Canopy instance identicalTo: before.
+	self assert: (Canopy / #somethingTheServerServes) value equals: 1.
+	self deny: (Canopy domainNames includes: #mine) ]
+		ensure: [ Canopy reset ]
+]

source/Canopy-Core/Canopy.class.st

@@ -34,6 +34,13 @@ Canopy class >> instance [
 		instance := self new  ]
 ]
 
+{ #category : 'accessing' }
+Canopy class >> instance: aCanopy [
+	"Put a tree back that #useNewInstanceDuring: took away. Nothing else has business
+	replacing the singleton - #reset is how you let go of one."
+	instance := aCanopy
+]
+
 { #category : 'domains' }
 Canopy class >> registerDomainNamed: aSymbol with: aNode [
 	^ self instance registerDomainNamed: aSymbol with: aNode
@@ -78,6 +85,22 @@ Canopy class >> reset [
 	instance := nil 
 ]
 
+{ #category : 'initialization' }
+Canopy class >> useNewInstanceDuring: aBlock [
+	"Evaluate aBlock against a fresh, empty tree and put the previous one back afterwards.
+
+	For a test that has to register domains of its own. #reset alone was what such a test
+	used to do, and it is right in an image that exists for the test run - but these test
+	classes travel into the server images, and AGTestRunnerHandler runs any TestCase suite
+	in the image it is asked for over /health. There #reset takes the tree the server is
+	serving: #instance lazily builds an empty one, setupMetrics never runs again, and
+	/metrics answers 200 with an empty body. A scrape cannot tell that from silence."
+	| previous |
+	previous := instance.
+	instance := self new.
+	^ aBlock ensure: [ instance := previous ]
+]
+
 { #category : 'domains' }
 Canopy >> domainNames [
 	^ self keys

source/Canopy-Core/CanopyAccessor.class.st

@@ -35,6 +35,22 @@ CanopyAccessor >> asRawValue [
 	^ readSelector ifNotNil: [ self value ]
 ]
 
+{ #category : 'testing' }
+CanopyAccessor >> declaresSameAs: aNode [
+	"Same object, same way in and same way out. Three things this deliberately does not say
+	yes to: an accessor that declares nothing at all - no object, or no selector in either
+	direction - is not the same declaration as another empty one, it is no declaration, and
+	two of them meeting is the oddity CanopyMergeTest has guarded since 2026-07-21. And the
+	object is compared by identity, because two equal-but-distinct objects are two different
+	things to read from."
+	^ object notNil
+		and: [ (readSelector notNil or: [ writeSelector notNil ])
+		and: [ (aNode isKindOf: CanopyAccessor)
+		and: [ aNode object == object
+		and: [ aNode readSelector = readSelector
+		and: [ aNode writeSelector = writeSelector ] ] ] ] ]
+]
+
 { #category : 'initialization' }
 CanopyAccessor >> initializeFromPragma: aPragma [
 	"The direction comes from the arity of the declaring method: one that takes a value can only
@@ -51,6 +67,23 @@ CanopyAccessor >> initializeFromPragma: aPragma [
 			writeSelector := aPragma method selector ]
 ]
 
+{ #category : 'actions' }
+CanopyAccessor >> mergeInto: aNode [
+	"A leaf bound to a live object still cannot be merged with another one - that is what
+	CanopyLeafNode says and it stays true. What this adds is narrower: a leaf that declares
+	the very same thing, the same object read and written through the same selectors, is not
+	a second declaration but the same one again. Then there is nothing to merge, and saying
+	so lets a class register itself twice without the second time failing - which is what an
+	image does when its setup runs again."
+	(self declaresSameAs: aNode) ifTrue: [ ^ aNode ].
+	^ super mergeInto: aNode
+]
+
+{ #category : 'accessing' }
+CanopyAccessor >> object [
+	^ object
+]
+
 { #category : 'accessing' }
 CanopyAccessor >> object: anObject [
 	object := anObject
@@ -65,6 +98,11 @@ CanopyAccessor >> printOn: aStream [
 		aStream << ']' ]
 ]
 
+{ #category : 'accessing' }
+CanopyAccessor >> readSelector [
+	^ readSelector
+]
+
 { #category : 'accessing' }
 CanopyAccessor >> readSelector: aSelector [
 	readSelector := aSelector
@@ -93,6 +131,11 @@ CanopyAccessor >> valueHolder [
 	^ (object perform: readSelector) asCanopyValue
 ]
 
+{ #category : 'accessing' }
+CanopyAccessor >> writeSelector [
+	^ writeSelector
+]
+
 { #category : 'accessing' }
 CanopyAccessor >> writeSelector: aSelector [
 	writeSelector := aSelector

source/Canopy-Metrics-Tests/CanopyZincCounterTest.class.st

@@ -90,3 +90,25 @@ CanopyZincCounterTest >> testRegisterZincMetricsRegistersZincDomainWithExpectedV
 	self assert: (output includesSubstring: '# HELP zinc_duration Average duration of requests') ]
 		ensure: [ CanopyZincCounter instance uninstall. Canopy reset. CanopyZincCounter reset ]
 ]
+
+{ #category : 'as yet unclassified' }
+CanopyZincCounterTest >> announcerSubscriptionsOfTheCounter [
+	"The one place this test reaches into the announcer. What it is really asking is how often
+	the counter is subscribed, and the announcer is the only one who knows."
+	^ ZnLogEvent announcer subscriptions subscriptions
+		select: [ :each | each subscriber == CanopyZincCounter instance ]
+]
+
+{ #category : 'as yet unclassified' }
+CanopyZincCounterTest >> testRegisterZincMetricsTwiceSubscribesOnce [
+	"Both halves of a second registration used to go wrong, and only one of them said so: the
+	domain registration raised, and before it did, the counter had already subscribed a second
+	time - so a retry, or a caller that swallowed the error, counted every request twice from
+	then on."
+	[ CanopyZincCounter reset.
+	Canopy registerZincMetrics.
+	self shouldnt: [ Canopy registerZincMetrics ] raise: Error.
+	self assert: self announcerSubscriptionsOfTheCounter size equals: 1.
+	self assert: Canopy domainNames asArray equals: #( #zinc ) ]
+		ensure: [ CanopyZincCounter instance uninstall. Canopy reset. CanopyZincCounter reset ]
+]

source/Canopy-Metrics/CanopyZincCounter.class.st

@@ -18,8 +18,17 @@ Class {
 
 { #category : 'installing' }
 CanopyZincCounter class >> canopyRegister [
+	"Repeatable, because an image can run its setup a second time - a REPL that stops and
+	starts the server again, a test that exercises it. Both halves used to fail there: the
+	subscription was made twice, and the domain registration then raised.
+
+	The strictness stays where it belongs. #registerDomainNamed:with: still refuses a second
+	owner for #zinc, and the merge below still answers 'conflict' when what hangs under
+	#zinc is not this counter's own declaration."
 	self install.
-	^ Canopy registerDomainNamed: #zinc with: (CanopyMappingBuilder new object: self instance; map: CanopyBranchNode new; build)
+	^ (Canopy instance at: #zinc ifAbsent: [ nil ])
+		ifNil: [ Canopy registerDomainNamed: #zinc with: self instance canopyMapping ]
+		ifNotNil: [ :domain | domain merge: self instance canopyMapping ]
 ]
 
 { #category : 'installing' }
@@ -130,7 +139,11 @@ CanopyZincCounter >> initializeResponses [
 
 { #category : 'installing' }
 CanopyZincCounter >> install [
-	registration := ZnLogEvent announcer
+	"Once. The announcer takes a second subscription without a word and then hands every
+	request to both of them, so the counter quietly counts double - the silent half of a
+	setup that ran again."
+	registration ifNotNil: [ ^ registration ].
+	^ registration := ZnLogEvent announcer
 		when: ZnSimplifiedServerTransactionEvent
 		do: [ :ann | self handleAnnouncement: ann ]
 		for: self
@@ -167,5 +180,7 @@ CanopyZincCounter >> responsesCanopy [
 
 { #category : 'installing' }
 CanopyZincCounter >> uninstall [
-	ZnLogEvent announcer unsubscribe: self
+	"Let go of the subscription and say so, or #install would refuse to make a new one."
+	ZnLogEvent announcer unsubscribe: self.
+	registration := nil
 ]