Fix CORS test on github actions (#1400)

.github/workflows/ci.yml

@@ -22,7 +22,7 @@ jobs:
     continue-on-error: ${{ matrix.experimental }}
     name: ${{ matrix.smalltalk }}
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - uses: hpi-swa/setup-smalltalkCI@v1
         with:
           smalltalk-image: ${{ matrix.smalltalk }}
@@ -42,6 +42,12 @@ jobs:
           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
         shell: bash
         timeout-minutes: 20
+      - name: Archive production artifacts
+        uses: actions/upload-artifact@v4
+        if: always()
+        with:
+          name: Screenshots Test Failures ${{ matrix.smalltalk }}
+          path: ${{ env.SMALLTALK_CI_BUILD }}/*.png
       - name: Upload coverage to Codecov
         uses: codecov/codecov-action@v3
         with:

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/crossOriginDataUrl.st

@@ -2,8 +2,8 @@ accessing-urls
 crossOriginDataUrl
 
 	| parts host port |
-	parts := self requestContext request host findTokens: ':'.
+	parts := self requestContext request host substrings: ':'.
 	host := parts first.
-	port := parts last asInteger.
+	port := parts last greaseInteger.
 	self assert: port ~= WACORSResourceExample corsAdaptorPort.
 	^ self buildDataUrlFor: host port: WACORSResourceExample corsAdaptorPort

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/errorHandlerFunction.st

@@ -1,8 +1,7 @@
 javascript
 errorHandlerFunction
 
-	^ (JSStream on: 'console.error(arguments[0])') , (JSStream on:
-		   'document.getElementById("result").style.backgroundColor = "red"')
-	  , (JSStream on:
-			   'document.getElementById("result").innerHTML = "<p>Error</p>"') 
-		  asFunction: #( 'result' )
+	^ (JSStream on: 'document.getElementById("result").style.backgroundColor = "Red"'), 
+		(JSStream on: 'document.getElementById("result").innerHTML = "<p>Error</p>"'),
+		(JSStream on: 'document.getElementById("result-contents").innerHTML = ""; response.text().then((text) => document.getElementById("result-contents").innerHTML += "<p>"+text+"</p>")')
+		  asFunction: #( 'response' )

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/originTextToUrlTable.st

@@ -1,4 +1,4 @@
-accessing
+private
 originTextToUrlTable
 
 	^ GRSmallDictionary2 new

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/renderCORSFilterOriginsOn..st

@@ -21,7 +21,7 @@ renderCORSFilterOriginsOn: html
 		html button
 			callback: [ 
 				self corsFilter
-					addAllowedOrigin: (self baseUrl asString allButLast) ];
+					addAllowedOrigin: (self baseUrl greaseString allButLast) ];
 			with: 'Allow other origin'.
 		html space.
 

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/renderContentOn..st

@@ -1,14 +1,12 @@
 rendering
 renderContentOn: html
-  html heading: 'CORS Test Page'.
-  self runningOnGemStone
-    ifTrue: [ 
-      html
-        paragraph:
-          'Make sure the CORS adaptor is running manually since we cannot check it when running on GemStone.' ].
+
+  	html heading: 'CORS Test Page'.
+	html paragraph: self requestContext request host.
+	self runningOnGemStone ifTrue: [ 
+      html paragraph: 'Make sure the CORS adaptor is running manually since we cannot check it when running on GemStone.' ].
   (self runningOnGemStone not
-    and: [ 
-      WACORSResourceExample corsAdaptor isNil
+    and: [ WACORSResourceExample corsAdaptor isNil
         or: [ WACORSResourceExample corsAdaptor isRunning not ] ])
     ifTrue: [ self renderAdaptorSetupOn: html ]
     ifFalse: [ 

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/renderMethodPreflightTestOn..st

@@ -10,7 +10,7 @@ renderMethodPreflightTestOn: html
 		with: [
 			self originTextToUrlTable keysAndValuesDo: [ :text :url | 
 				html button
-					onClick: ((JSStream on:('fetch(<1p>, {method: "DELETE"})' expandMacrosWith: url asString))
+					onClick: ((JSStream on:('document.getElementById("result-contents").innerHTML = "Doing request..."; fetch(<1p>, {method: "DELETE"})' expandMacrosWith: url greaseString))
 					 		call: 'then'
 					 		with: self successHandlerFunction
 					 		with: self errorHandlerFunction);

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/renderRequestResultIndicatorOn..st

@@ -4,4 +4,6 @@ renderRequestResultIndicatorOn: html
 		level2;
 		with: 'Result'.
 	html div
-		id: 'result'
+		id: 'result'.
+	html div
+		id: 'result-contents'

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/renderSimpleRequestTestOn..st

@@ -10,7 +10,7 @@ renderSimpleRequestTestOn: html
 			self originTextToUrlTable keysAndValuesDo: [ :text :url | 
 				html button
 					onClick:
-						((JSStream on: ('fetch(<1p>)' expandMacrosWith: url asString))
+						((JSStream on: ('document.getElementById("result-contents").innerHTML = "Doing request..."; fetch(<1p>)' expandMacrosWith: url greaseString))
 					 		call: 'then'
 					 		with: self successHandlerFunction
 					 		with: self errorHandlerFunction);

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/sameOriginDataUrl.st

@@ -2,7 +2,7 @@ accessing-urls
 sameOriginDataUrl
 
 	| parts host port |
-	parts := self requestContext request host findTokens: ':'.
+	parts := self requestContext request host substrings: ':'.
 	host := parts first.
-	port := parts last asInteger.
+	port := parts last greaseInteger.
 	^ self buildDataUrlFor: host port: port

repository/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/successHandlerFunction.st

@@ -1,8 +1,7 @@
 javascript
 successHandlerFunction
 
-	^ (JSStream on: 'console.log(arguments[0])') , (JSStream on:
-		   'document.getElementById("result").style.backgroundColor = "darkgreen"')
-	  , (JSStream on:
-			   'document.getElementById("result").innerHTML = "<p>Success</p>"') 
-		  asFunction: #( 'result' )
+	^ (JSStream on: 'document.getElementById("result").style.backgroundColor = "DarkGreen"'),
+		(JSStream on: 'document.getElementById("result").innerHTML = "<p>Success</p>"'),
+		(JSStream on: 'document.getElementById("result-contents").innerHTML = ""; response.text().then((text) => document.getElementById("result-contents").innerHTML += "<p>"+text+"</p>")')
+		  asFunction: #( 'response' )

repository/Seaside-Tests-Functional.package/WACORSResourceExample.class/class/corsAdaptorPort.st

@@ -1,4 +1,4 @@
 accessing
 corsAdaptorPort
 
-	^ 8084
+	^ 8888

repository/Seaside-Tests-Functional.package/WACORSResourceExample.class/instance/initialize.st

@@ -1,4 +1,4 @@
-private 
+initialization
 initialize 
 
 	super initialize.

repository/Seaside-Tests-Functional.package/WACORSResourceExample.class/instance/initializeSampleData.st

@@ -1,4 +1,4 @@
-private 
+private
 initializeSampleData
 
 	^ sampleData := ((1 to: 10) collect: [ :index | 

repository/Seaside-Tests-Functional.package/WACORSResourceExample.class/instance/sampleData.st

@@ -1,4 +1,4 @@
-private 
+private
 sampleData
 
 	sampleData ifNil: [ self initializeSampleData ].

repository/Seaside-Tests-Parasol.package/WAWebDriverFunctionalTestCase.class/instance/clickRestart.st

@@ -0,0 +1,7 @@
+helpers
+clickRestart
+
+	| button |
+	button := driver findElementByCSSSelector: 'input[type="submit"]'.
+	self assert: (button getAttribute: 'value') equals: 'Restart'.
+	button click

repository/Seaside-Tests-Parasol.package/WAWebDriverFunctionalTestCase.class/instance/expectedFailures.st

@@ -1,7 +1,7 @@
 running
 expectedFailures
 	| todo |
-	todo := #(testExpiryFunctionalTest testFilterFunctionalTest testUploadFunctionalTest testCORSFilterFunctionalTest).
+	todo := #(testExpiryFunctionalTest testFilterFunctionalTest testUploadFunctionalTest).
 	^ (GRPlatform current class == (Smalltalk at: #GRGemStonePlatform ifAbsent:[ nil ]))
 		ifTrue: [ #(testContextFunctionalTest), todo "requires https://github.com/GsDevKit/Grease/pull/17 to be merged" ]
 		ifFalse:[  todo ]

repository/Seaside-Tests-Parasol.package/WAWebDriverFunctionalTestCase.class/instance/performTest.st

@@ -0,0 +1,14 @@
+private
+performTest
+	"The code below can be uncommented to take screenshots of failing tests which will be collected by the Github CI action.
+	It is commented because it breaks Squeak and GemStone builds. Only works for Pharo builds."
+
+ 	^ super performTest
+	"^ [ super performTest ] on: TestFailure , Error do: [ :exceptionTest |
+			[ Transcript show: 'Taking screenshot to ', (FileLocator imageDirectory asFileReference) asString. self takeScreenshot ] on: Error do: [ :errorScreenshot |
+				Transcript
+					show: ('Could not take screenshot in {1}: {2}' format: {
+						self asString.
+						errorScreenshot messageText });
+					cr ].
+		exceptionTest pass ]"

repository/Seaside-Tests-Parasol.package/WAWebDriverFunctionalTestCase.class/instance/testCORSFilterFunctionalTest.st

@@ -2,55 +2,54 @@ testing
 testCORSFilterFunctionalTest
 	[ 
 		WACORSResourceExample register; registerCorsAdaptor.
-
 		self selectTest: 'WACORSFilterFunctionalTest'.
-
 		self should: [ driver findElementByPartialLinkText: 'Register CORS Resource' ] raise: BPNoSuchElementException.
 
 		self assert: (driver findElementByID: 'allowed-origins') getText equals: 'None'.
-		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Same Origin' ]) click.
+		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Same Origin' ]) click.
 		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.
-		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Cross Origin' ]) click.
-		 (Delay forMilliseconds: 300) wait.
-		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Error'.		
 
+		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Cross Origin' ]) click.
+		(Delay forMilliseconds: 300) wait.
+		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Error'.
+
+		"Now test with cross-origin allowed"
 		((driver findElementsByTagName: 'button') detect: [ :button | button getText = 'Allow other origin' ]) click.
-		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Same Origin' ]) click.
-  		(Delay forMilliseconds: 300) wait.
+
+		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Same Origin' ]) click.
+		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.
-		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Cross Origin' ]) click.
-	  (Delay forMilliseconds: 300) wait.
+
+		(((driver findElementByID: 'get-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Cross Origin' ]) click.
+		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.	
-						
+
 		"the following statement is to circumvent testing issue with the dev toolbar being over the delete buttons"
 		(driver findElementByID: 'result') moveToElement.
-
-		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Same Origin' ]) click.
-	  (Delay forMilliseconds: 300) wait.
+		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Same Origin' ]) click.
+	  	(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.
-		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Cross Origin' ]) click.
-	  (Delay forMilliseconds: 300) wait.
+
+		"the following statement is to circumvent testing issue with the dev toolbar being over the delete buttons"
+		(driver findElementByID: 'result') moveToElement.	
+		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Cross Origin' ]) click.
+		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Error'.		
 
 		((driver findElementsByTagName: 'button') detect: [ :button | button getText = 'Allow DELETE' ]) click.
 
 		"the following statement is to circumvent testing issue with the dev toolbar being over the delete buttons"
 		(driver findElementByID: 'result') moveToElement.		
-
 		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') 
 			detect: [ :button | button getText = 'Same Origin' ]) click.
-  		(Delay forMilliseconds: 300) wait.
+		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.
-		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') 
-			detect: [ :button | button getText = 'Cross Origin' ]) click.
-  		(Delay forMilliseconds: 300) wait.
+
+		"the following statement is to circumvent testing issue with the dev toolbar being over the delete buttons"
+		(driver findElementByID: 'result') moveToElement.				
+		(((driver findElementByID: 'delete-requests') findElementsByTagName: 'button') detect: [ :button | button getText = 'Cross Origin' ]) click.
+		(Delay forMilliseconds: 300) wait.
 		self assert: ((driver findElementByID: 'result') findElementByTagName: 'p') getText equals: 'Success'.	
 
 	] ensure: [ WACORSResourceExample unregister; unregisterCorsAdaptor ]

repository/Seaside-Tests-Parasol.package/WAWebDriverFunctionalTestCase.class/instance/testContextFunctionalTest.st

@@ -6,11 +6,11 @@ testContextFunctionalTest
 	self assert: ((GRCodec allCodecs collect: #printString) includes: ((driver findElementByID: 'Codec:') findElementByXPath: './td') getText).
 	self assert: (((driver findElementByID: 'Session:') findElementByXPath: './td') getText copyWithout: Character space) equals: 'aWASession'.
 	self assert: (((driver findElementByID: 'Application:') findElementByXPath: './td') getText copyWithout: Character space) equals: 'aWAApplication'.
-	self assert: ((((driver findElementByID: 'Request:') findElementByXPath: './td') getText copyWithout: Character space) beginsWith: 'aWARequest').
+	self assert: ((((driver findElementByID: 'Request:') findElementByXPath: './td') getText copyWithout: Character space) greaseBeginsWith: 'aWARequest').
 
 	possibleResponses := WAResponse allSubclasses collect:[ :c | 'a ', c name ].
 	responseText := ((driver findElementByID: 'Response:') findElementByXPath: './td') getText.
-	self assert: (possibleResponses anySatisfy: [ :prefix | responseText beginsWith: prefix ]).
+	self assert: (possibleResponses anySatisfy: [ :prefix | responseText greaseBeginsWith: prefix ]).
 
 	requestHandlers := driver findElementByID: 'handlers'.
 	self assert: ((requestHandlers findElementByXPath: './ol/li[1]') getText copyWithout: Character space) equals: 'aWARenderPhaseContinuation'.