Add tests

src/OpenTelemetry-Instrumentation-Tests/OTAbstractInstrumentationTest.class.st

@@ -0,0 +1,30 @@
+Class {
+	#name : 'OTAbstractInstrumentationTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'target'
+	],
+	#category : 'OpenTelemetry-Instrumentation-Tests',
+	#package : 'OpenTelemetry-Instrumentation-Tests'
+}
+
+{ #category : 'accessing' }
+OTAbstractInstrumentationTest >> instrumentationClass [
+
+	self subclassResponsibility
+]
+
+{ #category : 'running' }
+OTAbstractInstrumentationTest >> setUp [
+
+	super setUp.
+	self instrumentationClass install.
+	target := OTTestTarget new
+]
+
+{ #category : 'running' }
+OTAbstractInstrumentationTest >> tearDown [
+
+	self instrumentationClass uninstall.
+	super tearDown
+]

src/OpenTelemetry-Instrumentation-Tests/OTSampledInstrumentationTest.class.st

@@ -0,0 +1,22 @@
+Class {
+	#name : 'OTSampledInstrumentationTest',
+	#superclass : 'OTAbstractInstrumentationTest',
+	#category : 'OpenTelemetry-Instrumentation-Tests',
+	#package : 'OpenTelemetry-Instrumentation-Tests'
+}
+
+{ #category : 'accessing' }
+OTSampledInstrumentationTest >> instrumentationClass [
+
+	^ OTTestSampledInstrumentation
+]
+
+{ #category : 'tests' }
+OTSampledInstrumentationTest >> testFixedRateSampler [
+
+	self deny: OTTestSampledInstrumentation hasRunOnEnter.
+	target answer.
+	self deny: OTTestSampledInstrumentation hasRunOnEnter.
+	target answer.
+	self assert: OTTestSampledInstrumentation hasRunOnEnter
+]

src/OpenTelemetry-Instrumentation-Tests/OTSimpleInstrumentationTest.class.st

@@ -3,38 +3,26 @@ An OTInstrumentationConfigurationTest is a test class for testing the behavior o
 "
 Class {
 	#name : 'OTSimpleInstrumentationTest',
-	#superclass : 'TestCase',
-	#instVars : [
-		'target'
-	],
+	#superclass : 'OTAbstractInstrumentationTest',
 	#category : 'OpenTelemetry-Instrumentation-Tests',
 	#package : 'OpenTelemetry-Instrumentation-Tests'
 }
 
-{ #category : 'running' }
-OTSimpleInstrumentationTest >> setUp [
+{ #category : 'accessing' }
+OTSimpleInstrumentationTest >> instrumentationClass [
 
-	super setUp.
-	OTTestSimpleInstrumentation install.
-	target := OTTestTarget new
-]
-
-{ #category : 'running' }
-OTSimpleInstrumentationTest >> tearDown [
-
-	OTTestSimpleInstrumentation uninstall.
-	super tearDown
+	^ OTTestSimpleInstrumentation
 ]
 
 { #category : 'tests' }
 OTSimpleInstrumentationTest >> testEnsureHasRunOnExit [
 
 	self deny: OTTestSimpleInstrumentation hasRunOnExit.
-	[
-	target fail.
-	self fail "should not reach" ]
-		on: Error
-		do: [ nil ].
+	self
+		should: [
+			target fail.
+			self fail "should not reach" ]
+		raise: Error.
 	self assert: OTTestSimpleInstrumentation hasRunOnExit
 ]
 
@@ -53,6 +41,16 @@ OTSimpleInstrumentationTest >> testEventHasConfiguredData [
 	self assert: event fourth class equals: self class
 ]
 
+{ #category : 'tests' }
+OTSimpleInstrumentationTest >> testEventHasOperation [
+
+	| event |
+	target answer. "run instrumented method"
+	event := OTTestSimpleInstrumentation capturedEvent.
+	self assert: event isNotEmpty.
+	self assert: event first class identicalTo: RFMethodOperation
+]
+
 { #category : 'tests' }
 OTSimpleInstrumentationTest >> testHasRun [
 
@@ -81,15 +79,8 @@ OTSimpleInstrumentationTest >> testIsOneShot [
 ]
 
 { #category : 'tests' }
-OTSimpleInstrumentationTest >> testRecordException [
-
-	| span error |
-	span := OTSpan new start.
-	[ target fail ]
-		on: Error
-		do: [ :err | error := err ].
-	[
-	self assert: span status equals: 'ERROR'.
-	self assert: (span attributes at: 'error') equals: error description ]
-		ensure: [ span end ]
+OTSimpleInstrumentationTest >> testPassException [
+	"The instrumentation should let the exception happen normally."
+
+	self should: [ target fail ] raise: Error
 ]

src/OpenTelemetry-Instrumentation-Tests/OTSpanInstrumentationTest.class.st

@@ -1,34 +1,117 @@
 Class {
 	#name : 'OTSpanInstrumentationTest',
-	#superclass : 'TestCase',
+	#superclass : 'OTAbstractInstrumentationTest',
 	#instVars : [
-		'target'
+		'currentProcessor'
 	],
 	#category : 'OpenTelemetry-Instrumentation-Tests',
 	#package : 'OpenTelemetry-Instrumentation-Tests'
 }
 
+{ #category : 'accessing' }
+OTSpanInstrumentationTest >> instrumentationClass [
+
+	^ OTTestSpanInstrumentation
+]
+
 { #category : 'running' }
 OTSpanInstrumentationTest >> setUp [
+	"Remember the configured processor."
 
 	super setUp.
-	OTTestSpanInstrumentation install.
-	target := OTTestTarget new
+	currentProcessor := OTSpanProcessor current.
+	OTBatchSpanProcessor new beCurrent
 ]
 
 { #category : 'running' }
 OTSpanInstrumentationTest >> tearDown [
+	"Restore the configured processor."
 
-	OTTestSpanInstrumentation uninstall.
+	currentProcessor beCurrent.
 	super tearDown
 ]
 
 { #category : 'tests' }
-OTSpanInstrumentationTest >> testFixedRateSampler [
+OTSpanInstrumentationTest >> testDefaultSpanKind [
 
-	self deny: OTTestSpanInstrumentation hasRunOnEnter.
 	target answer.
-	self deny: OTTestSpanInstrumentation hasRunOnEnter.
+	self
+		assert: OTTestSpanInstrumentation capturedSpan kind
+		equals: OTSpan internal
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testDefaultSpanName [
+
+	target answer.
+	self
+		assert: OTTestSpanInstrumentation capturedSpan name
+		equals: (OTTestTarget >> #answer) name
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testRecordException [
+
+	| error span |
+	[ target fail ]
+		on: Error
+		do: [ :err | error := err ].
+	span := OTTestSpanInstrumentation capturedSpan.
+	self assert: span status equals: 'ERROR'.
+	self
+		assert: (span attributes at: 'exception')
+		equals: error description
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testSpanAttributes [
+	"Attributes were created and populated on method enter and exit."
+
+	| attributes |
 	target answer.
-	self assert: OTTestSpanInstrumentation hasRunOnEnter
+	attributes := OTTestSpanInstrumentation capturedSpan attributes.
+	self assert: attributes isNotNil.
+	self assert: (attributes includesKey: 'enter').
+	self assert: (attributes at: 'enter') equals: #OK.
+	self assert: (attributes includesKey: 'exit').
+	self assert: (attributes at: 'exit') equals: #OK
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testSpanExists [
+
+	self assert: OTTestSpanInstrumentation capturedSpan isNil.
+	target answer.
+	self
+		assert: OTTestSpanInstrumentation capturedSpan class
+		identicalTo: OTSpan
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testSpanLifetime [
+
+	| span |
+	target answer.
+	span := OTTestSpanInstrumentation capturedSpan.
+	self assert: span startTime isNotNil.
+	self assert: span endTime isNotNil.
+	self assert: span startTime <= span endTime
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testSpanStatus [
+
+	target answer.
+	self
+		assert: OTTestSpanInstrumentation capturedSpan status
+		equals: #OK
+]
+
+{ #category : 'tests' }
+OTSpanInstrumentationTest >> testSpanSuppression [
+
+	| span |
+	target suppressedAnswer.
+	span := OTTestSpanInstrumentation capturedSpan.
+	self assert: (span attributes includesKey: 'suppressed')
 ]

src/OpenTelemetry-Instrumentation-Tests/OTTestInstrumentationModule.class.st

@@ -21,5 +21,8 @@ OTTestInstrumentationModule class >> instrumentationName [
 { #category : 'accessing' }
 OTTestInstrumentationModule class >> instrumentations [
 
-	^ { OTTestSimpleInstrumentation. OTTestSpanInstrumentation }
+	^ {
+		  OTTestSimpleInstrumentation.
+		  OTTestSampledInstrumentation.
+		  OTTestSpanInstrumentation }
 ]

src/OpenTelemetry-Instrumentation-Tests/OTTestSampledInstrumentation.class.st

@@ -0,0 +1,12 @@
+Class {
+	#name : 'OTTestSampledInstrumentation',
+	#superclass : 'OTTestInstrumentation',
+	#category : 'OpenTelemetry-Instrumentation-Tests',
+	#package : 'OpenTelemetry-Instrumentation-Tests'
+}
+
+{ #category : 'configuring' }
+OTTestSampledInstrumentation class >> defineSampler [
+
+	sampler := OTSampler withRate: 2
+]

src/OpenTelemetry-Instrumentation-Tests/OTTestSpanInstrumentation.class.st

@@ -1,18 +1,54 @@
 Class {
 	#name : 'OTTestSpanInstrumentation',
 	#superclass : 'OTTestInstrumentation',
+	#classInstVars : [
+		'capturedSpan',
+		'suppressed'
+	],
 	#category : 'OpenTelemetry-Instrumentation-Tests',
 	#package : 'OpenTelemetry-Instrumentation-Tests'
 }
 
+{ #category : 'instrumenting' }
+OTTestSpanInstrumentation class >> capturedSpan [
+
+	^ capturedSpan
+]
+
 { #category : 'configuring' }
 OTTestSpanInstrumentation class >> defineInstrumenter [
 
-	instrumenter := OTInstrumenter forInstrumentationNamed: 'test'
+	instrumenter := OTInstrumenter forInstrumentationNamed: 'test'.
+	instrumenter spanSuppressionStrategy: [ :span :kind |
+		span isNotNil and: [ span name includesSubstring: 'suppressed' ] ]
 ]
 
-{ #category : 'configuring' }
-OTTestSpanInstrumentation class >> defineSampler [
+{ #category : 'instrumenting' }
+OTTestSpanInstrumentation class >> onMethodEnter: event [
+
+	| request |
+	request := event first method.
+	(suppressed := (instrumenter
+		                shouldStartUnder: OTSpan current
+		                request: request) not) ifTrue: [
+		^ capturedSpan attributeAt: 'suppressed' put: true ].
+	capturedSpan := instrumenter startRequest: request.
+	capturedSpan attributeAt: 'enter' put: #OK
+]
+
+{ #category : 'instrumenting' }
+OTTestSpanInstrumentation class >> onMethodExit: event withValue: returnValue [
+
+	suppressed ifTrue: [ "suppress only once" ^ suppressed := false ].
+	capturedSpan attributeAt: 'exit' put: #OK.
+	capturedSpan status ifNil: [ capturedSpan setOkStatus ].
+	instrumenter end: capturedSpan
+]
+
+{ #category : 'class initialization' }
+OTTestSpanInstrumentation class >> reset [
 
-	sampler := OTSampler withRate: 2
+	super reset.
+	capturedSpan := nil.
+	suppressed := false
 ]

src/OpenTelemetry-Instrumentation-Tests/OTTestTarget.class.st

@@ -5,14 +5,26 @@ Class {
 	#package : 'OpenTelemetry-Instrumentation-Tests'
 }
 
-{ #category : 'accessing' }
+{ #category : 'test methods' }
 OTTestTarget >> answer [
 
 	^ 42
 ]
 
-{ #category : 'asserting' }
+{ #category : 'test methods' }
 OTTestTarget >> fail [
 
 	Error signal
 ]
+
+{ #category : 'test methods' }
+OTTestTarget >> indirectAnswer [
+
+	^ self answer
+]
+
+{ #category : 'test methods' }
+OTTestTarget >> suppressedAnswer [
+
+	^ self answer
+]