CLASS TestNwApp EXTENDS Test MODULE TestNwjs CLASSVARS '' VARS 'app'

"Also tests NwManifest"

test
	| manifest hotKey |

	app := NwApp new.
	self assert: [ app class = NwApp ].

	app clearCache.
	self assert: [ app argv includes: '-test' ].
	self assert: [ app fullArgv includes: '-test' ].
	self assert: [ app dataPath includes: 'my-nw-app' ].

	"'app quit' cannot be tested here."
	self assert: [ ( app getProxyForUrl: 'localhost:8080' ) = 'DIRECT' ].

	app addOriginAccessWhitelistEntry: 'http://github.com/'
		destinationProtocol: 'chrome-extension' destinationHost: 'http://localhost'
		allowDestinationSubdomains: true.

	app removeOriginAccessWhitelistEntry: 'http://github.com/'
		destinationProtocol: 'chrome-extension' destinationHost: 'http://localhost'
		allowDestinationSubdomains: true.

	"Manifest"

	manifest := app manifest.
	self assert: [ manifest class = NwManifest ].
	self assert: [ manifest name = 'my-nw-app' ].
	self assert: [ manifest main endsWith: 'index.html' ].

	"Hotkey"

	hotKey := 'Ctrl+Shift+A'.
	app registerGlobalHotKey: hotKey
		then: [ self onRegisterGlobalHotKey: hotKey ]
		error: [ :message | self onRegisterGlobalHotKey: hotKey error: message].

	"closeAllWindows cannot be tested here beacuse it terminates the app."
	"app closeAllWindows."
!

"Hotkeys"

onRegisterGlobalHotKey: hotKey
	self assert: [ true ].
	self unregisterGlobalHotKey: hotKey
!
onRegisterGlobalHotKey: hotKey error: message
	"Failing to register the hotkey also counts als test succes.
	 Probably some security setting."
	self assert: [ true ].
	self unregisterGlobalHotKey: hotKey
!
unregisterGlobalHotKey: hotKey
	app unregisterGlobalHotKey: hotKey
		then: [ self onUnegisterGlobalHotKey: hotKey ]
		error: [ :message | self onUnregisterGlobalHotKey: hotKey error: message] .
!
onUnregisterGlobalHotKey: hotKey
	self assert: [ true ].
!
onUnregisterGlobalHotKey: hotKey error: message
	"Failing to unregister the hotkey also counts als test succes.
	 Probably some security setting."
	self assert: [ true ].
!
CLASS TestNwMenu EXTENDS Test MODULE TestNwjs CLASSVARS '' VARS ''

test
	| menu menuItem |

	menu := NwMenu newMenuBar.
	self assert: [ menu class = NwMenu ].
	self assert: [ menu type = 'menubar' ].

	menu := NwMenu new.
	self assert: [ menu class = NwMenu ].
	self assert: [ menu type = 'contextmenu' ].
	self assert: [ menu items length = 0 ].

	menuItem := NwMenuItem new: 'Edit'.
	menu append: menuItem.
	self assert: [ menu items length = 1 ].
	self assert: [ menu items first label = 'Edit' ].
	menu remove: menuItem.
	self assert: [ menu items length = 0 ].

	menuItem := NwMenuItem new: 'Item2'.
	menu append: menuItem.
	menuItem := NwMenuItem new: 'Item1'.
	menu insert: menuItem at: 0.
	self assert: [ menu items length = 2 ].
	self assert: [ menu items first label = 'Item1' ].
	menu removeAt: 0.
	self assert: [ menu items length = 1 ].
	self assert: [ menu items first label = 'Item2' ].
!

CLASS TestNwMenuItem EXTENDS Test MODULE TestNwjs CLASSVARS '' VARS ''

test
	| menuItem submenu |

	menuItem := NwMenuItem new: 'File'.
	self assert: [ menuItem type = 'normal' ].
	self assert: [ menuItem label = 'File' ].
	menuItem label: 'File2'.
	self assert: [ menuItem label = 'File2' ].

	self assert: [ menuItem submenu isNil ].
	submenu := NwMenu new.
	menuItem submenu: submenu.
	self assert: [ menuItem submenu = submenu ].

	self assert: [ menuItem icon = '' ].
	menuItem icon: 'icon.png'.
	self assert: [ menuItem icon = 'icon.png' ].

	self assert: [ menuItem tooltip = '' ].
	menuItem tooltip: 'My tooltip'.
	self assert: [ menuItem tooltip = 'My tooltip' ].

	self assert: [ menuItem click isNil ].
	menuItem click: [ self onMenuItemClick ].
	self assert: [ menuItem click notNil ].

	self assert: [ menuItem enabled ].
	menuItem enabled: false.
	self assert: [ menuItem enabled not ].

	self assert: [ menuItem key = '' ].
	"2025-08-14 Setting the menu item key crashes Nw.js on Windows:
	 This has been reported here: https://github.com/nwjs/nw.js/issues/8290
	menuItem key: 'F'.
	self assert: [ menuItem key = 'F1' ]."

	self assert: [ menuItem modifiers = '' ].
	"2025-08-14 Setting the menu item modifiers also crashes Nw.js on Windows:
	 This has been reported here: https://github.com/nwjs/nw.js/issues/8290
	menuItem modifiers: 'alt'.
	self assert: [ menuItem modifiers = 'alt' ]."

	"Checkbox"

	menuItem := NwMenuItem checkbox: 'Private'.
	self assert: [ menuItem type = 'checkbox' ].
	self assert: [ menuItem label = 'Private' ].

	self assert: [ menuItem checked not ].
	menuItem checked: true.
	self assert: [ menuItem checked ].

	"Separator"

	menuItem := NwMenuItem separator.
	self assert: [ menuItem type = 'separator' ].
!
CLASS TestNwWindow EXTENDS Test MODULE TestNwjs CLASSVARS '' VARS 'window'

"NwWindow is tested in TestMyNwWindow with a live Window."

CLASS TestQLabel EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| label |

	label := QLabel new.
	self assert: [ label jsClassName = 'QLabel' ].

	label setText: 'My Label'.
	self assert: [ label text = 'My Label' ].
!
CLASS TestQMainWindow EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| window menuBar centralWidget |

	window := QMainWindow new.
	self assert: [ window jsClassName = 'QMainWindow' ].

	menuBar := QMenuBar new.
	window setMenuBar: menuBar.
	self assert: [ window menuBar = menuBar ].

	centralWidget := QWidget new.
	window setCentralWidget: centralWidget.
	self assert: [ window centralWidget = centralWidget ].
!
CLASS TestQWidget EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| widget |

	widget := QWidget new.
	self assert: [ widget jsClassName = 'QWidget' ].

	widget setWindowTitle: 'My Window Title'.
	self assert: [ widget windowTitle = 'My Window Title' ].

	widget setStyleSheet: '#root { align-items: "center" }'.
	self assert: [ widget styleSheet startsWith: '#root' ].

	widget setWindowIcon: QIcon new.
	self assert: [ widget windowIcon jsClassName = 'QIcon' ].
!
CLASS TestQMenuBar EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

"Also tests QMenu and QAction"

test
	| action menu menuBar |

	"========================= Action"

	action := QAction new.
	self assert: [ action jsClassName = 'QAction' ].

	action setText: 'My Action'.
	"QAction.text() not implemented in NodeGui yet (5-OCT-2024)"
	"self assert: [ action text = 'My Action' ]."

	action addEventListener: 'triggered' then: [ self onAction ].
	"QAction.activate() not implemented in NodeGui yet (5-OCT-2024)"
	"action activate."

	"========================= Menu"

	menu := QMenu new.
	self assert: [ menu jsClassName = 'QMenu' ].

	menu setTitle: 'My Title'.
	self assert: [ menu title = 'My Title' ].

	menu addAction: action.
	self assert: [ menu menuAction jsClassName = 'QAction' ].

	"========================= MenuBar"

	menuBar := QMenuBar new.
	self assert: [ menuBar jsClassName = 'QMenuBar' ].

	menuBar addMenu: menu.
!
onAction
	"Never called."
	self assert: [ true ].
!
CLASS TestQBoxLayout EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| layout |
	layout := QBoxLayout new: QLayout topToBottom.
	self assert: [ layout class = QBoxLayout ].

	layout addWidget: QLabel new stretch: 0 align: QLayout alignCenter.
	self assert: [ layout count = 1 ].
!
CLASS TestQIcon EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| icon |
	icon := QIcon new: 'missing.ico'.

	self assert: [ icon name = '' ].
!
CLASS TestQPixmap EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| pixmap |
	pixmap := QPixmap new: 'missing.png'.

	self assert: [ pixmap class = QPixmap ].
!
CLASS TestQPushButton EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

"Also tests QAbstractButton"

test
	| button |
	button := QPushButton new.

	button setText: 'My Button'.
	self assert: [ button text = 'My Button' ].

	button onClick: [ self buttonClicked ].
	button click.
!
buttonClicked
	self assert: [ true ].
!
CLASS TestQApplication EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| qApplication |
	qApplication := QApplication instance.
	self assert: [ qApplication jsClassName = 'QApplication' ].
	self assert: [ qApplication testMode | true ].
!
CLASS TestQObject EXTENDS Test MODULE TestNodeGui CLASSVARS '' VARS ''

test
	| object |
	object := QObject new.
	self assert: [ object jsClassName = 'QObject' ].

	object setObjectName: 'myObjectName'.
	self assert: [ object objectName = 'myObjectName' ].
!
CLASS MyNodeWorker EXTENDS Object MODULE TestNode CLASSVARS '' VARS ''

METHODS

start
	NodeMessagePort parentPort on: 'message' class: String
		then: [ :message | self onMessage: message ].

	self assert: [ NodeMessagePort isMainThread not ].

	NodeMessagePort setEnvironmentData: 'MyWorker' to: 'Saved'.
	self assert: [ ( NodeMessagePort getEnvironmentData: 'MyWorker' ) = 'Saved' ].
!
onMessage: message
	self assert: [ message = 'Hello, worker!' ].

	NodeMessagePort parentPort postMessage: 'Hello, main thread!'.
!
CLASS TestNodeMessagePort EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
!
CLASS TestNodeWorker EXTENDS Test MODULE TestNode CLASSVARS '' VARS 'worker'

METHODS

test
	worker := NodeWorker new: './out/worker.js'.
	self assert: [ worker threadId >= 0 ].

	worker on: 'message' class: String then: [ :message | self onMessage: message ].
	worker on: 'messageerror' class: Error then: [ :error | self onMessageError: error ].
	worker on: 'error' class: Error then: [ :error | self onError: error ].
	worker on: 'exit' class: Integer then: [ :code | self onExit: code ].

	worker postMessage: 'Hello, worker!'.
!
onMessage: message
	self assert: [ message = 'Hello, main thread!' ].
	self terminate.
!
onMessageError: error
	self error: 'TestNodeWorker: NodeWorker massage error: ', error message.
!
onError: error
	self error: 'TestNodeWorker: NodeWorker error: ', error message.
!
terminate
	worker ref.
	worker unref.
	worker terminate.
!
onExit: code
	self assert: [ code >= 0 ].
!
CLASS TestExpress EXTENDS Test MODULE TestServer CLASSVARS '' VARS 'express server sessionCookie'

"Also tests class Server."

METHODS

test
	express := Express new.
	express useSession.

	express get: '/login'
		then: [ :request :response | self onLoginRequest: request response: response ].
	express get: '/products'
		then: [ :request :response | self onProductsRequest: request response: response ].

	server := express listen: 3000
		then: [ :error | self onExpressListen: error ].
!
async onExpressListen: error
	error isNil ifFalse: [ error throw ].

	await self requestLogin.
	await self requestProducts.
	server terminate.
!

"=============================== Login"

async requestLogin
	| url response text |

	url := 'http://localhost:3000/login?name=John&password=secret'.
	response := await Fetch request: url.

	text := await response text.
	self assert: [ text = 'Login succeeded' ].

	sessionCookie := response cookie.
	self assert: [ sessionCookie includes: 'connect.sid' ].
!
onLoginRequest: request response: response
	| name password |

	name := request query atProperty: 'name'.
	self assert: [ name = 'John' ].

	password := request query atProperty: 'password'.
	self assert: [ password = 'secret' ].

	request session set: 'loggedIn' to: true.
	response send: 'Login succeeded'.
!

"=============================== Products"

async requestProducts
	| headers options url text |

	headers := Headers new
		set: 'cookie' value: sessionCookie.
	options := RequestInit new
		headers: headers.

	url := 'http://localhost:3000/products'.
	text := await Fetch text: url options: options.
	self assert: [ text = 'Apple, Orange, Pear' ].
!
onProductsRequest: request response: response
	| loggedIn |
	loggedIn := ( request session get: 'loggedIn' ) = true.
	loggedIn
		ifFalse: [ response send: 'Not logged in' ]
		ifTrue: [ response send: 'Apple, Orange, Pear' ].
!
CLASS TestCpuUsage EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| cpuUsage |

	cpuUsage := Process cpuUsage.
	self assert: [ cpuUsage user >= 0 ].
	self assert: [ cpuUsage system >= 0 ].

	cpuUsage := Process threadCpuUsage.
	self assert: [ cpuUsage user >= 0 ].
	self assert: [ cpuUsage system >= 0 ].
!
CLASS TestEnvironment EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| var data |
	var := 'SMALLJS_TEMP'.
	data := 'EnvData'.

	Environment at: var put: data.
	self assert: [ ( Environment at: var ) = data ].

	Environment deleteAt: var.
	self assert: [ ( Environment at: var ) isNil ].
!
testLoad
	| tempPath envString |

	tempPath := Os tmpPath: 'smalljs-env-'.
	envString := 'SMALLJS_LOADED=loaded\n'.
	Fs writeFileSync: tempPath data: envString options: nil.

	Environment load: tempPath.
	self assert: [ ( Environment at: 'SMALLJS_LOADED' ) = 'loaded' ].

	Fs unlinkSync: tempPath.
!
CLASS TestMemoruUsage EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| memoryUsage |
	memoryUsage := Process memoryUsage.
	self assert: [ memoryUsage class = MemoryUsage ].

	self assert: [ memoryUsage rss > 1000 ].
	self assert: [ memoryUsage heapTotal > 1000 ].
	self assert: [ memoryUsage heapUsed > 1000 ].
	self assert: [ memoryUsage external > 1000 ].
	self assert: [ memoryUsage arrayBuffers > 1000 ].
!

CLASS TestProcess EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

testArguments
	| temp |
	self assert: [ Process argv length >= 2 ].
	self assert: [ Process argv first includes: 'node' ].
	self assert: [ Process argv0 includes: 'node' ].
	self assert: [ Process execPath includes: 'node' ].
	self assert: [ Process execArgv length = 0 ].
!
testDirectory
	| cwd chdir |

	cwd := Process cwd.
	self assert: [ ( cwd includes: '/' ) | ( cwd includes: '\\' ) ].

	chdir := Path join: cwd with: 'out'.
	Process chdir: chdir.
	self assert: [ Process cwd = chdir ].

	Process chdir: cwd.
!
testExiting
	"Only test these manually, because they exit..."

	"Process exit: 9"
	"Process abort."
	"Process kill: Process pid signal: 15."

	"To test this in VSCode, in Run and Debug, Breakpoints: 'Uncaught Exceptions' must be unchecked"
	"Process uncaughtExceptionCaptureCallback:
		[ :error | self onUncaughtException: error ].
	self causeUncaughtException."
!
onUncaughtException: error
	Console log: 'TestProcess: My uncaught exception handler'.
	Process exit: 1.
!
testPlatform
	| platforms platform archs |

	platforms := #( 'aix' 'darwin' 'freebsd' 'linux' 'openbsd' 'sunos' 'win32' 'android' ).
	platform := Process platform.
	self assert: [ platforms includes: platform ].

	Process isWindows ifTrue: [ self assert: [ platform = 'win32' ] ].
	Process isLinux ifTrue: [ self assert: [ platform = 'linux' ] ].
	Process isMacos ifTrue: [ self assert: [ platform = 'darwin' ] ].

	archs := #( 'arm' 'arm64' 'ia32' 'loong64' 'mips' 'mipsel' 'ppc64' 'riscv64' 's390' 's390x' 'x64' ).
	self assert: [ archs includes: Process arch ].
!
testMemory
	self assert: [ Process availableMemory > 1000 ].
	self assert: [ Process constrainedMemory >= 0 ].
	self assert: [ Process memoryUsage class = MemoryUsage ].
!
testIpc
	self assert: [ Process connected isNil ].
	"IPC not tested:"
	"Process disconnect."
	"Process channelRef."
	"Process channelUnref."
!
testPids
	self assert: [ Process pid > 0 ].
	self assert: [ Process ppid > 0 ].
!
testUids
	"Windows does not have these."
	Process isWindows ifTrue: [ ^ self ].

	"Setting UIDs and GIDs is not tested because it requires elevated rights."
	self assert: [ Process uid >= 0 ].
	self assert: [ Process euid >= 0 ].
	self assert: [ Process gid >= 0 ].
	self assert: [ Process egid >= 0 ].
!
testCpuUsage
	self assert: [ Process cpuUsage class = CpuUsage ].
	self assert: [ Process threadCpuUsage class = CpuUsage ].
!
testMisc
	| nodeVersion |
	"Only test this manually, to prevent polluting debug output."
	"Process emitWarning: 'Careful, now...'."

	self assert: [ Process hrtime > 1000 ].
	self assert: [ Process uptime >= 0 ].
	self assert: [ Process hasPermission: 'fs.read' reference: '.' ].

	self assert: [ Process version startsWith: 'v' ].
	nodeVersion := Process versions atJsProperty: 'node'.
	self assert: [ nodeVersion = ( Process version slice: 1 ) ].

	self assert: [ Process title length > 0 ].
!
testUmask
	| oldUmask umask |
	"On Windows, 'umask' always returns 0"
	Process isWindows ifTrue: [ ^ self ].

	"Process umask returns the pevious umask."
	oldUmask := Process umask: 2.
	umask := Process umask: oldUmask.
	self assert: [ umask = 2 ].
!

CLASS TestProcessConfig EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| config variables targetDefaults |

	config := Process config.
	self assert: [ config class = ProcessConfig ].

	variables := config targetDefaults.
	self assert: [ ( variables atJsProperty: 'default_configuration' ) length > 0 ].

	variables := config variables.
	self assert: [ ( variables atJsProperty: 'host_arch' ) = Process arch ].
!
CLASS TestResourceUsage EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| resourceUsage |
	resourceUsage := Process resourceUsage.
	self assert: [ resourceUsage class = ResourceUsage ].

	self assert: [ resourceUsage userCpuTime > 0 ].
	self assert: [ resourceUsage systemCpuTime > 0 ].
	self assert: [ resourceUsage maxRss > 0 ].

	self assert: [ resourceUsage minorPageFault >= 0 ].
	self assert: [ resourceUsage majorPageFault >= 0 ].
	self assert: [ resourceUsage swappedOut >= 0 ].

	self assert: [ resourceUsage fsRead >= 0 ].
	self assert: [ resourceUsage fsWrite >= 0 ].

	self assert: [ resourceUsage ipcSent >= 0 ].
	self assert: [ resourceUsage ipcReceived >= 0 ].
	self assert: [ resourceUsage signalsCount >= 0 ].

	self assert: [ resourceUsage voluntaryContextSwitches >= 0 ].
	self assert: [ resourceUsage involuntaryContextSwitches >= 0 ].
!
CLASS TestOs EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| loadavg tmpPath |

	self assert: [ Os tmpDir length > 0 ].
	tmpPath := Os tmpPath: 'smalljs-'.
	self assert: [ tmpPath includes: Os tmpDir ].
	self assert: [ tmpPath includes: 'smalljs-' ].
	self assert: [ #( '\n' '\r\n' ) includes: Os eol ].
	self assert: [ #( '/dev/null' '\\\\.\\nul' ) includes: Os devNull ].

	"User"

	self assert: [ Os homedir length > 0 ].
	self assert: [ Os userInfo class = OsUserInfo ].

	"Process"

	self checkPriority.
	self assert: [ Os uptime > 0 ].

	loadavg := Os loadavg.
	self assert: [ Os loadavg length = 3 ].
	self assert: [ Os loadavg first >= 0.0 ].

	self assert: [ Os freemem > 1000 ].
	self assert: [ Os totalmem > 1000 ].

	"OS"

	self assert: [ #( 'Windows_NT' 'Linux' 'Darwin' ) includes: Os type ].
	self assert: [ Os isWindows | Os isLinux | Os isMacos ].

	self assert: [ Os platform length > 0 ].
	self assert: [ Os version length > 0 ].
	self assert: [ Os release length > 0 ].

	"Host"

	self assert: [ Os hostname length > 0 ].
	self assert: [ Os machine length > 0 ].
	self assert: [ Os networkInterfaces values first first class = OsNetworkInterfaceInfo ].

	"CPU"

	self assert: [ Os arch length > 0 ].
	self assert: [ #( 'BE' 'LE' ) includes: Os endianness ].
	self assert: [ Os availableParallelism > 0 ].
	self assert: [ Os cpus first class = OsCpuInfo ].
!
checkPriority
	| normalPriority lowerPriority |

	normalPriority := OsConstants priority atJsProperty: 'PRIORITY_NORMAL'.
	self assert: [ ( Os getPriority: 0 ) = normalPriority ].

	"Linux and MacOS do not allow changing the process priority by default."
	Os isLinux | Os isMacos ifTrue: [ ^ self ].

	lowerPriority := OsConstants priority atJsProperty: 'PRIORITY_BELOW_NORMAL'.
	Os setPriority: 0 to: lowerPriority.
	self assert: [ ( Os getPriority: 0 ) = lowerPriority ].
	Os setPriority: 0 to: normalPriority.
!
CLASS TestOsConstants EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	|  signals errno priority |

	signals := OsConstants signals.
	self assert: [ ( signals atJsProperty: 'SIGHUP' ) = 1 ].

	errno := OsConstants errno.
	self assert: [ ( errno atJsProperty: 'E2BIG' ) = 7 ].

	priority := OsConstants priority.
	self assert: [ ( priority atJsProperty: 'PRIORITY_NORMAL' ) = 0 ].
!
CLASS TestOsCpuInfo EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	Os cpus do: [ :cpuInfo |
		self checkCpuInfo: cpuInfo ].
!
checkCpuInfo: cpuInfo
	self assert: [ cpuInfo class = OsCpuInfo ].

	self assert: [ cpuInfo model length > 0 ].
	self assert: [ cpuInfo speed > 0 ].

	self assert: [ cpuInfo user > 0 ].
	self assert: [ cpuInfo sys > 0 ].
	self assert: [ cpuInfo idle > 0 ].

	self assert: [ cpuInfo irq >= 0 ].
	self assert: [ cpuInfo nice >= 0 ].
!
CLASS TestOsNetworkInterfaceInfo EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| info |
	Os networkInterfaces values do: [ :infos |
		 infos do: [ :info |
		 	self checkInfo: info  ] ].
!
checkInfo: info
	self assert: [ info class = OsNetworkInterfaceInfo ].

	info family = 'IPv4'
		ifTrue: [ self checkInfoIpv4: info ]
		ifFalse: [
			info family = 'IPv6'
				ifTrue: [ self checkInfoIpv6: info ]
				ifFalse: [ self assert: [ false ] ] ].
!
checkInfoIpv4: info
	self assert: [ ( info address search: '[0-9]+\\.' ) = 0 ].
	self assert: [ ( info netmask search: '[0-9]+\\.' ) = 0 ].
	self assert: [ ( info cidr search: '[0-9]+\\.' ) = 0 ].
	self assert: [ ( info mac search: '[0-9a-z][0-9a-z]:' ) = 0 ].
	self assert: [ info internal | true ].
!
checkInfoIpv6: info
	self assert: [ ( info address search: '[0-9a-z]*:' ) = 0 ].
	self assert: [ info scopeid >= 0 ].
	self assert: [ ( info netmask search: '[0-9a-z]*:' ) = 0 ].
	self assert: [ ( info cidr search: '[0-9a-z]*:' ) = 0 ].
	self assert: [ ( info mac search: '[0-9a-z][0-9a-z]:' ) = 0 ].
	self assert: [ info internal | true ].
!
CLASS TestOsUserInfo EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

METHODS

test
	| info |
	info := Os userInfo.

	self assert: [ info class = OsUserInfo ].
	self assert: [ info username length > 0 ].
	self assert: [ info homedir length > 0 ].

	Os isWindows
		ifTrue: [ self checkInfoWindows: info ]
		ifFalse: [ self checkInfoUnix: info ].
!
checkInfoWindows: info
	self assert: [ info uid = -1 ].
	self assert: [ info gid = -1 ].
	self assert: [ info shell isNil ].
!
checkInfoUnix: info
	self assert: [ info uid >= 0 ].
	self assert: [ info gid >= 0 ].
	self assert: [ info shell length > 0 ].
!
CLASS TestFileHandle EXTENDS Test MODULE TestNode CLASSVARS '' VARS 'fileName fileHandle'

"Also tests class: FileStats"

async test
	await self open.
	await self stat.
	await self writeRead.
	await self properties.
	await self closeRemove.
!
async open
	fileName := Os tmpPath: 'smalljs-tfh-'.
	fileHandle := await FileHandle open: fileName flags: 'w+'.
	self assert: [ fileHandle class = FileHandle ].
	self assert: [ fileHandle jsClassName = 'FileHandle' ].
	self assert: [ fileHandle fd >= 0 ].
!
async stat
	| stats now |

	stats := await fileHandle stat.
	self assert: [ stats dev >= 1 ].
	self assert: [ stats ino >= 1 ].
	self assert: [ #( 33188 33204 33206 ) includes: stats mode ].
	self assert: [ stats nlink = 1 ].
	self assert: [ stats uid >= 0 ].
	self assert: [ stats gid >= 0 ].
	self assert: [ stats size = 0 ].
	self assert: [ stats blksize >= 512 ].

	now := Date now.
	self assert: [ ( now - stats ctime toMilliseconds ) abs < 300000 ].
	self assert: [ ( now - stats mtime toMilliseconds ) abs < 300000].
	self assert: [ ( now - stats atime toMilliseconds ) abs < 300000 ].

	self assert: [ ( now - stats ctimeMs ) abs < 300000 ].
	self assert: [ ( now - stats mtimeMs ) abs < 300000 ].
	self assert: [ ( now - stats atimeMs ) abs < 300000 ].
!
async writeRead
	| writeBuffer bytesWritten readBuffer bytesRead buffer stats |
	writeBuffer := Buffer new: 8.
	0 to: 7 do: [ :index |
		writeBuffer at: index put: 97 + index ].

	bytesWritten := await fileHandle write: writeBuffer offset: 2 length: 4 position: nil.
	self assert: [ bytesWritten = 4 ].

	readBuffer := Buffer new: 8.
	bytesRead := await fileHandle read: readBuffer offset: 2 length: 4 position: 0.
	self assert: [ bytesRead = 4 ].
	self assert: [ readBuffer length = 8 ].
	self assert: [ ( readBuffer subarray: 2 to: 6 ) toArray = #( 99 100 101 102 ) ].

	"Must reopen file to test writeFile."
	await fileHandle close.
	fileHandle := await FileHandle open: fileName flags: 'w+'.
	buffer := Buffer from: 'abcd'.
	await fileHandle writeFile: buffer.

	"Must reopen file to test readFile."
	await fileHandle close.
	fileHandle := await FileHandle open: fileName flags: 'r+'.
	buffer := await fileHandle readFile.
	self assert: [ buffer toString = 'abcd' ].

	await fileHandle truncate: 2.
	stats := await fileHandle stat.
	self assert: [ stats size = 2 ].

	await fileHandle sync.
	await fileHandle datasync.
!
async properties
	| stats |
	await fileHandle chmod: 33200.
	stats := await fileHandle stat.
	"On Windows chmod does work and stays 33206."
	self assert: [ #( 33200 33206 ) includes: stats mode ].

	"Don't actually change the user and group because we probably don't have permission.
	 Just set the currrent uid and gid and see if the call executes."
	await fileHandle chown: stats uid gid: stats gid.
	stats := await fileHandle stat.
	self assert: [ stats uid >= 0 ].
	self assert: [ stats gid >= 0 ].

	await fileHandle atime: 1 mtime: 2.
	stats := await fileHandle stat.
	self assert: [ stats atimeMs = 1000 ].
	self assert: [ stats mtimeMs = 2000 ].
!
async closeRemove
	await fileHandle close.
	Fs unlinkSync: fileName.
!
CLASS TestFs EXTENDS Test MODULE TestNode CLASSVARS ''
	VARS 'tempDirName subDirName tempFilePath tempFileFd'

"Also tests classes Dir, Dirent in sync mode."

test
	| prefix options mode |

	"Create temp directory"
	prefix := Path join: Os tmpDir with: 'smalljs-'.
	tempDirName := Fs mkdtempSync: prefix options: nil.
	self assert: [ tempDirName includes: 'smalljs-' ].
	self assert: [ Fs existsSync: tempDirName ].

	"Create subdirectory"
	subDirName := Path join: tempDirName with: 'sub1/sub2'.
	options := FileMkdirOptions new recursive: true.
	Fs mkdirSync: subDirName options: options.
	self assert: [ Fs existsSync: subDirName ].

	"Create file"
	tempFilePath := Path join: tempDirName with: 'tempfile.tmp'.
	tempFileFd := Fs openSync: tempFilePath flags: 'w+' mode: 384.
	self assert: [ tempFileFd >= 0 ].
	Fs closeSync: tempFileFd.

	mode := FileConstants fileOk.
	Fs accessSync: tempFilePath mode: mode.

	self writeReadFile.
!
writeReadFile
	| writeBuffer readBuffer |

	writeBuffer := Buffer from: 'abcd'.
	Fs writeFileSync: tempFilePath data: writeBuffer options: nil.

	writeBuffer := Buffer from: '12'.
	Fs appendFileSync: tempFilePath data: writeBuffer options: nil.

	readBuffer := Fs readFileSync: tempFilePath.
	self assert: [ readBuffer toString = 'abcd12' ].

	self writeReadBuffer.
!
writeReadBuffer
	| writeBuffer readBuffer bytesRead |

	tempFileFd := Fs openSync: tempFilePath flags: 'w+' mode: nil.
	writeBuffer := Buffer from: 'efgh'.
	Fs writeSync: tempFileFd buffer: writeBuffer options: nil.
	Fs closeSync: tempFileFd.

	tempFileFd := Fs openSync: tempFilePath flags: 'r+' mode: nil.
	readBuffer := Buffer new: 8.
	bytesRead := Fs readSync: tempFileFd buffer: readBuffer options: nil.
	self assert: [ bytesRead = 4 ].
	self assert: [ ( readBuffer subarray: 0 to: 4 ) toString = 'efgh' ].
	Fs closeSync: tempFileFd.

	self writeReadBufferPositioned.
!
writeReadBufferPositioned
	| writeBuffer readBuffer bytesRead |

	tempFileFd := Fs openSync: tempFilePath flags: 'w+' mode: nil.
	writeBuffer := Buffer from: 'ijklmn'.
	Fs writeSync: tempFileFd buffer: writeBuffer offset: 1 length: 4 position: nil.
	Fs closeSync: tempFileFd.

	tempFileFd := Fs openSync: tempFilePath flags: 'r+' mode: nil.
	readBuffer := Buffer new: 8.
	bytesRead := Fs readSync: tempFileFd buffer: readBuffer offset: 2 length: 2 position: 1.
	self assert: [ bytesRead = 2 ].
	self assert: [ ( readBuffer subarray: 2 to: 4 ) toString = 'kl' ].
	Fs closeSync: tempFileFd.

	self renameCopy.
!
renameCopy
	| tempFilePath2 |
	tempFilePath2 := Path join: tempDirName with: 'tempfile2.tmp'.

	Fs renameSync: tempFilePath to: tempFilePath2.
	self assert: [ ( Fs existsSync: tempFilePath ) not ].
	self assert: [ Fs existsSync: tempFilePath2 ].

	Fs copyFileSync: tempFilePath2 to: tempFilePath mode: nil.
	self assert: [ Fs existsSync: tempFilePath ].

	Fs unlinkSync: tempFilePath.
	Fs cpSync: tempFilePath2 to: tempFilePath options: nil.
	self assert: [ Fs existsSync: tempFilePath ].
	Fs unlinkSync: tempFilePath2.

	self accessPath.
!
accessPath
	| stats |

	Fs utimesSync: tempFilePath atime: 2 mtime: 1.
	stats := Fs statSync: tempFilePath options: nil.
	self assert: [ stats atimeMs = 2000 ].
	self assert: [ stats mtimeMs = 1000 ].

	"chmod and chown to nothing on Windows,
	 so don't actually change them and can't check results."
	Fs chmodSync: tempFilePath mode: stats mode.
	Fs chownSync: tempFilePath uid: stats uid gid: stats gid.

	self accessFd
!
accessFd
	| stats |

	tempFileFd := Fs openSync: tempFilePath flags: 'r+' mode: nil.
	Fs futimesSync: tempFileFd atime: 4 mtime: 3.
	stats := Fs fstatSync: tempFileFd options: nil.
	self assert: [ stats atimeMs = 4000 ].
	self assert: [ stats mtimeMs = 3000 ].

	"chmod and chown do nothing on Windows,
	 so don't actually change them and can't check results."
	Fs fchmodSync: tempFileFd mode: stats mode.
	Fs fchownSync: tempFileFd uid: stats uid gid: stats gid.
	Fs closeSync: tempFileFd.

	self truncate.
!
truncate
	| stats |
	Fs truncateSync: tempFilePath length: 2.
	stats := Fs statSync: tempFilePath options: nil.
	self assert: [ stats size = 2 ].

	tempFileFd := Fs openSync: tempFilePath flags: 'r+' mode: nil.
	Fs ftruncateSync: tempFileFd length: 0.
	stats := Fs fstatSync: tempFileFd options: nil.
	self assert: [ stats size = 0 ].

	Fs fsyncSync: tempFileFd.
	Fs fdatasyncSync: tempFileFd.

	self directory.
!
directory
	| pattern fileNames dir dirent |
	pattern := Path join: tempDirName with: '**/**'.
	fileNames := Fs globSync: pattern options: nil.
	self assert: [ fileNames length = 4 ].
	self assert: [ fileNames includes: tempDirName ].

	fileNames := Fs readdirSync: tempDirName options: nil.
	self assert: [ fileNames length = 2 ].
	self assert: [ fileNames includes: 'sub1' ].

	dir := Fs opendirSync: tempDirName options: nil.
	fileNames := #().
	[ ( dirent := dir readSync ) notNil ] whileTrue: [
		self dirent: dirent.
		fileNames add: dirent name ].
	self assert: [ fileNames length = 2 ].
	dir closeSync.

	self end.
!
dirent: dirent
	self assert: [ dirent parentPath = tempDirName ].

	#( 'sub1' 'tempfile.tmp' ) includes: dirent name.
	dirent name = 'tempfile.tmp' ifTrue: [
		self assert: [ dirent isFile ] ].
	dirent name = 'sub1' ifTrue: [
		self assert: [ dirent isDirectory ] ].

	self assert: [ dirent isCharacterDevice not ].
	self assert: [ dirent isBlockDevice not ].
	self assert: [ dirent isCharacterDevice not ].
	self assert: [ dirent isSymbolicLink not ].
	self assert: [ dirent isFifo not ].
	self assert: [ dirent isSocket not ].
!
end
	"Remove everything."
	| options |

	Fs unlinkSync: tempFilePath.
	self assert: [ ( Fs existsSync: tempFilePath ) not ].

	Fs rmdirSync: subDirName.
	self assert: [ ( Fs existsSync: subDirName ) not ].

	options := FileRmOptions new recursive: true.
	Fs rmSync: tempDirName options: options.
	self assert: [ ( Fs existsSync: tempDirName ) not ].
!
CLASS TestFsp EXTENDS Test MODULE TestNode CLASSVARS ''
	VARS 'tempDirName subDirName tempFilePath'

"Also tests classes Dir, Dirent in async mode."

async test
	await self makeTemp.
	await self openClose.
	await self renameCopyRemove.
	await self properties.
	await self directories.
	await self remove.
!
async makeTemp
	| prefix dirName options |

	"Create temp directory"
	prefix := Path join: Os tmpDir with: 'smalljs-tfsp-'.
	tempDirName := await Fsp mkdtemp: prefix.
	self assert: [ tempDirName includes: 'smalljs-' ].
	self assert: [ Fs existsSync: tempDirName ].

	"Create subdirectories"
	subDirName := Path join: tempDirName with: 'sub1/sub2'.
	options := FileMkdirOptions new recursive: true.
	await Fsp mkdir: subDirName options: options.
	self assert: [ Fs existsSync: subDirName ].
!
async openClose
	| fileHandle mode |
	tempFilePath := Path join: tempDirName with: 'tempfile.tmp'.
	fileHandle := await Fsp open: tempFilePath flags: 'w+' mode: 384.
	self assert: [ fileHandle fd >= 0 ].
	await fileHandle close.

	mode := FileConstants fileOk.
	await Fsp access: tempFilePath mode: mode.
!
async writeRead
	| buffer stats |
	buffer := Buffer from: 'abcd'.
	await Fsp writeFile: tempFilePath data: buffer options: nil.

	buffer := Buffer from: '12'.
	await Fsp appendFile: tempFilePath data: buffer options: nil.

	buffer := await Fsp readFile: tempFilePath options: nil.
	self assert: [ buffer toString = 'abcd12' ].

	await Fsp truncate: tempFilePath length: 2.
	stats := await Fsp stat: tempFilePath options: nil.
	self assert: [ stats size = 2 ].
!
async renameCopyRemove
	| tempFilePath2 |
	tempFilePath2 := Path join: tempDirName with: 'tempfile2.tmp'.
	await Fsp rename: tempFilePath to: tempFilePath2.
	self assert: [ ( Fs existsSync: tempFilePath ) not ].
	self assert: [ Fs existsSync: tempFilePath2 ].

	await Fsp copyFile: tempFilePath2 to: tempFilePath mode: nil.
	self assert: [ Fs existsSync: tempFilePath ].

	await Fsp unlink: tempFilePath.
	self assert: [ ( Fs existsSync: tempFilePath ) not ].

	await Fsp cp: tempFilePath2 to: tempFilePath options: nil.
	self assert: [ Fs existsSync: tempFilePath ].

	await Fsp unlink: tempFilePath2.
	self assert: [ ( Fs existsSync: tempFilePath2 ) not ].
!
async properties
	| stats |
	await Fsp utimes: tempFilePath atime: 2 mtime: 1.
	stats := await Fsp stat: tempFilePath options: nil.
	self assert: [ stats atimeMs = 2000 ].
	self assert: [ stats mtimeMs = 1000 ].

	"chmod and chown do nothing on Windows,
	 so don't actually change them and can't check for results."
	await Fsp chmod: tempFilePath mode: stats mode.
	await Fsp chown: tempFilePath uid: stats uid gid: stats gid.
!
async directories
	| fileNames pattern dir dirent |

	"Glob"

	fileNames := #().
	pattern := Path join: tempDirName with: '**/**'.
	await Fsp glob: pattern options: nil
		iterate: [ :fileName | fileNames add: fileName  ].
	self assert: [ fileNames length = 4 ].
	self assert: [ fileNames includes: tempDirName ].

	"Directory sync"


	"Directory async"
	fileNames := await Fsp readdir: tempDirName options: nil.
	self assert: [ fileNames length = 2 ].
	self assert: [ fileNames includes: 'sub1' ].

	fileNames := #().
	dir := await Fsp opendir: tempDirName options: nil.
	await dir read: [ :dirent |
		fileNames add: dirent name.
		self checkDirent: dirent ].
	self assert: [ fileNames length = 2 ].

	await dir close.
!
checkDirent: dirent
	self assert: [ dirent parentPath = tempDirName ].

	#( 'sub1' 'tempfile.tmp' ) includes: dirent name.
	dirent name = 'tempfile.tmp' ifTrue: [
		self assert: [ dirent isFile ] ].
	dirent name = 'sub1' ifTrue: [
		self assert: [ dirent isDirectory ] ].

	self assert: [ dirent isCharacterDevice not ].
	self assert: [ dirent isBlockDevice not ].
	self assert: [ dirent isCharacterDevice not ].
	self assert: [ dirent isSymbolicLink not ].
	self assert: [ dirent isFifo not ].
	self assert: [ dirent isSocket not ].
!
async remove
	| options |

	await Fsp unlink: tempFilePath.
	self assert: [ ( Fs existsSync: tempFilePath ) not ].

	await Fsp rmdir: subDirName options: nil.
	self assert: [ ( Fs existsSync: subDirName ) not ].

	options := FileRmOptions new recursive: true.
	await Fsp rm: tempDirName options: options.
	self assert: [ ( Fs existsSync: tempDirName ) not ].
!
CLASS TestPath EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	Path isWindows
		ifTrue: [ self checkWindows: Path ]
		ifFalse: [ self checkPosix: Path ].

	self checkWindows: Path win32.
	self checkPosix: Path posix.
!
checkPosix: pathClass
	| pathObject |

	self assert: [ ( pathClass resolve: 'file.txt' ) endsWith: '/file.txt' ].
	self assert: [ ( pathClass join: '/dir' with: 'file.txt' )  = '/dir/file.txt' ].

	self assert: [  pathClass sep = '/' ].
	self assert: [  pathClass delimiter = ':' ].

	self assert: [ ( pathClass dirname: '/dir/file.txt' )  = '/dir' ].
	self assert: [ ( pathClass basename: '/dir/file.txt' suffix: '' )  = 'file.txt' ].
	self assert: [ ( pathClass basename: '/dir/file.txt' suffix: '.txt' )  = 'file' ].
	self assert: [ ( pathClass extname: '/dir/file.txt' )  = '.txt' ].

	pathObject := PathObject new
		dir: '/dir'; name: 'file'; ext: '.txt'.
	self assert: [ ( pathClass format: pathObject )  = '/dir/file.txt' ].

	pathObject := pathClass parse: '/dir/file.txt'.
	self assert: [ pathObject root = '/' ].
	self assert: [ pathObject dir = '/dir' ].
	self assert: [ pathObject base = 'file.txt' ].
	self assert: [ pathObject name = 'file' ].
	self assert: [ pathObject ext = '.txt' ].

	self assert: [ pathClass matches: '/dir/file.txt' glob: '/dir/*' ].
	self assert: [ pathClass isAbsolute: '/dir/file.txt' ].

	self assert: [ pathClass isAbsolute: '/dir/file.txt' ].
	self assert: [ ( pathClass isAbsolute: 'dir/file.txt' ) not ].

	self assert: [ ( pathClass normalize: '/dir/../file.txt' ) = '/file.txt' ].
	self assert: [ ( pathClass relativeFrom: '/a/b/c' to: '/a/b/d' ) = '../d' ].
	self assert: [ ( pathClass toNamespacedPath: '/dir/file.txt' ) = '/dir/file.txt' ].

	self assert: [ pathClass posix = pathClass win32 posix ].
	self assert: [ pathClass win32 = pathClass posix win32 ].
!
checkWindows: pathClass
	| pathObject |

	self assert: [ ( pathClass resolve: 'file.txt' ) endsWith: '\\file.txt' ].
	self assert: [ ( pathClass join: '\\dir' with: 'file.txt' )  = '\\dir\\file.txt' ].

	self assert: [  pathClass sep = '\\' ].
	self assert: [  pathClass delimiter = ';' ].

	self assert: [ ( pathClass dirname: '\\dir\\file.txt' )  = '\\dir' ].
	self assert: [ ( pathClass basename: '\\dir\\file.txt' suffix: '' )  = 'file.txt' ].
	self assert: [ ( pathClass basename: '\\dir\\file.txt' suffix: '.txt' )  = 'file' ].
	self assert: [ ( pathClass extname: '\\dir\\file.txt' )  = '.txt' ].

	pathObject := PathObject new
		dir: '\\dir'; name: 'file'; ext: '.txt'.
	self assert: [ ( pathClass format: pathObject )  = '\\dir\\file.txt' ].

	pathObject := pathClass parse: '\\dir\\file.txt'.
	self assert: [ pathObject root = '\\' ].
	self assert: [ pathObject dir = '\\dir' ].
	self assert: [ pathObject base = 'file.txt' ].
	self assert: [ pathObject name = 'file' ].
	self assert: [ pathObject ext = '.txt' ].

	self assert: [ pathClass matches: '\\dir\\file.txt' glob: '\\dir\\*' ].
	self assert: [ pathClass isAbsolute: '\\dir\\file.txt' ].

	self assert: [ pathClass isAbsolute: '\\dir\\file.txt' ].
	self assert: [ ( pathClass isAbsolute: 'dir\\file.txt' ) not ].

	self assert: [ ( pathClass normalize: '\\dir\\..\\file.txt' ) = '\\file.txt' ].
	self assert: [ ( pathClass relativeFrom: '\\a\\b\\c' to: '\\a\\b\\d' ) = '..\\d' ].

	"toNamespacedPath: only has Windows behavior when run on Windows OS,
	 so not when the pathClass win32 version is run on Linux."
	Os isWindows ifTrue: [
		self assert: [ ( pathClass toNamespacedPath: '\\dir\\file.txt' ) startsWith: '\\\\?' ] ].

	self assert: [ pathClass posix = pathClass win32 posix ].
	self assert: [ pathClass win32 = pathClass posix win32 ].
!
CLASS TestPathObject EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| pathObject |
	pathObject := PathObject new.
	self assert: [ pathObject class = PathObject ].

	pathObject dir: '/dir'.
	self assert: [ pathObject dir = '/dir' ].

	pathObject root: '/'.
	self assert: [ pathObject root = '/' ].

	pathObject base: 'file.txt'.
	self assert: [ pathObject base = 'file.txt' ].

	pathObject name: 'file'.
	self assert: [ pathObject name = 'file' ].

	pathObject ext: '.txt'.
	self assert: [ pathObject ext = '.txt' ].
!
CLASS TestFileRmOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options |
	options := FileRmOptions new.

	options force: true.
	self assert: [ options force ].

	options recursive: true.
	self assert: [ options recursive ].

	options retryDelay: 100.
	self assert: [ options retryDelay = 100 ].

	options maxRetries: 5.
	self assert: [ options maxRetries = 5 ].
!
CLASS TestDirOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options |
	options := DirOptions new.

	options encoding: 'utf8'.
	self assert: [ options encoding = 'utf8' ].

	options withFileTypes: true.
	self assert: [ options withFileTypes ].

	options recursive: true.
	self assert: [ options recursive ].

!
CLASS TestFileConstants EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

testAccess
	self assert: [ FileConstants fileOk >= 0 ].
	self assert: [ FileConstants readOk >= 0 ].
	self assert: [ FileConstants writeOk >= 0 ].
	self assert: [ FileConstants executeOk >= 0 ].
!
testCopy
	self assert: [ FileConstants copyExclusive >= 0 ].
	self assert: [ FileConstants copyLink >= 0 ].
	self assert: [ FileConstants copyLinkForce >= 0 ].
!
CLASS TestFileCopyOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options |
	options := FileCopyOptions new.

	options dereference: true.
	self assert: [ options dereference ].

	options errorOnExist: true.
	self assert: [ options errorOnExist ].

	options force: true.
	self assert: [ options force ].

	options mode: 438.
	self assert: [ options mode = 438 ].

	options preserveTimestamps: true.
	self assert: [ options preserveTimestamps ].

	options recursive: true.
	self assert: [ options recursive ].

	options verbatimSymlinks: true.
	self assert: [ options verbatimSymlinks ].

	options filter: [ :src :dest | true ].
!
CLASS TestFileGlobOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options |
	options := FileGlobOptions new.

	options cwd: './web'.
	self assert: [ options cwd = './web' ].

	options withFileTypes: true.
	self assert: [ options withFileTypes ].

	options exclude: [ :path | false ].
!
CLASS TestFileMkdirOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options |
	options := FileMkdirOptions new.

	options recursive: true.
	self assert: [ options recursive ].

	options mode: 438.
	self assert: [ options mode = 438 ].
!
CLASS TestFileOptions EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| options signal |
	options := FileOptions new.

	options encoding: 'utf8'.
	self assert: [ options encoding = 'utf8' ].

	options autoClose: true.
	self assert: [ options autoClose ].

	options emitClose: true.
	self assert: [ options emitClose ].

	options start: 10.
	self assert: [ options start = 10 ].

	options end: 70.
	self assert: [ options end = 70 ].

	options highWaterMark: 1024.
	self assert: [ options highWaterMark = 1024 ].

	signal := AbortSignal abort.
	options signal: signal.
	self assert: [ options signal = signal ].
!
CLASS MyType EXTENDS SqlObject MODULE TestDatabase CLASSVARS ''
	VARS 'string integer float date boolean binary anil'

CLASSMETHODS

columns
	^ #( #( 'string' String )
		#( 'integer' Integer )
		#( 'float' Float )
		#( 'date' Date )
		#( 'boolean' Boolean )
		#( 'binary' Uint8Array )
		#( 'anil' Nil ) ).
!

fromObject: object
	^ self new
		id: ( object atProperty: 'id' );
		string: ( object atProperty: 'string' );
		integer: ( object atProperty: 'integer');
		float: ( object atProperty: 'float' );
		date: ( object atProperty: 'date' );
		boolean: ( object atProperty: 'boolean' );
		binary: ( object atProperty: 'binary' );
		anil: ( object atProperty: 'anil' ).
!

METHODS

"Accessing"

string
	^ string.
!
string: aString
	string := aString.
!
integer
	^ integer.
!
integer: aInteger
	integer := aInteger.
!
float
	^ float.
!
float: aFloat
	float := aFloat.
!
date
	^ date.
!
date: aDate
	date := aDate.
!
boolean
	^ boolean.
!
boolean: aBoolean
	boolean := aBoolean.
!
binary
	^ binary.
!
binary: aBinary
	binary := aBinary.
!
anil
	^ anil.
!
anil: aAnil
	anil := aAnil.
!

"Comparing"

= aType
	^ ( id = aType id ) &
		( string = aType string ) &
		( integer = aType integer ) &
		( ( float - aType float ) abs < 0.000001 ) &
		( date = aType date ) &
		( boolean = aType boolean ) &
		( binary = aType binary ) &
		( anil = aType anil ).
!

"Conversion"

toString
	^ 'Type: id: ', string toString,
		', string: ', string,
		', integer: ', integer toString,
		', float: ', float toString,
		', date: ', date toString,
		', boolean: ', boolean toString,
		', binary: ', binary toString,
		', anil: ', anil toString.
!
CLASS TestSqlDatabaseFactory EXTENDS Test MODULE TestDatabase CLASSVARS ''
	VARS ''

test
	self assert: [ ( SqlDatabaseFactory newFor: '../Database/SQLite/smalljs.db' ) class = SqliteDatabase ].
	self assert: [ ( SqlDatabaseFactory newFor:  'postgres://postgres:postgres@localhost:5432/smalljs' ) class = PostgresDatabase ].
	self assert: [ ( SqlDatabaseFactory newFor:  'mariadb://root:MariaDB@localhost:3307/smalljs?connectTimeout=0' ) class = MariadbDatabase ].
	self assert: [ ( SqlDatabaseFactory newFor:  'mysql://root:MySQL@localhost:3306/smalljs?connectTimeout=0' ) class = MysqlDatabase ].
!
CLASS TestSqliteDatabaseSync EXTENDS Test MODULE TestDatabase CLASSVARS ''
	VARS 'database typeTable type'

"Tests SQLite with its *sync* interface,
that is compatible with that of other supported databases with async interfaces when using await.
But awaits are not *necessary* and the testing functions don't need to be async.
Also tests SqliteTable."

disabled
	"Disable these tests if database env var is not set."
	^ self path isNil.
!
test
	self open.
	self deleteAll.
	self tableInsert.
	self databaseSelect.
	self tableSelectAll.
	self tableSelect.
	self tableSelectParameters.
	self tableSelectId.
	self tableUpdate.
	self tableDelete.
	self close.
!
open
	| path |
	path := self path.
	SqliteDatabase checkExists: path.
	database := SqliteDatabase new: path.
	database checkValid.

	typeTable := database connectTable: 'Type' rowClass: MyType.
!
path
	| path defaultPath |
	path := Environment at: 'SMALLJS_SQLITE'.
	path ifNotNil: [ ^ path ].

	defaultPath := '../Database/SQLite/smalljs.db'.
	( Fs existsSync: defaultPath ) ifTrue: [ ^ defaultPath ].

	^ nil.
!
deleteAll
	typeTable deleteAll.
!
tableInsert
	"This test the default type member object for subsequent tests."
	| binary |
	binary := ( Uint8Array new: 8 ) fill: 240 start: 0 end: 8.
	type := MyType new
		string: 'Hello'; integer: 13; float: Float pi;
		date: Date new; binary: binary; boolean: true.

	typeTable insert: type.
	self assert: [ type id > 0 ].
!
databaseSelect
	| statement rows newType |

	statement := database prepare: 'SELECT * FROM "Type" WHERE "string" = ?'.
	rows := statement all: #( ( type string ) ).
	self assert: [ rows length = 1 ].

	newType := MyType fromObject: rows first.
	"Manual type conversions, because the desired types are not known here."
	newType date: ( Date fromString: newType date ).
	newType boolean: ( Boolean fromInteger: newType boolean ).
	self assert: [ newType = type ].
!
tableSelectAll
	| selectedTypes |
	selectedTypes := typeTable selectAll.

	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
tableSelect
	| selectedTypes |
	selectedTypes := typeTable select: '"string" = \'Hello\''.

	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
tableSelectParameters
	| selectedTypes |
	selectedTypes := typeTable select: '"integer" = ?' with: #( 13 ).

	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
tableSelectId
	| selectedType |
	selectedType := typeTable selectId: type id.

	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
tableUpdate
	| selectedType |
	type string: 'World'.
	typeTable update: type.
	selectedType := typeTable selectId: type id.

	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
tableDelete
	| selectedType |
	typeTable delete: type.
	selectedType := typeTable selectId: type id.

	self assert: [ selectedType isNil ].
!
close
	database close.
!
CLASS TestSqliteDatabaseOptions EXTENDS Test MODULE TestDatabase CLASSVARS '' VARS ''

test
	| options |

	options := SqliteDatabaseOptions new.

	options open: true.
	self assert: [ options open ].

	options readOnly: true.
	self assert: [ options readOnly ].

	options enableForeignKeyConstraints: true.
	self assert: [ options enableForeignKeyConstraints ].

	options enableDoubleQuotedStringLiterals: true.
	self assert: [ options enableDoubleQuotedStringLiterals ].

	options allowExtension: true.
	self assert: [ options allowExtension ].
!
CLASS TestPostgresDatabase EXTENDS Test MODULE TestDatabase CLASSVARS ''
	VARS 'database typeTable type'

disabled
	"Temporaryly disable this module when there are connection timeouts
	 due to breakpoints in unrelated async functions."
	"^ true."

	"Disable these tests if database env var is not set."
	^ ( Environment at: 'SMALLJS_POSTGRES' ) isNil.
!
async test
	await self connect.
	await self tableDeleteAll.
	await self tableInsert.
	await self databaseSelect.
	await self tableSelectAll.
	await self tableSelect.
	await self tableSelectWith.
	await self tableSelectId.
	await self tableUpdate.
	await self tableDelete.
	await self end.
!
async connect
	| connectionString |
	connectionString := Environment at: 'SMALLJS_POSTGRES'.
	self assert: [ connectionString startsWith: 'postgres:' ].

	database := PostgresDatabase new.
	await database connect: connectionString.

	typeTable := database connectTable: 'Type' rowClass: MyType.
!
async tableDeleteAll
	await typeTable deleteAll.
!
async tableInsert
	| binary |
	binary := ( Uint8Array new: 6 ) fill: 127 start: 0 end: 6.
	type := MyType new
		string: 'Hi'; integer: 7; float: Float pi * 2;
		date: Date new; binary: binary; boolean: true.

	await typeTable insert: type.
	self assert: [ type id > 0 ].
!
async databaseSelect
	| query result selectedType |
	query := 'SELECT * FROM "Type" WHERE "string" = $1'.
	result := await database query: query with: #( ( type string ) ).
	self assert: [ result rows length = 1 ].

	selectedType := MyType fromObject: result rows first.
	"Manual date type conversion, because the desired type is not known here."
	selectedType date: ( Date fromString: selectedType date ).
	self assert: [ selectedType = type ].
!
async tableSelectAll
	| selectedTypes |
	selectedTypes := await typeTable selectAll.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelect
	| selectedTypes |
	selectedTypes := await typeTable select:  '`string` = "Hi"'.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectWith
	| selectedTypes |
	selectedTypes := await typeTable select: '`integer` = ?' with: #( 7 ).
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectId
	| selectedType |
	selectedType := await typeTable selectId: type id.
	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
async tableUpdate
	| updatedType |
	type string: 'There'.
	await typeTable update: type.

	updatedType := await typeTable selectId: type id.
	self assert: [ updatedType notNil ].
	self assert: [ updatedType = type ].
!
async tableDelete
	| detetedType |
	await typeTable delete: type.

	detetedType := await typeTable selectId: type id.
	self assert: [ detetedType isNil ].
!
async end
	await database end.
!
CLASS TestMysqlDatabase EXTENDS Test MODULE TestDatabase CLASSVARS ''
	VARS 'database typeTable type'

disabled
	"Temporaryly disable this module when there are connection timeouts
	 due to breakpoints in unrelated async functions."
	"^ true."

	"Disable these tests if database env var is not set."
	^ ( Environment at: 'SMALLJS_MYSQL' ) isNil.
!
async test
	await self connect.
	await self tableDeleteAll.
	await self tableInsert.
	await self databaseSelect.
	await self tableSelectAll.
	await self tableSelect.
	await self tableSelectWith.
	await self tableSelectId.
	await self tableUpdate.
	await self tableDelete.
	await self end.
!
async connect
	| connectionString |
	connectionString := Environment at: 'SMALLJS_MYSQL'.
	self assert: [ connectionString startsWith: 'mysql:' ].

	database := MysqlDatabase new.
	await database connect: connectionString.

	typeTable := database connectTable: 'type' rowClass: MyType.
!
async tableDeleteAll
	await typeTable deleteAll.
!
async tableInsert
	| binary |
	"The mysql2 package supports Node.js class Buffer and not the common class UInt8Array."
	binary := ( Buffer new: 6 ) fill: 127 start: 0 end: 6.
	type := MyType new
		string: 'Hi'; integer: 7; float: Float pi * 2;
		date: Date new; binary: binary; boolean: true.
	await typeTable insert: type.
	self assert: [ type id > 0 ].
!
async databaseSelect
	| query result selectedType |
	query := 'SELECT * FROM `Type` WHERE `string` = ?'.
	result := await database query: query with: #( ( type string ) ).
	self assert: [ result length = 1 ].

	selectedType := MyType fromObject: result first.
	"Manual date and boolean type conversion."
	selectedType date: ( Date fromString: selectedType date ).
	selectedType boolean: ( Boolean fromInteger: selectedType boolean ).
	self assert: [ selectedType = type ].
!
async tableSelectAll
	| selectedTypes |
	selectedTypes := await typeTable selectAll.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelect
	| selectedTypes |
	selectedTypes := await typeTable select: '`string` = "Hi"'.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectWith
	| selectedTypes |
	selectedTypes := await typeTable select: '`integer` = ?' with: #( 7 ).
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectId
	| selectedType |
	selectedType := await typeTable selectId: type id.
	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
async tableUpdate
	| selectedType |
	type string: 'There'.
	await typeTable update: type.

	selectedType := await typeTable selectId: type id.
	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
async tableDelete
	| selectedType |
	await typeTable delete: type.

	selectedType := await typeTable selectId: type id.
	self assert: [ selectedType isNil ].
!
async end
	await database end.
!
CLASS TestMariadbDatabase EXTENDS Test MODULE TestDatabase CLASSVARS ''
	VARS 'database typeTable type'

"Also tests class MariadbTable"

disabled
	"Temporaryly disable this module when there are connection timeouts
	 due to breakpoints in unrelated async functions."
	"^ true."

	"Disable these tests if database env var is not set."
	^ ( Environment at: 'SMALLJS_MARIADB' ) isNil.
!
async test
	await self connect.
	await self tableDeleteAll.
	await self tableInsert.
	await self databaseSelect.
	await self tableSelectAll.
	await self tableSelect.
	await self tableSelectWith.
	await self tableSelectId.
	await self tableUpdate.
	await self tableDelete.
	await self end.
!
async connect
	| connectionString |
	connectionString := Environment at: 'SMALLJS_MARIADB'.
	self assert: [ connectionString startsWith: 'mariadb:' ].

	database := MariadbDatabase new.
	await database connect: connectionString.

	typeTable := database connectTable: 'Type' rowClass: MyType.
!
async tableDeleteAll
	await typeTable deleteAll.
!
async tableInsert
	| binary |
	"The mariadb npm package supports Node.js class Buffer and not the common class UInt8Array."
	binary := ( Buffer new: 6 ) fill: 127 start: 0 end: 6.
	type := MyType new
		string: 'Hi'; integer: 7; float: Float pi * 2;
		date: Date new; binary: binary; boolean: true.
	await typeTable insert: type.
	self assert: [ type id > 0 ].
!
async databaseSelect
	| result newType |
	result := await database query: 'SELECT * FROM `Type` WHERE `string` = ?' with: #( ( type string ) ).
	self assert: [ result length = 1 ].

	newType := MyType fromObject: result first.
	"Manual type conversion, because the desired type is not known here."
	newType date: ( Date fromString: newType date ).
	newType boolean: ( Boolean fromInteger: newType boolean ).
	self assert: [ newType = type ].
!
async tableSelectAll
	| selectedTypes |
	selectedTypes := await typeTable selectAll.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelect
	| selectedTypes |
	selectedTypes := await typeTable select: '`string` = "Hi"'.
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectWith
	| selectedTypes |
	selectedTypes := await typeTable select: '`integer` = ?' with: #( 7 ).
	self assert: [ selectedTypes length = 1 ].
	self assert: [ selectedTypes first = type ].
!
async tableSelectId
	| selectedType |
	selectedType := await typeTable selectId: type id.
	self assert: [ selectedType notNil ].
	self assert: [ selectedType = type ].
!
async tableUpdate
	| updatedType |
	type string: 'There'.
	await typeTable update: type.

	updatedType := await typeTable selectId: type id.
	self assert: [ updatedType notNil ].
	self assert: [ updatedType = type ].
!
async tableDelete
	| deletedType |
	await typeTable delete: type.

	deletedType := await typeTable selectId: type id.
	self assert: [ deletedType isNil ].
!
async end
	await database end.
!
CLASS TestBuffer EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

testCreation
	| buffer |

	self assert: [ Buffer new length = 0 ].
	buffer := Buffer new: 3.
	self assert: [ ( Buffer new: 3 ) length = 3 ].
	self assert: [ ( Buffer new: 3 ) last = 0 ].
	self assert: [ ( Buffer with: 7 ) first = 7 ].
	self assert: [ ( Buffer with: 8 with: 9 ) last = 9 ].

	buffer := Buffer from: 'abc'.
	self assert: [ ( buffer at: 1 ) = 98 ].
!
CLASS TestEventEmitter EXTENDS Test MODULE TestNode CLASSVARS '' VARS ''

test
	| eventEmitter listeners |
	eventEmitter := EventEmitter new.
	self assert: [ eventEmitter jsClassName = 'EventEmitter' ].

	"Max"

	eventEmitter maxListeners: 20.
	self assert: [ eventEmitter maxListeners = 20 ].

	"Add"

	eventEmitter on: 'test' then: [ self onTest ].
	eventEmitter emit: 'test'.

	self assert: [ ( eventEmitter listenerCount: 'test' ) = 1 ].
	listeners := eventEmitter listeners: 'test'.
	self assert: [ listeners length = 1 ].
	self assert: [ listeners first class = Block ].

	eventEmitter on: 'testArg' class: Integer
		then: [ :arg | self onTestArg: arg ].
	eventEmitter emit: 'testArg' value: 23.

	self assert: [ ( eventEmitter listenerCount: 'testArg' ) = 1 ].
	self assert: [ eventEmitter eventNames = #( 'test' 'testArg') ].

	"Remove"

	eventEmitter removeAllListeners: 'test'.
	self assert: [ ( eventEmitter listenerCount: 'test' ) = 0 ].


	"Once"

	eventEmitter once: 'testOnce' then: [ self onTestOnce ].
	self assert: [ ( eventEmitter listenerCount: 'testOnce' ) = 1 ].
	eventEmitter emit: 'testOnce'.
	self assert: [ ( eventEmitter listenerCount: 'testOnce' ) = 0 ].

	eventEmitter once: 'testOnceArg' class: String
		then: [ :arg | self onTestOnceArg: arg ].
	self assert: [ ( eventEmitter listenerCount: 'testOnceArg' ) = 1 ].
	eventEmitter emit: 'testOnceArg' value: 'arg'.
	self assert: [ ( eventEmitter listenerCount: 'testOnceArg' ) = 0 ].


!
onTest
	self assert: [ true ].
!
onTestArg: arg
	self assert: [ arg = 23 ].
!
onTestOnce
	self assert: [ true ].
!
onTestOnceArg: arg
	self assert: [ arg = 'arg' ].
!
CLASS TestBrowserWindowOptions EXTENDS Test MODULE TestElectronMain CLASSVARS '' VARS ''

test
	| options webPreferences |

	options := BrowserWindowOptions new.

	options width: 1000.
	self assert: [ options width = 1000 ].
	options height: 800.
	self assert: [ options height = 800 ].

	webPreferences := WebPreferences new.
	options webPreferences: webPreferences.
	self assert: [ options webPreferences = webPreferences ].
!
CLASS TestWebPreferences EXTENDS Test MODULE TestElectronMain CLASSVARS '' VARS ''

test
	| webPreferences |

	webPreferences := WebPreferences new.

	webPreferences nodeIntegration: true.
	self assert: [ webPreferences nodeIntegration ].

	webPreferences nodeIntegrationInWorker: true.
	self assert: [ webPreferences nodeIntegrationInWorker ].

	webPreferences nodeIntegrationInSubFrames: true.
	self assert: [ webPreferences nodeIntegrationInSubFrames ].

	webPreferences contextIsolation: true.
	self assert: [ webPreferences contextIsolation ].

	webPreferences contextIsolation: true.
	self assert: [ webPreferences contextIsolation ].

	webPreferences sandbox: false.
	self assert: [ webPreferences sandbox not ].

	webPreferences preload: ( Path resolve: 'preload.mjs' ).
	self assert: [ webPreferences preload endsWith: 'preload.mjs' ].
!
CLASS TestBlob EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| blob |
	blob := Blob fromArray: ( Uint8Array from: #( 4 5 6 7 ) ).

	self assert: [ blob size = 4 ].
	self assert: [ blob type = '' ].
	self assert: [ ( blob slice: 1 to: 3 ) size = 2 ].
!
testStream
	| blob stream |
	blob := Blob fromArray: ( Uint8Array from: #( 4 5 6 7 ) ).

	self assert: [ blob size = 4 ].
	self assert: [ blob type = '' ].
	self assert: [ blob stream class = ReadableStream ].
	blob arrayBufferThen: [ :arrayBuffer | self onArrayBuffer: arrayBuffer ].
	blob textThen: [ :string | self onText: string ]
!
onText: string
	self assert: [ string = '4567' ].
!
onArrayBuffer: arrayBuffer
	self assert: [ arrayBuffer byteLength = 4 ].
	self assert: [ ( ArrayBuffer isView: arrayBuffer ) not ].
!
CLASS TestFile EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

"TODO: Implement more tests."
CLASS TestReadableStream EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| stream streamTee |
	stream := ( Blob fromArray: ( Uint8Array from: #( 4 5 6 7 ) ) ) stream.
	self assert: [ stream class = ReadableStream ].
	self assert: [ stream locked not ].
	self assert: [ stream getReader class = ReadableStreamDefaultReader ].
	self assert: [ stream locked ].

	stream := ( Blob fromArray: ( Uint8Array from: #( 4 5 6 7 ) ) ) stream.
	streamTee := stream tee.
	self assert: [ streamTee first class = ReadableStream ].
	streamTee first cancelThen: [ self onCancel ].
!
onCancel
	self assert: [ true ].
!

"TODO:
- pipeThrough: transformStream options: options
- pipeTo: writeableStream options: options
- tee"
CLASS TestAbstractInteger EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ 42 toInteger = 42 ].
!
testIteration
	| sum |

	sum := 0.
	1 to: 4 do: [ :num | sum := sum + num ].
	self assert: [ sum = 10 ].

	sum := 0.
	4 to: 1 by: -1 do: [ :num | sum := sum + num ].
	self assert: [ sum = 10 ].

	sum := 0.
	3 timesRepeat: [ sum increment ].
	self assert: [ sum = 3 ].
!
async testIterationAwait
	| sum |

	sum := 0.
	await 1 to: 4 doAwait: async [ :num |
		await Timer timeout: 1.
		sum := sum + num ].
	self assert: [ sum = 10 ].

	sum := 0.
	await 4 to: 1 by: -1 doAwait: async [ :num |
		await Timer timeout: 1.
		sum := await sum + num ].
	self assert: [ sum = 10 ].

	sum := 0.
	await 3 timesRepeatAwait: async [
		await Timer timeout: 1.
		sum := sum + 1 ].
	self assert: [ sum = 3 ].
!
testFunctions
	self assert: [ 8 even ].
	self assert: [ 7 odd ].
	self assert: [ 4 factorial = 24 ].
	self assert: [ 23 isPrime ].
	self assert: [ 21 isPrime not ].
	self assert: [ 21 factors last = 7 ].
	self assert: [ 21 firstDivider = 3 ].

!
CLASS TestBigInt EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ 9007199254740992 class = BigInt ].
	self assert: [ 13 toBigInt class = BigInt ].
!
testConversion
	self assert: [ 13 toBigInt toString = '13' ].
	self assert: [ 13 toBigInt toFloat = 13.0 ].
!
testComparisons
	self assert: [ 11 toBigInt = 11 toBigInt ].
	self assert: [ 11 toBigInt <= 11 toBigInt ].
	self assert: [ 11 toBigInt >= 11 toBigInt ].
	self assert: [ 11 toBigInt < 13 toBigInt ].
	self assert: [ 13 toBigInt > 11 toBigInt ].

	"Comparisons with integer arguments."
	self assert: [ 11 toBigInt = 11 ].
	self assert: [ 11 toBigInt <= 11 ].
	self assert: [ 11 toBigInt >= 11 ].
	self assert: [ 11 toBigInt < 12 ].
	self assert: [ 13 toBigInt > 12 ].

	"Comparisons with float arguments."
	self assert: [ 11 toBigInt = 11.0 ].
	self assert: [ 11 toBigInt <= 11.0 ].
	self assert: [ 11 toBigInt >= 11.0 ].
	self assert: [ 11 toBigInt < 12.0 ].
	self assert: [ 13 toBigInt > 12.0 ].

	"Comparions with fractions."
	self assert: [ 11 toBigInt = ( 22 / 2 ) ].
	self assert: [ 11 toBigInt <= ( 23 / 2 ) ].
	self assert: [ 11 toBigInt >= ( 21 / 2 ) ].
	self assert: [ 11 toBigInt < ( 23 / 2 ) ].
	self assert: [ 13 toBigInt > ( 25 / 2 ) ].
!
testBasicArithmatic
	"Basic arithmatic with long integer arguments."
	self assert: [ 3 toBigInt + 4 toBigInt = 7 toBigInt ].
	self assert: [ 4 toBigInt - 3 toBigInt = 1 toBigInt ].
	self assert: [ 3 toBigInt * 4 toBigInt = 12 toBigInt ].
	self assert: [ 4 toBigInt / 3 toBigInt = ( 4 / 3 ) ].
	self assert: [ 7 toBigInt // 3 toBigInt = 2 toBigInt ].
	self assert: [ 7 toBigInt % 3 toBigInt = 1 toBigInt ].
	self assert: [ 7 toBigInt ** 3 toBigInt = 343 toBigInt ].

	"Basic arithmatic with integer arguments."
	self assert: [ 3 toBigInt + 10 = 13 ].
	self assert: [ 3 toBigInt - 5 = -2 ].
	self assert: [ 3 toBigInt * 2 = 6 ].
	self assert: [ 3 toBigInt / 4 = ( 3 / 4 ) ].
	self assert: [ 7 toBigInt // 3 = 2 ].
	self assert: [ 7 toBigInt % 3 = 1 ].
	self assert: [ 7 toBigInt ** 3 = 343 toBigInt ].

	"Basic arithmatic with fraction arguments."
	self assert: [ 3 toBigInt + ( 1 / 2 ) = ( 7 / 2 ) ].
	self assert: [ 4 toBigInt - ( 1 / 2 ) = ( 7 / 2 ) ].
	self assert: [ 4 toBigInt * ( 1 / 2 ) = 2 ].
	self assert: [ 2 toBigInt / ( 1 / 2 ) = 4 ].
	self assert: [ 3 toBigInt // ( 2 / 3 ) = 4 ].
	self assert: [ 2 toBigInt % ( 4 / 3 ) = ( 2 / 3 ) ].
	self assert: [ 2 toBigInt ** ( 1 / 2 ) equals: 2 sqrt precision: 0.001 ].

	"Basic arithmatic with float arguments."
	self assert: [ 3 toBigInt + 10.0 = 13.0 ].
	self assert: [ 3 toBigInt - 5.0 = -2.0 ].
	self assert: [ 3 toBigInt * 2.0 = 6.0 ].
	self assert: [ 3 toBigInt / 4.0 = 0.75 ].
	self assert: [ 7 toBigInt // 3.0 = 2.0 ].
	self assert: [ 7 toBigInt % 3.0 = 1.0 ].
	self assert: [ 2 toBigInt ** 0.5 equals: 2 sqrt precision: 0.001 ].

	"Basic arithmatic with points."
	self assert: [ 3 toBigInt + ( 1 @ 2 ) = ( 4 @ 5 ) ].
	self assert: [ 4 toBigInt - ( 1 @ 2 ) = ( 3 @ 2 ) ].
	self assert: [ 2 toBigInt * ( 2 @ 3 ) = ( 4 @ 6 ) ].
	self assert: [ 6 toBigInt / ( 2 @ 3 ) = ( 3 @ 2 ) ].
	self assert: [ 7 toBigInt // ( 2 @ 3 ) = ( 3 @ 2 ) ].
	self assert: [ 8 toBigInt % ( 2 @ 3 ) = ( 0 @ 2 ) ].
!
testBitOperations
	self assert: [ 6 toBigInt & 3 toBigInt = 2 ].
	self assert: [ 6 toBigInt | 3 toBigInt = 7 ].
	self assert: [ ( 6 toBigInt xor: 3 toBigInt ) = 5 ].
	self assert: [ 7 toBigInt >> 1 toBigInt = 3 ].
	self assert: [ 3 toBigInt << 1 toBigInt = 6 ].

!
testGcd
	self assert: [ ( 12 toBigInt gcd: 9 toBigInt ) = 3 ].
	self assert: [ ( 12 toBigInt gcd: 9 ) = 3 ].
!
CLASS TestCharacter EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ ( Character fromCode: 65 ) = $A ].
	self assert: [ Character newline code = 10 ].
!
testAcesssing
	self assert: [ $A code = 65 ].
!
testConverting
	self assert: [ $a toString = 'a' ].

	self assert: [ $a toUpperCase = $A ].
	self assert: [ $1 toUpperCase = $1 ].

	self assert: [ $B toLowerCase = $b ].
	self assert: [ $@ toUpperCase = $@ ].
!
testComparisons
	self assert: [ $a = $a ].
	self assert: [ $a ~= $b ].
	self assert: [ $a < $b ].
	self assert: [ $a <= $a ].
!
testTesting
	self assert: [ $a isLowerCase ].
	self assert: [ $Z isUpperCase ].
	self assert: [ $e isLetter ].
	self assert: [ $. isLetter not ].
!
CLASS TestDate EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| msec date1 date1Utc date2 now |

	msec := Date now.
	self assert: [ Date now > 1730754619592 ].

	date1 := Date year: 2000 month: 2 day: 28 hours: 23 minutes: 58 seconds: 59.
	self assert: [ ( date1 year = 2000 ) & ( date1 month = 2 ) & ( date1 day = 28 ) ].
	self assert: [ ( date1 hours = 23 ) & ( date1 minutes = 58 ) & ( date1 seconds = 59 ) ].

	date2 := date1 copy.
	self assert: [ date1 = date2 ].
	date2 year: 2001.
	self assert: [ date1 ~= date2 ].

	date2 := Date new year: 1996; month: 10; day: 30; hours: 22; minutes: 21; seconds: 20; milliseconds: 123.
	self assert: [ ( date2 year = 1996 ) & ( date2 month = 10 ) & ( date2 day = 30 ) ].
	self assert: [ ( date2 hours = 22 ) & ( date2 minutes = 21 ) & ( date2 seconds = 20 ) & ( date2 milliseconds = 123 ) ].

	date2 utcYear: 1995; utcMonth: 9; utcDay: 15; utcHours: 14; utcMinutes: 13; utcSeconds: 12; utcMilliseconds: 999.
	self assert: [ ( date2 utcYear = 1995 ) & ( date2 utcMonth = 9 ) & ( date2 utcDay = 15 ) ].
	self assert: [ ( date2 utcHours = 14 ) & ( date2 utcMinutes = 13 ) & ( date2 utcSeconds = 12 ) & ( date2 utcMilliseconds = 999 ) ].

	self assert: [ ( date1 = date2 ) not ].
	self assert: [ ( Date fromMilliseconds: date1 toMilliseconds ) = date1 ].
	self assert: [ ( Date fromSeconds: date1 toSeconds ) = date1 ].

	self assert: [ date1 = date1 ].
	self assert: [ date2 < date1 ].
	self assert: [ date2 <= date1 ].
	self assert: [ date1 > date2 ].
	self assert: [ date1 < Date new ].
	date1Utc := Date utcYear: 2000 month: 2 day: 28 hours: 23 minutes: 58 seconds: 59.
	self assert: [ date1 toMilliseconds - ( date1 timezoneOffset * 60 * 1000 ) = date1Utc toMilliseconds ].

	now := Date new.
	self assert: [ ( Date fromString: now toIsoString ) = now ].

	self assert: [ date2 toDateString = 'Sun Oct 15 1995' ].
	self assert: [ date2 toTimeString includes: ':12' ].
	self assert: [ date2 toUtcString = 'Sun, 15 Oct 1995 14:13:12 GMT' ].
	self assert: [ date2 toIsoString = '1995-10-15T14:13:12.999Z' ].
	self assert: [ date2 toJson = '1995-10-15T14:13:12.999Z' ].
	self assert: [ date2 toLocaleDateString includes: '15' ].
	self assert: [ date2 toLocaleTimeString includes: '13' ].

	self assert: [ Date isJsDate: INLINE 'new Date()' ].
	self assert: [ ( Date isJsDate: INLINE '1' ) not ].
!
CLASS TestFloat EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testConstants
	self assert: [ Float pi toString startsWith: '3.14' ].
	self assert: [ Float epsilon < 0.000000001 ].
!
testConversion
	self assert: [ 3.4 toInteger = 3 ].
	self assert: [ 4.0 toString = '4' ].

	self assert: [ 2.5 f16Round = 2.5 ].
	"2.6 rounded to float16 is about: 2.599609375"
	self assert: [ 2.6 f16Round - 2.6 < -0.00001 ].

	self assert: [ 9007199254740991.0 isSafeInteger ].
	self assert: [ 9007199254740992.0 isSafeInteger not ].
!
testComparisons
	| bigInt fraction |

	self assert: [ 3.0 = 3.0 ].
	self assert: [ 7.0 <= 7.0 ].
	self assert: [ 7.0 >= 7.0 ].
	self assert: [ 2.9999999 equals: 3.0 precision: 0.00001 ].
	self assert: [ 2.9999999 < 3.0 ].
	self assert: [ 3.01 > 3.0 ].

	"Compare to integers."
	self assert: [ 3.0 = 3 ].
	self assert: [ 3.0 <= 3 ].
	self assert: [ 3.0 >= 3 ].
	self assert: [ 2.9 < 3 ].
	self assert: [ 3.1 > 3 ].

	"Compare to large integers."
	bigInt := BigInt fromJs: INLINE '13n'.
	self assert: [ bigInt class = BigInt ].
	self assert: [ 13.0 = bigInt ].
	self assert: [ 13.0 <= bigInt ].
	self assert: [ 13.0 >= bigInt ].
	self assert: [ 12.9 < bigInt ].
	self assert: [ 13.1 > bigInt ].

	"Compare to fractions."
	fraction := 1 / 2.
	self assert: [ fraction class = Fraction ].
	self assert: [ 0.5 = fraction ].
	self assert: [ 0.5 <= fraction ].
	self assert: [ 0.5 >= fraction ].
	self assert: [ 0.499 < fraction ].
	self assert: [ 0.501 > fraction ].
!
testBasicMath
	| epsilon bigInt fraction point |

	epsilon := 0.00001.

	"Basic math with floats."
	self assert: [ 2.0 + 3.0 = 5.0 ].
	self assert: [ 2.1 - 3.0 = -0.9 ].
	self assert: [ 4.1 * 3.0 equals: 12.3 precision: epsilon ].
	self assert: [ 7.0 / 2.0 = 3.5 ].
	self assert: [ 7.0 // 2.0 = 3.0 ].
	self assert: [ 7.0 % 2.0 = 1.0 ].
	self assert: [ 7.0 ** 2.0 equals: 49.0 precision: epsilon ].

	"Basic math with integers."
	self assert: [ 2.0 + 3 = 5.0 ].
	self assert: [ 2.1 - 3 = -0.9 ].
	self assert: [ 4.1 * 3 equals: 12.3 precision: epsilon ].
	self assert: [ 7.0 / 2 = 3.5 ].
	self assert: [ 7.0 // 2 = 3.0 ].
	self assert: [ 7.0 % 2 = 1.0 ].
	self assert: [ 7.0 ** 2  equals: 49.0 precision: epsilon ].

	"Basic math with large integers."
	bigInt := BigInt fromJs: INLINE '3n'.
	self assert: [ bigInt class = BigInt ].
	self assert: [ 2.0 + bigInt = 5.0 ].
	self assert: [ 2.1 - bigInt = -0.9 ].
	self assert: [ 4.1 * bigInt -12.3 < epsilon ].
	bigInt := BigInt fromJs: INLINE '2n'.
	self assert: [ 7.0 / bigInt = 3.5 ].
	self assert: [ 7.0 // bigInt = 3.0 ].
	self assert: [ 7.0 % bigInt = 1.0 ].
	self assert: [ 7.0 ** bigInt equals: 49.0 precision: epsilon ].

	"Basic math with fractions."
	fraction := 1 / 2.
	self assert: [ fraction class = Fraction ].
	self assert: [ 1.0 + fraction = 1.5 ].
	self assert: [ -1.0 - fraction = -1.5 ].
	self assert: [ 4.2 * fraction = 2.1 ].
	self assert: [ 7.0 / fraction = 14.0 ].
	self assert: [ 7.1 // fraction = 14.0 ].
	self assert: [ 7.1 % fraction equals: 0.1 precision: epsilon ].
	self assert: [ 2.0 ** fraction equals: 2.0 sqrt precision: epsilon ].

	"Basic math with points."
	point := 2.5 @ 3.0.
	self assert: [ point class = Point ].
	self assert: [ 1.0 + point = ( 3.5 @ 4.0 ) ].
	self assert: [ -1.0 - point = ( -3.5 @ -4.0 ) ].
	self assert: [ 2.0 * point = ( 5.0 @ 6.0 ) ].
	self assert: [ 30.0 / point = ( 12.0 @ 10.0 ) ].
	self assert: [ 5.0 // point = ( 2.0 @ 1.0 ) ].
	self assert: [ 5.0 % point = ( 0.0 @ 2.0 ) ].
!
testFunctions
	self assert: [ 2.0 sqrt equals: 1.4142135623730951 precision: 0.00001 ].
	self assert: [ 2.0 ln equals: 0.6931471805599453 precision: 0.00001 ].
	self assert: [ 2.0 log equals: 0.30102999566398114 precision: 0.00001 ].
	self assert: [ 2.0 exp equals: 7.38905609893065 precision: 0.00001 ].
	self assert: [ 2.0 ** 3 = 8.0 ].
	self assert: [ Float pi sin equals: 0.0 precision: 0.00001 ].
	self assert: [ Float pi cos equals: -1.0 precision: 0.00001 ].
	self assert: [ Float pi tan equals: 0.0 precision: 0.00001 ].
!
CLASS TestFraction EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ ( Fraction numerator: 2 denominator: 3 ) = ( 2 / 3 ) ].
	self assert: [ ( Fraction numerator: 4 denominator: 6 ) = ( 2 / 3 ) ].
!
testConversion
	self assert: [ ( 5 / 3 ) toInteger = 1 ].
	self assert: [ ( 3 / 4 ) toFloat = 0.75 ].
	self assert: [ ( 3 / 4 ) toString = '( 3 / 4 )' ].

!
testAccessing
	self assert: [ ( Fraction numerator: 2 denominator: 3 ) numerator = 2 ].
	self assert: [ ( Fraction numerator: 2 denominator: 3 ) denominator = 3 ].
!
testComparisons
	| bigInt fraction |

	self assert: [ ( 2 / 3 ) = ( 4 / 6 ) ].
	self assert: [ ( 2 / 3 ) <= ( 2 / 3 ) ].
	self assert: [ ( 2 / 3 ) >= ( 2 / 3 ) ].
	self assert: [ ( 2 / 3 ) < ( 5 / 6 ) ].
	self assert: [ ( 2 / 3 ) > ( 3 / 6 ) ].

	"Compare to integers."
	self assert: [ ( 4 / 2 ) = 2 ].
	self assert: [ ( 4 / 2 ) <= 2 ].
	self assert: [ ( 4 / 2 ) >= 2 ].
	self assert: [ ( 7 / 3 ) < 3 ].
	self assert: [ ( 7 / 3 ) > 2 ].

	"Compare to large integers."
	bigInt := BigInt fromJs: INLINE '2n'.
	self assert: [ ( 4 / 2 ) = bigInt ].
	self assert: [ ( 4 / 2 ) <= bigInt ].
	self assert: [ ( 4 / 2 ) >= bigInt ].
	self assert: [ ( 5 / 3 ) < bigInt ].
	self assert: [ ( 7 / 3 ) > bigInt ].

!
testBasicMath
	| bigInt point |

	"Basic math with fractions."
	self assert: [ ( 1 / 3 ) + ( 1 / 6 ) = ( 1 / 2 ) ].
	self assert: [ ( 1 / 3 ) - ( 1 / 6 ) = ( 1 / 6 ) ].
	self assert: [ ( 1 / 3 ) * ( 2 / 3 ) = ( 2 / 9 ) ].
	self assert: [ ( 1 / 3 ) / ( 2 / 3 ) = ( 1 / 2 ) ].
	self assert: [ ( 7 / 3 ) // ( 1 / 2 ) = 4 ].
	self assert: [ ( 7 / 3 ) % ( 1 / 2 ) = ( 1 / 3 ) ].
	self assert: [ ( 7 / 3 ) % ( 1 / 2 ) = ( 1 / 3 ) ].
	self assert: [ ( 1 / 2 ) ** ( 1 / 2 ) equals: 0.707 precision: 0.01 ].

	"Basic math with integers."
	self assert: [ ( 2 / 3 ) + 2 = ( 8 / 3 ) ].
	self assert: [ ( 4 / 3 ) - 1 = ( 1 / 3 ) ].
	self assert: [ ( 4 / 3 ) * 2 = ( 8 / 3 ) ].
	self assert: [ ( 4 / 3 ) / 2 = ( 2 / 3 ) ].
	self assert: [ ( 8 / 3 ) // 2 = 1 ].
	self assert: [ ( 8 / 3 ) % 2 = ( 2 / 3 ) ].
	self assert: [ ( 1 / 2 ) ** 2 equals: 0.25 precision: 0.01 ].

	"Basic math with points."
	self assert: [ ( 1 / 3 ) + ( 2 @ 3 ) = ( ( 7 / 3 ) @ ( 10 / 3 ) ) ].
	self assert: [ ( 1 / 3 ) - ( 1 @ 2 ) = ( ( -2 / 3 ) @ ( -5 / 3 ) ) ].
	self assert: [ ( 1 / 3 ) * ( 1 @ 2 ) = ( ( 1 / 3 ) @ ( 2 / 3 ) ) ].
	self assert: [ ( 1 / 3 ) / ( 1 @ 2 ) = ( ( 1 / 3 ) @ ( 1 / 6 ) ) ].
	self assert: [ ( 1 / 3 ) // ( 1 @ 2 ) = ( 0 @ 0 ) ].
	self assert: [ ( 1 / 3 ) % ( 1 @ 2 ) = ( ( 1 / 3 ) @ ( 1 / 3 ) ) ].
!
testFunctions
	self assert: [ ( 1 / 3 ) negated = ( -1 / 3 ) ].
!
CLASS TestInteger EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ 42 class = Integer ].
	self assert: [ ( Integer fromJs: INLINE '7' ) class = Integer ].
	self assert: [ #( 2 3 4 ) includes: ( Integer randomFrom: 2 to: 4 ) ].
!
testConversion
	self assert: [ 123 toString = '123' ].
	self assert: [ 123 toBigInt class = BigInt ].
	self assert: [ 8 toFloat = 8.0 ].
!
testComparisons
	self assert: [ 11 = 11 ].
	self assert: [ 11 <= 11 ].
	self assert: [ 11 >= 11 ].
	self assert: [ 11 < 12 ].
	self assert: [ 13 > 11 ].

	"Comparisons with large integer arguments."
	self assert: [ 11 = 11 toBigInt ].
	self assert: [ 11 <= 11 toBigInt ].
	self assert: [ 11 >= 11 toBigInt ].
	self assert: [ 11 < 12 toBigInt ].
	self assert: [ 13 > 11 toBigInt ].

	"Comparisons with fractions."
	self assert: [ 2 = ( 4 / 2 ) ].
	self assert: [ 2 >= ( 4 / 2 ) ].
	self assert: [ 2 <= ( 4 / 2 ) ].
	self assert: [ 2 < ( 7 / 3 ) ].
	self assert: [ 2 > ( 5 / 3 ) ].

	"Comparisons with floats."
	self assert: [ 2 = 2.0 ].
	self assert: [ 2 >= 2.0 ].
	self assert: [ 2 >= 2.0 ].
	self assert: [ 2 < 2.1 ].
	self assert: [ 2 > 1.95 ].
!
testBasicArithmatic
	"Basic arithmatic with integer arguments."
	self assert: [ 3 + 4 = 7 ].
	self assert: [ 4 - 3 = 1 ].
	self assert: [ 3 * 4 = 12 ].
	self assert: [ 4 / 3 = ( 4 / 3 ) ].
	self assert: [ 7 // 3 = 2 ].
	self assert: [ 7 % 3 = 1 ].
	self assert: [ 7 ** 3 = 343 ].

	"Basic arithmatic with large integer arguments."
	self assert: [ 3 + 4 toBigInt = 7 ].
	self assert: [ 4 - 3 toBigInt = 1 ].
	self assert: [ 3 * 4 toBigInt = 12 ].
	self assert: [ 4 / 3 toBigInt = ( 4 / 3 ) ].
	self assert: [ 7 // 3 toBigInt = 2 ].
	self assert: [ 7 % 3 toBigInt = 1 ].
	self assert: [ 7 ** 3 toBigInt = 343 toBigInt ].

	"Basic arithmatic with fractions."
	self assert: [ 3 + ( 1 / 2 ) = ( 7 / 2 ) ].
	self assert: [ 4 - ( 1 / 2 ) = ( 7 / 2 ) ].
	self assert: [ 4 * ( 1 / 2 ) = 2 ].
	self assert: [ 2 / ( 1 / 2 ) = 4 ].
	self assert: [ 3 // ( 2 / 3 ) = 4 ].
	self assert: [ 2 % ( 4 / 3 ) = ( 2 / 3 ) ].
	self assert: [ 4 ** ( 1 / 2 ) equals: 2.00 precision: 0.01 ].

	"Basic arithmatic with floats."
	self assert: [ 3 + 0.5 = 3.5 ].
	self assert: [ 4 - 0.5 = 3.5 ].
	self assert: [ 4 * 0.5 = 2.0 ].
	self assert: [ 2 / 0.5 = 4 ].
	self assert: [ 3 // 0.8 = 3.0 ].
	self assert: [ 2 % 0.8 = 0.4 ].
	self assert: [ 2 ** 2.0 equals: 4.00 precision: 0.01 ].

	"Basic arithmatic with points."
	self assert: [ 3 + ( 1 @ 2 ) = ( 4 @ 5 ) ].
	self assert: [ 4 - ( 1 @ 2 ) = ( 3 @ 2 ) ].
	self assert: [ 2 * ( 2 @ 3 ) = ( 4 @ 6 ) ].
	self assert: [ 6 / ( 2 @ 3 ) = ( 3 @ 2 ) ].
	self assert: [ 7 // ( 2 @ 3 ) = ( 3 @ 2 ) ].
	self assert: [ 8 % ( 2 @ 3 ) = ( 0 @ 2 ) ].
!
testBitOperations
	self assert: [ 6 & 3 = 2 ].
	self assert: [ 6 | 3 = 7 ].
	self assert: [ ( 6 xor: 3 ) = 5 ].
	self assert: [ 7 >> 1 = 3 ].
	self assert: [ 3 << 1 = 6 ].

!
testGcd
	self assert: [ ( 12 gcd: 9 ) = 3 ].
	self assert: [ ( 12 gcd: 9 toBigInt ) = 3 ].
!
CLASS TestMagnitude EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ ( 1 min: 2 ) = 1 ].
	self assert: [ ( 4 min: 3 ) = 3 ].
	self assert: [ ( 5 max: 6 ) = 6 ].
	self assert: [ ( 8 max: 7 ) = 8 ].
!
CLASS TestNumber EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ 5 squared = 25 ].
	self assert: [ 25 isSquare ].
	self assert: [ 26 isSquare not ].
	self assert: [ 4 sqrt = 2.0 ].
	self assert: [ 3 negated = -3 ].
	self assert: [ -3 abs = 3 ].
	self assert: [ 8 \\ 3 = 2 ].

	self assertError: [ 1 / 0 ].
!
CLASS TestPoint EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ ( Point x: 1 y: 2 ) = ( 1 @ 2 ) ].
	self assert: [ ( Point jsX: ( 1 js ) jsY: ( 2 js ) ) = ( 1 @ 2 ) ].
!
testConversion
	self assert: [ ( 1 @ 2 ) toString = '( 1 @ 2 )' ].
!
testAccessing
	self assert: [ ( Point x: 1 y: 2 ) x = 1 ].
	self assert: [ ( Point x: 1 y: 2 ) y = 2 ].

	self assert: [ ( ( 1 @ 2 ) x: 4 ) x = 4 ].
	self assert: [ ( ( 1 @ 2 ) y: 5 ) y = 5 ].

!
testComparisons
	self assert: [ ( 1 @ 2 ) = ( 1 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) <= ( 1 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) >= ( 1 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) < ( 2 @ 3 ) ].
	self assert: [ ( 2 @ 3 ) > ( 1 @ 2 ) ].

!
testBasicArithmatic
	self assert: [ ( 1 @ 2 ) + ( 3 @ 4 ) = ( 4 @ 6 ) ].
	self assert: [ ( 3 @ 4 ) - ( 1 @ 2 ) = ( 2 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) * ( 3 @ 4 ) = ( 3 @ 8 ) ].
	self assert: [ ( 4 @ 8 ) / ( 2 @ 4 ) = ( 2 @ 2 ) ].
	self assert: [ ( 4 @ 8 ) // ( 3 @ 5 ) = ( 1 @ 1 ) ].
	self assert: [ ( 4 @ 8 ) % ( 3 @ 5 ) = ( 1 @ 3 ) ].

	"Basic arithmatic with integer arguments."
	self assert: [ ( 1 @ 2 ) + 3 = ( 4 @ 5 ) ].
	self assert: [ ( 3 @ 4 ) - 2 = ( 1 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) * 3 = ( 3 @ 6 ) ].
	self assert: [ ( 4 @ 8 ) / 2 = ( 2 @ 4 ) ].
	self assert: [ ( 4 @ 8 ) // 3 = ( 1 @ 2 ) ].
	self assert: [ ( 4 @ 8 ) % 3 = ( 1 @ 2 ) ].

	"Basic arithmatic with large integer arguments."
	self assert: [ ( 1 @ 2 ) + 3 toBigInt = ( 4 @ 5 ) ].
	self assert: [ ( 3 @ 4 ) - 2 toBigInt = ( 1 @ 2 ) ].
	self assert: [ ( 1 @ 2 ) * 3 toBigInt = ( 3 @ 6 ) ].
	self assert: [ ( 4 @ 8 ) / 2 toBigInt = ( 2 @ 4 ) ].
	self assert: [ ( 4 @ 8 ) // 3 toBigInt = ( 1 @ 2 ) ].
	self assert: [ ( 4 @ 8 ) % 3 toBigInt = ( 1 @ 2 ) ].

	"Basic arithmatic with float arguments."
	self assert: [ ( 1 @ 2 ) + 3.5 = ( 4.5 @ 5.5 ) ].
	self assert: [ ( 3 @ 4 ) - 2.5 = ( 0.5 @ 1.5 ) ].
	self assert: [ ( 1 @ 2 ) * 1.5 = ( 1.5 @ 3.0 ) ].
	self assert: [ ( 3 @ 7 ) / 2.0 = ( 1.5 @ 3.5 ) ].
	self assert: [ ( 4 @ 8 ) // 3.5 = ( 1.0 @ 2.0 ) ].
	self assert: [ ( 4 @ 8 ) % 3.5 = ( 0.5 @ 1.0 ) ].

	"Basic arithmatic with fraction arguments."
	self assert: [ ( 1 @ 2 ) + ( 1 / 2 ) = ( ( 3 / 2 ) @ ( 5 / 2 ) ) ].
	self assert: [ ( 3 @ 4 ) - ( 1 / 2 ) = ( ( 5 / 2 ) @ ( 7 / 2 ) ) ].
	self assert: [ ( 1 @ 2 ) * ( 1 / 2 ) = ( ( 1 / 2 ) @ 1 ) ].
	self assert: [ ( 3 @ 7 ) / ( 1 / 2 ) = ( 6 @ 14 ) ].
	self assert: [ ( 4 @ 8 ) // ( 4 / 3 ) = ( 3 @ 6 ) ].
	self assert: [ ( 1 @ 2 ) % ( 2 / 3 ) = ( ( 1 / 3 ) @ 0 ) ].

!
testFunctions
	self assert: [ ( 2 @ 3 ) negated = ( -2 @ -3 ) ].
	self assert: [ ( -2 @ -3 ) abs = ( 2 @ 3 ) ].
	self assert: [ ( ( 2 @ 3 ) dotProduct: ( 4 @ 5 ) ) = 23 ].

!
CLASS TestPoint3d EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ ( Point3d x: 1 y: 2 z: 3 ) = ( 1 @ 2 @ 3 ) ].
	self assert: [ ( Point3d jsX: ( 1 js ) jsY: ( 2 js ) jsZ: ( 3 js ) ) = ( 1 @ 2 @ 3 ) ].
!
testConversion
	self assert: [ ( 1 @ 2 @ 3 ) toString = '( 1 @ 2 @ 3 )' ].
!
testAccessing
	| point3d |
	point3d := Point3d x: 1 y: 2 z: 3.

	self assert: [ point3d x = 1 ].
	self assert: [ point3d y = 2 ].
	self assert: [ point3d z = 3 ].

	point3d := 4 @ 5 @ 6.
	self assert: [ point3d x = 4 ].
	self assert: [ point3d y = 5 ].
	self assert: [ point3d z = 6 ].
!
testComparisons
	self assert: [ ( 1 @ 2 @ 3 ) = ( 1 @ 2 @ 3 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) <= ( 1 @ 2 @ 3 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) >= ( 1 @ 2 @ 3 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) < ( 2 @ 3 @ 4 ) ].
	self assert: [ ( 2 @ 3 @ 4 ) > ( 1 @ 2 @ 3 ) ].
!
testBasicArithmatic
	"Basic arithmatic with Point3d arguments."
	self assert: [ ( 1 @ 2 @ 3 ) + ( 4 @ 5 @ 6 ) = ( 5 @ 7 @ 9 ) ].
	self assert: [ ( 4 @ 5 @ 6 ) - ( 1 @ 2 @ 3 ) = ( 3 @ 3 @ 3 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) * ( 4 @ 5 @ 6 ) = ( 4 @ 10 @ 18 ) ].
	self assert: [ ( 4 @ 8 @ 16 ) / ( 2 @ 4 @ 8 ) = ( 2 @ 2 @ 2 ) ].
	self assert: [ ( 4 @ 8 @ 16 ) // ( 3 @ 5 @ 9 ) = ( 1 @ 1 @ 1 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) % ( 3 @ 5 @ 7 ) = ( 1 @ 3 @ 5 ) ].

	"Basic arithmatic with Integer arguments."
	self assert: [ ( 1 @ 2 @ 3 ) + 4 = ( 5 @ 6 @ 7 ) ].
	self assert: [ ( 3 @ 4 @ 5 ) - 2 = ( 1 @ 2 @ 3 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) * 4 = ( 4 @ 8 @ 12 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) / 2 = ( 2 @ 4 @ 6 ) ].
	self assert: [ ( 4 @ 8 @ 10 ) // 3 = ( 1 @ 2 @ 3 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) % 3 = ( 1 @ 2 @ 0 ) ].

	"Basic arithmatic with large integer arguments."
	self assert: [ ( 1 @ 2 @ 3 ) + 4 toBigInt = ( 5 @ 6 @ 7 ) ].
	self assert: [ ( 5 @ 6 @ 7 ) - 2 toBigInt = ( 3 @ 4 @ 5 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) * 3 toBigInt = ( 3 @ 6 @ 9 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) / 2 toBigInt = ( 2 @ 4 @ 6 ) ].
	self assert: [ ( 4 @ 8 @ 12  ) // 3 toBigInt = ( 1 @ 2 @ 4 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) % 3 toBigInt = ( 1 @ 2 @ 0 ) ].

	"Basic arithmatic with float arguments."
	self assert: [ ( 1 @ 2 @ 3 ) + 3.5 = ( 4.5 @ 5.5 @ 6.5 ) ].
	self assert: [ ( 3 @ 4 @ 5 ) - 2.5 = ( 0.5 @ 1.5 @ 2.5 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) * 1.5 = ( 1.5 @ 3.0 @ 4.5 ) ].
	self assert: [ ( 3 @ 7 @ 8 ) / 2.0 = ( 1.5 @ 3.5 @ 4.0 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) // 3.5 = ( 1.0 @ 2.0 @ 3.0 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) % 3.5 = ( 0.5 @ 1.0 @ 1.5  ) ].

	"Basic arithmatic with fraction arguments."
	self assert: [ ( 1 @ 2 @ 3 ) + ( 1 / 2 ) = ( ( 3 / 2 ) @ ( 5 / 2 ) @ ( 7 / 2 ) ) ].
	self assert: [ ( 3 @ 4 @ 5 ) - ( 1 / 2 ) = ( ( 5 / 2 ) @ ( 7 / 2 ) @ ( 9 / 2 ) ) ].
	self assert: [ ( 1 @ 2 @ 3 ) * ( 1 / 2 ) = ( ( 1 / 2 ) @ 1 @ ( 3 / 2 ) ) ].
	self assert: [ ( 3 @ 7 @ 9 ) / ( 1 / 2 ) = ( 6 @ 14 @ 18 ) ].
	self assert: [ ( 4 @ 8 @ 12 ) // ( 4 / 3 ) = ( 3 @ 6 @ 9 ) ].
	self assert: [ ( 1 @ 2 @ 3 ) % ( 2 / 3 ) = ( ( 1 / 3 ) @ 0 @ ( 1 / 3 ) ) ].

!
testFunctions
	self assert: [ ( 2 @ 3 @ 4 ) negated = ( -2 @ -3 @ -4 ) ].
	self assert: [ ( -2 @ -3 @ -4 ) abs = ( 2 @ 3 @ 4 ) ].
	self assert: [ ( ( 2 @ 3 @ 4 ) dotProduct: ( 4 @ 5 @ 6 ) ) = 47 ].
!
CLASS TestRectangle EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreatiing
	self assert: [ ( Rect origin: ( 1 @ 2 ) extent: ( 3 @ 4 ) ) class = Rect ].
	"Method fromJs: jsDOMRect can only be tested in a browser environment."
!
testConverting
	self assert: [ ( Rect origin: ( 1 @ 2 ) extent: ( 3 @ 4 ) ) toString = 'Rect( ( 1 @ 2 ) , ( 3 @ 4 ) )' ].
!
testAccessing
	| rectangle |
	rectangle := Rect new origin: ( 1 @ 2 ) extent: ( 3 @ 4 ).
	self assert: [ rectangle origin = ( 1 @ 2 ) ].
	self assert: [ rectangle extent = ( 3 @ 4 ) ].
!
testComparing
	self assert: [ ( Rect origin: ( 1 @ 2 ) extent: ( 3 @ 4 ) ) = ( Rect origin: ( 1 @ 2 ) extent: ( 3 @ 4 ) ) ].
!
CLASS TestString EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	self assert: [ String new = '' ].
	self assert: [ ( String fromJs: INLINE '"a"' ) = 'a' ].
	self assert: [ ( String fromCharacter: $A ) = 'A' ].
	self assert: [ ( String fromCharCode: 66 ) = 'B' ].
	self assert: [ ( ( String newline ) at: 0 ) code = 10 ].
	self assert: [ 'a' toString = 'a' ].
!
testConversion
	self assert: [ 'abc' toString = 'abc' ].
	self assert: [ '42' toInteger = 42 ].
	self assert: [ '3.14' toFloat = 3.14 ].
!
testAccessing
	self assert: [ 'abcd' length = 4 ].
	self assert: [ ( 'abc' at: 1 ) = $b ].
	self assertError: [ 'abc' at: 10 ].
	self assert: [ ( 'azc' at: 1 put: $b ) = 'abc' ].
!
testRegularExpressions
	self assert: [ ( 'This is It!' match: '[A-Z].' flags: 'g' ) = #( 'Th' 'It' ) ].
	self assert: [ ( 'This is It!' search: '[A-I].' ) = 8 ].
!
testIteration
	| sum |
	sum := 0.
	'ABC' do: [ :char |
		sum := sum + char code ].
	self assert: [ sum = 198 ].
!
testSearching
	self assert: [ 'abcde' includes: 'bc' ].
	self assert: [ ( 'abcde' includes: 'bc' from: 3 ) not ].
	self assert: [ 'abcde' startsWith: 'abc' ].
	self assert: [ 'abcde' endsWith: 'de' ].
	self assert: [ ( 'abcde' indexOf: 'cd' ) = 2 ].
	self assert: [ ( 'abcabcabc' indexOf: 'abc' from: 1 ) = 3 ].
	self assert: [ ( 'abcabcabc' lastIndexOf: 'abc' ) = 6 ].
	self assert: [ ( 'abcabcabc' lastIndexOf: 'abcd' ) = -1 ].
	self assert: [ ( 'abcabcabc' lastIndexOf: 'abc' from: 4 ) = 3 ].
!
testComparisons
	self assert: [ 'aa', 'bb' = 'aabb' ].
	self assert: [ 'aa' ~= 'bb' ].
	self assert: [ 'a' ~= 1 ].
	self assert: [ 'a' ~= Object new ].

	self assert: [ 'a' < 'b' ].
	self assert: [ 'a' <= 'a' ].
	self assert: [ 'b' > 'a' ].
	self assert: [ 'b' >= 'b' ].

	self assert: [ ( 'a' localeCompare: 'b' ) = -1 ].
!
testManipulation
	self assert: [ 'aa', 'bb' = 'aabb' ].
	self assert: [ 'cc' + 'dd' = 'ccdd' ].
	self assert: [ ( 'de' concat: 'f' ) = 'def' ].
	self assert: [ ( 'aabb' substring: 1 ) = 'abb' ].
	self assert: [ ( 'aabb' substring: 1 to: 3 ) = 'ab' ].

	self assert: [ ( 'abcd' slice: 2 ) = 'cd' ].
	self assert: [ ( 'abcd' slice: 1 to: 3 ) = 'bc' ].
	self assert: [ ( ( 'This is it' split: ' ' ) at: 1 ) = 'is' ].

	self assert: [ ( 'abc' padEnd: 5 ) = 'abc  ' ].
	self assert: [ ( 'def' padEnd: 6 with: 'x' ) = 'defxxx' ].

	self assert: [ ( 'abc' padStart: 5 ) = '  abc' ].
	self assert: [ ( 'def' padStart: 6 with: 'x' ) = 'xxxdef' ].

	self assert: [ ( 'ab' repeat: 3 ) = 'ababab' ].

	self assert: [ ( 'abab' replace: 'b' with: 'd' ) = 'adab' ].
	self assert: [ ( 'abab' replaceAll: 'b' with: 'd' ) = 'adad' ].

	self assert: [ '  abc  ' trim = 'abc' ].
	self assert: [ '  abc' trimStart = 'abc' ].
	self assert: [ 'abc  ' trimEnd = 'abc' ].
!
testCase
	self assert: [ 'abc' toUpperCase = 'ABC' ].
	self assert: [ 'abc' toLocaleUpperCase = 'ABC' ].

	self assert: [ 'ABC' toLowerCase = 'abc' ].
	self assert: [ 'ABC' toLocaleLowerCase = 'abc' ].
!
testEscapedChars
	| string |

	string := '\b\f\n\r\t\v'.
	self assert: [ string length = 6 ].
	self assert: [ ( string at: 0 ) = 8 ].
	self assert: [ ( string at: 1 ) = 12 ].
	self assert: [ ( string at: 2 ) = 10 ].
	self assert: [ ( string at: 3 ) = 13 ].
	self assert: [ ( string at: 4 ) = 9 ].
	self assert: [ ( string at: 5 ) = 11 ].

	string := '\\'.
	self assert: [ string length = 1 & ( ( string at: 0 ) = 92 ) ].

	string := '"'.
	self assert: [ string length = 1 & ( ( string at: 0 ) = 34 ) ].

	string := '\''.
	self assert: [ string length = 1 & ( ( string at: 0 ) = 39 ) ].

	self assert: [ 'Hello world!' isWellFormed ].
	self assert: [ 'Hello world \uD800' isWellFormed not ].
	self assert: [ 'Hello world!' toWellFormed = 'Hello world!' ].
	self assert: [ 'Hello world \uD800' toWellFormed isWellFormed ].
!
CLASS TestAbort EXTENDS Test MODULE Core CLASSVARS '' VARS ''

"Tests AbortSignal and AbortController"

testCreation
	|  signal depenentSignal |

	self assertError: [ AbortSignal new ].
	signal := AbortSignal abort.
	self assert: [ signal aborted ].

	depenentSignal := AbortSignal any: #( signal ).
	self assert: [ signal aborted ].
!
testFetchAbort
	| controller requestInit response signal |

	"This test is disabled by default, because the VSCode debugger halts
	on the rejected promise after the intentionally aborted fetch."
	^ self.

	controller := AbortController new.
	requestInit := RequestInit new
		signal: controller signal.

	"Don't await the fetch, but immediately abort it after starting."
	Promise fromJs: ( Fetch request: 'https://jsonplaceholder.typicode.com/posts/1' options: requestInit )
		then: [ :response | self onFetchAbort: response ]
		catch: [ :error | self onFetchAbortError: error ].

	controller abort.
	signal := controller signal.
	self assert: [ signal aborted ].
	self assert: [ signal reason name = 'AbortError' ].
!
onFetchAbort: response
	"This should not be called, the fetch request should have been aborted."
	self Error: 'Fetch was not aborted'.
!
onFetchAbortError: error
	"This error is intended behavior, caused by an aborted fetch."
	self assert: [ error name = 'AbortError' ].
!
testFetchTimedAbort
	| requestInit |

	"This test is disabled by default, because the VSCode debugger halts
	on the rejected promise after the intentionally aborted fetch."
	^ self.

	requestInit := RequestInit new
		signal: ( AbortSignal timeout: 0 ).

	Promise fromJs: ( Fetch request: 'https://jsonplaceholder.typicode.com/posts/1' options: requestInit )
		then: [ :response | self onFetchTimedAbort: response ]
		catch: [ :error | self onFetchTimedAbortError: error ].
!
onFetchTimedAbort: response
	"This should not be called, the fetch request should have been aborted."
	self Error: 'Fetch was not aborted'.
!
onFetchTimedAbortError: error
	"This error is intended behavior, caused by an aborted fetch."
	self assert: [ error name = 'TimeoutError' ].
!
CLASS TestFetch EXTENDS Test MODULE Core CLASSVARS '' VARS ''

async test
	"The test API: https://jsonplaceholder.typicode.com/posts/1
	Gives response body: (will have double quotes for the strings):
	{ 'userId' : 1, 'id': 1, 'title': 'sunt aut facere ...', 'body': 'quia et suscipit ...' }"

	| url response text object |
	url := 'https://jsonplaceholder.typicode.com/posts/1'.

	response := await Fetch request: url.
	self assert: [ response ok ].

	text := await Fetch text: url.
	self assert: [ text includes: 'title' ].

	object := await Fetch object: url.
	self assert: [ ( object atProperty: 'id' ) = 1 ].
!
CLASS TestFormData EXTENDS Test MODULE Core CLASSVARS '' VARS ''

test
	| formData |

	formData := FormData new.
	self assert: [ formData class = FormData ].

	formData append: 'name' value: 'Alice'.
	formData append: 'address' value: 'Church st'.

	self assert: [ formData has: 'name' ].
	self assert: [ ( formData has: 'xname' ) not ].

	self assert: [ formData keys = #( 'name' 'address') ].
	self assert: [ formData values = #( 'Alice' 'Church st') ].
	self assert: [ formData entries = #( #( 'name' 'Alice' ) #( 'address' 'Church st') ) ].

	formData append: 'name' value: 'Bob'.
	self assert: [ ( formData get: 'name' ) = 'Alice' ].
	self assert: [ ( formData getAll: 'name' ) = #( 'Alice' 'Bob' ) ].

	formData set: 'address' value: 'Penny ln'.
	self assert: [ ( formData get: 'address' ) = 'Penny ln' ].

	formData delete: 'address'.
	self assert: [ formData keys = #( 'name' 'name' ) ].
!
testBlob
	| formData blob blob2 |

	formData := FormData new.
	blob := Blob fromArray: ( Uint8Array from: #( 4 5 6 7 ) ).
	formData append: 'blob' value: blob.
	blob2 := formData get: 'blob'.
	self assert: [ blob2 size = 4 ]
!

"TODO: Test creation with HtmlFormElement in Browser tests."
CLASS TestHeaders EXTENDS Test MODULE Core CLASSVARS '' VARS ''

test
	| headers entries |

	headers := Headers new.
	self assert: [ headers class = Headers ].
	self assert: [ headers jsClassName = 'Headers' ].

	entries := #(
  		#( 'set-cookie' 'greeting=hello' )
  		#( 'x-custom-header' 'name=world' ) ).
	headers := Headers init: entries.
	self assert: [ headers entries = entries ].
	self assert: [ headers keys = #( 'set-cookie' 'x-custom-header' ) ].
	self assert: [ headers values = #( 'greeting=hello' 'name=world' ) ].
	self assert: [ headers getSetCookie = #( 'greeting=hello' ) ].

	headers append: 'x-header' value: 'value'.
	self assert: [ ( headers get: 'x-header' ) = 'value' ].

	headers set: 'x-header' value: 'new-value'.
	self assert: [ ( headers get: 'x-header' ) = 'value, new-value' ].

	self assert: [ headers has: 'x-header' ].
	headers delete: 'x-header'.
	self assert: [ ( headers has: 'x-header' ) not ].
!
CLASS TestRequest EXTENDS Test MODULE Core CLASSVARS '' VARS ''

testDefaults
	| request |
	self assertError: [ Request new ].
	request := Request url: 'http://unknown.com'.

	self assert: [ request bodyUsed not ].
	self assert: [ request cache = 'default' ].
	self assert: [ request credentials = 'same-origin' ].
	self assert: [ request destination = '' ].
	self assert: [ request headers keys length = 0 ].
	self assert: [ request integrity = '' ].
	self assert: [ request keepalive not ].
	self assert: [ request method = 'GET' ].
	self assert: [ request mode = 'cors' ].
	self assert: [ request redirect = 'follow' ].
	self assert: [ request referrer = 'about:client' ].
	self assert: [ request referrerPolicy = '' ].
	self assert: [ request signal aborted not ].
	self assert: [ request url includes: 'unknown.com' ].
!
testInitialized
	| requestInit request |

	requestInit := RequestInit new
		body: 'request body';
		cache: 'reload';
		credentials: 'omit';
		headers: ( Headers new append: 'x-custom-header' value: 'custom value' );
		integrity: 'sha256-abc123';
		keepalive: true;
		method: 'POST';
		mode: 'same-origin';
		redirect: 'manual';
		referrer: 'http://referrer.com';
		referrerPolicy: 'origin';
		signal: ( AbortController new signal ).

	request := Request url: 'http://unknown.com' options: requestInit.

	self assert: [ request bodyUsed not ].
	self assert: [ request cache = 'reload' ].
	self assert: [ request credentials = 'omit' ].
	self assert: [ request destination = '' ].
	self assert: [ ( request headers get: 'x-custom-header' ) = 'custom value' ].
	self assert: [ request integrity = 'sha256-abc123' ].
	self assert: [ request keepalive ].
	self assert: [ request method = 'POST' ].
	self assert: [ request mode = 'same-origin' ].
	self assert: [ request redirect = 'manual' ].
	"Note: Browsers do not copy the referrer set in requestInit."
	self assert: [ #( 'http://referrer.com/' 'about:client' ) includes: request referrer ].
	self assert: [ request referrerPolicy = 'origin' ].
	self assert: [ request signal aborted not ].
	self assert: [ request url includes: 'unknown.com' ].
!
async testMethods
	| url requestInit request arrayBuffer blob bytes text object formData |

	url := 'http://unknown.com'.
	requestInit := RequestInit new
		method: 'POST';
		body: 'request body';
		integrity: 'sha256-abc123'.

	request := Request url: url options: requestInit.
	self assert: [ request clone integrity = request integrity ].

	"Note: 2025-07-29:
	 The method Request.clone in Node.js does *not* create re-readable requests (error: unusable),
	 so a new request is made for every buffer reading."

	request := Request url: url options: requestInit.
	arrayBuffer := await request arrayBuffer.
	self assert: [ arrayBuffer byteLength = 12 ].

	request := Request url: url options: requestInit.
	blob := await request blob.
	self assert: [ blob size = 12 ].

	request := Request url: url options: requestInit.
	bytes := await request bytes.
	self assert: [ bytes byteLength = 12 ].

	request := Request url: url options: requestInit.
	text := await request text.
	self assert: [ text = 'request body' ].

	requestInit body: '{ "a": 1 }'.
	request := Request url: url options: requestInit.
	object := await request json.
	self assert: [ ( object atProperty: 'a' ) = 1 ].

	requestInit body: ( FormData new append: 'b' value: 2 ).
	request := Request url: url options: requestInit.
	formData := await request formData.
	self assert: [ ( formData get: 'b' ) = 2 ].
!
CLASS TestRequestInit EXTENDS Test MODULE Core CLASSVARS '' VARS ''

test
	| requestInit |

	requestInit := RequestInit new.
	self assert: [ requestInit isEmpty ].

	requestInit method: 'POST'.
	self assert: [ requestInit method = 'POST' ].

	requestInit headers: Headers new.
	self assert: [ requestInit headers class = Headers ].

	requestInit body: ( ArrayBuffer new: 8 ).
	self assert: [ requestInit body byteLength = 8 ].

	requestInit mode: 'cors'.
	self assert: [ requestInit mode = 'cors' ].

	requestInit credentials: 'same-origin'.
	self assert: [ requestInit credentials = 'same-origin' ].

	requestInit cache: 'reload'.
	self assert: [ requestInit cache = 'reload' ].

	requestInit redirect: 'follow'.
	self assert: [ requestInit redirect = 'follow' ].

	requestInit referrer: ''.
	self assert: [ requestInit referrer = '' ].

	requestInit referrerPolicy: 'no-referrer'.
	self assert: [ requestInit referrerPolicy = 'no-referrer' ].

	requestInit integrity: 'sha256-BpfBw7ivV8q2jLiT13fxDYAe2tJllusRSZ273h2nFSE='.
	self assert: [ requestInit integrity = 'sha256-BpfBw7ivV8q2jLiT13fxDYAe2tJllusRSZ273h2nFSE=' ].

	requestInit keepalive: false.
	self assert: [ requestInit keepalive not ].

	requestInit signal: AbortController new signal.
	self assert: [ requestInit signal class = AbortSignal ].

	requestInit priority: 'high'.
	self assert: [ requestInit priority = 'high' ].
!
CLASS TestResponse EXTENDS Test MODULE Core CLASSVARS '' VARS ''

async test
	| url response headers text bytes arrayBuffer blob object |

	"The test API: https://jsonplaceholder.typicode.com/posts/1
	Gives response body: (will have double quotes for the strings):
	{ 'userId' : 1, 'id': 1, 'title': 'sunt aut facere ...', 'body': 'quia et suscipit ...' }"
	url := 'https://jsonplaceholder.typicode.com/posts/1'.
	response := await Fetch request: url.
	self assert: [ response body class = ReadableStream ].
	self assert: [ response bodyUsed not ].

	headers := response headers.
	self assert: [ headers class = Headers ].
	self assert: [ ( headers get: 'content-type' ) includes: 'application' ].

	self assert: [ response ok ].
	self assert: [ response status = 200 ].
	"Browsers give default status empty string iso 'OK'"
	self assert: [ #( 'OK' '' ) includes: response statusText ].
	self assert: [ response statusAndText includes: '200' ].

	self assert: [ response redirected not ].
	"Browsers give deault type 'cors' iso 'basic'"
	self assert: [ #( 'basic' 'cors' ) includes: response type ].
	self assert: [ response url = url ].

	text := await response clone text.
	self assert: [ text includes: 'title' ].

	bytes := await response clone bytes.
	self assert: [ ( bytes at: 0 ) = 123 ].
	self assert: [ ( bytes at: 1 ) = 10 ].

	arrayBuffer := await response clone arrayBuffer.
	self assert: [ arrayBuffer byteLength = 292 ].

	blob := await response clone blob.
	self assert: [ blob size = 292 ].

	object := await response clone json.
	self assert: [ ( object atProperty: 'id' ) = 1 ].

	"formDataThen: is not tested here,
	 because the is no suitable API present in API test site typicode.com."
!
CLASS TestEventTarget EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

CLASS TestPointerEvent EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

CLASS TestCrypto EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| buffer |

	buffer := Uint8Array new: 8.
	Crypto randomValues: buffer.
	self assert: [ buffer toArray ~= #( 0 0 0 0 0 0 0 0 ) ].

	self assert: [ Crypto randomUuid length = 36 ].
!
async testDigest
	| plainText plainData digestBuffer digestData |
	plainText := 'secret'.
	plainData := Uint8Array encodeFromString: plainText.

	digestBuffer := await Crypto digest: 'SHA-256' data: plainData.
	self assert: [ digestBuffer class = ArrayBuffer ].
	self assert: [ digestBuffer byteLength = 32 ].

	digestData := Uint8Array buffer: digestBuffer.
	self assert: [ digestData toHex = '2bb80d537b1da3e38bd30361aa855686bde0eacd7162fef6a25fe97bf527a25b' ].
!
CLASS TestCryptoAes EXTENDS Test MODULE TestCrypto CLASSVARS ''
	VARS 'keyUsages key'

"Tests the AES encryption algorithm: AES-GCM"

async test
	await self generateKey.
	await self encryptDecrypt.
	await self exportImportKey.
	await self wrapUnwrapKey.
!
async generateKey
	| params |
	params := AesKeyGenParams new
		name: 'AES-GCM';
		length: 256.
	keyUsages := #( 'encrypt' 'decrypt' 'wrapKey' 'unwrapKey' ).
	key := await Crypto generateKey: params extractable: true usages: keyUsages.
	self checkKey: key.
!
checkKey: key
	| params |
	self assert: [ key class = CryptoKey ].
	self assert: [ key type = 'secret' ].
	self assert: [ key extractable ].
	self assert: [ key usages = keyUsages ].

	params := key algorithm.
	self assert: [ params class = AesKeyGenParams ].
	self assert: [ params name = 'AES-GCM' ].
	self assert: [ params length = 256 ].
!
async encryptDecrypt
	| params plainText plainData encryptedBuffer decryptedBuffer decryptedData decryptedText |

	"params also contains the 'iv' 12 byte nonce, needed for decrypting."
	params := AesGcmParams new.
	plainText := 'Hello, AES-GCM!'.
	plainData := Uint8Array encodeFromString: plainText.
	encryptedBuffer := await Crypto encrypt: params key: key data: plainData.

	decryptedBuffer := await Crypto decrypt: params key: key data: encryptedBuffer.
	decryptedData := Uint8Array buffer: decryptedBuffer.
	decryptedText := decryptedData decodeToString.
	self assert: [ decryptedText = plainText ].
!
async exportImportKey
	| exportedKey importedKey |

	"Export import in raw format."

	exportedKey := await Crypto exportKey: 'raw' key: key.
	self assert: [ exportedKey class = ArrayBuffer ].
	self assert: [ exportedKey byteLength = 32 ].

	importedKey := await Crypto importKey: 'raw' keyData: exportedKey
		algorithm: key algorithm extractable: true usages: keyUsages.
	self checkKey: importedKey.

	"Export import in jwk format."

	exportedKey := await Crypto exportKey: 'jwk' key: key.
	self assert: [ exportedKey class = JsObject ].
	self assert: [ ( exportedKey atJsProperty: 'alg' ) = 'A256GCM' ].

	importedKey := await Crypto importKey: 'jwk' keyData: exportedKey
		algorithm: key algorithm extractable: true usages: keyUsages.
	self checkKey: importedKey.
!
async wrapUnwrapKey
	| params wrappedKey unwrappedKey |

	"params also has iv random bits that need to be used for unwrapping."
	params := AesGcmParams new.
	wrappedKey := await Crypto wrapKey: 'jwk' key: key wrappingKey: key algorithm: params.
	self assert: [ wrappedKey class = ArrayBuffer ].
	self assert: [ wrappedKey byteLength = 160 ].

	unwrappedKey := await Crypto unwrapKey: 'jwk' key: wrappedKey unwrappingKey: key unwrapAlgo: params
		algorithm: key algorithm extractable: true usages: keyUsages.
	self checkKey: unwrappedKey.
!
CLASS TestCryptoEcdh EXTENDS Test MODULE TestCrypto CLASSVARS ''
	VARS 'algorithm keyPair'

"Tests the key exchange algorithm ECDH."

async testGenerateKey
	| params usages privateKey publicKey |

	algorithm := 'ECDH'.
	params := EcKeyGenParams new
		name: algorithm;
		namedCurve: 'P-384'.

	usages := #( 'deriveKey' 'deriveBits' ).
	keyPair := await Crypto generateKey: params extractable: true usages: usages.
	self assert: [ keyPair class = CryptoKeyPair ].

	privateKey := keyPair privateKey.
	self assert: [ privateKey class = CryptoKey ].
	self assert: [ privateKey type = 'private' ].
	self assert: [ privateKey extractable ].
	self assert: [ privateKey usages = usages ].
	self checkParams: privateKey algorithm.

	publicKey := keyPair publicKey.
	self assert: [ publicKey class = CryptoKey ].
	self assert: [ publicKey type = 'public' ].
	self assert: [ privateKey extractable ].
	self assert: [ publicKey usages = #() ].
	self checkParams: publicKey algorithm.

	await self deriveKey.
!
checkParams: params
	self assert: [ params class = EcKeyGenParams ].
	self assert: [ params name = algorithm ].
	self assert: [ params namedCurve = 'P-384' ].
!
async deriveKey
	| params derivedKeyParams derivedKeyUsages derivedKey derivedBits |

	params := EcdhKeyDeriveParams new
		name: 'ECDH';
		public: keyPair publicKey.

	"Derive AES key."

	derivedKeyParams := AesKeyGenParams new
		name: 'AES-CBC';
		length: 256.

	derivedKeyUsages := #( 'encrypt' 'decrypt' ).
	derivedKey := await Crypto deriveKey: params key: keyPair privateKey
		type: derivedKeyParams extractable: true usages: derivedKeyUsages.
	self assert: [ derivedKey class = CryptoKey ].
	self assert: [ derivedKey type = 'secret' ].
	self assert: [ derivedKey extractable ].
	self assert: [ derivedKey usages = derivedKeyUsages ].

	derivedKeyParams := derivedKey algorithm.
	self assert: [ derivedKeyParams class = AesKeyGenParams ].
	self assert: [ derivedKeyParams name = 'AES-CBC' ].
	self assert: [ derivedKeyParams length = 256 ].

	"Derive bits."

	derivedBits := await Crypto deriveBits: params key: keyPair privateKey length: 256.
	self assert: [ derivedBits class = ArrayBuffer ].
	self assert: [ derivedBits byteLength = 32 ].
!
CLASS TestCryptoRsa EXTENDS Test MODULE TestCrypto CLASSVARS ''
	VARS 'algorithm keyPair'

"Tests the RSA encryption algorithm RSA-OAEP."

async testGenerateKey
	| params privateKey publicKey |
	algorithm := 'RSA-OAEP'.
	params := RsaKeyGenParams new
		name: algorithm;
		modulusLength: 2048;
		publicExponent: ( Uint8Array from: #( 1 0 1 ) );
		hash: 'SHA-256'.

	keyPair := await Crypto generateKey: params extractable: true usages: #( 'encrypt' 'decrypt' ).
	self assert: [ keyPair class = CryptoKeyPair ].

	privateKey := keyPair privateKey.
	self assert: [ privateKey class = CryptoKey ].
	self assert: [ privateKey type = 'private' ].
	self assert: [ privateKey extractable ].
	self assert: [ privateKey usages = #( 'decrypt' ) ].
	self checkParams: privateKey algorithm.

	publicKey := keyPair publicKey.
	self assert: [ publicKey class = CryptoKey ].
	self assert: [ publicKey type = 'public' ].
	self assert: [ privateKey extractable ].
	self assert: [ publicKey usages = #( 'encrypt' ) ].
	self checkParams: publicKey algorithm.

	await self encryptDecrypt.
!
checkParams: params
	self assert: [ params class = RsaKeyGenParams ].
	self assert: [ params name = algorithm ].
	self assert: [ params modulusLength = 2048 ].
	self assert: [ params publicExponent = ( Uint8Array from: #( 1 0 1 ) ) ].
!
async encryptDecrypt
	| plainText plainData encryptedBuffer decryptedBuffer decryptedData decryptedText |

	plainText := 'Hello, RSA-OAEP!'.
	plainData := Uint8Array encodeFromString: plainText.
	encryptedBuffer := await Crypto encrypt: algorithm key: keyPair publicKey data: plainData.

	decryptedBuffer := await Crypto decrypt: algorithm key: keyPair privateKey data: encryptedBuffer.
	decryptedData := Uint8Array buffer: decryptedBuffer.
	decryptedText := decryptedData decodeToString.
	self assert: [ decryptedText = plainText ].
!
CLASS TestCryptoRsaSigning EXTENDS Test MODULE TestCrypto CLASSVARS ''
	VARS 'algorithm keyPair'

"Tests the RSA signing algorithm RSA-PSS."

async testGenerateKey
	| params privateKey publicKey |
	algorithm := 'RSA-PSS'.
	params := RsaKeyGenParams new
		name: algorithm;
		modulusLength: 2048;
		publicExponent: ( Uint8Array from: #( 1 0 1 ) );
		hash: 'SHA-256'.

	keyPair := await Crypto generateKey: params extractable: true usages: #( 'sign' 'verify' ).
	self assert: [ keyPair class = CryptoKeyPair ].

	privateKey := keyPair privateKey.
	self assert: [ privateKey class = CryptoKey ].
	self assert: [ privateKey type = 'private' ].
	self assert: [ privateKey extractable ].
	self assert: [ privateKey usages = #( 'sign' ) ].
	self checkParams: privateKey algorithm.

	publicKey := keyPair publicKey.
	self assert: [ publicKey class = CryptoKey ].
	self assert: [ publicKey type = 'public' ].
	self assert: [ publicKey usages = #( 'verify' ) ].
	self checkParams: publicKey algorithm.

	await self signVerify.
!
checkParams: params
	self assert: [ params class = RsaKeyGenParams ].
	self assert: [ params name = algorithm ].
	self assert: [ params modulusLength = 2048 ].
	self assert: [ params publicExponent = ( Uint8Array from: #( 1 0 1 ) ) ].
!
async signVerify
	| params plainText plainData signatureBuffer verified |

	params := RsaPssParams new saltLength: 32.
	plainText := 'Hello, RSA-PSS!'.
	plainData := Uint8Array encodeFromString: plainText.
	signatureBuffer := await Crypto sign: params key: keyPair privateKey data: plainData.

	verified := await Crypto verify: params key: keyPair publicKey signature: signatureBuffer data: plainData.
	self assert: [ verified ].
!
CLASS TestAesGcmParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params iv additionalData |
	params := AesGcmParams new.
	self assert: [ params class = AesGcmParams ].
	self assert: [ params name = 'AES-GCM' ].

	iv := Uint8Array new: 12.
	Crypto randomValues: iv.
	params iv: iv.
	self assert: [ params iv = iv ].

	additionalData := Uint8Array new: 8.
	params additionalData: additionalData.
	self assert: [ params additionalData = additionalData ].

	params tagLength: 64.
	self assert: [ params tagLength = 64 ].
!
CLASS TestAesKeyGenParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params |
	params := AesKeyGenParams new.
	self assert: [ params class = AesKeyGenParams ].

	params name: 'AES-GCM'.
	self assert: [ params name = 'AES-GCM' ].

	params length: 256.
	self assert: [ params length = 256 ].
!
CLASS TestEcdhKeyDeriveParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params key |
	params := EcdhKeyDeriveParams new.
	self assert: [ params class = EcdhKeyDeriveParams ].

	params name: 'ECDH'.
	self assert: [ params name = 'ECDH' ].

	key = CryptoKey new.
	params public: key.
	self assert: [ params public = key ].
!
CLASS TestEcKeyGenParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params |
	params := EcKeyGenParams new.
	self assert: [ params class = EcKeyGenParams ].

	params name: 'ECDH'.
	self assert: [ params name = 'ECDH' ].

	params namedCurve: 'P-512'.
	self assert: [ params namedCurve = 'P-512' ].
!
CLASS TestRsaKeyGenParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params exponent |
	params := RsaKeyGenParams new.
	self assert: [ params class = RsaKeyGenParams ].

	params name: 'RSA-OAEP'.
	self assert: [ params name = 'RSA-OAEP' ].

	params modulusLength: 2048.
	self assert: [ params modulusLength = 2048 ].

	exponent := Uint8Array from: #( 1 0 1 ).
	params publicExponent: exponent.
	self assert: [ params publicExponent = exponent ].

	params hash: 'SHA-256'.
	self assert: [ params hash = 'SHA-256' ].
!
CLASS TestRsaOaepParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params buffer |
	params := RsaOaepParams new.
	self assert: [ params class = RsaOaepParams ].
	self assert: [ params name = 'RSA-OAEP' ].

	buffer := ArrayBuffer new: 8.
	params label: buffer.
	self assert: [ params label = buffer ].
!
CLASS TestRsaPssParams EXTENDS Test MODULE TestCrypto CLASSVARS '' VARS ''

test
	| params |
	params := RsaPssParams new.
	self assert: [ params class = RsaPssParams ].
	self assert: [ params name = 'RSA-PSS' ].

	params saltLength: 32.
	self assert: [ params saltLength = 32 ].
!
CLASS TestDictionary EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| dict string array |
	dict := Dictionary new.
	dict at: 'a' put: 'aValue'.
	dict at: 'b' put: 'bValue'.
	dict at: 'c' put: 'xValue'.
	"Replace value at key 'c'"
	dict at: 'c' put: 'cValue'.

	self assert: [ dict toString = 'Dictionary( { a, aValue } { b, bValue } { c, cValue } )' ].

	self assert: [ dict size = 3 ].
	self assert: [ dict keyValues first key = 'a' ].

	self assert: [ dict has: 'a' ].
	self assert: [ ( dict find: 'a' ) key = 'a' ].

	self assert: [ ( dict at: 'a' ) = 'aValue' ].
	self assertError: [ dict at: 'z' ].
	self assert: [ ( dict at: 'b' ifAbsent: [ nil ] ) = 'bValue' ].
	self assert: [ ( dict at: 'z' ifAbsent: [ nil ] ) = nil ].

	dict removeAt: 'b'.
	self assert: [ dict size = 2 ].

	string := ''.
	dict do: [ :key :value |
		string := string, key, value ].
	self assert: [ string = 'aaValueccValue' ].

	dict clear.
	self assert: [ dict size = 0 ].

	array := #( #( 'a' 1 ) #( 'b' 2 ) ).
	dict := Dictionary fromArray: array.
	self assert: [ dict size = 2 ].
	self assert: [ ( dict at: 'a' ) = 1 ].
	self assert: [ ( dict at: 'b' ) = 2 ].

	array := dict toArray.
	self assert: [  array = #( #( 'a' 1 ) #( 'b' 2 ) ) ]
!
CLASS TestKeyValue EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| keyValue |
	keyValue := KeyValue key: 'a' value: 'aValue'.
	self assert: [ keyValue class = KeyValue ].
	self assert: [ keyValue toString = '{ a, aValue }' ].
	self assert: [ keyValue key = 'a' ].
	self assert: [ keyValue value = 'aValue' ].

	keyValue key: 'b'.
	self assert: [ keyValue key = 'b' ].
	keyValue value: 'bValue'.
	self assert: [ keyValue value = 'bValue' ].
!
CLASS TestMap EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| map sum count array |

	map := Map new.
	self assert: [ map class = Map ].

	map set: 'a' value: 1.
	map set: 'b' value: 2.
	map set: 'c' value: 9.
	"Replace value at key 'c'"
	map set: 'c' value: 3.

	self assert: [ map size = 3 ].
	self assert: [ ( map get: 'c' ) = 3 ].
	self assert: [ ( map get: 'z' ) = nil ].
	self assert: [ map has: 'b' ].
	self assert: [ ( map has: 'd' ) not ].

	self assert: [ map delete: 'b' ].
	self assert: [ ( map has: 'b' ) not ].

	map set: 'b' value: 22.
	self assert: [ ( map get: 'b' ) = 22 ].
	map set: 'b' value: 2.
	self assert: [ ( map get: 'b' ) = 2 ].

	self assert: [ map keys length = 3 ].
	self assert: [ ( map keys at: 0 ) = 'a' ].
	self assert: [ ( map values at: 2 ) = 2 ].

	self assert: [ ( ( map entries at: 2 ) at: 0 ) = 'b' ].
	self assert: [ ( ( map entries at: 2 ) at: 1 ) = 2 ].

	sum := 0.
	map forEach: [ :key :value |
		self assert: [ #( 'a' 'b' 'c' ) includes: key ].
		self assert: [ value > 0 ].
		sum := sum + value ].
	self assert: [ sum = 6 ].

	count := 0.
	map forEach: [ :key :value |
		count := count + 1 ].
	self assert: [ count = 3 ].

	array := #( #( 'a' 1 ) #( 'b' 2 ) ).
	map := Map fromArray: array.
	self assert: [ map size = 2 ].
	self assert: [ ( map get: 'a' ) = 1 ].
	self assert: [ ( map get: 'b' ) = 2 ].

	array := map toArray.
	self assert: [  array = #( #( 'a' 1 ) #( 'b' 2 ) ) ].

	map clear.
	self assert: [ map size = 0 ].
!
testGroupBy
	| groupBlock map v |
	groupBlock := [ :element | element % 2 = 0 ifTrue: [ 'even' ] ifFalse: [ 'odd' ] ].
	map := Map group: #( 1 2 3 4 5 ) by: groupBlock.
	self assert: [ map size = 2 ].
	v := map get: 'even'.
	self assert: [ ( map get: 'even' ) = #( 2 4 ) ].
	self assert: [ ( map get: 'odd' ) = #( 1 3 5 ) ].
!
CLASS TestSet EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| set set2 set3 string |

	set := Set new.
	set add: 'a'.
	set add: 'b'.
	set add: 'c'.
	self assert: [ set size = 3 ].
	self assert: [ set values = #( 'a' 'b' 'c' ) ].
	self assert: [ set keys = set values ].
	self assert: [ set entries = #( #( 'a' 'a' ) #( 'b' 'b' ) #( 'c' 'c' ) ) ].
	self assert: [ set toString = 'Set( a b c )' ].

	self assert: [ ( set find: 'b' ) = 'b' ].
	self assert: [ ( set find: 'd' ) isNil ].

	self assert: [ set has: 'b' ].
	self assert: [ ( set has: 'd' ) not ].

	string := ''.
	set forEach: [ :value | string := string + value ].
	self assert: [ string = 'abc' ].

	set2 := Set new: #( 'c' 'd' ).
	self assert: [ ( set difference: set2 ) values = #( 'a' 'b' ) ].
	self assert: [ ( set intersection: set2 ) values = #( 'c' ) ].
	self assert: [ ( set symmetricDifference: set2 ) values = #( 'a' 'b' 'd' ) ].
	self assert: [ ( set union: set2 ) values = #( 'a' 'b' 'c' 'd' ) ].

	set3 := Set new: #( 'e' ).
	self assert: [ set isDisjointFrom: set3 ].
	self assert: [ ( set isDisjointFrom: set2 ) not ].

	set3 := Set new: #( 'a' 'b' ).
	self assert: [ set3 isSubsetOf: set ].
	self assert: [ ( set isSubsetOf: set3 ) not ].
	self assert: [ set isSupersetOf: set3 ].
	self assert: [ ( set3 isSupersetOf: set2 ) not ].

	set delete: 'b'.
	self assert: [ set size = 2 ].
	self assert: [ set values = #( 'a' 'c' ) ].
	set clear.
	self assert: [ set size = 0 ].
!

CLASS TestArray EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCore
	| array1 array2 value |

	array1 := Array new: 3.
	array2 := #( 4 5 6 ).
	value := 7.

	self assert: [ array1 length + array2 length = 6 ].
	self assert: [ #( 1 'a' 3.14 value ( 4 + 5 ) ) toString = '#( 1 a 3.14 7 9 )' ].
	self assert: [ ( #( 1 2 3 ) join: ',' ) = '1,2,3' ].

	self assert: [ array1 = #( nil nil nil ) ].
	self assert: [ array2 = #( 4 5 6 ) ].
	self assert: [ ( array2 at: 1 ) = 5 ].
	array2 at: 2 put: 7.
	self assert: [ ( array2 at: 2 ) = 7 ].
	array2 add: 8.
	self assert: [ array2 length = 4 ].

	self assert: [ ( #( 1 2 3 ) at: 1 with: 9 ) = #( 1 9 3 ) ].

	self assert: [ #( 1 2 ) , #( 3 4 ) = #( 1 2 3 4 ) ].
	self assert: [ array2 pop = 8 ].
	self assertError: [ Array new pop ].

	array1 := #( 1 2 ).
	array2 := array1 copy.
	self assert: [ array1 = array2 ].
	array2 add: 3.
	self assert: [ array1 ~= array2 ].
!
testCreation
	| array jsArray |

	self assert: [ Array new length = 0 ].
	self assert: [ ( Array new: 3 ) length = 3 ].
	self assert: [ ( Array with: 7 ) first = 7 ].
	self assert: [ ( Array with: 8 with: 9 ) last = 9 ].

	array := Array fromJs: INLINE '[ 4, 5, 6 ]'.
	"Array now contains JS numbers, not ST numbers."
	self assert: [ ( Integer fromJs: ( array at: 1 ) ) = 5 ].

	array := Array fromJs: INLINE '[ 6, 7, 8 ]' elementClass: Integer.
	self assert: [ ( array at: 1 ) = 7 ].

	array := Array fromJs: INLINE '[ 10, 11, 12 ]' elementConverter:
		[ :element | ( Integer fromJs: element ) * 10 ].
	self assert: [ ( array at: 1 ) = 110 ].

	jsArray := ( Array with: 13 with: 'a' ) toJs.
	self assert: [ ( Integer fromJs: INLINE 'jsArray[ 0 ]' ) = 13 ].
	self assert: [ ( String fromJs: INLINE 'jsArray[ 1 ]' ) = 'a' ].
!
testSearch
	| array |
	array := #( 5 6 7 8 9 ).

	self assert: [ ( array filter: [ :element | element % 2 = 0 ] ) = #( 6 8 ) ].
	self assert: [ ( array find: [ :element | element = 8 ] ) = 8 ].
	self assert: [ ( array find: [ :element | element = 10 ] ) = nil ].
	self assert: [ ( array findIndex: [ :element | element = 8 ] ) = 3 ].
	self assert: [ ( array findIndex: [ :element | element = 10 ] ) = -1 ].
	self assert: [ ( array findLastIndex: [ :element | element % 2 = 0 ] ) = 3 ].
	self assert: [ ( array findLastIndex: [ :element | element >= 10 ] ) = -1 ].
	self assert: [ ( array indexOf: 6 ) = 1 ].
	self assert: [ ( array indexOf: 3 ) = -1 ].
	self assert: [ array includes: 8 ].
	self assert: [ ( array includes: 10 ) not ].
!
testModify
	| array |
	array := #( 5 6 7 ).

	self assert: [ ( array map: [ :element | element squared ] ) = #( 25 36 49 ) ].
	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] ) = 18 ].
	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] with: 100 ) = 118 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] ) = -4 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] with: 100 ) = 82 ].
	self assert: [ array copy reverse = #( 7 6 5 ) ].
	self assert: [ array toReversed = #( 7 6 5 ) ].
	self assert: [ ( array shift = 5 ) & ( array = #( 6 7 ) ) ].
	self assert: [ ( array unshift: 5 ) = #( 5 6 7 ) ].
	self assert: [ ( array slice: 1 ) = #( 6 7 ) ].
	self assert: [ ( array slice: 0 to: 2 ) = #( 5 6 ) ].
	self assert: [ ( array copy splice: 1 ) = #( 5 ) ].
	self assert: [ ( array copy splice: 1 count: 1 ) = #( 5 7 ) ].
	self assert: [ ( array toSpliced: 1 ) = #( 5 ) ].
	self assert: [ ( array toSpliced: 1 count: 1 ) = #( 5 7 ) ].
	self assert: [ ( array copy swap: 0 with: 2 ) = #( 7 6 5 ) ].
	self assert: [ ( #( 4 5 6 ) removeAt: 1 ) = #( 4 6 ) ].
	self assert: [ ( array copy copyWithin: 0 start: 1 end: 3 ) = #( 6 7 7 ) ].
!
testIteration
	| array sum |
	array := #( 4 5 6 ).
	sum := 0.
	array do: [ :num | sum := sum + num ].
	self assert: [ sum = 15 ].

	self assert: [ array every: [ :element | element > 3 ] ].
	self assert: [ ( array every: [ :element | element <= 5 ] ) not ].
	self assert: [ array some: [ :element | element > 5 ] ].
	self assert: [ ( array some: [ :element | element > 6 ] ) not ].

!
testSort
	| reverseCompareBlock |
	self assert: [ #( 9 8 7 6 5 4 3 2 1 0 ) sort = #( 0 1 2 3 4 5 6 7 8 9 ) ].
	self assert: [ #( 10 90 32 74 34 57 89 61 32 44 ) sort = #( 10 32 32 34 44 57 61 74 89 90 ) ].

	self assert: [ #( 9 8 7 6 5 4 3 2 1 0 ) toSorted = #( 0 1 2 3 4 5 6 7 8 9 ) ].
	self assert: [ #( 10 90 32 74 34 57 89 61 32 44 ) toSorted = #( 10 32 32 34 44 57 61 74 89 90 ) ].

	reverseCompareBlock := [ :a :b | b compare: a ].
	self assert: [ ( #( 10 90 32 74 34 57 89 61 32 44 ) sortWith: reverseCompareBlock ) = #( 90 89 74 61 57 44 34 32 32 10 ) ].
	self assert: [ ( #( 10 90 32 74 34 57 89 61 32 44 ) toSortedWith: reverseCompareBlock ) = #( 90 89 74 61 57 44 34 32 32 10 ) ].
!
testRandomize
	| array randomArray sum |

	array := Array new.
	1 to: 30 do: [ :index |
		array add: index ].

	randomArray := array copy randomize.
	"The chance of the arrays now being equal is 1E-32."
	self assert: [ randomArray ~= array ].

	sum := randomArray reduce: [ :element1 :element2 | element1 + element2 ].
	self assert: [ sum = ( 31 * 30 / 2 ) ].
!
CLASS TestArrayBuffer EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| arrayBuffer |
	arrayBuffer := ArrayBuffer new: 8.

	self assert: [ arrayBuffer class = ArrayBuffer ].
	self assert: [ arrayBuffer byteLength = 8 ].
!
CLASS TestFloat16Array EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	| array |

	self assert: [ Float16Array new length = 0 ].
	self assert: [ ( Float16Array new: 3 ) length = 3 ].
	self assert: [ ( Float16Array new: 3 ) last = 0 ].
	self assert: [ ( Float16Array with: 7.0 ) first = 7.0 ].
	self assert: [ ( Float16Array with: 8.0 with: 9.0 ) last = 9.0 ].

	array := Float16Array from: #( -400.0 5.0 6000.0 ).
	self assert: [ ( array at: 1 ) = 5.0 ].

!
testConversion
	| array |
	array := Float16Array from: #( -400.0 5.0 6000.0 ).

	self assert: [ array toArray = #( -400.0 5.0 6000.0 ) ].
	self assert: [ ( array entries at: 1 ) = #( 1 5.0 ) ].
	self assert: [ ( array join: ' ' ) = '-400 5 6000' ].
	self assert: [ array toString = '#( -400 5 6000 )' ].
!
testBuffer
	| array |
	array := Float16Array from: #( -400.0 5.0 6000.0 ).

	self assert: [ ( ArrayBuffer isView: array ) not ].
	self assert: [ array buffer class = ArrayBuffer ].
	self assert: [ array buffer byteLength = 6 ].
	self assert: [ ( array slice: 1 to: 2 ) first = 5.0 ].
!
testCore
	| array |

	array := Float16Array new: 3.
	self assert: [ array toArray = #( 0.0 0.0 0.0 ) ].
	self assert: [ array length = 3 ].

	self assert: [ ( array at: 0 ) = 0.0 ].
	array at: 1 put: -400.0.
	self assert: [ ( array at: 1 ) = -400.0 ].
	array at: 2 put: 6000.
	self assert: [ ( array at: 2 ) = 6000.0 ].

	array := Float16Array from: #( -400.0 5.0 6000.0 ).
	self assert: [ array length = 3 ].
	self assert: [ array toArray = #( -400.0 5.0 6000.0 ) ].
	self assert: [ array toString includes: '6000' ].

!
testSearch
	| array |
	array := Float16Array from: #( 5.0 6.0 7.0 8.0 9.0 ).

	self assert: [ ( array filter: [ :element | element % 2 = 0 ] ) toArray = #( 6.0 8.0 ) ].

	self assert: [ ( array find: [ :element | element = 8.0 ] ) = 8.0 ].
	self assert: [ ( array find: [ :element | element = 10.0 ] ) = nil ].

	self assert: [ ( array findIndex: [ :element | element = 8.0 ] ) = 3 ].
	self assert: [ ( array findIndex: [ :element | element = 10.0 ] ) = -1 ].

	self assert: [ ( array findLast: [ :element | element < 8.0 ] ) = 7.0 ].
	self assert: [ ( array findLast: [ :element | element >= 10.0 ] ) = nil ].

	self assert: [ ( array findLastIndex: [ :element | element < 8.0 ] ) = 2 ].
	self assert: [ ( array findLastIndex: [ :element | element >= 10.0 ] ) = -1 ].

	self assert: [ ( array indexOf: 6.0 ) = 1 ].
	self assert: [ ( array indexOf: 3.0 ) = -1 ].

	self assert: [ ( ( Float16Array from: #( 3.0 3.0 4.0 ) ) lastIndexOf: 3.0 ) = 1 ].
	self assert: [ ( ( Float16Array from: #( 3.0 3.0 4.0 ) ) lastIndexOf: 5.0 ) = -1 ].

	self assert: [ array includes: 8.0 ].
	self assert: [ ( array includes: 10.0 ) not ].
!
testIteration
	| array sum |
	array := #( 4.0 5.0 6.0 ).

	sum := 0.
	array do: [ :num | sum := sum + num ].
	self assert: [ sum = 15.0 ].

	self assert: [ array every: [ :element | element >= 4.0 ] ].
	self assert: [ ( array every: [ :element | element <= 5.0 ] ) not ].

	self assert: [ array some: [ :element | element > 5.0 ] ].
	self assert: [ ( array some: [ :element | element > 6.0 ] ) not ].
!
testModification
	| array |
	array := Float16Array from: #( 5.0 6.0 7.0 ).

	self assert: [ ( array map: [ :element | element squared ] ) toArray = #( 25.0 36.0 49.0 ) ].

	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] ) = 18.0 ].
	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] with: 100.0 ) = 118.0 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] ) = -4.0 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] with: 100.0 ) = 82.0 ].

	self assert: [ ( array slice: 1 ) toArray = #( 6.0 7.0 ) ].
	self assert: [ ( array slice: 0 to: 2 ) toArray = #( 5.0 6.0 ) ].

	self assert: [ ( array copy swap: 0 with: 2 ) toArray = #( 7.0 6.0 5.0 ) ].
	self assert: [ ( array copy copyWithin: 0 start: 1 end: 3 ) toArray = #( 6.0 7.0 7.0 ) ].
	self assert: [ ( array copy fill: 9.0 start: 0 end: 2 ) toArray = #( 9.0 9.0 7.0 ) ].
	self assert: [ array copy reverse toArray = #( 7.0 6.0 5.0 ) ].
	self assert: [ ( array copy set: ( Float16Array from: #( 8.0 9.0 ) ) offset: 1 ) toArray = #( 5.0 8.0 9.0 ) ].
!
testSelection
	| array |
	array := Float16Array from: #( 5.0 6.0 7.0 ).

	self assert: [ ( array subarray: 1 ) toArray = #( 6.0 7.0 ) ].
	self assert: [ ( array subarray: 1 to: 2 ) toArray = #( 6.0 ) ].
!
testSort
	self assert: [ #( 9.0 8.0 7.0 6.0 5.0 4.0 3.0 2.0 1.0 0.0 ) sort = #( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ) ].
	self assert: [ #( 10.0 90.0 32.0 74.0 34.0 57.0 89.0 61.0 30.0 44.0 ) sort = #( 10.0 30.0 32.0 34.0 44.0 57.0 61.0 74.0 89.0 90.0 ) ].
!
CLASS TestUint8Array EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

testCreation
	| array |

	self assert: [ Uint8Array new length = 0 ].
	self assert: [ ( Uint8Array new: 3 ) length = 3 ].
	self assert: [ ( Uint8Array new: 3 ) last = 0 ].
	self assert: [ ( Uint8Array with: 7 ) first = 7 ].
	self assert: [ ( Uint8Array with: 8 with: 9 ) last = 9 ].

	array := Uint8Array from: #( 4 5 6 ).
	self assert: [ ( array at: 1 ) = 5 ].

!
testConversion
	| array |
	array := Uint8Array from: #( 4 5 6 ).

	self assert: [ array toArray = #( 4 5 6 ) ].
	self assert: [ ( array entries at: 1 ) = #( 1 5 ) ].
	self assert: [ ( array join: ' ' ) = '4 5 6' ].
	self assert: [ array toString = '#( 4 5 6 )' ].

	self assert: [ array toHex = '040506' ].
	self assert: [ ( Uint8Array fromHex: '4a4b4c' ) toArray = #( 74 75 76 ) ].
!
testCoding
	| array |
	array := Uint8Array encodeFromString: 'ABC'.
	self assert: [ array toArray = #( 65 66 67 ) ].
	self assert: [ array decodeToString = 'ABC' ].
!
testBuffer
	| array |
	array := Uint8Array from: #( 4 5 6 ).

	self assert: [ ( ArrayBuffer isView: array ) not ].
	self assert: [ array buffer class = ArrayBuffer ].
	self assert: [ array buffer byteLength = 3 ].
	self assert: [ ( array slice: 1 to: 2 ) first = 5 ].
!
testCore
	| array1 array2 |

	array1 := Uint8Array new: 3.
	array2 := Uint8Array from: #( 4 5 6 ).

	self assert: [ array1 toArray = #( 0 0 0 ) ].
	self assert: [ array2 toArray = #( 4 5 6 ) ].

	self assert: [ array1 length + array2 length = 6 ].
	self assert: [ array2 toString = '#( 4 5 6 )' ].

	self assert: [ ( array2 at: 1 ) = 5 ].
	array2 at: 2 put: 7.
	self assert: [ ( array2 at: 2 ) = 7 ].
	array2 at: 0 put: 257.
	self assert: [ ( array2 at: 0 ) = 1 ].
	array2 at: 0 put: -1.
	self assert: [ ( array2 at: 0 ) = 255 ].
!
testSearch
	| array |
	array := Uint8Array from: #( 5 6 7 8 9 ).

	self assert: [ ( array filter: [ :element | element % 2 = 0 ] ) toArray = #( 6 8 ) ].

	self assert: [ ( array find: [ :element | element = 8 ] ) = 8 ].
	self assert: [ ( array find: [ :element | element = 10 ] ) = nil ].

	self assert: [ ( array findIndex: [ :element | element = 8 ] ) = 3 ].
	self assert: [ ( array findIndex: [ :element | element = 10 ] ) = -1 ].

	self assert: [ ( array findLast: [ :element | element < 8 ] ) = 7 ].
	self assert: [ ( array findLast: [ :element | element >= 10 ] ) = nil ].

	self assert: [ ( array findLastIndex: [ :element | element < 8 ] ) = 2 ].
	self assert: [ ( array findLastIndex: [ :element | element >= 10 ] ) = -1 ].

	self assert: [ ( array indexOf: 6 ) = 1 ].
	self assert: [ ( array indexOf: 3 ) = -1 ].

	self assert: [ ( ( Uint8Array from: #( 3 3 4 ) ) lastIndexOf: 3 ) = 1 ].
	self assert: [ ( ( Uint8Array from: #( 3 3 4 ) ) lastIndexOf: 5 ) = -1 ].

	self assert: [ array includes: 8 ].
	self assert: [ ( array includes: 10 ) not ].
!
testIteration
	| array sum |
	array := #( 4 5 6 ).

	sum := 0.
	array do: [ :num | sum := sum + num ].
	self assert: [ sum = 15 ].

	self assert: [ array every: [ :element | element >= 4 ] ].
	self assert: [ ( array every: [ :element | element <= 5 ] ) not ].

	self assert: [ array some: [ :element | element > 5 ] ].
	self assert: [ ( array some: [ :element | element > 6 ] ) not ].
!
testModification
	| array |
	array := Uint8Array from: #( 5 6 7 ).

	self assert: [ ( array map: [ :element | element squared ] ) toArray = #( 25 36 49 ) ].

	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] ) = 18 ].
	self assert: [ ( array reduce: [ :element1 :element2 | element1 + element2 ] with: 100 ) = 118 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] ) = -4 ].
	self assert: [ ( array reduceRight: [ :element1 :element2 | element1 - element2 ] with: 100 ) = 82 ].

	self assert: [ ( array slice: 1 ) toArray = #( 6 7 ) ].
	self assert: [ ( array slice: 0 to: 2 ) toArray = #( 5 6 ) ].

	self assert: [ ( array copy swap: 0 with: 2 ) toArray = #( 7 6 5 ) ].
	self assert: [ ( array copy copyWithin: 0 start: 1 end: 3 ) toArray = #( 6 7 7 ) ].
	self assert: [ ( array copy fill: 9 start: 0 end: 2 ) toArray = #( 9 9 7 ) ].
	self assert: [ array copy reverse toArray = #( 7 6 5 ) ].
	self assert: [ ( array copy set: ( Uint8Array from: #( 8 9 ) ) offset: 1 ) toArray = #( 5 8 9 ) ].
!
testSelection
	| array |
	array := Uint8Array from: #( 5 6 7 ).

	self assert: [ ( array subarray: 1 ) toArray = #( 6 7 ) ].
	self assert: [ ( array subarray: 1 to: 2 ) toArray = #( 6 ) ].
!
testSort
	self assert: [ #( 9 8 7 6 5 4 3 2 1 0 ) sort = #( 0 1 2 3 4 5 6 7 8 9 ) ].
	self assert: [ #( 10 90 32 74 34 57 89 61 30 44 ) sort = #( 10 30 32 34 44 57 61 74 89 90 ) ].
!
CLASSEXTENSION Object

"This is a sample extension of the Object class
to test the compiler EXTENSION feature."

CLASSMETHODS

extensionClassMethod
	^ 'extensionClassMethod'.
!

METHODS

extensionMethod
	^ 'extensionMethod'.
!

CLASS TestBlock EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| milliseconds num |
	self assert: [ [ 1 + 2 ] value = 3 ].
	self assert: [ ( [ :a | a squared ] value: 3 ) = 9 ].
	self assert: [ ( [ :a :b | a * b ] value: 3 value: 4 ) = 12 ].
	self assert: [ [ true ] and: [ true ] ].
	self assert: [ [ false ] or: [ true ] ].
	self assert: [ ( [ :x | x + 1 ] script ) includes: 'x.$$plus' ].

	milliseconds := Date new.
	[ Date new <= milliseconds ] whileTrue.
	self assert: [ Date new > milliseconds ].

	num := 0.
	[ num < 3 ]	whileTrue: [ num := num + 1 ].
	self assert: [ num = 3 ].

	num := [ | a | a := 1. a + 1 ] value.
	self assert: [ num = 2 ].

	async [ await 1 ] value.
	"The following 2 commented lines would generate compiler errors
	about using 'await' outside an async method or block."
	"await 1."
	"[ await 1 ] value."

!
async testValueAwait
	| result |

	result := await async [ await 1 + 2 ] valueAwait.
	self assert: [ result = 3 ].

	result := await async [ :a | await a + a ] valueAwait: 3.
	self assert: [ result = 6 ].

	result := await async [ :a :b | await a + b ] valueAwait: 3 value: 2.
	self assert: [ result = 5 ].
!
async testWhileTrueAwait
	| milliseconds num |

	milliseconds := Date new.
	await async [ await Timer timeout: 10.
			Date new <= milliseconds ] whileTrueAwait.
	self assert: [ Date new > milliseconds ].

	num := 0.
	await [ num < 3 ] whileTrueAwait:
		async [ await Timer timeout: 10.
			num := num + 1. ].
	self assert: [ num = 3 ].
!

testTryCatch
	| result |
	result := [ Object missingMethod ]
		tryCatch: [ :error | self onTryCatch: error ].
	self assert: [ result = 'caught' ].
!
onTryCatch: error
	self assert: [ error message includes: 'is not a function' ].
	^ 'caught'.
!
async testTryAwaitCatch
	| result |
	result := await async [ Object missingMethod ]
		tryAwaitCatch: [ :error | self onTryCatch: error ].
	self assert: [ result = 'caught' ].
!
CLASS TestBoolean EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ true toString = 'true' ].
	self assert: [ false toString = 'false' ].

	self assert: [ true = true ].
	self assert: [ true ~= false ].

	self assert: [ false < true ].
	self assert: [ false <= true ].
	self assert: [ true > false ].
	self assert: [ true >= false ].

	self assert: [ true ifTrue: [ true ] ].
	self assert: [ ( false ifTrue: [ true ] ifFalse: [ false ] ) not ].
	self assert: [ false ifFalse: [ true ] ].
	self assert: [ ( false ifFalse: [ false ] ifTrue: [ true ] ) not ].

	self assert: [ true and: [ true ] ].
	self assert: [ ( true and: [ false ] ) not ].

	self assert: [ true or: [ false ] ].
	self assert: [ ( false or: [ false ] ) not ].

	self assert: [ true ].
	self assert: [ false not ].

	self assert: [ true & true ].
	self assert: [ ( true & false ) not ].

	self assert: [ true | false ].
	self assert: [ ( false | false ) not ].

!
async testAsyncAwait
	| trueBlock falseBlock result |
	trueBlock := async [ await Timer timeout: 1. true ].
	falseBlock := async [ await Timer timeout: 2. false ].

	"The result cannot go directly into asserts with sync blocks."
	self checkResult: ( await true ifTrueAwait: trueBlock ).
	self checkResult: ( ( await false ifTrueAwait: trueBlock ifFalseAwait: falseBlock ) not ).
	self checkResult: ( ( await false ifFalseAwait: falseBlock ) not ).
	self checkResult: ( await true ifFalseAwait: [ falseBlock ] ifTrueAwait: trueBlock ).
!
checkResult: result
	self assert: [ result ].
!
CLASS TestClass EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ Class name = 'Class' ].
	self assert: [ Class toString = 'class Class' ].
	self assert: [ Class superclass = Object ].

	self assert: [ Class name = 'Class' ].

	self assert: [ Class methodNames includes: 'name' ].
	self assert: [ ( Class methodNames includes: 'xname' ) not ].
	self assert: [ Class classMethodNames includes: 'classes' ].
	self assert: [ Boolean methodNames includes: '|' ].
	self assert: [ Boolean methodNames includes: 'not' ].

	self assert: [ Boolean canUnderstand: 'not' ].
	self assert: [ Boolean canUnderstand: 'isNil' ].
	self assert: [ ( Boolean canUnderstand: 'XisNil' ) not ].
!
testCompiler
	| a_b |
	a_b := 3.
	self assert: [ a_b = 3 ].
!
_test_reservered_words
	| delete |
	delete := true.
	self assert: [ delete ].
!
CLASS TestCompiler EXTENDS Test MODULE TestCore CLASSVARS 'c1'
	VARS 'v1
	v2'

	"This class tests some compiler parsing features"

CLASSMETHODS

testClass
	self assert: [ c1 isNil ].
!

METHODS

test
	self assert: [ c1 = v1 ].
	self assert: [ v1 = v2 ].
	self assert: [ 1+2=3 ].
	self assert: [ self A: 1 b: 2 ].
!
A:a b:b
	^ true.
!
testClassExtension
	"These will succeed if ObjectExtension.st was successfully compiled."
	self assert: [ Object extensionClassMethod = 'extensionClassMethod' ].
	self assert: [ Object new extensionMethod = 'extensionMethod' ].
!
CLASS TestConsole EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

"The JS console object produces only output / side effects that cannot be read back.
 So the tests in this class should be visually isnpected.
 And de test are disabled by default, so the don't mess up other logging.
 Enable tests by replacing 'noTest' with 'test' or by calling 'noTest' explicitly."

METHODS

"This test is disabled default by calling it 'noTest',
 so console testing massages do not obscure other loggings."

noTest
	| label |

	Console log: 'This log message should be cleared.'.
	Console clear.
	Console assert: false value: 'This assert message should be shown.'.
	Console assert: true value: 'This assert message should NOT be shown.'.
	Console assert: true value: 'This assert message should NOT be shown.'.
	Console debug: 'Debug mesage.'.
	Console error: 'Error message.'.
	Console info: 'Info message.'.
	Console log: 'Log message.'.
	Console warn: 'Warning message.'.

	label := 'label3'.
	Console count: label.
	Console countReset: label.
	Console count: label.
	Console count: label.
	Console count: label.

	Console dir: 'aString'.
	Console dirxml: 'anXmlString'.
	Console table: #( 'A' 'B' 'C' ).

	label := 'groupLabel'.
	Console group: label.
	Console log: 'At level 1'.
	Console groupCollapsed: label.
	Console log: 'Collapsed at level 2'.
	Console groupEnd: label.
	Console groupEnd: label.
	Console log: 'Back at level 0'.

	label := 'timeLabel'.
	Console time: label.
	Console timeStamp: label.
	Console timeLog: label.
	Console timeEnd: label.

	Console log: 'The following stack trace is explicitly requested:'.
	Console trace.
!
CLASS TestDebugger EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''
	"This class contains some code set breakpoints in and step through,
	 to see if the debugger is working as desired."
test1
	^ 1 + 2.
!
test2
	| a b |

	a := 1.
	b := a + 2.

	"self log: 'Debugger finished'."
!
CLASS TestError EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| error cause |

	self assertError: [ Error throw: 'My error' ].
	[ Error throw: 'My error' ] tryCatch: [ :error | self onError: error ].

	error := Error new.
	self assert: [ error message = '' ].
	error message: 'My message'.
	self assert: [ error message = 'My message' ].

	error := Error new: 'New error'.
	self assert: [ error message = 'New error' ].
	self assertError: [ error throw ].

	self assert: [ error cause isNil ].
	cause := Error new: 'Error cause'.
	error cause: cause.
	self assert: [ error cause message = 'Error cause' ].

	error := Error new: 'Error with cause' cause: cause.
	self assert: [ error cause message = 'Error cause' ].
!
onError: error
	self assert: [ error message = 'My error' ].
	self assert: [ error name = 'Error' ].
	self assert: [ error toString = 'Error: Error: My error' ].
!
CLASS TestJsObject EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| jsObject |

	self assert: [ JsObject new isUndefined ].
	self assert: [ JsObject newEmpty isEmpty ].
	self assert: [ ( JsObject fromJs: INLINE 'null' ) isNull ].
	self assert: [ ( JsObject fromJs: INLINE 'undefined' ) isNull ].

	self assert: [ JsObject newEmpty toString = 'a JsObject( [object Object] )' ].
	self assert: [ ( JsObject new js: INLINE '123' ) toString = 'a JsObject( 123 )' ].

	jsObject := JsObject fromJs: INLINE '{
		name: "John Doe", age: 50, pi: 3.14, itIs: true, empty: null,
		things: [ 1, "b", 3.3 ], nested: { inHere: "I am in here" } }'.

	self assert: [ ( jsObject atJsProperty: 'name' ) = 'John Doe' ].
	self assert: [ ( jsObject atJsProperty: 'age' ) = 50 ].
	self assert: [ ( jsObject atJsProperty: 'pi' ) = 3.14 ].
	self assert: [ ( jsObject atJsProperty: 'itIs' ) = true ].
	self assert: [ ( jsObject atJsProperty: 'empty' ) = nil ].
	self assert: [ ( ( jsObject atJsProperty: 'things' ) at: 1 ) = 'b' ].
	self assert: [ ( ( jsObject atJsProperty: 'nested' ) atProperty: 'inHere' ) = 'I am in here' ].

	self assert: [ jsObject hasOwn: 'age' ].
	self assert: [ ( jsObject hasOwn: 'missing' ) not ].

	self assert: [ Date new jsClassName = 'Date' ].
	self assert: [ true jsType = 'boolean' ].

!
testJson
	| object |

	object := Object fromJson: '{ "a": 1, "b": { "b1": 21 }, "c": [ 31, 32 ] }'.

	self assert: [ ( object atProperty: 'a' ) = 1 ].
	self assert: [ ( ( object atProperty: 'b' ) atProperty: 'b1' ) = 21 ].
	self assert: [ ( object atProperty: 'c' ) = #( 31 32 ) ].
!
CLASS TestNil EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	self assert: [ nil = nil ].
	self assert: [ nil class = Nil ].
	self assert: [ nil isNull ].
	self assert: [ nil isNil ].
	self assert: [ nil toString = 'nil' ].

	self assert: [ ( Nil fromJs: INLINE 'null' ) = nil ].
	self assert: [ ( Nil fromJs: INLINE 'undefined' ) = nil ].
	self assert: [ ( Nil fromJs: 3 ) = 3 ].

	self assert: [ nil ifNil: [ true ] ].
	self assert: [ 1 ifNotNil: [ true ] ].
!
CLASS TestObject EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| object |
	object := Object new.

	self assert: [ object isMemberOf: Object ].
	self assert: [ String new isKindOf: Object ].
	self assert: [ self isKindOf: Test ].
	self assert: [ 10 respondsTo: '+' ].

	self assert: [ object = object ].
	self assert: [ object == object ].
	self assert: [ object ~= Object new ].

	self assert: [ true ].
	self assertError: [ object error: 'My error.' ].
	self assertError: [ object subclassResponsibility ].
	self assertError: [ object halt ].

	self assert: [ object isNil not ].
	self assert: [ object notNil ].
	self assert: [ object yourself = object ].
!
testConversion
	| object js |
	object := Object new.

	self assert: [ object toString = 'a Object' ].
	"JS cannot compare objects for value quality, so use toJson for implecitly testing toJs."
	self assert: [ object toJson = '{}' ].
!
testPerform
	| object |
	object := Object new.

	self assert: [ ( object perform: 'toString' ) = 'a Object' ].
	self assert: [ object perform: '=' with: object ].
	self assert: [ ( 'abc' perform: 'substring:to:' with: 1 with: 2 ) = 'b' ].
	self assert: [ ( Date perform: 'year:month:day:' with: 1980 with: 2 with: 28 ) year = 1980 ].
!
testAssignment
	| object1 object2 |

	object1 := 7.
	self assert: [ object1 = 7 ].

	object2 := 'a'.
	self assert: [ object2 = 'a' ].

	object1 := object2 := 2.0.
	self assert: [ ( object1 = 2.0 ) & ( object2 = 2.0 ) ].
!
testProperties
	| point |
	point := ( 2 @ 3 ).

	self assert: [ point keys = #( 'x' 'y' ) ].
	self assert: [ point entries first = #( 'x' 2 ) ].

	self assert: [ point ownPropertyNames = #( 'x' 'y' ) ].
	self assert: [ ( point atProperty: 'x' ) = 2 ].
	self assert: [ ( point atProperty: 'z' ) isNil ].

	point atProperty: 'y' put: 4.
	self assert: [ ( point atProperty: 'y' ) = 4 ].
!
CLASS TestPromise EXTENDS Test MODULE TestCore CLASSVARS '' VARS ''

test
	| promise |

	promise := Promise new: [ :resolve :reject |
		Timer timeout: 10 then: [ resolve value: 42 ] ].
	promise then: [ :value | self assert: [ value = 42 ] ].

	promise := Promise resolve: 'ok'.
	promise then: [ :value | self assert: [ value = 'ok' ] ].
	promise finally: [ self assert: [ true ] ].
!
testCollections
	| promise1 promise2 result |

	promise1 := Promise resolve: 42.
	promise2 := Promise resolve: 'ok'.

	result := Promise all: #( promise1 promise2 )
		then: [ :values | self assert: [ values = #( 42 'ok' ) ] ].
	self assert: [ result class = Promise ].

	result := Promise allSettled: #( promise1 promise2 ) then: [ :promiseStatuses |
		self assert: [ promiseStatuses length = 2 ].
		self assert: [ promiseStatuses first status = 'fulfilled' ].
		self assert: [ promiseStatuses first value = 42 ] ].
	self assert: [ result class = Promise ].

	result := Promise any: #( promise1 promise2 )
		then: [ :value | self assert: [ value = 42 ] ].
	self assert: [ result class = Promise ].

	result := Promise race: #( promise1 promise2 )
		then: [ :value | self assert: [ value = 42 ] ].
	self assert: [ result class = Promise ].
!
async testAsyncAwait
	| result |
	result := await self asyncMethod.
	self assert: [ result = 'asyncMethodResult' ].
!
async asyncMethod
	"Await here shows the intended use,
	but it does not do anything on constants."
	^ await 'asyncMethodResult'.
!
testThenFinally
	| promise1 promise2 |

	promise1 := Promise resolve: 'resolved'.
	promise2 := Promise fromJs: promise1 js
		then: [ :result | self onThen: result ]
		catch: [ :result | self onCatch: result ]
		finally: [  self onFinally ].
!
onThen: result
	self assert: [ result = 'resolved' ].
!
onCatch: error
	"Error handling here shows the intended use,
	but this method should not be reached."
	error throw.
!
onFinally
	"This method should be reached."
	self assert: [ true ].
!
testCatch
	| promise1 promise2 |

	"This test is disabled by default because it halts the VSCode debugger.
	It can be enabled to check that 'onExpectedCatch:' is called after continuing with [F5]."
	^ self.

	promise1 := Promise reject: 'rejected'.
	promise2 := Promise fromJs: promise1 js
		then: [ :result | self onThen: result ]
		catch: [ :result | self onExpectedCatch: result ]
		finally: [  self onFinally ].
!
onExpectedCatch: reason
	self assert: [ reason = 'rejected' ].
!
CLASS TestTimer EXTENDS Test MODULE TestCore CLASSVARS '' VARS 'count'

testTimeout
	| timer |
	timer := Timer timeout: 10 then: [ self onTimeout: timer ].
!
onTimeout: timer
	self assert: [ timer id > 0 ].
!
async testAwaitTimeout
	| timer |
	timer := Timer new.
	await timer timeout: 10.
	self assert: [ timer id > 0 ].

	await Timer timeout: 10.
!
testClearTimeout
	| timer |
	timer := Timer timeout: 10 then: [ self notReached ].
	timer clearTimeout.
!
notReached
	self assert: [ false ].
!
testInterval
	| timer |
	count := 0.
	timer := Timer interval: 10 then: [ self onInterval: timer ].
!
onInterval: timer
	self assert: [ timer id > 0 ].
	self assert: [ count < 2 ].
	count increment >= 2 ifTrue: [
		timer clearInterval ].
!
CLASS TestScreen EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| screen |
	screen := Window default screen.

	self assert: [ screen class = Screen ].

	self assert: [ screen availTop >= 0 ].
	self assert: [ screen availLeft >= 0 ].

	self assert: [ screen height > 0 ].
	self assert: [ screen width > 0 ].

	self assert: [ screen availHeight > 0 ].
	self assert: [ screen availWidth > 0 ].

	self assert: [ screen colorDepth > 0 ].
	self assert: [ screen pixelDepth > 0 ].

	self assert: [ screen orientation class = ScreenOrientation ].
!
CLASS TestScreenOrientation EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| screenOrientation |
	screenOrientation := Window default screen orientation.

	self assert: [ screenOrientation class = ScreenOrientation ].

	self assert: [
		#( 'portrait-primary' 'portrait-secondary' 'landscape-primary' 'landscape-secondary' )
			includes: screenOrientation type ].

	self assert: [ screenOrientation angle >= 0 ].

	screenOrientation lock: 'any' onLocked: [] onError: [].
	screenOrientation unlock.
!
CLASS TestVisualViewport EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| visualViewport |
	visualViewport := Window default visualViewport.
	self assert: [ visualViewport class = VisualViewport ].

	self assert: [ visualViewport offset >= ( 0 @ 0 ) ].
	self assert: [ visualViewport pageOffset >= ( 0 @ 0 ) ].
	self assert: [ visualViewport size >= ( 0 @ 0 ) ].
	self assert: [ visualViewport scale > 0 ].
!
CLASS TestWindow EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

testPlatforms
	self assert: [ Window isFirefox | true ].
	self assert: [ Window isChromium | true ].
	self assert: [ Window isMacos | true ].
!
testProperties
	| window |
	window := Window default.

	self assert:[ window class = Window ].
	self assert:[ window closed not ].
	self assert:[ window console = Console ].
	self assert:[ window customElements class = CustomElementRegistry ].
	self assert:[ window devicePixelRatio > 0.0 ].
	self assert:[ window document = Document default ].
	self assert:[ window frameElement isNil ].
	self assert:[ window frames class = Window ].
	self assert:[ window history class = History ].
	self assert:[ window innerHeight > 0 ].
	self assert:[ window innerWidth > 0 ].
	self assert:[ window length >= 0 ].
	self assert:[ window localStorage class = Storage ].
	self assert:[ window location class = Location ].
	self assert:[ window locationBarVisible ].
	self assert:[ window menuBarVisible ].
	self assert:[ window navigator class = Navigator ].
	self assert:[ window opener isNil ].
	self assert:[ window outerHeight > 0 ].
	self assert:[ window outerWidth > 0 ].
	self assert:[ window pageXOffset >= 0 ].
	self assert:[ window pageYOffset >= 0 ].
	self assert:[ window parent = window ].
	self assert:[ window personalBarVisible ].
	self assert:[ window screen class = Screen ].
	self assert:[ window scrollBarsVisible | true ].
	self assert:[ window scrollX >= 0 ].
	self assert:[ window scrollY >= 0 ].
	self assert:[ window self class = Window ].
	self assert:[ window sessionStorage class = Storage ].
	self assert:[ window speechSynthesis class = SpeechSynthesis ].
	self assert:[ window statusBarVisible | true ].
	self assert:[ window toolBarVisible | true ].
	self assert:[ window top = window ].
	self assert:[ window visualViewport class = VisualViewport ].
	self assert:[ window window = window ].
!
CLASS TestHtmlTableElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"This class tests TestHtmlTableElement and all elements contained within it."

METHODS

testTable
	| table tHead tBody tFoot |

	table := Document default createElement: 'table'.
	self assert: [ table class = HtmlTableElement ].

	tHead := table createTHead.
	self assert: [ tHead class = HtmlTableSectionElement ].
	self assert: [ table tHead = tHead ].
	table deleteTHead.
	self assert: [ table tHead isNil ].

	tBody := table createTBody.
	self assert: [ tBody class = HtmlTableSectionElement ].
	self assert: [ table tBodies first = tBody ].

	tFoot := table createTFoot.
	self assert: [ tFoot class = HtmlTableSectionElement ].
	self assert: [ table tFoot = tFoot ].
	table deleteTFoot.
	self assert: [ table tFoot isNil ].

!
testCaption
	| table caption |

	table := Document default createElement: 'table'.
	self assert: [ table class = HtmlTableElement ].

	caption := table createCaption.
	self assert: [ caption class = HtmlTableCaptionElement ].
	self assert: [ table caption = caption ].

	caption innerHtml: '<b>My table caption</b>'.
	self assert: [ caption innerHtml = '<b>My table caption</b>' ].

	table deleteCaption.
	self assert: [ table caption isNil ].
!
testSections
	| table row tBody |

	table := Document default createElement: 'table'.
	self assert: [ table class = HtmlTableElement ].

	tBody := table createTBody.
	self assert: [ tBody class = HtmlTableSectionElement ].

	row := table insertRow: -1.
	self assert: [ row class = HtmlTableRowElement ].
	self assert: [ tBody rows length = 1 ].
	table deleteRow: 0.
	self assert: [ tBody rows length = 0 ].

	row := tBody insertRow: -1.
	self assert: [ row class = HtmlTableRowElement ].
	self assert: [ tBody rows length = 1 ].
	tBody deleteRow: 0.
	self assert: [ tBody rows length = 0 ].
!
testRow
	| table row cell |

	table := Document default createElement: 'table'.
	self assert: [ table class = HtmlTableElement ].

	row := table insertRow: -1.
	self assert: [ row class = HtmlTableRowElement ].
	self assert: [ row rowIndex = 0 ].
	self assert: [ row sectionRowIndex = 0 ].

	cell := row insertCell: -1.
	self assert: [ row cells length = 1 ].
	self assert: [ row cells first = cell ].

	row deleteCell: 0.
	self assert: [ row cells length = 0 ].
!
testCell
	| table row headerCell cell |

	table := Document default createElement: 'table'.
	self assert: [ table class = HtmlTableElement ].

	row := table insertRow: -1.
	self assert: [ row class = HtmlTableRowElement ].

	headerCell := Document default createElement: 'th'.
	self assert: [ headerCell class = HtmlTableCellElement ].

	headerCell abbr: 'myAbbr'.
	self assert: [ headerCell abbr = 'myAbbr' ].

	headerCell scope: 'row'.
	self assert: [ headerCell scope = 'row' ].

	headerCell id: 'headerCellId'.
	row appendChild: headerCell.
	self assert: [ headerCell cellIndex = 0 ].

	cell := row insertCell: -1.
	self assert: [ cell class = HtmlTableCellElement ].
	self assert: [ cell cellIndex = 1 ].

	cell headers: 'headerCellId'.
	self assert: [ cell headers = 'headerCellId' ].

	self assert: [ cell rowSpan = 1 ].
	cell rowSpan: 2.
	self assert: [ cell rowSpan = 2 ].

	self assert: [ cell colSpan = 1 ].
	cell colSpan: 2.
	self assert: [ cell colSpan = 2 ].
!
CLASS TestAttr EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| attr |
	"Attributes names should be lower case."
	attr := Document new createAttribute: 'my-name'.
	self assert: [ attr class = Attr ].
	self assert: [ attr name = 'my-name' ].

	attr value: 'myValue'.
	self assert: [ attr value = 'myValue' ].
!
CLASS TestCharacterData EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''
	"Note: CharacterData is an abstract class.
		We will test using instances of the Text subsclass."

METHODS

testProperties
	| text |

	text := Document default createTextNode: 'My Text'.
	self assert: [ text data = 'My Text' ].
	text data: text data, '!'.
	self assert: [ text data = 'My Text!' ].
	self assert: [ text length = 8 ].
	self assert: [ text nextElementSibling = nil ].
	self assert: [ text previousElementSibling = nil ].
!
testNodeMethods
	| paragraph text |

	paragraph := ( Document default createElement: 'p' ) textContent: 'My Paragraph'.
	text := paragraph firstChild.
	text before: '>'.
	self assert: [ paragraph firstChild data = '>' ].
	text after: '<'.
	self assert: [ paragraph lastChild data = '<' ].
	self assert: [ paragraph childNodes length = 3 ].

	paragraph lastChild replaceWith: '<!'.
	self assert: [ paragraph lastChild data = '<!' ].
!
testDataMethods
	| text |

	text := Text new data: 'ab'.

	text appendData: 'cd'.
	self assert: [ text data = 'abcd' ].

	text deleteDataAt: 2 count: 2.
	self assert: [ text data = 'ad' ].

	text insertDataAt: 2 with: '12'.
	self assert: [ text data = 'a12d' ].

	text replaceDataAt: 2 count: 2 with: '345'.
	self assert: [ text data = 'a345d' ].

	self assert: [ ( text substringDataAt: 2 count: 3 ) = '345' ].
!
CLASS TestComment EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| comment |

	comment := Comment new: 'New comment.'.
	self assert: [ comment data = 'New comment.' ].

	comment := Document default createComment: 'Comment in document.'.
	Document default head appendChild: comment.
	self assert: [ Document default head lastChild class = Comment ].
!
CLASS TestNode EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Tests abstract Node class through instances of div and paragraph."

test
	| document div p1 p2 p3 text |
	document := Document new.

	div := document createElement: 'div'.
	self assert: [ div class = HtmlDivElement ].
	self assert: [ div isConnected not ].
	document body appendChild: div.
	self assert: [ div isConnected ].

	p1 := document createElement: 'p'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p1.

	p2 := document createElement: 'p'.
	self assert: [ p2 class = HtmlParagraphElement ].
	div appendChild: p2.

	"Properties"

	self assert: [ div baseUri = 'about:blank' ].
	self assert: [ div firstChild = p1 ].
	self assert: [ div lastChild = p2 ].
	self assert: [ p1 nextSibling = p2 ].
	self assert: [ p2 previousSibling = p1 ].

	self assert: [ p1 nodeName = 'P' ].
	self assert: [ p1 nodeType = 1 ].
	self assert: [ p1 nodeValue isNil ].

	self assert: [ p1 ownerDocument = document ].
	self assert: [ p1 parentElement = div ].
	self assert: [ p1 parentNode = div ].

	self assert: [ p1 textContent = '' ].
	p1 textContent: 'P1 text'.
	self assert: [ p1 textContent = 'P1 text' ].

	"Methods"

	p3 := p1 cloneNode: true.
	self assert: [ p3 textContent = 'P1 text' ].
	p3 textContent: 'P3 text'.

	self assert: [ ( p1 compareDocumentPosition: p2 ) = 4  ]. "4 = Following"
	self assert: [ div contains: p1 ].
	self assert: [ p1 getRootNode = document ].
	self assert: [ div hasChildNodes ].

	div insert: p2 before: p1.
	self assert: [ div firstChild = p2 ].
	div insert: p1 before: p2.
	self assert: [ div firstChild = p1 ].

	self assert: [ p1 isEqualNode: p1 ].
	self assert: [ ( p1 isEqualNode: p2 ) not ].
	self assert: [ p1 isSameNode: p1  ].
	self assert: [ ( p1 isSameNode: p2 ) not ].

	text := document createTextNode: ' added'.
	p1 appendChild: text.
	p1 normalize.
	self assert: [ p1 textContent = 'P1 text added' ].

	div replaceChild: p2 with: p3.
	self assert: [ div lastChild = p3 ].

	div removeChild: p3.
	self assert: [ div lastChild = p1 ].
!
CLASS TestText EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| text paragraph |

	text := Text new: 'abcd'.
	self assert: [ text data = 'abcd' ].
	self assert: [ text assignedSlot = nil ].
	self assert: [ text wholeText = 'abcd' ].

	paragraph := Document default createElement: 'p'.
	text := Document default createTextNode: 'RedBlue'.
	paragraph appendChild: text.
	paragraph firstChild splitText: 4.
	self assert: [ paragraph firstChild data = 'Red' ].
	self assert: [ paragraph lastChild data = 'Blue' ].
!
CLASS TestClipboard EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Note reading and writing the clipboard may require user authorisation,
 so there are not automated unit tests possible for them.
 Functionality is tested in MyBrowserApp."

test
	| clipboard |

	clipboard := Window default navigator clipboard.
	self assert: [ clipboard class = Clipboard ].
!
CLASS TestNavigator EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| navigator |

	navigator := Window default navigator.

	self assert: [ navigator clipboard class = Clipboard ].
	self assert: [ navigator cookieEnabled class = Boolean ].
	self assert: [ navigator geolocation class = Geolocation ].
	self assert: [ navigator hardwareConcurrency >= 1 ].
	self assert: [ navigator language  includes: '-' ].
	self assert: [ navigator languages length >= 1 ].
	self assert: [ navigator locks class = LockManager ].
	self assert: [ navigator maxTouchPoints >= 0 ].
	self assert: [ navigator mediaCapabilities class = MediaCapabilities ].
	self assert: [ navigator mediaDevices class = MediaDevices ].
	self assert: [ navigator mediaSession class = MediaSession ].
	self assert: [ navigator onLine class = Boolean ].
	self assert: [ navigator pdfViewerEnabled class = Boolean ].
	self assert: [ navigator platform class = String ].
	self assert: [ navigator permissions class = Permissions ].
	self assert: [ navigator serviceWorker class = ServiceWorkerContainer ].
	self assert: [ navigator storage class = StorageManager ].
	self assert: [ navigator userAgent includes: 'Mozilla' ].

	"2024-05-18: This currently results in error 405: Method not allowed"
	"self assert: [ navigator sendBeacon: '/' data: 'ping' ]."
!


" TODO:
vibrate: pattern
	^ Boolean fromJs: INLINE 'this.js.vibrate( pattern.$toJs() )'.
!
"CLASS TestElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Test Element class though div and paragraph subclass instances."

testProperties
	| document div p1 p2 |
	document := Document new.

	div := document createElement: 'div'.
	self assert: [ div class = HtmlDivElement ].
	document body appendChild: div.
	self assert: [ div isConnected ].

	p1 := document createElement: 'p'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p1.

	p2 := document createElement: 'p'.
	self assert: [ p2 class = HtmlParagraphElement ].
	div appendChild: p2.

	self assert: [ div id = '' ].
	div id: 'div'.
	self assert: [ div id = 'div' ].

	self assert: [ ( div attributes getNamedItem: 'id' ) value = 'div' ].

	self assert: [ div childElementCount = 2 ].
	self assert: [ div children first = p1 ].

	self assert: [ div className = '' ].
	div className: 'divClass'.
	self assert: [ div className = 'divClass' ].

	self assert: [ div classList length = 1 ].
	self assert: [ div classList contains: 'divClass' ].

	self assert: [ div clientTop = 0 ].
	self assert: [ div clientLeft = 0 ].
	self assert: [ div clientHeight = 0 ].
	self assert: [ div clientWidth = 0 ].

	self assert: [ div firstElementChild = p1 ].
	self assert: [ div lastElementChild = p2 ].
	self assert: [ div innerHtml = '<p></p><p></p>' ].
	self assert: [ div localName = 'div' ].
	self assert: [ div namespaceUri startsWith: 'http' ].
	self assert: [ div outerHtml startsWith: '<div ' ].
	self assert: [ div part length = 0 ].
	self assert: [ div prefix isNil ].

	self assert: [ p1 nextElementSibling = p2 ].
	self assert: [ p2 previousElementSibling = p1 ].

	self assert: [ div scrollTop = 0 ].
	self assert: [ div scrollLeft = 0 ].
	self assert: [ div scrollHeight = 0 ].
	self assert: [ div scrollWidth = 0 ].

	self assert: [ div assignedSlot isNil ].
	self assert: [ div shadowRoot isNil ].
	self assert: [ div slot = '' ].
	self assert: [ div tagName = 'DIV' ].
!
testMethods
	"Method attachShadow: is tested in TestShadowRoot."
	"Todo: Test dispatchEvent: in class Event class"
	"Todo: Test these in class PointerEvents:
		hasPointerCapture, releasePointerCapture, setPointerCapture, requestPointerLock "
	"Todo: Test requestFullscreen:... in interactive mode."

	| document div p1 p2 rect0 |
	document := Document new.

	div := ( document createElement: 'div' ) id: 'div'.
	self assert: [ div class = HtmlDivElement ].
	document body appendChild: div.
	self assert: [ div isConnected ].

	p1 := ( document createElement: 'p' ) id: 'p1'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p1.

	p2 := ( document createElement: 'p' ) id: 'p2'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p2.

	p2 after: p1.
	self assert: [ p2 nextElementSibling = p1 ].

	p2 before: p1.
	self assert: [ p2 previousElementSibling = p1 ].

	p2 insertAdjacentElement: p1 position: 'afterend'.
	self assert: [ div lastElementChild = p1 ].
	p2 insertAdjacentElement: p1 position: 'beforebegin'.
	self assert: [ div firstElementChild = p1 ].

	p2 insertAdjacentHtml: '<p id="p3"></p>' position: 'afterend'.
	self assert: [ div lastElementChild id = 'p3' ].
	div lastElementChild remove.

	p2 insertAdjacentText: 'Inserted Text node' position: 'afterend'.
	self assert: [ p2 nextSibling textContent = 'Inserted Text node' ].
	p2 nextSibling remove.

	self assert: [ ( p1 closest: 'div' ) id = 'div' ].
	self assert: [ ( p1 getAttribute: 'id' ) = 'p1' ].
	self assert: [ p1 getAttributeNames first = 'id' ].
	self assert: [ ( p1 getAttributeNode: 'id' ) value = 'p1' ].
	self assert: [ p1 hasAttribute: 'id' ].
	self assert: [ p1 hasAttributes ].
	self assert: [ p1 matches: '#p1' ].

	rect0 := Rect origin: ( 0 @ 0 ) extent: ( 0 @ 0 ).
	self assert: [ p1 getBoundingClientRect = rect0 ].
	self assert: [ div getClientRects isEmpty ].

	p1 className: 'pClass'.
	self assert: [ ( document getElementsByClassName: 'pClass' ) first = p1 ].
	self assert: [ ( document getElementsByTagName: 'p' ) first = p1 ].
!
testMethods2
	| document div p1 p2 p3 p4 attr element paragraph text elements  |
	document := Document new.

	div := ( document createElement: 'div' ) id: 'div'.
	self assert: [ div class = HtmlDivElement ].
	document body appendChild: div.
	self assert: [ div isConnected ].

	p1 := ( document createElement: 'p' ) id: 'p1'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p1.

	p2 := ( document createElement: 'p' ) id: 'p2'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p2.

	div prepend: p2.
	self assert: [ div children first = p2 ].
	div prepend: p1.
	self assert: [ div children first = p1 ].

	self assert: [ ( div querySelector: '#p1' ) id = 'p1' ].
	self assert: [ ( div querySelectorAll: '#p1' ) first id = 'p1' ].

	"Note: Attribute names must be lower case."
	div setAttribute: 'my-attr' value: 'my-value'.
	self assert: [ ( div getAttribute: 'my-attr' ) = 'my-value' ].
	div removeAttribute: 'my-attr'.
	self assert: [ ( div getAttribute: 'my-attr' ) = nil ].

	attr := ( document createAttribute: 'my-attr2' ) value: 'my-value2'.
	div setAttributeNode: attr.
	self assert: [ ( div getAttribute: 'my-attr2' ) = 'my-value2' ].
	div removeAttributeNode: attr.
	self assert: [ ( div getAttribute: 'my-attr2' ) = nil ].

	p3 := ( document createElement: 'p' ) id: 'p3'.
	div replaceChildren: p3.
	self assert: [ div children length = 1 ].

	p4 := ( document createElement: 'p' ) id: 'p4'.
	p3 replaceWith: p4.
	self assert: [ div children first id = 'p4' ].

	div removeChildren.
	self assert: [ div children length = 0 ].
!
testCreation
	| document element |
	document := Document new.

	#( 'body' 'br' 'button' 'div' 'embed' 'field' 'form' 'head' 'html' 'image' 'input'
	   'label' 'link' 'meta' 'p' 'script' 'slot' 'span' 'textarea' 'title' 'unknown' )
	   	do: [ :tagName |
			element := document createElement: tagName.
			self assert: [ element tagName = tagName toUpperCase ] ].
!
CLASS TestHtmlAnchorElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| anchor |

	anchor := Document new createElement: 'a'.
	self assert: [ anchor class = HtmlAnchorElement ].

	self assert: [ anchor download = '' ].
	anchor download: 'Test.txt'.
	self assert: [ anchor download = 'Test.txt' ].

	self assert: [ anchor href = '' ].
	self assert: [ anchor protocol = ':' ].
	self assert: [ anchor host = '' ].
	self assert: [ anchor port = '' ].
	self assert: [ anchor hostname = '' ].
	self assert: [ anchor origin = '' ].

	anchor href: 'http://localhost:8080/SmallJS.png'.
	self assert: [ anchor href = 'http://localhost:8080/SmallJS.png' ].
	self assert: [ anchor host = 'localhost:8080' ].
	self assert: [ anchor hostname = 'localhost' ].
	self assert: [ anchor port = '8080' ].
	self assert: [ anchor pathname = '/SmallJS.png' ].
	self assert: [ anchor origin = 'http://localhost:8080' ].

	self assert: [ anchor hreflang = '' ].
	anchor hreflang: 'en'.
	self assert: [ anchor hreflang = 'en' ].

	self assert: [ anchor username = '' ].
	anchor username: 'John'.
	self assert: [ anchor username = 'John' ].

	self assert: [ anchor password = '' ].
	anchor password: 'secret'.
	self assert: [ anchor password = 'secret' ].

	self assert: [ anchor protocol = 'http:' ].
	anchor protocol: 'ftp:'.
	self assert: [ anchor protocol = 'ftp:' ].

	self assert: [ anchor referrerPolicy = '' ].
	anchor referrerPolicy: 'origin'.
	self assert: [ anchor referrerPolicy = 'origin' ].

	self assert: [ anchor rel = '' ].
	anchor rel: 'alternate'.
	self assert: [ anchor rel = 'alternate' ].
	self assert: [ anchor relList length = 1 ].

	self assert: [ anchor search = '' ].
	anchor search: '?q=123'.
	self assert: [ anchor search = '?q=123' ].

	self assert: [ anchor target = '' ].
	anchor target: '_blank'.
	self assert: [ anchor target = '_blank' ].

	self assert: [ anchor text = '' ].
	anchor text: 'SmallJS.png'.
	self assert: [ anchor text = 'SmallJS.png' ].

	self assert: [ anchor type = '' ].
	anchor type: 'image/jpg'.
	self assert: [ anchor type = 'image/jpg' ].
!
CLASS TestHtmlButtonElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''
	"Form related properties of buttons are tested in TestHtmlFormElement."

test
	| button |
	button := Document new createElement: 'button'.
	self assert: [ button class = HtmlButtonElement ].

	self assert: [ button autofocus not ].
	button autofocus: true.
	self assert: [ button autofocus ].

	self assert: [ button disabled not ].
	button disabled: true.
	self assert: [ button disabled ].

	self assert: [ button labels isEmpty ].

	self assert: [ button name = '' ].
	button name: 'buttonName'.
	self assert: [ button name= 'buttonName' ].

	self assert: [ button tabIndex = 0 ].
	button tabIndex: -1.
	self assert: [ button tabIndex = -1 ].

	self assert: [ button type = 'submit' ].
	button type: 'button'.
	self assert: [ button type = 'button' ].

	self assert: [ button willValidate not ].
	self assert: [ button validationMessage = '' ].
	self assert: [ button valid ].

	self assert: [ button value = '' ].
!
CLASS TestHtmlDataListElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| document dataList option options |

	document := Document new.

	dataList := document createElement: 'datalist'.
	self assert: [ dataList class = HtmlDataListElement ].

	#( 'First' 'Second' ) do: [ :optionString |
		option := document createElement: 'option'.
		self assert: [ option class = HtmlOptionElement ].
		option value: optionString.
		dataList appendChild: option ].

	options := dataList options.
	self assert: [ options length = 2 ].
	self assert: [ options first value = 'First' ].
	self assert: [ ( dataList indexOf: 'Second' ) = 1 ].
	self assert: [ ( dataList indexOf: 'Missing' ) = -1 ].
!
CLASS TestHtmlElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Test HtmlElement through instances of subclasses."

testProperties
	| paragraph  |
	paragraph := Document new createElement: 'p'.
	self assert: [ paragraph class = HtmlParagraphElement ].

	self assert: [ paragraph accessKey = '' ].
	paragraph accessKey: 'q'.
	self assert: [ paragraph accessKey = 'q' ].

	self assert: [ paragraph dir = '' ].
	paragraph dir: 'ltr'.
	self assert: [ paragraph dir = 'ltr' ].

	self assert: [ paragraph enterKeyHint = '' ].
	paragraph enterKeyHint: 'done'.
	self assert: [ paragraph enterKeyHint = 'done' ].

	self assert: [ paragraph hidden not ].
	paragraph hidden: true.
	self assert: [ paragraph hidden ].

	self assert: [ paragraph inert not ].
	paragraph inert: true.
	self assert: [ paragraph inert ].

	self assert: [ paragraph innerText = '' ].
	paragraph innerText: 'Text'.
	self assert: [ paragraph innerText = 'Text' ].

	self assert: [ paragraph outerText = paragraph innerText ].

	self assert: [ paragraph isContentEditable not ].

	self assert: [ paragraph lang = '' ].
	paragraph lang: 'en'.
	self assert: [ paragraph lang = 'en' ].

	self assert: [ paragraph nonce = '' ].
	paragraph nonce: 'whatever'.
	self assert: [ paragraph nonce = 'whatever' ].
	paragraph nonce: ''.

	self assert: [ paragraph offsetTop = 0 ].
	self assert: [ paragraph offsetLeft = 0 ].
	self assert: [ paragraph offsetHeight = 0 ].
	self assert: [ paragraph offsetWidth = 0 ].

	self assert: [ paragraph style class = CssStyleDeclaration ].

	self assert: [ paragraph tabIndex = -1 ].
	paragraph tabIndex: 0.
	self assert: [ paragraph tabIndex = 0 ].
	paragraph tabIndex: -1.

	self assert: [ paragraph title = '' ].
	paragraph title: 'Title'.
	self assert: [ paragraph title = 'Title' ].
!
testMethods
	| document paragraph  |
	document := Document new.

	"These can only be tested in visible documents:
		paragraph forceFocus.
		paragraph blur."

	"Method click is tested in TestEventTarget."
!
CLASS TestHtmlEmbedElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testProperties
	| body embed |

	body := Document new body
		innerHtml: '<embed id="embed" type="text/html" src="Missing.html" width="300" height="40">'.
	embed := body children first.

	self assert: [ embed size = ( 300 @ 40 ) ].
	self assert: [ embed src = 'Missing.html' ].
	self assert: [ embed type = 'text/html' ].
!
CLASS TestHtmlFieldSetElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testProperties
	| fieldSet |

	fieldSet := Document default createElement: 'fieldset'.

	self assert: [ fieldSet disabled not ].
	fieldSet disabled: true.
	self assert: [ fieldSet disabled ].

	fieldSet name: 'fieldSetName'.
	self assert: [ fieldSet name = 'fieldSetName' ].
	self assert: [ fieldSet type = 'fieldset' ].
	self assert: [ fieldSet validationMessage isEmpty ].
	self assert: [ fieldSet validity class = ValidityState ].
	self assert: [ fieldSet willValidate not ].
	self assert: [ fieldSet elements isEmpty ].
!
testMethods
	| fieldSet |

	fieldSet := Document default createElement:  'fieldset'.

	self assert: [ fieldSet checkValidity ].
	self assert: [ fieldSet reportValidity ].

	self assert: [ fieldSet validity customError not ].
	fieldSet setCustomValidity: 'My custom validity error message.'.
	self assert: [ fieldSet validity customError ].
	fieldSet setCustomValidity: ''.
!
CLASS TestHtmlFormElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| form |

	form := Document default createElement: 'form'.
	form appendChild: ( Document default createElement: 'input' ).
	form appendChild: ( Document default createElement: 'button' ).

	self assert: [ form elements length = 2 ].
	self assert: [ form length = 2 ].

	form name: 'formName'.
	self assert: [ form name = 'formName' ].

	self assert: [ form method = 'get' ].
	form method: 'post'.
	self assert: [ form method = 'post' ].

	self assert: [ form target = '' ].
	form target: 'notarget'.
	self assert: [ form target = 'notarget' ].

	form action: 'Index.html'.
	self assert: [ form action endsWith: 'Index.html' ].
	form action: 'noaction'.
	self assert: [ form action endsWith: 'noaction' ].

	self assert: [ form enctype = 'application/x-www-form-urlencoded' ].
	form enctype: 'text/plain'.
	self assert: [ form enctype = 'text/plain' ].

	self assert: [ form acceptCharset = '' ].
	form acceptCharset: 'utf-8'.
	self assert: [ form acceptCharset = 'utf-8' ].

	self assert: [ form autocomplete = 'on' ].
	form autocomplete: 'off'.
	self assert: [ form autocomplete = 'off' ].

	self assert: [ form noValidate not ].
	form noValidate: true.
	self assert: [ form noValidate ].
!
testSubmitButton
	| form button |

	button := Document default createElement: 'button'.
	form := Document default createElement: 'form'.
	form appendChild: button.

	self assert: [ button form class = HtmlFormElement ].
	self assert: [ button formAction startsWith: 'http' ].
	self assert: [ button formEnctype = '' ].
	self assert: [ button formMethod = '' ].
	self assert: [ button formNoValidate not ].
	self assert: [ button formTarget = '' ].
!
testInput
	| form input |

	input := Document default createElement: 'input'.
	form := Document default createElement: 'form'.
	form appendChild: input.

	self assert: [ input form class = HtmlFormElement ].
	self assert: [ input formAction startsWith: 'http' ].
	self assert: [ input formEnctype = '' ].
	self assert: [ input formMethod = '' ].
	self assert: [ input formNoValidate not ].
	self assert: [ input formTarget = '' ].
!
CLASS TestHtmlIframeElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| iframe |

	iframe := Document default createElement: 'iframe'.

	self assert: [ iframe allow = '' ].
	iframe allow: 'camera'.
	self assert: [ iframe allow = 'camera' ].

	self assert: [ iframe size = ( 0 @ 0 ) ].
	self assert: [ iframe contentDocument isNil ].
	self assert: [ iframe contentWindow isNil ].

	self assert: [ iframe name = '' ].
	iframe name: 'newName'.
	self assert: [ iframe name = 'newName' ].

	self assert: [ iframe referrerPolicy = '' ].
	iframe referrerPolicy: 'strict-origin'.
	self assert: [ iframe referrerPolicy = 'strict-origin' ].

	self assert: [ iframe sandbox entries isEmpty ].

	self assert: [ iframe src = '' ].
	iframe src: 'Missing.html'.
	self assert: [ iframe src endsWith: 'Missing.html' ].

	self assert: [ iframe srcDoc = '' ].
	iframe srcDoc: '<!DOCTYPE html><p>Hello World!</p>'.
	self assert: [ iframe srcDoc = '<!DOCTYPE html><p>Hello World!</p>' ].
!
CLASS TestHtmlImageElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| image exptectedNaturalSize |
	image := Document default createElement: 'img'.
	self assert: [ image class = HtmlImageElement ].

	self assert: [ image alt = '' ].
	image alt: 'New alt text'.
	self assert: [ image alt = 'New alt text' ].

	self assert: [ image currentSrc = '' ].

	self assert: [ image crossOrigin isNil ].
	image crossOrigin: 'anonymous'.
	self assert: [ image crossOrigin = 'anonymous' ].

	self assert: [ image decoding = 'auto' ].
	image decoding: 'sync'.
	self assert: [ image decoding = 'sync' ].

	self assert: [ image size = ( 0 @ 0 ) ].
	image size: ( 100 @ 75 ).
	self assert: [ image size = ( 100 @ 75 ) ].

	self assert: [ image naturalSize = ( 0 @ 0 ) ].

	self assert: [ image isMap not ].
	image isMap: true.
	self assert: [ image isMap ].

	"Firefox defaults to 'eager'"
	self assert: [ #( 'auto' 'eager' ) includes: image loading ].
	image loading: 'lazy'.
	self assert: [ image loading = 'lazy' ].

	self assert: [ image sizes = '' ].

	self assert: [ image src = '' ].
	image src: 'Missing.jpg'.
	self assert: [ image src endsWith: 'Missing.jpg' ].

	self assert: [ image srcSet = '' ].
	image srcSet: 'SmallJS2.png 4x'.
	self assert: [ image srcSet = 'SmallJS2.png 4x' ].

	self assert: [ image useMap = '' ].
!
CLASS TestHtmlInputElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Form related properties are tested in TestHtmlFormElement."

test
	| input |
	input := Document new createElement: 'input'.

	input name: 'inputName'.
	self assert: [ input name = 'inputName' ].

	self assert: [ input type = 'text' ].
	input type: 'button'.
	self assert: [ input type = 'button' ].
	input type: 'text'.

	self assert: [ input disabled not ].
	input disabled: true.
	self assert: [ input disabled ].

	self assert: [ input autofocus not ].
	input autofocus: true.
	self assert: [ input autofocus ].

	self assert: [ input value = '' ].
	input value: 'New input'.
	self assert: [ input value = 'New input' ].
	input setRangeText: ' inserted ' start: 3 end: 4 selectMode: 'select'.
	self assert: [ input value = 'New inserted input' ].

	self assert: [ input autocomplete= '' ].
	input autocomplete: 'on'.
	self assert: [ input autocomplete= 'on' ].

	self assert: [ input readOnly not ].
	input readOnly: true.
	self assert: [ input readOnly ].

	self assert: [ #( 'forward' 'none' ) includes: input selectionDirection ].
	input selectionDirection: 'backward'.
	self assert: [ input selectionDirection = 'backward' ].
	input selectionDirection: 'forward'.

	self assert: [ input size = 20 ].
	input size: 30.
	self assert: [ input size = 30 ].
	input size: 20.
!
testValidation
	| input |
	input := Document new createElement: 'input'.

	self assert: [ input validity ].
	self assert: [ input validationMessage = '' ].
	self assert: [ input willValidate ].
	self assert: [ input checkValidity ].
	self assert: [ input reportValidity ].

	input setCustomValidity: ''.
!
testSelection
	| input |
	input := Document new createElement: 'input'.

	input value: 'My value'.

	input selectionStart: 1.
	self assert: [ input selectionStart = 1 ].
	input selectionEnd: 4.
	self assert: [ input selectionEnd = 4 ].

	input select.
	self assert: [ input selectionStart = 0 ].
	self assert: [ input selectionEnd = input value length ].

	input setSelectionRange: 2 to: 5.
	self assert: [ input selectionStart = 2 ].
	self assert: [ input selectionEnd = 5 ].
!
testCheckboxInput
	| checkboxInput |
	checkboxInput := Document new createElement: 'input'.
	checkboxInput type: 'checkbox'.

	self assert: [ checkboxInput type = 'checkbox' ].
	self assert: [ checkboxInput checked not ].
	checkboxInput checked: true.
	self assert: [ checkboxInput checked ].
	checkboxInput checked: false.
!
testRadioInput
	| radioInput |
	radioInput := Document new createElement: 'input'.
	radioInput type: 'radio'; name: 'radioSelect'; value: 'radio'.

	self assert: [ radioInput type = 'radio' ].
	self assert: [ radioInput checked not ].
	radioInput checked: true.
	self assert: [ radioInput checked ].

	self assert: [ radioInput defaultChecked not ].
	radioInput defaultChecked: true.
	self assert: [ radioInput defaultChecked ].

	self assert: [ radioInput indeterminate not ].
!
testImageInput
	| imageInput |
	imageInput := Document new createElement: 'input'.
	imageInput type: 'image'.

	self assert: [ imageInput type = 'image' ].

	self assert: [ imageInput src = '' ].
	imageInput src: 'Missing.jpg'.
	self assert: [ imageInput src endsWith: 'Missing.jpg' ].

	self assert: [ imageInput alt = '' ].
	imageInput alt: 'SmallJS2'.
	self assert: [ imageInput alt = 'SmallJS2' ].

	self assert: [ imageInput imageSize = ( 0 @ 0 ) ].
	imageInput imageSize: ( 64 @ 32 ).
	self assert: [ imageInput imageSize = ( 64 @ 32 ) ].
!
testFileInput
	| fileInput |
	fileInput := Document new createElement: 'input'.
	fileInput type: 'file'.

	self assert: [ fileInput type = 'file' ].

	self assert: [ fileInput accept = '' ].
	fileInput accept: 'image/png'.
	self assert: [ fileInput accept = 'image/png' ].

	self assert: [ fileInput files = #( ) ].
!
testNumber
	| numberInput |

	numberInput := Document new createElement: 'input'.

	self assert: [ numberInput min = '' ].
	numberInput min: '1'.
	self assert: [ numberInput min = '1' ].

	self assert: [ numberInput max = '' ].
	numberInput max: '99'.
	self assert: [ numberInput max = '99' ].

	self assert: [ numberInput minLength = -1 ].
	numberInput minLength: 1.
	self assert: [ numberInput minLength = 1 ].

	self assert: [ numberInput maxLength = -1 ].
	numberInput maxLength: 2.
	self assert: [ numberInput maxLength = 2 ].

	self assert: [ numberInput pattern = '' ].
	numberInput pattern: '[0-9]*'.
	self assert: [ numberInput pattern = '[0-9]*' ].

	self assert: [ numberInput placeholder = '' ].
	numberInput placeholder: 'Alt text'.
	self assert: [ numberInput placeholder = 'Alt text' ].
!
testDateInput
	| dateInput |
	dateInput := Document new createElement: 'input'.
	dateInput type: 'date'.

	self assert: [ dateInput type = 'date' ].

	dateInput value: '1900-01-01'.
	self assert: [ dateInput value = '1900-01-01' ].
	self assert: [ dateInput valueAsDate year = 1900 ].
	self assert: [ dateInput valueAsNumber = -2208988800000 ].

	dateInput stepUp: 2.
	self assert: [ dateInput value = '1900-01-03' ].
	dateInput stepDown: 1.
	self assert: [ dateInput value = '1900-01-02' ].
!
CLASS TestHtmlLabelElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| label  |
	label := Document new createElement: 'label'.
	self assert: [ label class = HtmlLabelElement ].

	self assert: [ label control isNil ].
	self assert: [ label form isNil ].

	self assert: [ label htmlFor = '' ].
	label htmlFor: 'someId'.
	self assert: [ label htmlFor = 'someId' ].
!
CLASS TestHtmlLinkElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| link |
	link := Document new createElement: 'link'.
	self assert: [ link class = HtmlLinkElement ].

	self assert: [ link as = '' ].
	link as: 'style'.
	self assert: [ link as = 'style' ].

	self assert: [ link crossOrigin isNil ].
	link crossOrigin: 'use-credentials'.
	self assert: [ link crossOrigin = 'use-credentials' ].

	self assert: [ link disabled not ].
	link disabled: true.
	self assert: [ link disabled ].

	self assert: [ link href = '' ].
	link href: 'Missing.css'.
	self assert: [ link href endsWith: 'Missing.css' ].

	self assert: [ link hreflang = '' ].
	link hreflang: 'en'.
	self assert: [ link hreflang = 'en' ].

	self assert: [ link media = '' ].
	link media: 'print'.
	self assert: [ link media = 'print' ].

	self assert: [ link referrerPolicy = '' ].
	link referrerPolicy: 'no-referrer'.
	self assert: [ link referrerPolicy = 'no-referrer' ].

	self assert: [ link rel = '' ].
	link rel: 'alternate'.
	self assert: [ link rel = 'alternate' ].
	self assert: [ link relList values first = 'alternate' ].

	self assert: [ link type = '' ].
	link type: 'text/css'.
	self assert: [ link type = 'text/css' ].
!
CLASS TestHtmlMetaElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| meta |
	meta := Document default createElement: 'meta'.
	self assert: [ meta class = HtmlMetaElement ].

	meta charset: 'utf-8'.
	self assert: [ meta charset = 'utf-8' ].

	meta httpEquiv: 'refresh'.
	self assert: [ meta httpEquiv = 'refresh' ].

	meta name: 'theme-color'.
	self assert: [ meta name = 'theme-color' ].

	meta content: '#3c790a'.
	self assert: [ meta content = '#3c790a' ].

	meta media: '(prefers-color-scheme: dark)'.
	self assert: [ meta media = '(prefers-color-scheme: dark)' ].
!
CLASS TestHtmlOptionElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	|  option |

	option := Document default createElement: 'option'.

	option value: 'Option value'.
	self assert: [ option value = 'Option value' ].

	option text: 'Option text'.
	self assert: [ option text = 'Option text' ].

	option selected: true.
	self assert: [ option selected ].

	option defaultSelected: true.
	self assert: [ option defaultSelected ].
!
CLASS TestHtmlScriptElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| script |
	script := Document new createElement: 'script'.
	self assert: [ script class = HtmlScriptElement ].
	self assert: [ HtmlScriptElement supports: 'module' ].

	self assert: [ script type = '' ].
	script type: 'application/javascript'.
	self assert: [ script type = 'application/javascript' ].

	self assert: [ script src endsWith: '' ].
	script src: 'Missing.js'.
	self assert: [ script src endsWith: 'Missing.js' ].

	self assert: [ script isAsync ].
	script isAsync: false.
	self assert: [ script isAsync not ].

	self assert: [ script defer not ].
	script defer: true.
	self assert: [ script defer ].

	self assert: [ script crossOrigin isNil ].
	script crossOrigin: 'anonymous'.
	self assert: [ script crossOrigin = 'anonymous' ].

	self assert: [ script referrerPolicy = '' ].
	script referrerPolicy: 'same-origin'.
	self assert: [ script referrerPolicy = 'same-origin' ].

	self assert: [ script text = '' ].
	script text: 'let n = 1;'.
	self assert: [ script text = 'let n = 1;' ].
!
CLASS TestHtmlSelectElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| select option v |
	select := Document new createElement: 'select'.

	self assert: [ select name = '' ].
	select name: 'selectName'.
	self assert: [ select name = 'selectName' ].

	self assert: [ select type = 'select-one' ].

	self assert: [ select length = 0 ].
	select length: 1.
	self assert: [ select length = 1 ].

	self assert: [ select selectedIndex = 0 ].
	select selectedIndex: -1.
	self assert: [ select selectedIndex = -1 ].

	"Options"

	select length: 0.
	option := Document new createElement: 'option'.
	option id: 'optionId'.
	option value: 'optionValue'.
	select add: option.
	self assert: [ select options length = 1 ].
	self assert: [ select options first id = 'optionId' ].
	self assert: [ select options first = option ].

	self assert: [ ( select item: 0 ) = option ].
	self assert: [ ( select namedItem: 'optionId' ) = option ].

	"Modifying"

	select remove: 0.
	self assert: [ select options length = 0 ].

	"Settings"

	self assert: [ select autocomplete = '' ].
	select autocomplete: 'on'.
	self assert: [ select autocomplete = 'on' ].

	self assert: [ select disabled not ].
	select disabled: true.
	self assert: [ select disabled ].

	self assert: [ select multiple not ].
	select multiple: true.
	self assert: [ select multiple ].

	self assert: [ select required not ].
	select required: true.
	self assert: [ select required ].

	self assert: [ select form isNil ].

	self assert: [ select labels length = 0 ].

	"Validating"

	self assert: [ select validationMessage = '' ].
	self assert: [ select validity valueMissing ].
	self assert: [ select willValidate not ].
	self assert: [ select checkValidity ].
	self assert: [ select reportValidity ].
	select setCustomValidity: 'myError'.
	self assert: [ select validity customError ].
!
CLASS TestHtmlSlotElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| document slot paragraph |
	document := Document new.
	slot := document createElement: 'slot'.
	self assert: [ slot class = HtmlSlotElement ].

	self assert: [ slot name = '' ].
	slot name: 'slot-name'.
	self assert: [ slot name = 'slot-name' ].

	paragraph := ( document createElement: 'p' ) textContent: 'Slot text'.
	"This wont work, need to create shadow DOM."
	slot assign: paragraph.

	self assert: [ slot assignedElements length = 0 ].
	self assert: [ slot assignedNodes length = 0 ].
!
CLASS TestHtmlTemplateElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| document template span |
	document := Document new.

	template := document createElement: 'template'.
	self assert: [ template class = HtmlTemplateElement ].
	template content appendChild: ( document createTextNode: 'Template text' ).

	span := document createElement: 'span'.
	self assert: [ span class = HtmlSpanElement ].

	span appendChild: ( template content cloneNode: true ).
	self assert: [ span firstChild textContent = 'Template text' ].

	template content appendChild: ( document createTextNode: 'Template text2' ).
	span appendChild: template cloneContent.
	self assert: [ span lastChild textContent = 'Template text2' ].
!
CLASS TestHtmlTextAreaElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| textArea |
	textArea := Document new createElement: 'textarea'.
	self assert: [ textArea class = HtmlTextAreaElement ].

	self assert: [ textArea placeholder = '' ].
	textArea placeholder: 'Enter text here'.
	self assert: [ textArea placeholder = 'Enter text here' ].

	self assert: [ textArea value = '' ].
	textArea defaultValue: 'zz'.
	self assert: [ textArea defaultValue = 'zz' ].

	self assert: [ textArea value = 'zz' ].
	textArea value: 'aa\nbb'.
	self assert: [ textArea value = 'aa\nbb' ].

	self assert: [ textArea autocapitalize = '' ].
	textArea autocapitalize: 'none'.
	self assert: [ textArea autocapitalize = 'none' ].

	self assert: [ textArea autofocus not ].
	textArea autofocus: true.
	self assert: [ textArea autofocus ].

	self assert: [ textArea cols = 20 ].
	textArea cols: 30.
	self assert: [ textArea cols = 30 ].

	self assert: [ textArea rows = 2 ].
	textArea rows: 3.
	self assert: [ textArea rows = 3 ].

	self assert: [ textArea disabled not ].
	textArea disabled: true.
	self assert: [ textArea disabled ].

	self assert: [ textArea form isNil ].

	self assert: [ textArea minLength = -1 ].
	textArea minLength: 4.
	self assert: [ textArea minLength = 4 ].

	self assert: [ textArea maxLength = -1 ].
	textArea maxLength: 98.
	self assert: [ textArea maxLength = 98 ].

	self assert: [ textArea readOnly not ].
	textArea readOnly: true.
	self assert: [ textArea readOnly ].

	self assert: [ textArea required not ].
	textArea required: true.
	self assert: [ textArea required ].

	textArea select.
	self assert: [ textArea selectionStart = 0 ].
	textArea selectionStart: 3.
	self assert: [ textArea selectionStart = 3 ].

	self assert: [ textArea selectionEnd = 5 ].
	textArea selectionEnd: 4.
	self assert: [ textArea selectionEnd = 4 ].

	textArea setSelectionRange: 1 to: 3.
	self assert: [ textArea selectionStart = 1 ].
	self assert: [ textArea selectionEnd = 3 ].

	self assert: [ #( 'forward' 'none' ) includes: textArea selectionDirection ].
	textArea selectionDirection: 'backward'.
	self assert: [ textArea selectionDirection = 'backward' ].

	self assert: [ textArea textLength = 5 ].
	self assert: [ textArea validationMessage = '' ].
	self assert: [ textArea validity class = ValidityState ].
	self assert: [ textArea willValidate not ].
	self assert: [ textArea reportValidity ].

	self assert: [ textArea checkValidity ].
	textArea setCustomValidity: 'Custom error'.
	self assert: [ textArea checkValidity ].
	textArea setCustomValidity: ''.
	self assert: [ textArea checkValidity ].

	textArea setRangeText: 'AA' start: 0 end: 2.
	self assert: [ textArea value = 'AA\nbb' ].

	self assert: [ textArea wrap = '' ].
	textArea wrap: 'soft'.
	self assert: [ textArea wrap = 'soft' ].

	self assert: [ textArea labels length = 0 ].
!
CLASS TestHtmlTitleElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| document title |
	document := Document new.
	document title: 'My title'.

	title := document querySelector: 'title'.
	self assert: [ title class = HtmlTitleElement ].
	self assert: [ title text = 'My title' ].
	title text: 'New title'.
	self assert: [ title text = 'New title' ].
	self assert: [ document title = 'New title' ].
!
CLASS TestDocument EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testProperties
	| document element paragraph |
	document := Document new.
	self assert: [ document class = Document ].

	self assert: [ document hasFocus not ].
	self assert: [ document activeElement class = HtmlBodyElement ].

	self assert: [ document head class = HtmlHeadElement ].
	self assert: [ document body class = HtmlBodyElement ].
	document body: document body.

	self assert: [ document characterSet = 'UTF-8' ].
	self assert: [ document doctype class = DocumentType ].
	self assert: [ document documentElement class = HtmlHtmlElement ].
	self assert: [ document contentType = 'text/html' ].
	self assert: [ document documentUri = 'about:blank' ].

	self assert: [ document childElementCount = 1 ].
	self assert: [ document children length = 1 ].
	self assert: [ document children first class = HtmlHtmlElement ].
	self assert: [ document firstElementChild class = HtmlHtmlElement ].
	self assert: [ document lastElementChild class = HtmlHtmlElement ].

	self assert: [ document hidden class = Boolean ].
	self assert: [ #( 'visible' 'hidden' ) includes: document visibilityState ].
	self assert: [ document fullscreenElement = nil ].
	self assert: [ document pointerLockElement = nil ].

	self assert: [ document embeds length = 0 ].
	self assert: [ document forms length = 0 ].
	self assert: [ document images length = 0 ].
	self assert: [ document links length = 0 ].
	self assert: [ document plugins length = 0 ].
	self assert: [ document scripts length = 0 ].
	self assert: [ document styleSheets length = 0 ].
!
testHtmlProperties
	| document |
	document := Document new.

	"This fails for locally created document:
	document cookie: 'name=chocolateChip'.
	self assert: [ document cookie = 'name=chocolateChip' ]."

	self assert: [ document defaultView isNil ].

	self assert: [ document designMode = 'off' ].
	Window isFirefox ifFalse: [
		document designMode: 'on'.
		self assert: [ document designMode = 'on' ] ].
	document designMode: 'off'.

	"JS Document.dir is initially an empty string iso one of the allowed values."
	document dir: 'rtl'.
	self assert: [ document dir = 'rtl' ].
	document dir: 'ltr'.
	self assert: [ document dir = 'ltr' ].

	self assert: [ document lastModified length > 8 ].
	self assert: [ document location isNil ].
	self assert: [ #( 'loading' 'interactive' 'complete' ) includes: document readyState ].
	self assert: [ document referrer = '' or: [ document referrer startsWith: 'http' ] ].

	self assert: [ document title = '' ].
	document title: 'Document title'.
	self assert: [ document title = 'Document title' ].
	document title: ''.

	self assert: [ document url = 'about:blank' ].
!
testMethods
	| document paragraph |
	document := Document new.

	self assert: [ ( document createAttribute: 'myAttr' ) class = Attr ].
	self assert: [ ( document createComment: 'myComment' ) class = Comment ].
	self assert: [ document createDocumentFragment class = DocumentFragment ].
	self assert: [ ( document createElement: 'unknown' ) class = HtmlUnknownElement ].
	self assert: [ ( document createElement: 'p' ) class = HtmlParagraphElement ].
	self assert: [ document createRange class = Range ].
	self assert: [ ( document createTextNode: 'myText' ) class = Text ].

	paragraph := ( document createElement: 'p' )
		id: 'paragraphId';
		className: 'paragraphClass'.
	document body appendChild: paragraph.

	self assert: [ ( document getElementById: 'paragraphId' class: HtmlParagraphElement ) id = 'paragraphId' ].
	self assert: [ ( document getElementsByName: 'paragraphName' ) length = 0 ].
	self assert: [ ( document getElementsByClassName: 'paragraphClass' ) first className = 'paragraphClass' ].
	self assert: [ ( document getElementsByTagName: 'p' ) first class = HtmlParagraphElement ].
	self assert: [ document getSelection isNil ].
!
testNodeMethods
	| document newDocument newNode adoptedNode importedNode |
	document := Document new.

	newDocument := Document new.
	newNode := ( newDocument createElement: 'p' ) textContent: 'Adopted paragraph.'.
	newDocument body appendChild: newNode.
	self assert: [ newDocument body children length = 1 ].

	adoptedNode := document adoptNode: newNode.
	self assert: [ adoptedNode class = HtmlParagraphElement ].
	self assert: [ newDocument body children length = 0 ].

	newNode := ( newDocument createElement: 'p' ) textContent: 'Imported paragraph.'.
	importedNode := document importNode: newNode deep: true.
	self assert: [ importedNode class = HtmlParagraphElement ].
!
testQuery
	| document |
	document := Document new.

	document body appendChild: ( document createElement: 'p' ).
	self assert: [ ( document querySelector: 'p' ) class = HtmlParagraphElement ].
	self assert: [ ( document querySelectorAll: 'p' ) length = 1 ].
!
testWriting
	| document |
	document := Document new.

	document open.
	document writeln: '<p>Hello world!</p>'.
	document write: '<p>The number is 42.</p>'.
	document close.

	self assert: [ ( document querySelectorAll: 'p' ) length = 2 ].
!
testPage
	| document |
	document := Document new.

	self assert: [ document documentUri = 'about:blank' ].
	self assert: [ document contentType = 'text/html' ].
	self assert: [ document characterSet = 'UTF-8' ].
!
CLASS TestDocumentFragment EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| documentFragment elementArray |
	documentFragment := DocumentFragment new.

	documentFragment append: ( Document default createElement: 'label' ).
	documentFragment append: ( Document default createElement: 'input' ).
	documentFragment prepend: ( Document default createElement: 'p' ).

	self assert: [ documentFragment childElementCount = 3 ].
	self assert: [ documentFragment firstElementChild class = HtmlParagraphElement ].
	self assert: [ ( documentFragment children at: 1 ) class = HtmlLabelElement ].
	self assert: [ documentFragment lastElementChild class = HtmlInputElement ].

	self assert: [ ( documentFragment querySelector: 'label' ) class = HtmlLabelElement ].
	self assert: [ ( documentFragment querySelectorAll: 'input' ) first class = HtmlInputElement ].

	elementArray := Array with: ( Document default createElement: 'p' ).
	documentFragment replaceChildren: elementArray.
	self assert: [ documentFragment firstElementChild class = HtmlParagraphElement ].
!
CLASS TestDocumentType EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testDocumentTypeProperties
	| documentType |
	documentType := Document default doctype.
	self assert: [ documentType class = DocumentType ].
	self assert: [ documentType name = 'html' ].
	self assert: [ documentType publicId = '' ].	"HTML5"
	self assert: [ documentType systemId = '' ].	"HTML5"
!
testDocumentTypeMethods
	"Methods before, after and replaceWith place nodes in the document.
	 They seem duplicates of document functionality and not usefull for HTML documents."
!
CLASS TestShadowRoot EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| document shadow paragraph  |

	document := Document new.
	shadow := document body shadowRoot.
	shadow isNil ifTrue: [
		shadow := document body attachShadow: 'open' delegatesFocus: false ].
	self assert: [ shadow class = ShadowRoot ].

	"Create test shadow root document."
	paragraph := ( Document default createElement: 'p' ) textContent: 'New paragraph within shadow root'.
	shadow appendChild: paragraph.
	self assert: [ shadow firstElementChild class = HtmlParagraphElement ].

	"Test properties."

	self assert: [ shadow activeElement isNil ].
	self assert: [ shadow adoptedStyleSheets length = 0 ].
	self assert: [ shadow delegatesFocus not ].
	self assert: [ shadow fullscreenElement = nil ].
	self assert: [ shadow host class = HtmlBodyElement ].
	self assert: [ shadow innerHtml startsWith: '<p>' ].
	self assert: [ shadow mode = 'open' ].
	self assert: [ shadow pointerLockElement isNil ].
	self assert: [ shadow styleSheets length = 0 ].

	"Test methods."

	self assert: [ shadow getAnimations length = 0 ].
!
CLASS TestCssStyleSheet EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| cssStyleSheet ruleText index |

	cssStyleSheet := CssStyleSheet new.
	self assert: [ cssStyleSheet class = CssStyleSheet ].
	self assert: [ cssStyleSheet ownerRule isNil ].

	ruleText := '.italicBold { font-style: italic; font-weight: bold; }'.
	cssStyleSheet insertRule: ruleText index: index.
	index := cssStyleSheet findStyleRuleIndex: '.italicBold'.
	self assert: [ index >= 0 ].

	cssStyleSheet deleteRule: index.
	self assert: [ cssStyleSheet cssRules length = 0 ].
!
CLASS TestStyleSheet EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| styleSheet |

	styleSheet := CssStyleSheet new.
	"Note: The StyleSheet class is never used by itself, only CssStyleSheet."
	self assert: [ styleSheet class = CssStyleSheet ].

	self assert: [ styleSheet disabled not ].
	styleSheet disabled: true.
	self assert: [ styleSheet disabled ].
	styleSheet disabled: false.

	self assert: [ styleSheet href isNil ].
	self assert: [ styleSheet media class = MediaList ].
	self assert: [ styleSheet ownerNode isNil ].
	self assert: [ styleSheet title = '' ].
	self assert: [ styleSheet type = 'text/css' ].
!
CLASS TestCssRule EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Note: This class tests all the CssRule* classes."

testCssRule
	| cssStyleSheet ruleText cssRule |

	cssStyleSheet := CssStyleSheet new.
	cssStyleSheet replace: '.italicBold { font-style: italic; font-weight: bold; }'.
	cssRule := cssStyleSheet cssRules first.

	self assert: [ cssRule cssText = '.italicBold { font-style: italic; font-weight: bold; }' ].
	self assert: [ cssRule parentRule = nil ].
	self assert: [ cssRule parentStyleSheet = cssStyleSheet ].
!
CLASS TestCanvasRenderingContext2d EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"Also tests classes CanvasGradient and CanvasPattern."

testProperties
	| canvas context  |

	canvas := Document default createElement: 'canvas'.
	self assert: [ canvas class = HtmlCanvasElement ].

	context := canvas getContext2d.
	self assert: [ context class = CanvasRenderingContext2d ].

	self assert: [ context canvas = canvas ].

	self assert: [ #( 'ltr' 'inherit' ) includes: context direction  ].
	context direction: 'rtl'.
	self assert: [ context direction = 'rtl' ].

	self assert: [ context fillStyle = '#000000' ].
	context fillStyle: '#808182'.
	self assert: [ context fillStyle = '#808182' ].

	self assert: [ context font = '10px sans-serif' ].
	context font: '48px serif'.
	self assert: [ context font = '48px serif' ].

	self assert: [ context fontKerning = 'auto' ].
	context fontKerning: 'normal'.
	self assert: [ context fontKerning = 'normal' ].

	self assert: [ context fontStretch = 'normal' ].
	context fontStretch: 'expanded'.
	self assert: [ context fontStretch = 'expanded' ].

	self assert: [ context globalAlpha = 1.0 ].
	context globalAlpha: 0.5.
	self assert: [ context globalAlpha = 0.5 ].

	self assert: [ context globalCompositeOperation = 'source-over' ].
	context globalCompositeOperation: 'source-in'.
	self assert: [ context globalCompositeOperation = 'source-in' ].

	self assert: [ context imageSmoothingEnabled ].
	context imageSmoothingEnabled: false.
	self assert: [ context imageSmoothingEnabled not ].

	self assert: [ context letterSpacing = '0px' ].
	context letterSpacing: '2px'.
	self assert: [ context letterSpacing = '2px' ].

	self assert: [ context lineCap = 'butt' ].
	context lineCap: 'round'.
	self assert: [ context lineCap = 'round' ].

	self assert: [ context lineDashOffset = 0 ].
	context lineDashOffset: 4.
	self assert: [ context lineDashOffset = 4 ].

	self assert: [ context lineJoin = 'miter' ].
	context lineJoin: 'round'.
	self assert: [ context lineJoin = 'round' ].

	self assert: [ context lineWidth = 1 ].
	context lineWidth: 2.
	self assert: [ context lineWidth = 2 ].

	self assert: [ context shadowBlur = 0 ].
	context shadowBlur: 15.
	self assert: [ context shadowBlur = 15 ].

	self assert: [ context shadowColor = 'rgba(0, 0, 0, 0)' ].
	context shadowColor: 'red'.
	self assert: [ context shadowColor = '#ff0000' ].

	self assert: [ context shadowOffset = ( 0 @ 0 ) ].
	context shadowOffset: ( 1 @ 2 ).
	self assert: [ context shadowOffset = ( 1 @ 2 ) ].

	self assert: [ context strokeStyle = '#000000' ].
	context strokeStyle: '#123456'.
	self assert: [ context strokeStyle = '#123456' ].

	self assert: [ context textAlign = 'start' ].
	context textAlign: 'center'.
	self assert: [ context textAlign = 'center' ].

	self assert: [ context textBaseline = 'alphabetic' ].
	context textBaseline: 'top'.
	self assert: [ context textBaseline = 'top' ].

	self assert: [ context textRendering = 'auto' ].
	context textRendering: 'optimizeSpeed'.
	self assert: [ context textRendering = 'optimizeSpeed' ].

	self assert: [ context wordSpacing = '0px' ].
	context wordSpacing: '3px'.
	self assert: [ context wordSpacing = '3px' ].
!
testMethods
	"Note:
	 Only methods that return a result are tested here.
	 Methods that draw on the canvas are tested visually in CanvasComponent."

	| canvas context imageData pattern gradient attributes lineDash matrix textMetrics contextAttributes |

	canvas := Document default createElement: 'canvas'.
	self assert: [ canvas class = HtmlCanvasElement ].

	context := canvas getContext2d.
	self assert: [ context class = CanvasRenderingContext2d ].

	imageData := context getImageData: ( Rect origin: ( 20 @ 10 ) extent: ( 40 @ 30 ) ).
	self assert: [ imageData class = ImageData ].

	imageData := context createImageData: ( 20 @ 10 ).
	self assert: [ imageData class = ImageData ].

	pattern := context createPattern: canvas repetition: 'repeat'.
	self assert: [ pattern class = CanvasPattern ].

	gradient := context createLinearGradientFrom: ( 10 @ 20 ) to: ( 30 @ 40 ).
	self assert: [ gradient class = CanvasGradient ].
	gradient addColorStop: 0.5 color: 'green'.

	gradient := context createRadialGradientFrom: ( 10 @ 20 ) radius: 5 to: ( 30 @ 40 ) radius: 15.
	self assert: [ gradient class = CanvasGradient ].

	lineDash := context getLineDash.
	self assert: [ lineDash = #( ) ].

	matrix := context getTransform.
	self assert: [ matrix isIdentity ].

	self assert: [ context isContextLost not ].
	self assert: [ ( context isPointInPath: ( 10 @ 0 ) ) not ].
	self assert: [ ( context isPointInStroke: ( 10 @ 0 ) ) not ].

	textMetrics := context measureText: 'Hello world'.
	self assert: [ textMetrics class = TextMetrics ].

	contextAttributes := context getContextAttributes.
	self assert: [ contextAttributes class = ContextAttributes ].
!
CLASS TestContextAttributes EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| context contextAttributes |
	context := ( Document default createElement: 'canvas' ) getContext2d.
	contextAttributes := context getContextAttributes.
	self assert: [ contextAttributes class = ContextAttributes ].

	self assert: [ contextAttributes alpha ].
	self assert: [ contextAttributes colorSpace = 'srgb' ].
	self assert: [ contextAttributes desynchronized not ].
	self assert: [ contextAttributes willReadFrequently not ].
!
CLASS TestDomMatrix EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"2D testing"

test2dReadOnly
	| matrix jsObject matrix2 point |

	matrix := DomMatrix new.
	self assert: [ matrix is2d ].
	self assert: [ matrix isIdentity ].

	matrix := DomMatrix init: #( 1 2 3 4 5 6 ).
	self assert: [ matrix is2d ].
	self assert: [ matrix isIdentity not ].
	self assert: [ matrix toString = 'matrix(1, 2, 3, 4, 5, 6)' ].
	self assert: [ matrix a = 1 ].
	self assert: [ matrix b = 2 ].
	self assert: [ matrix c = 3 ].
	self assert: [ matrix d = 4 ].
	self assert: [ matrix e = 5 ].
	self assert: [ matrix f = 6 ].

	jsObject := matrix toJson.
	self assert: [ ( jsObject atJsProperty: 'a' ) = 1 ].
	self assert: [ ( jsObject atJsProperty: 'b' ) = 2 ].
	self assert: [ ( jsObject atJsProperty: 'c' ) = 3 ].
	self assert: [ ( jsObject atJsProperty: 'd' ) = 4 ].
	self assert: [ ( jsObject atJsProperty: 'e' ) = 5 ].
	self assert: [ ( jsObject atJsProperty: 'f' ) = 6 ].

	matrix2 := matrix flipX.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( -1 -2 3 4 5 6 ) ) precision: 0.001 ].

	matrix2 := matrix flipY.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 1 2 -3 -4 5 6 ) ) precision: 0.001 ].

	matrix2 := matrix inverse.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( -2 1 1.5 -0.5 1 -2 ) ) precision: 0.001 ].

	matrix2 := matrix multiply: matrix.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 7 10 15 22 28 40 ) ) precision: 0.001 ].

	matrix2 := matrix rotateAxis: ( 1 @ 0 @ 0 ) angle: 90.
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 1 2 0 0 0 0 1 0 -3 -4 0 0 5 6 0 1 ) ) precision: 0.001 ].

	matrix2 := matrix rotate: 90.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 3 4 -1 -2 5 6 ) ) precision: 0.001 ].

	matrix2 := matrix rotateFromVector: ( 1 @ 0 @ 0 ).
	self assert: [ ( matrix2 a = 1 ) & ( matrix2 b = 2 ) ].

	matrix2 := matrix scale: ( 2 @ 2 @ 2 ).
	self assert: [ ( matrix2 a * 10 ) toInteger = 11 ].

	point := matrix transformPoint: 1 @ 2 @ 3.
	self assert: [ ( matrix transformPoint: 1 @ 2 @ 3 ) = ( 12 @ 16 @ 3 ) ].

	matrix2 := matrix translate: ( 1 @ 2 @ 3 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 1 2 0 0 3 4 0 0 0 0 1 0 12 16 3 1 ) ) precision: 0.001 ].
!
test2dMutating
	| matrix matrix2 point |

	matrix := DomMatrix init: #( 1 2 3 4 5 6 ).

	matrix2 := matrix copy invertSelf.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( -2 1 1.5 -0.5 1 -2 ) ) precision: 0.001 ].

	matrix2 := matrix copy multiplySelf: matrix copy.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 7 10 15 22 28 40 ) ) precision: 0.001 ].

	matrix2 := matrix copy preMultiplySelf: matrix copy.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 7 10 15 22 28 40 ) ) precision: 0.001 ].

	matrix2 := matrix copy translateSelf: ( 1 @ 2 @ 3 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 1 2 0 0 3 4 0 0 0 0 1 0 12 16 3 1 ) ) precision: 0.001 ].

	matrix2 := matrix copy scaleSelf: 2.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 2 4 6 8 5 6 ) ) precision: 0.001 ].

	matrix2 := matrix copy scaleSelf: 3 origin: ( 1 @ 2 @ 3 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 3 6 0 0 3 4 0 0 0 0 2 0 -1 -6 0 1 ) ) precision: 0.001 ].

	matrix2 := matrix copy scale3dSelf: ( 2 @ 3 @ 4 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 2 4 0 0 6 8 0 0 0 0 2 0 -10 -16 0 1 ) ) precision: 0.001 ].

	matrix2 := matrix copy scale3dSelf: ( 2 @ 3 @ 4 ) origin: ( 1 @ 2 @ 3 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 2 4 0 0 6 8 0 0 0 0 2 0 -10 -16 -1 1 ) ) precision: 0.001 ].

	matrix2 := matrix copy rotateSelf: ( 45 @ 45 @ 45 ).
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 2 3 -0.70 0 2.41 3.12 0.5 0 0.41 1.12 0.5 0 5 6 0 1 ) ) precision: 0.1 ].

	matrix2 := matrix copy rotateAxisAngleSelf: ( 1 @ 2 @ 3 ) degrees: 90.
	self assert: [ matrix2 equals3d: ( DomMatrix init: #( 2.90 3.92 -0.32 0 0.19 -0.17 0.69 0 1.23 2.14 0.64 0 5 6 0 1 ) ) precision: 0.1 ].

	matrix2 := matrix copy rotateFromVectorSelf: ( 1 @ 2 @ 3 ).
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 3.13 4.47 0.44 0 5 6 ) ) precision: 0.1 ].

	matrix2 := DomMatrix new setMatrixValue: 'scale( 2 )'.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 2 0 0 2 0 0 ) ) precision: 0.001 ].

	matrix2 := matrix copy skewXSelf: 10.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 1 2 3.17 4.35 5 6 ) ) precision: 0.1 ].

	matrix2 := matrix copy skewYSelf: 20.
	self assert: [ matrix2 equals2d: ( DomMatrix init: #( 2.09 3.45 3 4 5 6 ) ) precision: 0.1 ].
!

"3D testing"

test3d
	| matrix jsObject |

	matrix := DomMatrix init: #( 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ).
	self assert: [ matrix is3d ].
!

"TODO: more...?"
CLASS TestDomPoint EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testConversion
	| domPoint domPoint2 jsObject |

	domPoint := DomPoint fromPoint: 1 @ 2.
	self assert: [ domPoint toPoint = ( 1 @ 2 ) ].

	domPoint := DomPoint fromPoint3d: 1 @ 2 @ 3.
	self assert: [ domPoint toPoint = ( 1 @ 2 @ 3 ) ].
!
testReadonly
	| domPoint domPoint2 jsObject |

	domPoint := DomPoint x: 1 y: 2.
	self assert: [ domPoint x = 1 ].
	self assert: [ domPoint y = 2 ].

	domPoint := DomPoint x: 3 y: 4 z: 5.
	self assert: [ domPoint x = 3 ].
	self assert: [ domPoint y = 4 ].
	self assert: [ domPoint z = 5 ].

	domPoint := DomPoint x: 6 y: 7 z: 8 w: 9.
	self assert: [ domPoint x = 6 ].
	self assert: [ domPoint y = 7 ].
	self assert: [ domPoint z = 8 ].
	self assert: [ domPoint w = 9 ].

	jsObject := domPoint toJson.
	self assert: [ ( jsObject atJsProperty: 'x' ) = 6 ].
	self assert: [ ( jsObject atJsProperty: 'y' ) = 7 ].
	self assert: [ ( jsObject atJsProperty: 'z' ) = 8 ].
	self assert: [ ( jsObject atJsProperty: 'w' ) = 9 ].

	domPoint2 := domPoint copy.
	self assert: [ domPoint2 x = 6 ].
	self assert: [ domPoint2 y = 7 ].
	self assert: [ domPoint2 z = 8 ].
	self assert: [ domPoint2 w = 9 ].
!
testMutable
	| domPoint domPoint2 |

	domPoint := DomPoint x: 0 y: 0.
	domPoint x: 1.
	self assert: [ domPoint x = 1 ].
	domPoint y: 2.
	self assert: [ domPoint y = 2 ].

	domPoint := DomPoint x: 0 y: 0 z: 0.
	domPoint x: 3.
	self assert: [ domPoint x = 3 ].
	domPoint y: 4.
	self assert: [ domPoint y = 4 ].
	domPoint z: 5.
	self assert: [ domPoint z = 5 ].

	domPoint := DomPoint x: 0 y: 0 z: 0 w: 0.
	domPoint x: 6.
	self assert: [ domPoint x = 6 ].
	domPoint y: 7.
	self assert: [ domPoint y = 7 ].
	domPoint z: 8.
	self assert: [ domPoint z = 8 ].
	domPoint w: 9.
	self assert: [ domPoint w = 9 ].
!
CLASS TestHtmlCanvasElement EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| canvas context url offscreenCanvas |
	canvas := Document default createElement: 'canvas'.
	self assert: [ canvas class = HtmlCanvasElement ].

	self assert: [ canvas width = 300 ].
	canvas width: 200.
	self assert: [ canvas width = 200 ].

	self assert: [ canvas height = 150 ].
	canvas height: 100.
	self assert: [ canvas height = 100 ].

	self assert: [ canvas size = ( 200 @ 100 ) ].
	canvas size: ( 100 @ 50 ).
	self assert: [ canvas size = ( 100 @ 50 ) ].

	context := canvas getContext: '2d'.
	self assert: [ context class = CanvasRenderingContext2d ].
	context := canvas getContext2d.
	self assert: [ context class = CanvasRenderingContext2d ].

	canvas toBlobType: 'image/png' quality: 1.0
		then: [ :blob | self onToBlob: blob ].

	url := canvas toDataUrlType: 'image/png' quality: 1.0.
	self assert: [ url startsWith: 'data:image/png;' ].

	"Must create fresh canvas to test method transferControlToOffscreen."
	canvas := Document default createElement: 'canvas'.
	self assert: [ canvas class = HtmlCanvasElement ].
	offscreenCanvas := canvas transferControlToOffscreen.
	self assert: [ offscreenCanvas class = OffscreenCanvas ].
!
onToBlob: blob
	"Note: Different browsers encode differently."
	self assert: [ blob size > 100 ].
	self assert: [ blob type = 'image/png' ].
!
CLASS TestImageBitmap EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

async test
	| context imageData imageBitmap |
	context := ( Document default createElement: 'canvas' ) getContext2d.
	imageData := context getImageData: ( Rect origin: ( 20 @ 10 ) extent: ( 40 @ 30 ) ).
	self assert: [ imageData class = ImageData ].

	imageBitmap := await ImageBitmap create: imageData.
	self assert: [ imageBitmap class = ImageBitmap ].

	self assert: [ imageBitmap width = 40 ].
	self assert: [ imageBitmap height = 30 ].
	self assert: [ imageBitmap extent = ( 40 @ 30 ) ].

	imageBitmap close.
!
CLASS TestImageData EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| context imageData |
	context := ( Document default createElement: 'canvas' ) getContext2d.
	imageData := context getImageData: ( Rect origin: ( 20 @ 10 ) extent: ( 40 @ 30 ) ).
	self assert: [ imageData class = ImageData ].

	self assert: [ imageData data length = 4800 ].
	self assert: [ imageData width = 40 ].
	self assert: [ imageData height = 30 ].
	self assert: [ imageData extent = ( 40 @ 30 ) ].

	imageData := context createImageData: ( 20 @ 10 ).
	self assert: [ imageData class = ImageData ].

	self assert: [ imageData width = 20 ].
	self assert: [ imageData height = 10 ].
	self assert: [ imageData extent = ( 20 @ 10 ) ].
	self assert: [ imageData pixelLength = 200 ].

	imageData atPixel: 0 @ 0 put: #( 3 4 5 6 ).
	self assert: [ ( imageData atPixel: 0 @ 0 ) = #( 3 4 5 6 ) ].
!
CLASS TestPath2d EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"The methods of class Path2d are visually tested in Component.
 No unit tests at the moment."

CLASS TestTextMetrics EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| context textMetrics |
	context := ( Document default createElement: 'canvas' ) getContext2d.
	textMetrics := context measureText: 'Hello world'.
	self assert: [ textMetrics class = TextMetrics ].

	self assert: [ textMetrics width > 40 ].

	self assert: [ textMetrics actualBoundingBoxLeft > -100 ].
	self assert: [ textMetrics actualBoundingBoxRight >= 40 ].
	self assert: [ textMetrics actualBoundingBoxAscent >= 5 ].
	self assert: [ textMetrics actualBoundingBoxDescent >= 0 ].

	self assert: [ textMetrics fontBoundingBoxAscent >= 5 ].
	self assert: [ textMetrics fontBoundingBoxDescent >= 0 ].

	self assert: [ textMetrics hangingBaseline >= 5 ].
	self assert: [ textMetrics alphabeticBaseline = 0 ].
	self assert: [ textMetrics ideographicBaseline < -0.5 ].
!
CLASS TestDomImplementation EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testCreateDocumentType
	| documentType |
	documentType := Document default implementation
		createDocumentType: 'svg:svg' publicId: '-//W3C//DTD SVG 1.1//EN' systemId: 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'.
	self assert: [ documentType name = 'svg:svg' ].
!
testCreateHtmlDocument
	| document |
	document := Document default implementation createHtmlDocument.
	self assert: [ document class name = 'Document' ].
!
CLASS TestDomTokenList EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| paragraph domTokenList |

	self assertError: [ DomTokenList new ].

	paragraph := Document default createElement: 'p'.
	domTokenList := paragraph classList.
	self assert: [ domTokenList class = DomTokenList ].

	domTokenList add: 'a'; add: 'b'; add: 'c'.
	self assert: [ domTokenList length = 3 ].
	self assert: [ domTokenList value = 'a b c' ].
	self assert: [ domTokenList contains: 'b' ].
	self assert: [ domTokenList entries = #( '0,a' '1,b' '2,c' ) ].
	self assert: [ ( domTokenList item: 1 ) = 'b' ].
	self assert: [ domTokenList keys last = 2 ].

	domTokenList remove: 'b'.
	self assert: [ ( domTokenList contains: 'b' ) not ].

	domTokenList replace: 'c' with: 'd'.
	self assert: [ domTokenList contains: 'd' ].

	domTokenList toggle: 'd'.
	self assert: [ ( domTokenList contains: 'd' ) not ].
	self assert: [ domTokenList values = #( 'a' ) ].

	self assertError: [ domTokenList supports: 'some-new-feature' ].
!
CLASS TestLocation EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

testProperties
	| location |
	location := Document default location.

	self assert: [ location class = Location ].

	self assert: [ location href includes: location origin ].
	self assert: [ location href includes: location protocol ].
	self assert: [ location origin includes: location host ].
	self assert: [ location host includes: location hostname ].

	self assert: [ location pathname startsWith: '/' ].
	self assert: [ location search = '' or: [ location search startsWith: '?' ] ].
!
testMethods
	| location |
	location := Document default location.

	"These methods are too disruptive to be tested here:
		assign: , replace: , reload ."

	self assert: [ location href = location toString ].

!
CLASS TestNamedNodeMap EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| document input namedNodeMap attr |
	document := Document new.

	input := document createElement: 'input'.
	self assert: [ input class = HtmlInputElement ].
	input id: 'myInput'; type: 'checkbox'; readOnly: true.

	namedNodeMap := input attributes.
	self assert: [ namedNodeMap length = 3 ].
	self assert: [ ( namedNodeMap getNamedItem: 'type' ) value = 'checkbox' ].
	self assert: [ ( namedNodeMap item: 1 ) name = 'id' ].

	"Attribute name should be lowercase."
	attr := document createAttribute: 'my-name'.
	attr value: 'myValue'.
	namedNodeMap setNamedItem: attr.
	self assert: [ ( namedNodeMap getNamedItem: 'my-name' ) value = 'myValue' ].

	namedNodeMap removeNamedItem: 'my-name'.
	self assert: [ ( namedNodeMap getNamedItem: 'my-name' ) = nil ].
!
CLASS TestRange EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

"This class also tests AbstractRange."

METHODS

test
	| document div p1 p2 p3 p4 range range2 documentFragment div2 |

	document := Document new.

	div := document createElement: 'div'.
	self assert: [ div class = HtmlDivElement ].
	document body appendChild: div.

	p1 := ( document createElement: 'p' ) id: 'p1'.
	self assert: [ p1 class = HtmlParagraphElement ].
	div appendChild: p1.

	p2 := ( document createElement: 'p' ) id: 'p2'.
	self assert: [ p2 class = HtmlParagraphElement ].
	div appendChild: p2.

	p3 := ( document createElement: 'p' ) id: 'p3'.
	self assert: [ p3 class = HtmlParagraphElement ].
	div appendChild: p3.

	range := document createRange.

	self assert: [ range commonAncestorContainer = document ].
	self assert: [ range collapsed = true ].
	self assert: [ range endContainer = document ].
	self assert: [ range endOffset = 0 ].
	self assert: [ range startContainer = document ].
	self assert: [ range startOffset = 0 ].

	range setStart: p1 offset: 0.
	self assert: [ range startContainer id = 'p1' ].
	range setEnd: p3 offset: 0.
	self assert: [ range endContainer id = 'p3' ].

	self assert: [ range commonAncestorContainer class = HtmlDivElement ].
	self assert: [ range collapsed = false ].
	range collapse.
	self assert: [ range collapsed = true ].
	range collapseToStart.
	self assert: [ range collapsed = true ].

	range setStart: p1 offset: 0.
	range setEnd: p3 offset: 0.
	self assert: [ ( range comparePoint: p2 offset: 0 ) = 0 ].
	range2 := Range new selectNode: p2.
	self assert: [ ( range compareBoundaryPoints: 0 with: range2 ) = -1 ].

	documentFragment := range cloneContents.
	self assert: [ documentFragment children length = 3 ].

	range2 := range cloneRange.
	self assert: [ range2 class = Range ].
	self assert: [ range2 endContainer class = HtmlParagraphElement ].

	documentFragment := range createContextualFragment: '<div>I am a div node</div>'.
	self assert: [ documentFragment firstElementChild class = HtmlDivElement ].

	"Test deleteContents"
	p4 := ( document createElement: 'p' ) id: 'p4'.
	div appendChild: p4.
	self assert: [ div childElementCount = 4 ].
	range2 := Range new selectNode: div lastElementChild.
	range2 deleteContents.
	self assert: [ div childElementCount = 3 ].

	"Test extractContents"
	p4 := ( document createElement: 'p' ) id: 'p4'.
	div appendChild: p4.
	self assert: [ div childElementCount = 4 ].
	range2 := Range new selectNode: div lastElementChild.
	documentFragment := range2 extractContents.
	self assert: [ documentFragment firstElementChild id = 'p4' ].
	self assert: [ div childElementCount = 3 ].

	"Test client rectangles"
	range := Range new selectNode: p1.
	self assert: [ range getBoundingClientRect extent = ( 0 @ 0 ) ].
	self assert: [ range getClientRects isEmpty ].
	self assert: [ range isPointInRange: p1 offset: 0 ].

	"Test insertNode"
	range := Range new selectNode: p1.
	p4 := ( document createElement: 'p' ) id: 'p4'.
	range insertNode: p4.
	self assert: [ div childElementCount = 4 ].
	p4 remove.
	self assert: [ div childElementCount = 3 ].

	self assert: [ range intersectsNode: p1 ].

	"Test surroundContents"
	p4 := ( document createElement: 'p' ) id: 'p4'.
	div appendChild: p4.
	self assert: [ div childElementCount = 4 ].
	div2 := document createElement: 'div'.
	self assert: [ div class = HtmlDivElement ].
	div appendChild: div2.
	self assert: [ div childElementCount = 5 ].
	range := Range new selectNode: p4.
	range surroundContents: div2.
	self assert: [ div childElementCount = 4 ].
	self assert: [ div2 children first id = 'p4' ].
	div lastElementChild remove.
!
CLASS TestSelection EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

METHODS

test
	| document selection range selectionInput selectionResultLabel text |

	"Limited testing here.
	Selections need an active window to be tested fully.
	This is done by TestSelectionComponent in the Browser project."

	selection := Selection new.

	self assert: [ selection anchorNode isNil ].
	self assert: [ selection anchorOffset = 0 ].
	self assert: [ selection focusNode isNil ].
	self assert: [ selection focusOffset = 0 ].
	self assert: [ selection isCollapsed ].
	self assert: [ selection rangeCount = 0 ].
	self assert: [ selection type = 'None' ].
!CLASS TestValidityState EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| validityState |
	validityState := ( Document new createElement: 'fieldSet' ) validity.
	self assert: [ validityState class = ValidityState ].

	self assert: [ validityState badInput not ].
	self assert: [ validityState customError not ].
	self assert: [ validityState patternMismatch not ].
	self assert: [ validityState rangeOverflow not ].
	self assert: [ validityState rangeUnderflow not ].
	self assert: [ validityState stepMismatch not ].
	self assert: [ validityState tooLong not ].
	self assert: [ validityState tooShort not ].
	self assert: [ validityState typeMismatch not ].
	self assert: [ validityState valueMissing not ].

	self assert: [ validityState valid ].
!
CLASS TestBrowserApp EXTENDS Test MODULE TestBrowser CLASSVARS '' VARS ''

test
	| app |

	app := BrowserApp new.

	self assert: [ app testMode | true ].
	self assert: [ app url startsWith: 'http' ].

	"These methods are to destructive to test here:
		navigateTo: url
		stop
	 They are tested in the examples."
!
CLASS TestComponent EXTENDS Test MODULE TestBrowser CLASSVARS 'component' VARS ''

test
	| app parent |

	component := Component new.
	app := BrowserApp new.
	parent := Component new.

	component app: app.
	self assert: [ component app = app ].

	component parent: parent.
	self assert: [ component parent = parent ].

	"Note: Loading a component is tested in the Browser project."
!
CLASS TestAiChatRequest EXTENDS Test MODULE TestAiShared CLASSVARS '' VARS ''

test
	| request object |

	request := AiChatRequest new
		provider: 'openai';
		model: 'gpt-4o';
		messages: #( 'Say this is a test' ).
	self assert:[ request provider = 'openai' ].
	self assert:[ request model = 'gpt-4o' ].
	self assert:[ request messages = #( 'Say this is a test' ) ].
	self assert: [ request toString = 'AiChatRequest( provider: openai, model: gpt-4o, messages: "#( Say this is a test )" )' ].

	object := Object new
		atProperty: 'provider' put: 'deepthought';
		atProperty: 'model' put: 'universal';
		atProperty: 'messages' put: '["The question of life"]'.
	request := AiChatRequest fromObject: object.
	self assert:[ request provider = 'deepthought' ].
	self assert:[ request model = 'universal' ].
	self assert:[ request messages = #( 'The question of life' ) ].
!
CLASS TestAiChatResponse EXTENDS Test MODULE TestAiShared CLASSVARS '' VARS ''

test
	| response object |

	response := AiChatResponse new
		success: true;
		text: 'Your answer'.
	self assert: [ response success ].
	self assert: [ response text = 'Your answer' ].
	self assert: [ response toString = 'AiChatResponse( success: true, text: "Your answer" )' ].

	object := Object new
		atProperty: 'success' put: false;
		atProperty: 'text' put: 'Failed to answer'.
	response := AiChatResponse fromObject: object.
	self assert: [ response success not ].
	self assert: [ response text = 'Failed to answer' ].
!
CLASS TestAiProviders EXTENDS Test MODULE TestAiShared CLASSVARS '' VARS ''

test
	| providers providers2 |

	providers := AiProviders new.
	providers setProvider: 'openai' models: 'o3 o4'.
	self assert: [ providers size = 1 ].
	self assert: [ ( providers modelsFor: 'openai' ) = 'o3 o4' ].
	self assert: [ providers toString = 'AiProviders( openai )' ].

	providers2 := AiProviders fromObject: providers toObject.
	self assert: [ providers providers = providers2 providers ].
	self assert: [ ( providers modelsFor: 'openai' ) = ( providers2 modelsFor: 'openai' ) ].
	self assert: [ providers size = providers2 size ].
	self assert: [ providers toString = providers2 toString ].
!

CLASS TestAiFactory EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

"Tests the common chat interface of all AI provivers."

test
	#( 'ollama' "'openai' 'deepseek' 'googleai' 'anthropic'" )
		do: [ :name | self testAi: name ]
!
async testAi: name
	| ai response |
	( AiFactory available: name ) ifFalse: [ ^ false ].

	ai := AiFactory new: name.
	response := await ai chat: #( 'Say exactly: This is a test' ).
	self assert: [ response toLowerCase includes: 'test'  ].
!
CLASS TestOpenai EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

"Also tests classes:
	OpenaiChatCompletion, OpenaiChatCompletionChoice,
	OpenaiChatCompletionMessage, OpenaiCompletionUsage."

disabled
	^ Openai available not.
!
async test
	| openai request chatCompletion choice message usage |

	openai := Openai new.
	request := OpenaiChatCompletionRequest new
		model: openai model;
		addRole: 'user' content: 'Say exactly: This is a test'.
	chatCompletion := await openai createChatCompletion: request.

	self assert: [ chatCompletion class = OpenaiChatCompletion ].
	self assert: [ ( Date new toSeconds - chatCompletion created toSeconds ) < 60 ].
	self assert: [ chatCompletion id startsWith: 'chatcmpl' ].
	self assert: [ #( 'chatgpt' 'gpt' 'o1' 'o4' ) some: [ :modelNameStart |
		chatCompletion model startsWith: modelNameStart ] ].
	self assert: [ chatCompletion object = 'chat.completion' ].
	self assert: [ #( 'scale' 'default' ) includes: chatCompletion serviceTier ].
	chatCompletion systemFingerprint ifNotNil: [
		self assert: [ chatCompletion systemFingerprint startsWith: 'fp_' ] ].
	self assert: [ chatCompletion choices length = 1 ].

	choice := chatCompletion choices first.
	self assert: [ choice class = OpenaiChatCompletionChoice ].
	self assert: [ choice finishReason = 'stop' ].
	self assert: [ choice index = 0 ].

	message := choice message.
	self assert: [ message class = OpenaiChatCompletionMessage ].
	self assert: [ message role = 'assistant' ].
	self assert: [ message content toLowerCase includes: 'test' ].

	usage := chatCompletion usage.
	self assert: [ usage class = OpenaiCompletionUsage ].
	self assert: [ usage completionTokens > 0 ].
	self assert: [ usage promptTokens > 0 ].
	self assert: [ usage totalTokens = ( usage completionTokens + usage promptTokens ) ].

	self assert: [ usage completionAcceptedPredictionTokens = 0 ].
	self assert: [ usage completionAudioTokens = 0 ].
	self assert: [ usage completionReasoningTokens >= 0 ].
	self assert: [ usage completionRejectedPredictionTokens = 0 ].

	self assert: [ usage promptAudioTokens = 0 ].
	self assert: [ usage promptCachedTokens = 0 ].
!
CLASS TestOpenaiClientOptions EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

test
	| openai options |

	options := OpenaiClientOptions new.
	self assert: [ options class = OpenaiClientOptions ].

	self assert: [ options baseUrl = ( Environment at: 'OPENAI_BASE_URL' ) ].
	self assert: [ options apiKey = ( Environment at: 'OPENAI_API_KEY' ) ].
	self assert: [ options organization = ( Environment at: 'OPENAI_ORGANIZATION' ) ].
	self assert: [ options project = ( Environment at: 'OPENAI_PROJECT' ) ].

	options baseUrl: 'https://api.openai.com/v1'.
	self assert: [ options baseUrl = 'https://api.openai.com/v1' ].

	options apiKey: 'sk-proj-mySecretApiKey'.
	self assert: [ options apiKey = 'sk-proj-mySecretApiKey' ].

	options organization: 'SmallJS'.
	self assert: [ options organization = 'SmallJS' ].

	options project: 'AI for SmallJS'.
	self assert: [ options project = 'AI for SmallJS' ].

	openai := Openai new: options.
	self assert: [ openai class = Openai ].
	self assert: [ openai apiKey = options apiKey ].
	self assert: [ openai organization = options organization ].
	self assert: [ openai project = options project ].
!
CLASS TestOllama EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

"Also tests classes: OllamaChatRequest, OllamaChatResponse."

disabled
	^ Ollama available not.
!
async test
	| ollama request response message |

	ollama := Ollama new.
	self assert: [ ollama config host startsWith: 'http' ].

	request := OllamaChatRequest new
		model: ollama model;
		addRole: 'user' content: 'Say exactly: This is a test'.

	response := await ollama chatRequest: request.
	self assert: [ response class = OllamaChatResponse ].
	self assert: [ response model = ollama model ].
	self assert: [ response createdAt toSeconds > ( Date new toSeconds - 60 ) ].
	self assert: [ response done ].
	self assert: [ response doneReason = 'stop' ].
	self assert: [ response evalCount > 0 ].
	self assert: [ response evalDuration > 0 ].
	self assert: [ response promptEvalCount > 0 ].
	self assert: [ response promptEvalDuration > 0 ].
	self assert: [ response totalDuration > 0 ].

	message := response message.
	self assert: [ message role = 'assistant' ].
	self assert: [ message content toLowerCase includes: 'test' ].
!
async testEmbedding
	| ollama request response message |

	ollama := Ollama new.
	request := OllamaEmbedRequest new
		model: ollama embeddingModel;
		input: 'Shall we play a game?'.

	response := await ollama embed: request.
	self assert: [ response class = OllamaEmbedResponse ].
	self assert: [ response model = ollama embeddingModel ].
	self assert: [ response embedding length = 768 ].
	self assert: [ response promptEvalCount > 0 ].
	self assert: [ response loadDuration > 1000 ].
	self assert: [ response totalDuration > 1000 ].
!
CLASS TestOllamaConfig EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

test
	| config ollama |

	config := OllamaConfig new.
	self assert: [ config class = OllamaConfig ].

	config host: 'http://localhost:11434'.
	self assert: [ config host = 'http://localhost:11434' ].

	ollama := Ollama new: config.
	self assert: [ ollama class = Ollama ].
	self assert: [ ollama config host = config host ].
!
CLASS TestOllamaMessage EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

test
	| message |

	message := OllamaMessage new.
	self assert: [ message class = OllamaMessage ].

	message role: 'user'.
	self assert: [ message role = 'user' ].

	message content: 'Say: This is a test'.
	self assert: [ message content = 'Say: This is a test' ].
!
CLASS TestGoogleai EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

"Also tests classes: GoogleaiModel GoogleaiContentResult"

disabled
	^ Googleai available not.
!
async test
	| googleai params model response text |

	googleai := Googleai new.
	self assert: [ googleai apiKey length > 10 ].

	params := GoogleaiModelParams new
		model: Googleai models first.

	model := googleai generativeModel: params.
	self assert: [ model apiKey = googleai apiKey ].
	self assert: [ model model includes: params model ].

	response := await model generateContent: #( 'Say exactly: This is a test' ).
	text := response text.
	self assert: [ text toLowerCase includes: 'test' ].
!
CLASS TestDeepseek EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

"The Deepseek API is fully compatible with that of OpenAI.
 The only configuration differences are environment variables:
 	Base URL: DEEPSEEK_BASE_URL
	API key: DEEPSEEK_API_KEY
	Text models: DEEPSEEK_TEXT_MODELS

The class DeepseekClientOptions uses the Deepseek base URL and API key env vars for defaults."

"This also tests these OpenAI classes for use with DeepSeek:
	OpenaiChatCompletion, OpenaiChatCompletionChoice,
	OpenaiChatCompletionMessage, OpenaiCompletionUsage."

disabled
	^ Deepseek available not.
!
async test
	| deepseek request chatCompletion choice message usage |

	deepseek := Deepseek new.
	request := OpenaiChatCompletionRequest new
		model: deepseek model;
		addRole: 'user' content: 'Say exactly: This is a test'.
	chatCompletion := await deepseek createChatCompletion: request.

	self assert: [ chatCompletion class = OpenaiChatCompletion ].
	self assert: [ ( Date new toSeconds - chatCompletion created toSeconds ) < 60 ].
	self assert: [ chatCompletion id length > 10 ].
	self assert: [ chatCompletion model startsWith: 'deepseek' ].
	self assert: [ chatCompletion object = 'chat.completion' ].
	self assert: [ chatCompletion systemFingerprint startsWith: 'fp_' ].
	self assert: [ chatCompletion choices length = 1 ].

	choice := chatCompletion choices first.
	self assert: [ choice class = OpenaiChatCompletionChoice ].
	self assert: [ choice finishReason = 'stop' ].
	self assert: [ choice index = 0 ].

	message := choice message.
	self assert: [ message class = OpenaiChatCompletionMessage ].
	self assert: [ message role = 'assistant' ].
	self assert: [ message content toLowerCase includes: 'test'  ].

	usage := chatCompletion usage.
	self assert: [ usage class = OpenaiCompletionUsage ].
	self assert: [ usage completionTokens > 0 ].
	self assert: [ usage promptTokens > 0 ].
	self assert: [ usage totalTokens = ( usage completionTokens + usage promptTokens ) ].

	self assert: [ usage promptCachedTokens = 0 ].
!
CLASS TestAnthropic EXTENDS Test MODULE TestAi CLASSVARS '' VARS 'anthropic'

"Also tests classes: AnthropicCreateMessageParams, AnthropicMessage."

disabled
	^ Anthropic available not.
!
async test
	| messageParam createMessageParams message textBlock usage |

	anthropic := Anthropic new.
	self assert: [ anthropic apiKey startsWith: 'sk-ant' ].
	self assert: [ anthropic authToken isNil ].
	self assert: [ anthropic baseUrl startsWith: 'https:' ].
	self assert: [ anthropic maxRetries >= 0 ].
	self assert: [ anthropic timeout > 0 ].

	messageParam := AnthropicMessageParam new
		role: 'user';
		content: 'Say exactly: This is a test'.
	self assert: [ messageParam role = 'user' ].
	self assert: [ messageParam content = 'Say exactly: This is a test' ].

	createMessageParams := AnthropicCreateMessageParams new
		model: anthropic model;
		maxTokens: 1024;
		messages: ( Array with: messageParam ).
	self assert: [ createMessageParams model = anthropic model ].
	self assert: [ createMessageParams maxTokens = 1024 ].
	self assert: [ createMessageParams stream not ].

	messageParam := createMessageParams messages first.
	self assert: [ messageParam role = 'user' ].
	self assert: [ messageParam content = 'Say exactly: This is a test' ].

	message := await anthropic create: createMessageParams.
	self assert: [ message class = AnthropicMessage ].
	self assert: [ message content length = 1 ].
	self assert: [ message id startsWith: 'msg' ].
	self assert: [ message model startsWith: 'claude' ].
	self assert: [ message role = 'assistant' ].
	self assert: [ message stopReason = 'end_turn' ].
	self assert: [ message stopSequence isNil ].
	self assert: [ message type = 'message' ].

	textBlock := message content first.
	self assert: [ textBlock class = AnthropicTextBlock ].
	self assert: [ textBlock text toLowerCase includes: 'test' ].

	usage := message usage.
	self assert: [ usage class = AnthropicUsage ].
	self assert: [ usage cacheCreationInputTokens >= 0 ].
	self assert: [ usage cacheReadInputTokens >= 0 ].
	self assert: [ usage inputTokens > 0 ].
	self assert: [ usage outputTokens > 0 ].
!
CLASS TestAnthropicClientOptions EXTENDS Test MODULE TestAi CLASSVARS '' VARS ''

test
	| anthropic options |

	options := AnthropicClientOptions new.
	self assert: [ options class = AnthropicClientOptions ].

	self assert: [ options baseUrl = ( Environment at: 'ANTHROPIC_BASE_URL' ) ].
	self assert: [ options apiKey = ( Environment at: 'ANTHROPIC_API_KEY' ) ].

	options baseUrl: 'https://api.anthropic.com/newBaseUrl'.
	self assert: [ options baseUrl = 'https://api.anthropic.com/newBaseUrl' ].

	options apiKey: 'sk-proj-mySecretApiKey'.
	self assert: [ options apiKey = 'sk-proj-mySecretApiKey' ].

	options maxRetries: 3.
	self assert: [ options maxRetries = 3 ].

	options timeout: 5000.
	self assert: [ options timeout = 5000 ].

	anthropic := Anthropic new: options.
	self assert: [ anthropic class = Anthropic ].
	self assert: [ anthropic baseUrl = options baseUrl ].
	self assert: [ anthropic apiKey = options apiKey ].
	self assert: [ anthropic maxRetries = options maxRetries ].
	self assert: [ anthropic timeout = options timeout ].
!
CLASS MyMessage EXTENDS Object MODULE WebWorkersApp CLASSVARS ''
	VARS 'id size'

CLASSMETHODS

fromJs: jsObject
	^ self new
		id: ( jsObject atJsProperty: 'id' );
		size: ( jsObject atJsProperty: 'size' ).
!

METHODS

"Accessing"

id
	^ id.
!
id: aId
	id := aId.
!
size
	^ size.
!
size: aSize
	size := aSize.
!

"Conversion"

toString
	^ 'MyMessage( id: ', id toString, ', size: ', size toString, ' )'.
!
CLASS MyWorker EXTENDS Object MODULE MyWorker CLASSVARS ''	VARS ''

start
	DedicatedWorkerGlobalScope default
		onMessage: [ :messageEvent | self onMessage: messageEvent ].
!
onMessage: messageEvent
	| myMessage |

	MessageEvent. 	"Force import"

	myMessage := MyMessage fromJs: messageEvent data.
	self log: 'MyWorker received message form main: id: ', myMessage toString.

	"Do the work."
	self work: myMessage size.

	"Report my worker id as being finished."
	self log: 'MyWorker: Posting message back to main with id: ', myMessage id toString.
	DedicatedWorkerGlobalScope default postMessage: myMessage id.
!
work: size
	"The work consists of adding random numbers 'size' times 10 K.
	 The result is discarded."

	| sum |
	sum := 0.

	size timesRepeat: [
		10000 timesRepeat: [
			sum := sum + Float random ] ].
!
CLASS WebWorkersApp EXTENDS BrowserApp MODULE WebWorkersApp CLASSVARS ''
	VARS 'workers startTime
		workSizeInput workersInput startButton resultsTable'

start
	workers := #().
	self bindElements.
!
bindElements
	workSizeInput := Document getElementById: 'workSizeInput' class: HtmlInputElement.
	workersInput := Document getElementById: 'workersInput' class: HtmlInputElement.
	resultsTable := Document getElementById: 'resultsTable' class: HtmlTableElement.
	startButton := Document getElementById: 'startButton' class: HtmlButtonElement.
	startButton onClick: [ self onStart ].
!
totalWorkSize
	^ workSizeInput value toInteger.
!
workerCount
	^ workersInput value toInteger.
!
workerSize
	^ ( self totalWorkSize / self workerCount ) toInteger.
!
onStart
	self clearResults.
	self startWorkers.
!
clearResults
	"(Re)oad worker results into table."
	| row |
	resultsTable tBody innerHtml: ''.
	1 to: self workerCount do: [ :index |
		row := resultsTable tBody insertRow: -1.
		row insertCell textContent: index toString.
		row insertCell ].
!
startWorkers
	self stopWorkers.
	startTime := Date now.
	1 to: self workerCount do: [ :index |
		self startWorker: index ].
!
stopWorkers
	workers do: [ :worker |
		worker terminate ].
	workers := #().
!
startWorker: index
	| worker message |

	worker := Worker new: 'Script/worker.js'
		options: ( WorkerOptions new type: 'module' ).
	worker onMessage: [ :event | self onWorkerMessage: event ].

	message := MyMessage new id: index; size: self workerSize.
	worker postMessage: message.

	workers add: worker.
!
onWorkerMessage: event
	| runTime workerId  cell |
	runTime := Date now - startTime.

	workerId := Integer fromJs: event data js.
	self log: 'WebWorkersApp.onWorkerMessage: received id: ', workerId toString.

	( workers at: workerId - 1 ) terminate.

	cell := ( resultsTable rows at: workerId ) cells at: 1.
	cell textContent: runTime toString.
!

"Accessing (used by tests)"

workSizeInput
	^ workSizeInput.
!
workersInput
	^ workersInput.
!
resultsTable
	^ resultsTable.
!
startButton
	^ startButton.
!
CLASS TestWebWorkersApp EXTENDS Object MODULE TestWebWorkersApp CLASSVARS '' VARS 'webWorkersApp'

"Test WebWorkersApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	webWorkersApp := WebWorkersApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await Test all.
	await self testGui.
!
async testGui
	"Set work size to 100 and workers to 2.
	 Then press start button and check results in the results table."

	webWorkersApp workSizeInput value: '100'.
	webWorkersApp workersInput value: '2'.

	await Timer timeout: 1000.
	webWorkersApp startButton click.

	await Timer timeout: 4000.
	self checkResults.

	webWorkersApp stop.
!
checkResults
	"Check if all benchmark results contain numbers."
	| rows |

	rows := webWorkersApp resultsTable tBody rows.
	self assert: [ rows length = 2 ].

	rows do: [ :row |
		self assert: [ ( row cells at: 1 ) textContent toInteger >= 1 ].
		self assert: [ ( row cells at: 1 ) textContent toInteger >= 10 ] ].
!
CLASS Task EXTENDS Object MODULE TodoApp CLASSVARS '' VARS 'title due done'

constructor
	title := ''.
	done := false.
!

title
	^ title.
!
title: aTitle
	title := aTitle.
!

due
	^ due.
!
due: aDue
	due := aDue.
!
dueString
	^ due isNil
		ifTrue: [ '' ]
		ifFalse: [ due toLocaleDateString ].
!

done
	^ done = true.
!
done: aDone
	done := aDone = true.
!
doneString
	^ done
		ifTrue: [ String fromCharCode: 10004 ]
		ifFalse: [ String fromCharCode: 9634 ].
!
CLASS TodoApp EXTENDS BrowserApp MODULE TodoApp CLASSVARS ''
	VARS 'language tasks
		languageSelect
		newTaskTitleInput newTaskDueInput newTaskAddButton
		taskTable sortColumn sortDescending'

start
	self bindElements.
	self loadDefaultLanguage.
	self loadTasks.
	self showTasks.
!
bindElements
	"Bind HTML elements to vars, set defaults, set event listeners."

	languageSelect := Document getElementById: 'languageSelect' class: HtmlSelectElement.
	languageSelect addEventListener: 'change' then: [ self loadLanguage ].

	newTaskTitleInput := Document getElementById: 'newTaskTitleInput' class: HtmlInputElement.
	newTaskTitleInput value: 'New task'.

	newTaskDueInput := Document getElementById: 'newTaskDueInput' class: HtmlInputElement.
	newTaskDueInput value: ( Date new toIsoString substring: 0 to: 10 ).

	newTaskAddButton := Document getElementById: 'newTaskAddButton' class: HtmlButtonElement.
	newTaskAddButton onClick: [ self addNewTask ].

	taskTable := Document getElementById: 'taskTable' class: HtmlTableElement.
	taskTable onClick: [ :event | self taskTableClicked: event ].
!
loadDefaultLanguage
	| languageId |
	language := Language supported: #( 'en-US' 'es' ).
	languageId := languageSelect value.
	language load: languageId.
!
loadLanguage
	| index |
	index := languageSelect selectedIndex.
	index >= 0 ifTrue: [
		language load: ( language supported at: index ) ].
!
loadTasks
	"Load some generated tasks into tasks array."

	| due task |
	tasks := Array new.
	due := Date new.
	#( 'Code' 'Test' 'Release' ) do: [ :title |
		due day: due day + title length.
		task := Task new title: title; due: due copy.
		tasks add: task ].
!
showTasks
	"Show tasks array on HTML page."

	| deleteString row |

	deleteString := String fromCharCode: 10005.

	taskTable tBody innerHtml: ''.
	tasks do: [ :task |
		row := taskTable tBody insertRow: -1.
		row insertCell textContent: task title.
		row insertCell textContent: task dueString.
		row insertCell textContent: task doneString.
		row insertCell textContent: deleteString.
	].
!
addNewTask
	"Create new task from its input elements,
	 add it to the tasks array and update the list in the page."

	| task |
	task := Task new
		title: newTaskTitleInput value;
		due: newTaskDueInput valueAsDate.

	tasks add: task.

	self showTasks.
!
taskTableClicked: event
	"Process task table click actions, which can be:
		- Done cell clicked > Toggle done value.
		- Delete cell clicked > Remove task."

	| cell position |
	cell := HtmlElement fromJsSubElement: event target js.
	cell class ~= HtmlTableCellElement ifTrue: [
		cell := cell parentElement ].
	position := Point x: cell cellIndex y: cell parentElement rowIndex.

	"These actions check themselves if they should be activated, using position."
	self sortColumn: position.
	self toggleTaskDone: position cell: cell.
	self deleteTask: position.
!
sortColumn: position
	"Sort colums "

	| sortProperty sortBlock |

	"Check if a column header cell was clicked."
	( position x <= 2 ) & ( position y = 1 ) ifFalse: [ ^ nil ].

	sortProperty := #( 'title' 'due' 'done' ) at: position x.
	sortDescending := ( position x = sortColumn ) ifTrue: [ sortDescending not ] ifFalse: [ false ].
	sortBlock := sortDescending
		ifTrue: [ [ :task1 :task2 | ( task2 atProperty: sortProperty ) compare: ( task1 atProperty: sortProperty ) ] ]
		ifFalse: [ [ :task1 :task2 | ( task1 atProperty: sortProperty ) compare: ( task2 atProperty: sortProperty ) ] ].
	tasks sortWith: sortBlock.
	sortColumn := position x.

	self showTasks.
!
toggleTaskDone: position cell: cell
	"Toggle done value of task at position and update table."

	| task |

	"Check if done cell was clicked."
	( position x = 2 ) & ( position y >= 2 ) ifFalse: [ ^ nil ].

	task := tasks at: position y - 2.
	task done: task done not.
	cell textContent: task doneString.
!
deleteTask: position
	"Delete task at position and update table."

	"Check if delete cell was clicked."
	( position x = 3 ) & ( position y >= 2 ) ifFalse: [ ^ nil ].

	tasks removeAt: position y - 2.
	taskTable deleteRow: position y.
!

"Accessing (used by tests)"

tasks
	^ tasks.
!
languageSelect
	^ languageSelect.
!
newTaskTitleInput
	^ newTaskTitleInput.
!
newTaskDueInput
	^ newTaskDueInput.
!
newTaskAddButton
	^ newTaskAddButton.
!
taskTable
	^ taskTable.
!
CLASS TestTask EXTENDS Test MODULE TestTodoApp CLASSVARS '' VARS ''

test
	| task title due |

	task := Task new.
	self assert: [ task title = '' ].
	self assert: [ task done not ].

	title := 'New task'.
	task title: title.
	self assert: [ task title = title ].

	due := Date new.
	task due: due.
	self assert: [ task due = due ].
	self assert: [ task dueString includes: due year toString ].

	self assert: [ task doneString = ( String fromCharCode: 9634 ) ].
	task done: true.
	self assert: [ task done ].
	self assert: [ task doneString = ( String fromCharCode: 10004 ) ].
!
CLASS TestTodoApp EXTENDS Object MODULE TestTodoApp CLASSVARS '' VARS 'todoApp'

"Test TodoApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	todoApp := TodoApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestTask all.
	await self testGui.
!
async testGui
	"Click increase counter button 2 times then click reset.
	 For every click check if counter label is updated correctly.
	 Exit if all tests succeed."

	self testTasksLoaded.
	await self testAddNewTask.
	await self testCompleteTask.
	await self testDeleteTask.
	await self testSortTasks.
	await self testLanguage.

	await self stop.
!
testTasksLoaded
	self assert: [ todoApp taskTable tBody rows length = todoApp tasks length ].
!
async testAddNewTask
	| expectedTaskCount |
	expectedTaskCount := todoApp tasks length + 1.

	todoApp newTaskAddButton click.
	await Timer timeout: 1000.
	self assert: [ todoApp tasks length = expectedTaskCount ].
	self assert: [ todoApp taskTable tBody rows length = expectedTaskCount ].
	self assert: [ ( todoApp taskTable tBody rows last cells at: 0 ) textContent = todoApp tasks last title ].
!
async testCompleteTask
	self assert: [ todoApp tasks last done not ].
	self assert: [ ( todoApp taskTable tBody rows last cells at: 2 ) textContent = todoApp tasks last doneString ].

	( todoApp taskTable tBody rows last cells at: 2 ) click.
	await Timer timeout: 1000.
	self assert: [ todoApp tasks last done ].
	self assert: [ ( todoApp taskTable tBody rows last cells at: 2 ) textContent = todoApp tasks last doneString ].
!
async testDeleteTask
	| expectedTaskCount |
	expectedTaskCount := todoApp tasks length - 1.

	( todoApp taskTable tBody rows last cells at: 3 ) click.
	await Timer timeout: 1000.
	self assert: [ todoApp tasks length = expectedTaskCount ].
	self assert: [ todoApp taskTable tBody rows length = expectedTaskCount ].
!
async testSortTasks
	| lastTaskTitle |
	lastTaskTitle := todoApp tasks last title.

	( todoApp taskTable tHead rows at: 1 ) cells first click.
	await Timer timeout: 1000.
	self assert: [ todoApp tasks last title ~= lastTaskTitle ].
	self assert: [ todoApp taskTable tBody rows last cells first textContent ~= lastTaskTitle ].
	self assert: [ todoApp taskTable tBody rows last cells first textContent = todoApp tasks last title ].
!
async testLanguage
	"Select second language (Spanish) and check of GUI changed to it."

	| changeEvent titleSpan |

	todoApp languageSelect selectedIndex: 1.
	changeEvent := Event type: 'change'.
	todoApp languageSelect dispatchEvent: changeEvent.

	await Timer timeout: 1000.
	titleSpan := Document getElementById: 'titleSpan' class: HtmlSpanElement.
	self assert: [ titleSpan textContent = 'Hacer' ].
!
async stop
	await Timer timeout: 1000 then: [
		todoApp stop ].
!
CLASS LoginResponse EXTENDS Object MODULE ShopShared CLASSVARS '' VARS 'success message'

CLASSMETHODS

success: success message: message
	^ self new success: success; message: message.
!
fromObject: object
	^ self new
		success: ( object atProperty: 'success' );
		message: ( object atProperty: 'message' ).
!

METHODS

"Accessing"

success
	^ success.
!
success: aSuccess
	success := aSuccess.
!
message
	^ message.
!
message: aMessage
	message := aMessage.
!

"Conversion"

toString
	^ 'LoginResponse( success: ', success toString, ', message: ', message toString, ' )'.
!
CLASS Order EXTENDS SqlObject MODULE ShopShared CLASSVARS '' VARS 'person product amount'

CLASSMETHODS

columns
	^ #( #( 'person' Integer )
			#( 'product' Integer )
			#( 'amount' Integer ) ).
!
fromObject: object
	^ Order new
		id: ( object atProperty: 'id' );
		person: ( object atProperty: 'person' );
		product: ( object atProperty: 'product' );
		amount: ( object atProperty: 'amount' ).
!

METHODS

person
	^ person.
!
person: aPerson
	person := aPerson.
!
product
	^ product.
!
product: aProduct
	product := aProduct.
!
amount
	^ amount.
!
amount: aAmount
	amount := aAmount.
!
CLASS Person EXTENDS SqlObject MODULE ShopShared CLASSVARS '' VARS 'name password'

CLASSMETHODS

columns
	^ #( #( 'name' String )
		#( 'password' String ) ).
!
fromObject: object
	^ self new
		id: ( object atProperty: 'id' );
		name: ( object atProperty: 'name' );
		password: ( object atProperty: 'password' ).
!
fromJsObject: jsObject
	^ self new
		name: ( jsObject atJsProperty: 'user' );
		password: ( jsObject atJsProperty: 'password' ).
!

METHODS

"Accessing"

name
	^ name.
!
name: aName
	name := aName.
!
password
	^ password.
!
password: aPassword
	password := aPassword.
!

"Converting"

toQuery
	"Return URL query part to request this person."
	^ '?name=', name, '&password=', password.
!
CLASS Product EXTENDS SqlObject MODULE ShopShared CLASSVARS '' VARS 'name price'

CLASSMETHODS

columns
	^ #( #( 'name' String )
		#( 'price' Integer ) ).
!
fromObject: object
	^ Product new
		id: ( object atProperty: 'id' );
		name: ( object atProperty: 'name' );
		price: ( object atProperty: 'price' ).
!

METHODS

name
	^ name.
!
name: aName
	name := aName.
!
price
	^ price.
!
price: aPrice
	price := aPrice.
!
priceString
	^ self price toFloat / 100 toFixed: 2.
!
CLASS TestLoginResponse EXTENDS Test MODULE TestShopShared CLASSVARS '' VARS ''

test
	| loginResponse object |

	loginResponse := LoginResponse success: true message: 'Success!'.
	self assert:[ loginResponse success ].
	self assert:[ loginResponse message = 'Success!' ].
	self assert:[ loginResponse toString = 'LoginResponse( success: true, message: Success! )' ].

	object := Object new
		atProperty: 'success' put: false;
		atProperty: 'message' put: 'Wrong password'.
	loginResponse := LoginResponse fromObject: object.
	self assert:[ loginResponse success not ].
	self assert:[ loginResponse message = 'Wrong password' ].

	loginResponse := LoginResponse new.
	loginResponse success: false.
	self assert:[ loginResponse success not ].

	loginResponse message: 'Failed!'.
	self assert:[ loginResponse message = 'Failed!' ].
!
CLASS TestOrder EXTENDS Test MODULE TestShopShared CLASSVARS '' VARS ''

test
	| order |

	self assert:[ Order columns first = #( 'person' Integer ) ].

	order := Order new.

	order person: 1.
	self assert:[ order person = 1 ].

	order product: 2.
	self assert:[ order product = 2 ].

	order amount: 100.
	self assert:[ order amount = 100 ].
!
CLASS TestPerson EXTENDS Test MODULE TestShopShared CLASSVARS '' VARS ''

test
	| person |
	person := Person new.

	self assert: [ Person columns first = #( 'name' String ) ].

	person name: 'Test'.
	self assert:[ person name = 'Test' ].

	person password: 'secret'.
	self assert:[ person password = 'secret' ].
!
CLASS TestProduct EXTENDS Test MODULE TestShopShared CLASSVARS '' VARS ''

test
	| product |
	product := Product new.

	self assert: [ product class columns first = #( 'name' String ) ].

	product name: 'Test'.
	self assert:[ product name = 'Test' ].

	product price: 123.
	self assert:[ product price = 123 ].
!
CLASS DbPerson EXTENDS Person MODULE ShopServer CLASSVARS '' VARS 'salt'

"Implements a person in the datase, which is a supperset of the shared Person class."

CLASSMETHODS

columns
	^ super columns
		add: #( 'salt' Integer ).
!
fromObject: object
	^ super fromObject: object
		salt: ( object atProperty: 'salt' ).
!

METHODS

"Accessing"

salt
	^ salt.
!
salt: aSalt
	salt := aSalt.
!

"Password management"

"Passwords are stored internally as a SHA256 digests
of a random salt integer prefixed to the plaintext password."

async setPassword: aPassword
	"Set password using new salt."
	salt := ( Float random * 1000000 ) toInteger.
	password := await self hashPassword: aPassword.
!
async checkPassword: aPassword
	^ ( await self hashPassword: aPassword ) = password.
!
async hashPassword: aPassword
	"Return hashed password with stored salt."
	| passwordData digestBuffer hashedPassword |
	passwordData := Uint8Array encodeFromString: self salt toString + aPassword.
	digestBuffer := await Crypto digest: 'SHA-256' data: passwordData.
	hashedPassword := ( Uint8Array buffer: digestBuffer ) toHex.
	^ hashedPassword.
!
CLASS ShopServer EXTENDS Object MODULE ShopServer CLASSVARS ''
	VARS 'express server database personTable productTable orderTable'

"This app provides a Shop API for users, products and orders in the /api route.
It also provides a static web server for web content of the client.
It uses databases enabled in the '.env' file."

METHODS

async start
	Console log: 'Shop Server.'.
	await self connectDatabase.
	await self startServer.
!
async connectDatabase
	| connectionString |
	connectionString := Environment at: 'SHOP_DATABASE'.
	connectionString isNil ifTrue: [
		Error throw: 'Environment variable "SHOP_DATABASE" not set.' ].

	database := SqlDatabaseFactory newFor: connectionString.
	Console log: 'Connecting to database type: ', database class name.
	await database connect: connectionString.

	personTable := database connectTable: 'Person' rowClass: DbPerson.
	productTable := database connectTable: 'Product' rowClass: Product.
	orderTable := database connectTable: 'Order' rowClass: Order.
!
startServer
	| portString port clientPath |

	portString := Environment at: 'SHOP_PORT'.
	portString isNil ifTrue: [
		Error throw: 'Environment variable "SHOP_PORT" not set.' ].
	port := portString toInteger.
	( port < 1024 ) | ( port > 65535 ) ifTrue: [
		Error throw: 'Invalid port number: ', portString ].

	clientPath := Environment at: 'SHOP_CLIENT'.
	clientPath isNil ifTrue: [
		clientPath := '../Client/web'.
		Console log: 'Environment variable "SHOP_CLIENT" not set, defaulting to: ', clientPath ].
	Console log: 'Client path: ', clientPath.

	express := Express new.
	express useSession.
	express static: clientPath.
	express get: '/api/login'
		then: [ :request :response | self login: request response: response ].
	express get: '/api/products'
		then: [ :request :response | self products: request response: response ].
	express get: '/api/orders'
		then: [ :request :response | self orders: request response: response ].

	Console log: 'Starting webserver.'.
	server := express listen: port then: [ self onListen: port ].
!
onListen: port
	Console log: 'Server started on port: ', port toString.
!

"Example login request:
	localhost:3000/api/login?name=John&password=secret
 Example LoginResponse:
 	{ success: true, message: 'Login succeeded' }"

async login: request response: response
	| person dbPersons dbPerson |

	person := Person fromObject: request query.
	person name notNil ifFalse: [
		^ self sendLoginResponse: response success: false message: 'Login parameter "name" missing' ].
	person password notNil ifFalse: [
		^ self sendLoginResponse: response success: false message: 'Login parameter "password" missing' ].

	dbPersons := await personTable select: '`name` = ?' with: #( ( person name ) ).
	dbPersons length > 0 ifFalse: [
		^ self sendLoginResponse: response success: false message: 'User not found: ', person name ].

	dbPerson := dbPersons first.
	( await dbPerson checkPassword: person password ) ifFalse: [
		^ self sendLoginResponse: response success: false message: 'Password check failed' ].

	request session set: 'user' to: dbPerson.
	self sendLoginResponse: response success: true message: 'Login succeeded'.
!
sendLoginResponse: response success: success message: message
	| loginResponse |
	loginResponse := LoginResponse success: success message: message.
	Console log: 'Sending login response: ', loginResponse toString.
	response send: loginResponse.
!
getRequestUser: request response: response
	"Returns the logged-in user (Person) from the request or nil if it does not exist.
 	 If the user is not found, a server response 500 is sent also.
 	 Requests can only contain serialized data, so the ST object has to be reconstructed from that."

	| userObject |
	userObject := request session get: 'user'.
	userObject isNil ifTrue: [
		response sendStatus: 500 message: 'Not logged in.'.
		^ nil ].

	^ Person fromObject: userObject.
!
checkRequestUser: request response: response
	^ ( self getRequestUser: request response: response ) notNil.
!

"Example products request:
	localhost:3000/api/products
returns:
	'[ { 'id': 1, 'name' : 'Apple', 'price': 100 },
		{ 'id': 2, 'name': 'Orange', 'price': 150 },
		{ 'id': 3, 'name': 'Mango', 'price': 220 } ]'
"

async products: request response: response
	| products |
	( self checkRequestUser: request response: response ) ifFalse: [ ^ nil ].

	products := await productTable selectAll.
	response send: products toJsObject.
!

"Example orders request:
	localhost:3000/api/orders
 Will return an object with:
 	An array all orders for the logged-in user
 	and an array of all products associated with the orders."

async orders: request response: response
	| query user userId orders products result |

	user := self getRequestUser: request response: response.
	user isNil ifTrue: [ ^ nil ].

	userId := user id.
	orders := await orderTable select: '`person` = ?' with: #( userId ).

	query := '`id` in ( select `product` from `Order` where `person` = ? )'.
	products := await productTable select: query with: #( userId ).

	result := Object new
		atProperty: 'orders' put: orders;
		atProperty: 'products' put: products.
	response send: result toJsObject.
!
async stop
	await server terminate.
	await database end.
!
CLASS TestDbPerson EXTENDS Test MODULE TestShopServer CLASSVARS '' VARS ''

async test
	| dbPerson match |
	dbPerson := DbPerson new.

	self assert: [ DbPerson columns last = #( 'salt' Integer ) ].

	await dbPerson setPassword: 'secret'.
	self assert:[ dbPerson salt >= 0 ].
	self assert:[ dbPerson password length = 64 ].

	match := await dbPerson checkPassword: 'secret'.
	self assert: [ match ].
!
CLASS TestShopServer EXTENDS Object MODULE TestShopServer CLASSVARS '' VARS 'shopServer sessionCookie'

"Test ShopServer units and API.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	shopServer := ShopServer new.
	await shopServer start.

	"Run sync and async unit tests of all imported Test* classes and log results."
	await TestPerson all.
	await self testApi.
!
async testApi
	self log: 'Starting API tests.'.

	"The tests are chained end-to-start because they must run async."
	await self requestLogin.
	await self requestProducts.
	await self requestOrders.
	await self stopServer.
!
async requestLogin
	| person url response object loginResponse |
	person := Person new name: 'John'; password: 'secret'.
	url := 'http://localhost:3000/api/login', person toQuery.
	response := await Fetch request: url.
	self assert: [ response status = 200 ].

	object := await response json.
	loginResponse := LoginResponse fromObject: object.
	self assert: [ loginResponse success ].
	self assert: [ loginResponse message = 'Login succeeded' ].

	sessionCookie := response cookie.
	self assert: [ sessionCookie includes: 'connect.sid' ].

!
async requestProducts
	| objects products product |
	objects := await self fetchObject: 'http://localhost:3000/api/products'.

	"'objects' should contain an array of productss."
	self assert: [ objects length = 3 ].

	product := Product fromObject: objects first.
	self assert: [ product id = 1 ].
	self assert: [ product name = 'Apple' ].
	self assert: [ product price = 100 ].
!
async requestOrders
	| object orders order products product |
	object := await self fetchObject: 'http://localhost:3000/api/orders'.

	"'object' should contain properties 'orders' and 'products'
	 each containting an array of objects with values of the type indicated.
	 The products are the ones referenced by the orders."

	orders := object atProperty: 'orders'.
	self assert: [ orders class = Array ].
	self assert: [ orders length = 2 ].

	order := Order fromObject: orders first.
	self assert: [ order id = 1 ].
	self assert: [ order person = 1 ].
	self assert: [ order product = 1 ].
	self assert: [ order amount = 10 ].

	products := object atProperty: 'products'.
	self assert: [ products class = Array ].
	self assert: [ products length = 2 ].

	product := Product fromObject: products last.
	self assert: [ product id = 2 ].
	self assert: [ product name = 'Orange' ].
	self assert: [ product price = 150 ].
!
async fetchObject: url
	"Fetch array of objects while setting session cookie."
	| options headers |

	headers := Headers new
		set: 'cookie' value: sessionCookie.
	options := RequestInit new
		headers: headers.

	^ await Fetch object: url options: options.
!
async stopServer
	self log: 'API tests successful.'.
	self log: 'Stopping server.'.
	await shopServer stop.
!
CLASS ShopApp EXTENDS BrowserApp MODULE ShopClient CLASSVARS ''
	VARS 'component'

"Var 'component' holds the currently loaded SPA component.
It can be one a LoginCompoment, ProductComponent or OrderComponent"

async start
	await self loadComponent: LoginComponent.
!
async loadComponent: componentClass
	component := componentClass new app: self.
	"Note: A compontent's start method is called automatically"
	await component loadIntoElement: 'component'.
!
component
	^ component.
!
CLASS LoginComponent EXTENDS Component MODULE ShopClient CLASSVARS ''
	VARS 'userNameInput passwordInput loginButton loginErrorSpan'

htmlPath
	^ 'Login/Login.html'.
!
start
	self bindElements.

	"For easy access :-)"
	userNameInput value: 'John'.
	passwordInput value: 'secret'.
!
bindElements
	userNameInput := Document getElementById: 'userNameInput' class: HtmlInputElement.
	passwordInput := Document getElementById: 'passwordInput' class: HtmlInputElement.

	loginButton := Document getElementById: 'loginButton' class: HtmlButtonElement.
	loginButton onClick: [ :event | self onLogin ].

	loginErrorSpan := Document getElementById: 'loginErrorSpan' class: HtmlSpanElement.
!
async onLogin
	| person loginApi object response |

	person := Person new
		name: userNameInput value;
		password: passwordInput value.
	loginApi := self app url, '/api/login', person toQuery.
	object := await Fetch object: loginApi.

	response := LoginResponse fromObject: object.
	self log: 'ShopServer login response: ', response toString.

	response success
		ifTrue: [ self app loadComponent: ProductComponent ]
		ifFalse: [ loginErrorSpan textContent: response message ].
!

"Accessing (used by tests)"

userNameInput
	^ userNameInput.
!
passwordInput
	^ passwordInput.
!
loginButton
	^ loginButton.
!
CLASS NavBarComponent EXTENDS Component MODULE ShopClient CLASSVARS ''
	VARS 'productsSpan ordersSpan'

htmlPath
	^ 'NavBar/NavBar.html'.
!
start
	self bindElements.
!
bindElements
	productsSpan := Document getElementById: 'navBarProductsSpan' class: HtmlSpanElement.
	productsSpan onClick: [ :event | self app loadComponent: ProductComponent ].

	ordersSpan := Document getElementById: 'navBarOrdersSpan' class: HtmlSpanElement.
	ordersSpan onClick: [ :event | self app loadComponent: OrderComponent ].
!

"Accessing - Used by tests"

productsSpan
	^ productsSpan.
!
ordersSpan
	^ ordersSpan.
!
CLASS OrderComponent EXTENDS Component MODULE ShopClient CLASSVARS ''
	VARS 'orders products navBar orderTable'

METHODS

htmlPath
	^ 'Order/Order.html'.
!
async start
	navBar := NavBarComponent new app: self app.
	await navBar loadIntoElement: 'orderNavBar'.

	orderTable := Document getElementById: 'orderTable' class: HtmlTableElement.

	await self loadOrders.
!
async loadOrders
	|  ordersApi object |

	ordersApi := Window default location hostPath, '/api/orders'.
	object := await Fetch  object: ordersApi.

	orders := ( object atProperty: 'orders' )
		map: [ :object | Order fromObject: object ].
	products := ( object atProperty: 'products' )
		map: [ :object | Product fromObject: object ].

	"Connect orders to products by direct references, replacing product ids."
	orders do: [ :order |
		order product: ( products find: [ :product | product id = order product ] ) ].

	self showOrders.

	self app testMode ifTrue: [
		TestOrderComponent new test: self ].
!
showOrders
	| row priceString |

	orderTable tBody innerHtml: ''.

	orders do: [ :order |
		row := orderTable tBody insertRow: -1.
		row insertCell textContent: order product name.
		row insertCell textContent: order amount.
		row insertCell textContent: order product priceString.
	]
!

"Accessing (used by tests)"

navBar
	^ navBar.
!
orderTable
	^ orderTable.
!
orders
	^ orders.
!
CLASS ProductComponent EXTENDS Component MODULE ShopClient CLASSVARS ''
	VARS 'products navBar productTable'

htmlPath
	^ 'Product/Product.html'.
!
async start
	navBar := NavBarComponent new app: self app.

	await navBar loadIntoElement: 'productNavBar'.
	productTable := Document getElementById: 'productTable' class: HtmlTableElement.

	await self loadProducts.
!

"Loading"

async loadProducts
	| productsApi objects |

	productsApi := self app url, '/api/products'.
	objects := await Fetch object: productsApi.

	products := objects map: [ :object | Product fromObject: object ].
	self showProducts.
!

"Showing"

async showProducts
	| row |

	productTable tBody innerHtml: ''.

	products do: [ :product |
		row := productTable tBody insertRow: -1.
		row insertCell textContent: product name.
		row insertCell textContent: product priceString ].
!

"Accessing (used by tests)"

navBar
	^ navBar.
!
productTable
	^ productTable.
!
products
	^ products.
!
CLASS TestLoginComponent EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS ''

"Tests the GUI of the Shop client login page.
 This class is not a subclass of Test so is not called automatically with Test all."

test: loginComponent
	self assert: [ loginComponent userNameInput value = 'John' ].
	self assert: [ loginComponent passwordInput value = 'secret' ].
!
CLASS TestOrderComponent EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS ''

"Tests the GUI of the Shop client Order page.
 This class is not a subclass of Test so is not called automatically with Test all."

test: orderComponent
	| tBody cells |

	tBody := orderComponent orderTable tBody.
	self assert: [ tBody class = HtmlTableSectionElement ].
	self assert: [ tBody rows length = 2 ].

	cells := tBody rows first cells.
	self assert: [ cells length = 3 ].
	self assert: [ ( cells at: 0 ) textContent = 'Apple' ].
	self assert: [ ( cells at: 1 ) textContent = '10' ].
	self assert: [ ( cells at: 2 ) textContent = '1.00' ].
!
CLASS TestProductComponent EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS ''

"Tests the GUI of the Shop client Product page.
 This class is not a subclass of Test so is not called automatically with Test all."

test: productComponent
	| tBody cells |

	tBody := productComponent productTable tBody.
	self assert: [ tBody class = HtmlTableSectionElement ].
	self assert: [ tBody rows length = 3 ].

	cells := tBody rows first cells.
	self assert: [ cells length = 2 ].
	self assert: [ ( cells at: 0 ) textContent = 'Apple' ].
	self assert: [ ( cells at: 1 ) textContent = '1.00' ].
!
CLASS TestShopApp EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS ''

"Tests the GUI of the Shop client login page.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	| shopApp loginComponent productComponent orderComponent |
	"Run sync and async tests of all imported Test* classes and log results."
	await TestPerson all.

	shopApp := ShopApp new.
	await shopApp start.
	await Timer timeout: 2000.

	loginComponent := shopApp component.
	TestLoginComponent new test: loginComponent.
	loginComponent loginButton click.
	await Timer timeout: 2000.

	productComponent := shopApp component.
	TestProductComponent new test: productComponent.
	productComponent navBar ordersSpan click.
	await Timer timeout: 2000.

	orderComponent := shopApp component.
	TestOrderComponent new test: orderComponent.
	shopApp stop.
!
CLASS LoginApp EXTENDS BrowserApp MODULE ShopClient CLASSVARS ''
	VARS 'userNameInput passwordInput loginButton loginErrorSpan'

METHODS

start
	self references.
	self bindElements.

	"For easy access :-)"
	userNameInput value: 'John'.
	passwordInput value: 'secret'.
!
references
	"Prevent minimizing of apps for other HTML pages."
	^ true. 	"Don't actually execute the references now."
	ProductApp start.
	OrderApp start.
!
bindElements
	userNameInput := Document getElementById: 'userNameInput' class: HtmlInputElement.
	passwordInput := Document getElementById: 'passwordInput' class: HtmlInputElement.

	loginButton := Document getElementById: 'loginButton' class: HtmlButtonElement.
	loginButton onClick: [ :event | self login ].

	loginErrorSpan := Document getElementById: 'loginErrorSpan' class: HtmlSpanElement.
!
async login
	| person loginApi object response |

	person := Person new
		name: userNameInput value;
		password: passwordInput value.
	loginApi := self url, '/api/login', person toQuery.
	object := await Fetch object: loginApi.

	response := LoginResponse fromObject: object.
	self log: 'ShopServer login response: ', response toString.

	response success
		ifTrue: [ self navigateTo: '../Product/Product.html' ]
		ifFalse: [ loginErrorSpan textContent: response message ].
!

"Accessing (used by tests)"

userNameInput
	^ userNameInput.
!
passwordInput
	^ passwordInput.
!
loginButton
	^ loginButton.
!
CLASS OrderApp EXTENDS BrowserApp MODULE ShopClient CLASSVARS ''
	VARS 'orderTable orders products'

METHODS

async start
	orderTable := Document getElementById: 'orderTable' class: HtmlTableElement.

	await self loadOrders.
!
async loadOrders
	|  ordersApi object |

	ordersApi := Window default location hostPath, '/api/orders'.
	object := await Fetch object: ordersApi.

	products := ( object atProperty: 'products' )
		map: [ :object | Product fromObject: object ].
	orders := ( object atProperty: 'orders' )
		map: [ :object | Order fromObject: object ].
	"Connect orders to products by direct references, replacing product ids."
	orders do: [ :order | order product:
		( products find: [ :product | product id = order product ] ) ].

	self showOrders.
!
showOrders
	| row priceString |

	orderTable tBody innerHtml: ''.

	orders do: [ :order |
		row := orderTable tBody insertRow: -1.
		row insertCell textContent: order product name.
		row insertCell textContent: order amount.
		row insertCell textContent: order product priceString.
	]
!

"Accessing (used by tests)"

orderTable
	^ orderTable.
!
orders
	^ orders.
!
CLASS ProductApp EXTENDS BrowserApp MODULE ShopClient CLASSVARS '' VARS 'productTable products'

METHODS

async start
	productTable := Document getElementById: 'productTable' class: HtmlTableElement.

	await self loadProducts.
!

"Loading"

async loadProducts
	| productsApi objects |

	productsApi := self url, '/api/products'.
	objects := await Fetch object: productsApi.

	products := objects map: [ :object | Product fromObject: object ].

	self showProducts.
!
onLoadProductsError: error
	self error: error message.
!

"Showing"

showProducts
	| row |

	productTable tBody innerHtml: ''.

	products do: [ :product |
		row := productTable tBody insertRow: -1.
		row insertCell textContent: product name.
		row insertCell textContent: product priceString ].
!

"Accessing (used by tests)"

productTable
	^ productTable.
!
products
	^ products.
!
CLASS TestLoginApp EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS 'loginApp'

"Tests the GUI of the Shop client login page.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	loginApp := LoginApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestPerson all.

	await Timer timeout: 500.
	self testLoginFields.

	"Press login button.
	 App should navigate to producs page then."
	loginApp loginButton click.
!
testLoginFields
	"Check if login fields are filled correctly"

	self assert: [ loginApp userNameInput value = 'John' ].
	self assert: [ loginApp passwordInput value = 'secret' ].
!
CLASS TestOrderApp EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS 'orderApp'

"Tests the GUI of the Shop client Order page.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	orderApp := OrderApp new.
	await orderApp start.

	await Timer timeout: 1000.
	self testOrderFields.

	"This was the last test, close the app window."
	await Timer timeout: 1000.
	orderApp stop.

!
testOrderFields
	"Check if order fields are filled correctly."
	| tBody cells |

	tBody := orderApp orderTable tBody.
	self assert: [ tBody class = HtmlTableSectionElement ].
	self assert: [ tBody rows length = 2 ].

	cells := tBody rows first cells.
	self assert: [ cells length = 3 ].
	self assert: [ ( cells at: 0 ) textContent = 'Apple' ].
	self assert: [ ( cells at: 1 ) textContent = '10' ].
	self assert: [ ( cells at: 2 ) textContent = '1.00' ].
!
CLASS TestProductApp EXTENDS Object MODULE TestShopClient CLASSVARS '' VARS 'productApp'

"Tests the GUI of the Shop client Product page.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	productApp := ProductApp new.
	await productApp start.

	"Check if product fields are filled correctly.
	 Then exit the application."

	await Timer timeout: 1000.
	self testProductFields.

	await Timer timeout: 1000.
	self navigateToOrders.
!
testProductFields
	| tBody cells |

	tBody := productApp productTable tBody.
	self assert: [ tBody class = HtmlTableSectionElement ].
	self assert: [ tBody rows length = 3 ].

	cells := tBody rows first cells.
	self assert: [ cells length = 2 ].
	self assert: [ ( cells at: 0 ) textContent = 'Apple' ].
	self assert: [ ( cells at: 1 ) textContent = '1.00' ].
!
navigateToOrders
	| ordersLink |

	ordersLink := Document getElementById: 'ordersLink' class: HtmlAnchorElement.
	"Cannot click on navigation bar, because then window close with not be allowed anymore."
	"ordersLink href: ordersLink href, '?test'.
	 ordersLink click."
	productApp navigateTo: ordersLink href.
!
CLASS Card EXTENDS Object MODULE EmojiMemoryApp CLASSVARS ''
	VARS 'face turned'

"Var face is the emoji (single) character string of the card.
Var turned is a boolean indicating if the card has been turned face up."

CLASSMETHODS

"Creating"

face: face
	"Create a new card with argument face.
	The card is not turned by detault."
	^ self new face: face.
!
empty
	^ ( self face: 'X' ) turned: true.
!

METHODS

"Initializing"

constructor
	turned := false.
!

"Accessing"

face
	^ face.
!
back
	"Character string to display for unturned card"
	^ '🂠'.
!
face: aFace
	face := aFace.
!
turned
	^ turned.
!
turned: aTurned
	turned := aTurned.
!
display
	"Return display string for card,
	depending on turned status."
	^ turned
		ifTrue: [ self face ]
		ifFalse: [ self back ].
!

"Copying"

copy
	^ Card new
		face: self face;
		turned: self turned.
!
CLASS Deck EXTENDS Object MODULE EmojiMemoryApp CLASSVARS ''
	VARS 'allCardFaces size cards'

"Var size is a Point holding the columns (x) and rows (y) of the game.
Var cards is a one dimensional array storing the columns per rows sequentially.
So the length of the cards array is columns * rows."

CLASSMETHODS

async initialize: aSize
	^ await self new initialize: aSize.
!

METHODS

"Initializing"

async initialize: aSize
	"Create new game with argument size (Point)."
	| pairCount face card |

	size := aSize.

	"Fetch all possible cards and randomize order."
	allCardFaces := await Fetch object: 'cards.json'.
	allCardFaces randomize.

	"Add pairs of all available cards to cards array."
	cards := Array new.
	pairCount := size x * size y // 2.
	0 to: pairCount - 1 do: [ :index |
		face := allCardFaces at: index.
		card := Card face: face.
		cards add: card; add: card copy ].

	"Randomize playing cards."
	cards randomize.

	"If number of cards is uneven, add an empty, turned card."
	size x * size y \\ 2 = 1 ifTrue: [
		cards add: Card empty ].
!

"Accessing"

allCardFaces
	^ allCardFaces.
!
cardAt: point
	^ cards at: point y * size x + point x.
!
size
	^ size.
!
cards
	^ cards.
!
length
	"Number of cards in the desk,
	not counting filler card to make it even."
	^ cards length // 2 * 2.
!
CLASS EmojiMemoryApp EXTENDS BrowserApp MODULE EmojiMemoryApp CLASSVARS ''
	VARS 'size deck lastCard lastCell revertPending turns left
		startButton columnsInput rowsInput
		deckRow deckTable winTemplate
		turnsRow turnsInput leftInput'

async start
	self bindElements.
	size := 4 @ 3.
	self updateSize.
!
bindElements
	"Bind HTML elements to vars, set defaults, set event listeners."

	startButton := Document getElementById: 'startButton' class: HtmlButtonElement.
	startButton onClick: [ self startGame ].

	columnsInput := Document getElementById: 'columnsInput' class: HtmlInputElement.
	rowsInput := Document getElementById: 'rowsInput' class: HtmlInputElement.

	deckRow := Document getElementById: 'deckRow' class: HtmlTableRowElement.
	deckTable := Document getElementById: 'deckTable' class: HtmlTableElement.
	deckTable onClick: [ :event | self onDeckTableClicked: event ].
	winTemplate := Document getElementById: 'winTemplate' class: HtmlTemplateElement.

	turnsRow := Document getElementById: 'turnsRow' class: HtmlTableRowElement.
	turnsInput := Document getElementById: 'turnsInput' class: HtmlInputElement.
	leftInput := Document getElementById: 'leftInput' class: HtmlInputElement.
!
updateSize
	columnsInput value: size x toString.
	rowsInput value: size y toString.
!
async startGame
	size x: ( ( columnsInput value toInteger max: 2 ) min: 9 ).
	size y: ( ( rowsInput value toInteger max: 2 ) min: 9 ).
	self updateSize.

	deck := await Deck new initialize: size.
	self createDeckTable.

	turns := 0.
	self updateTurnsInput.
	left := deck length.
	self updateLeftInput.

	revertPending := false.
!
createDeckTable
	| row cell card |

	deckTable removeChildren.
	0 to: deck size y - 1 do: [ :y  |
		row := deckTable insertRow: -1.
		0 to: deck size x - 1 do: [ :x |
			card := deck cardAt: x @ y.
			row insertCell textContent: card display ] ].
!
async onDeckTableClicked: event
	"Turn clicked card if it was not done already."
	| cell point card |

	revertPending ifTrue: [ ^ nil ].
	left = 0 ifTrue: [ ^ nil ].

	"Get table cell and point clicked on."
	cell := HtmlElement fromJsSubElement: event target js.
	cell class ~= HtmlTableCellElement ifTrue: [
		cell := cell parentElement ].
	point := Point x: cell cellIndex y: cell parentElement rowIndex.

	"Turn card if unturned and display face."
	card := deck cardAt: point.
	card turned ifTrue: [ ^ nil ].
	card turned: true.
	cell replaceChildren: card display.

	turns := turns + 1.
	self updateTurnsInput.

	left := left - 1.
	self updateLeftInput.
	left = 0 ifTrue: [ ^ self win ].

	"If turned does not match last card,
	unturn them both after a small pause."

	"No last card"
	lastCard ifNil: [
		lastCard := card. lastCell := cell ^ nil ].

	"Matching last card"
	card face = lastCard face ifTrue: [
		lastCard := nil. lastCell := nil. ^ nil ].

	"Different last card, unturn both after pause."
	revertPending := true.
	await Timer timeout: 2000.
	revertPending := false.
	card turned: false.
	cell replaceChildren: card display.
	lastCard turned: false.
	lastCell replaceChildren: lastCard display.
	lastCard := nil.
	left := left + 2.
	self updateLeftInput.
!
updateTurnsInput
	turnsInput value: turns toString.
!
updateLeftInput
	leftInput value: left toString.
!
win
	deckTable replaceChildren: (
		winTemplate content cloneNode: true ).
!

"Accessing GUI - Used by tests"

startButton
	^ startButton.
!
columnsInput
	^ columnsInput.
!
rowsInput
	^ rowsInput.
!
deckTable
	^ deckTable.
!
turnsInput
	^ turnsInput.
!
leftInput
	^ leftInput.
!

"Accessing model - Used by tests"

size
	^ size.
!
deck
	^ deck.
!
turns
	^ turns.
!
left
	^ left.
!
CLASS TestCard EXTENDS Test MODULE TestDeckApp CLASSVARS '' VARS ''

async test
	| card card2 emptyCard |

	"Normal card"
	card := Card face: 'K'.
	self assert: [ card face = 'K' ].
	self assert: [ card turned not ].

	card face: 'Q'.
	self assert: [ card face = 'Q' ].

	card turned: true.
	self assert: [ card turned ].
	self assert: [ card display = 'Q' ].

	card turned: false.
	self assert: [ card display = card back ].

	card2 := card copy.
	self assert: [ card2 face = card face ].
	card2 face: 'A'.
	self assert: [ card2 face ~= card face ].

	"Empty card"
	emptyCard := Card empty.
	self assert: [ emptyCard face = 'X' ].
	self assert: [ emptyCard turned ].
!

CLASS TestDeck EXTENDS Test MODULE TestDeckApp CLASSVARS '' VARS ''

async test
	| size deck card emptyCard x |

	"Uneven size, so empty card will be added."
	size := 5 @ 3.
	deck := await Deck initialize: size.
	self assert: [ deck allCardFaces length > 100 ].
	self assert: [ deck size = size ].
	self assert: [ deck length = 14 ].
	self assert: [ deck cards length = 15 ].

	"Check a normal card"
	card := deck cardAt: 3 @ 1.
	self assert: [ card face length > 1 ].
	self assert: [ card turned not ].

	"The last card should be empty."
	emptyCard := deck cardAt: 4 @ 2.
	self assert: [ emptyCard face = 'X' ].
	self assert: [ emptyCard turned ].
!
CLASS TestEmojiMemoryApp EXTENDS BrowserApp MODULE TestEmojiMemoryApp CLASSVARS ''
	VARS 'emojiMemoryApp'

"Test EmojiMemoryApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	"Run sync and async tests of all imported Test* classes and log results."
	await TestDeck all.
	await self testGui.
	await self stop.
!
async testGui
	"Check game defaults, start new game, check that top-left card cell is unturned,
	click on that card, check if it is turned."

	| rows cells cell |

	"Create game and check defaults."
	emojiMemoryApp := await EmojiMemoryApp new start.
	await Timer timeout: 1000.

	self assert: [ emojiMemoryApp columnsInput value toInteger = 4 ].
	self assert: [ emojiMemoryApp rowsInput value toInteger = 3 ].

	"Start game and check top-left card."

	emojiMemoryApp startButton click.
	await Timer timeout: 1000.

	rows := emojiMemoryApp deckTable rows.
	self assert: [ rows length = 3 ].
	cells := rows first cells.
	self assert: [ cells length = 4 ].
	cell := cells first.
	self assert: [ cell class = HtmlTableCellElement ].
	self assert: [ cell textContent = '🂠' ].

	self assert: [ emojiMemoryApp turnsInput value toInteger = 0 ].
	self assert: [ emojiMemoryApp leftInput value toInteger = 12 ].

	"Click on top-left card and check updates."

	cell click.
	await Timer timeout: 1000.
	self assert: [ cell textContent = emojiMemoryApp deck cards first face ].

	self assert: [ emojiMemoryApp turnsInput value toInteger = 1 ].
	self assert: [ emojiMemoryApp leftInput value toInteger = 11 ].
!
async end
	await Timer timeout: 1000.
	emojiMemoryApp stop.
!
CLASS Lpad EXTENDS Object MODULE MyNwApp CLASSVARS '' VARS ''

"Encapsulates the infamous npm package 'lpad',
to show how to import an external npm package in NWjs.
2025-09-23: Options using 'import' forms are currently not working,
	one must use 'require()' with a relative path to the main file."

INLINE 'const lpad$ = require( "../node_modules/lpad/index.js" );'

CLASSMETHODS

leftPad: string with: prefix
	^ String fromJs: INLINE 'lpad$.default( string.js , prefix.js )'
!

CLASS MyNwApp EXTENDS NwApp MODULE MyNwApp CLASSVARS ''
	VARS 'body fileInput fileOpenButton
		fileOutputCell fileTextAreaTemplate fileTextArea
		menuBar contextMenu'

"Running"

start
	self bindElements.
	self setMenu.
	self testLpad.
!

"HTML Elements"

bindElements
	"Bind HTML elements to variables, set defaults, set event listeners."

	body := Document default body.

	fileInput := Document default getElementById: 'fileInput' class: HtmlInputElement.
	fileInput value: 'poem.txt'.

	fileOpenButton := Document default getElementById: 'fileOpenButton' class: HtmlButtonElement.
	fileOpenButton onClick: [ self openFile ].

	fileOutputCell := Document default getElementById: 'fileOutputCell' class: HtmlTableCellElement.
	fileTextAreaTemplate := Document default getElementById: 'fileTextAreaTemplate' class: HtmlTemplateElement.
!

"Menus"

setMenu
	self setMenuBar.
	self setContextMenu.
!
setMenuBar
	"The menus are built from the bottom up."

	| exitMenuItem fileMenu fileMenuItem |

	exitMenuItem := NwMenuItem new: 'Exit'.
	exitMenuItem icon: 'Images/Exit.png'.
	exitMenuItem click: [ self quit ].

	fileMenu := NwMenu new.
	fileMenu append: exitMenuItem.

	fileMenuItem := NwMenuItem new: 'File'.
	fileMenuItem submenu: fileMenu.

	menuBar := NwMenu newMenuBar.
	menuBar append: fileMenuItem.

	NwWindow get menu: menuBar.
!
setContextMenu
	| item |

	contextMenu := NwMenu new.

	#( 'Red' 'Green' 'Blue' ) do: [ :color |
		item := NwMenuItem checkbox: color.
		item click: [ self onColorMenu: color ].
		contextMenu append: item ].

	body addEventListener: 'contextmenu'
		then: [ :mouseEvent | self onMouseContextMenu: mouseEvent ].
!

"Color changes"

onMouseContextMenu: mouseEvent
	mouseEvent preventDefault.
	contextMenu popup: mouseEvent client.
!
onColorMenu: color
	body style setProperty: 'background-color' value: color toLowerCase.

	"Make sure this item is the only item checked.
	 There is no uncheck option, override it."
	contextMenu items do: [ :item |
		item checked: item label = color ].
!

"File display"

openFile
	| fileName text |
	fileName := fileInput value.
	text := ( Fs existsSync: fileName )
		ifTrue: [ ( Fs readFileSync: fileName ) toString ]
		ifFalse: [ 'File not found: ', fileName ].
	self displayFileText: text.
!
displayFileText: text
	self createFileTextArea.
	fileTextArea value: text.
!
createFileTextArea
	"Only create it once"
	fileTextArea ifNotNil: [ ^ nil ].

	fileTextArea := fileTextAreaTemplate cloneContent children first.
	fileOutputCell replaceChildren: fileTextArea.
!

"Lpad"

testLpad
	"Test call to Lpad class, then encapsulates the npm package: lpad"
	| padded |
	padded := Lpad leftPad: 'abc\ndef\n' with: 'x'.
	self assert: [ padded = 'xabc\nxdef\n' ]
!

"Accessing (used by tests)"

body
	^ body.
!
menuBar
	^ menuBar.
!
contextMenu
	^ contextMenu.
!
fileOpenButton
	^ fileOpenButton.
!
fileTextArea
	^ fileTextArea.
!

CLASS TestMyNwApp EXTENDS Object MODULE TestMyNwApp CLASSVARS '' VARS 'myNwApp'

async start
	myNwApp := MyNwApp new start.
	await Timer timeout: 1000.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestNwApp all.

	await TestMyNwMenu new test: myNwApp.
	"TestMyWindow closes the window as the last test."
	await TestMyNwWindow new test: myNwApp.
!
CLASS TestMyNwMenu EXTENDS Object MODULE TestMyNwApp CLASSVARS '' VARS 'app'

"Tests menus in MyNwApp"

async test: aApp
	app := aApp.

	self testMenuBar.
	await self testContextMenu.
!
testMenuBar
	| menuBar fileMenuItem fileMenu exitMenuItem |

	menuBar := app menuBar.
	self assert: [ menuBar class = NwMenu ].
	self assert: [ menuBar type = 'menubar' ].
	self assert: [ menuBar items length = 1 ].

	fileMenuItem := menuBar items first.
	self assert: [ fileMenuItem class = NwMenuItem ].
	self assert: [ fileMenuItem label = 'File' ].

	fileMenu := fileMenuItem submenu.
	self assert: [ fileMenu class = NwMenu ].
	self assert: [ fileMenu type = 'contextmenu' ].
	self assert: [ fileMenu items length = 1 ].

	exitMenuItem := fileMenu items first.
	self assert: [ exitMenuItem class = NwMenuItem ].
	self assert: [ exitMenuItem label = 'Exit' ].
!
async testContextMenu
	| contextMenu greenMenuItem |

	contextMenu := app contextMenu.
	self assert: [ contextMenu class = NwMenu ].
	self assert: [ contextMenu type = 'contextmenu' ].
	self assert: [ contextMenu items length = 3 ].

	greenMenuItem := contextMenu items at: 1.
	self assert: [ greenMenuItem class = NwMenuItem ].
	self assert: [ greenMenuItem label = 'Green' ].

	greenMenuItem click value.
	await Timer timeout: 500.
	self assert: [ ( app body style getPropertyValue: 'background-color' ) = 'green' ].
!
CLASS TestMyNwWindow EXTENDS Object MODULE TestMyNwApp CLASSVARS ''
	VARS 'app window'

async test: aApp
	app := aApp.

	self testWindow.
	await self testFileOpen.
	await self testSize.
	await self testMinimizeMaximize.
	await self testMove.
	await self testFullscreen.
	await self testFocus.
	await self testShow.
	await self testAlwaysOnTop.
	await self testKioskMode.
	await self testAttention.
	self close.
!
testWindow
	| domWindow |

	window := NwWindow get.
	self assert: [ window class = NwWindow ].
	self assert: [ window title = 'My NW.js App' ].
	self assert: [ window menu class = NwMenu ].
	self assert: [ window zoomLevel = 0 ].

	domWindow := Window default.
	self assert: [ ( NwWindow get: domWindow ) window = domWindow ].
!
async testFileOpen
	app fileOpenButton click.
	await Timer timeout: 1000.
	self assert: [ app fileTextArea value includes: 'Lizard' ].
!
async testSize
	| oldSize |

	window moveToCenter.
	window resizable: true.
	"Minimum and maximum sizes are one enforced after window move or resize,
	 so they are not tested here."
	window minimumSize: 100 @ 200.
	window maximumSize: 800 @ 600.
	await Timer timeout: 500.

	"Windows sizing operation are executed async,
	so small delay is done before checking each result,
	which also allows for a visual check."


	"Resizing sets the *inner* window size,
	 while window size gives the *outer* window size."
	window resizeTo: ( 400 @ 200 ).
	await Timer timeout: 500.
	self assert: [ window size >= ( 400 @ 200 ) ].
	self assert: [ window size < ( 500 @ 300 ) ].

	oldSize := window size.
	window resizeBy: ( 20 @ 10 ).
	await Timer timeout: 500.

	"2025-10-03: ResizeBy does not work anymore?
		And can even *reduce* the window size by 1 because of rounding?"
	"self assert: [ window size >= ( oldSize + ( 20 @ 10 ) ) ]."
	self assert: [ window size + ( 5 @ 5 ) >= oldSize ].
!
async testMinimizeMaximize
	| oldSize |

	"Skip minimizing and maximizing tests on Linux because of this issue:
	 https://github.com/nwjs/nw.js/issues/8291"
	"Skip minimizing and maximizing tests on Macos because of issues."
	Window isLinux | Window isMacos ifTrue: [ ^ self ].

	oldSize := window size.
	window maximize.
	await Timer timeout: 500.
	"Maximizing does not change the NW.js window size,
	 but the DOM window size *is* changed."
	self assert: [ window window innerSize > oldSize ].

	window minimize.
	"MacOS needs longer timeout because of animations."
	await Timer timeout: 1000.
	self assert: [ Document default hidden ].

	window restore.
	window focus: true.
	await Timer timeout: 1000.
	self assert: [ Document default hidden not ].

	"TODO: Is this necessary for any platform?"
	window resizeTo: oldSize.
	await Timer timeout: 500.
!
async testMove
	window moveTo: ( 200 @ 100 ).
	await Timer timeout: 500.
	self assert: [ window offset = ( 200 @ 100 ) ].

	window moveBy: ( 20 @ 10 ).
	await Timer timeout: 500.
	self assert: [ window offset >= ( 218 @ 108 ) ].

	window moveToCenter.
	await Timer timeout: 500.
	self assert: [ window offset > ( 220 @ 110 ) ].
!
async testFullscreen
	window fullscreen: true.
	await Timer timeout: 1000.
	self assert: [ window fullscreen ].

	window fullscreen: false.
	await Timer timeout: 1000.
	self assert: [ window fullscreen not ].
!
async testFocus
	"Does not work right on MacOS and Linux."
	Window isWindows ifFalse: [ ^ nil ].

	window focus: false.
	await Timer timeout: 500.
	self assert: [ window focus not ].

	window focus: true.
	await Timer timeout: 500.
	self assert: [ window focus ].
!
async testShow
	window show: false.
	await Timer timeout: 500.
	self assert: [ window show not ].

	window show: true.
	window focus: true.
	await Timer timeout: 500.
	"Unfortunately, window.show does not restore the document visibility state,
	even though tge document is shown."
	"self assert: [ window show not ]."
!
async testAlwaysOnTop
	window alwaysOnTop: true.
	await Timer timeout: 500.
	self assert: [ window alwaysOnTop ].

	window alwaysOnTop: false.
	await Timer timeout: 500.
	self assert: [ window alwaysOnTop not ].
!
async testKioskMode
	"Skip kiosk mode on MacOS because the app won't quit anymore after using it."
	Window isMacos ifTrue: [ ^ self ].

	window kioskMode: true.
	await Timer timeout: 500.
	self assert: [ window kioskMode ].

	window kioskMode: false.
	await Timer timeout: 500.
	self assert: [ window kioskMode not ].
!
async testAttention
	window requestAttention: true.
	await Timer timeout: 3000.
!
close
	window close.
	"window closeForce."
	"app quit."
!

"Manual tests"

reload
	"Only called in manual test, because it restarts the app."
	window reload.
	"window reloadIgnoringCache."
!
devTools
	"Only called in manual test, because the dev tools window cannot be closed (NW.js bug)."
	window devTools: true.
!

"TODO: Test: open: url options: options"
"TODO: test: eval: script frame: frame"
CLASS MyNodeGuiApp EXTENDS QApplication MODULE MyNodeGuiApp CLASSVARS ''
	VARS 'window greetLabel changeStyleButton colors colorIndex'

start
	colors := #( 'black' 'red' 'green' 'blue' ).
	colorIndex := 0.

	self createWindow.
!
createWindow
	window := QMainWindow new.
	window setWindowTitle: 'Hello NodeGui'.
	window setWindowIcon: self createIcon.
	window setMenuBar: self createMenuBar.
	window setStyleSheet: self createStyleSheet.
	window setCentralWidget: self createCentralWidget.
	window show.
!
createIcon
	^ QIcon new: 'assets/logo.ico'.
!
createMenuBar
	| action menu menuBar |

	action := QAction new.
	action setText: 'Exit'.
	action addEventListener: 'triggered' then: [ self onFileExit ].

	menu := QMenu new.
	menu setTitle: 'File'.
	menu addAction: action.

	menuBar := QMenuBar new.
	menuBar addMenu: menu.
	^ menuBar.
!
onFileExit
	QApplication instance quit.
!
createStyleSheet
	^ ( Fs readFileSync: 'assets/default.css' ) toString.
!
createCentralWidget
	| widget |
	widget := QWidget new.
	widget setObjectName: 'root'.
	widget setLayout: self createRootLayout.
	^ widget.
!
createRootLayout
	| layout |
	layout := QBoxLayout new: QLayout topToBottom.
	layout addWidget: self createImageLabel stretch: 0 align: QLayout alignCenter.
	layout addWidget: self createGreetLabel stretch: 0 align: QLayout alignCenter.
	layout addWidget: self createChangeStyleButton stretch: 0 align: QLayout alignCenter.
	^ layout.
!
createImageLabel
	| image label |
	image := QPixmap new: 'assets/logo.png'.
	label := QLabel new setPixmap: image.
	^ label.
!
createGreetLabel
	| label |
	label := QLabel new.
	label setObjectName: 'greetLabel'.
	label setText: 'Hello from NodeGui!'.
	greetLabel := label.
	^ label.
!
createChangeStyleButton
	| button |
	button := QPushButton new.
	button setObjectName: 'changeStyleButton'.
	button setText: 'Change style'.
	button onClick: [ self changeStyle ].
	changeStyleButton := button.
	^ button.
!
changeStyle
	colorIndex := colorIndex + 1 % colors length.
	greetLabel setInlineStyle: 'color: ', ( colors at: colorIndex ).
!

"Accessing (used by tests)"

greetLabel
	^ greetLabel.
!
changeStyleButton
	^ changeStyleButton.
!
colors
	^ colors.
!
colorIndex
	^ colorIndex.
!
CLASS TestMyNodeGuiApp EXTENDS Object MODULE TestMyNodeGuiApp CLASSVARS ''
	VARS 'myNodeguiApp'

"Test MyNodeguiApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	myNodeguiApp := MyNodeGuiApp new start.
	await Timer timeout: 1000.
	await TestQApplication all.
 	await self testGui.
!
async testGui
	"Click the 'Change Style' button
	 and check if the style of the greeting label has changed."

	myNodeguiApp changeStyleButton click.
	await Timer timeout: 1000.
	"NodeGui/QT cannot read widget styles,
	 so just check if colorIndex has changed."
	self assert: [ myNodeguiApp colorIndex = 1 ].

	await Timer timeout: 1000.
	myNodeguiApp quit.
!
CLASS MyElectronApi EXTENDS ElectronApi MODULE MyElectronPreload CLASSVARS '' VARS ''

expose
	self apiName: 'myApi'.
	self addMethod: 'setTitle' block: [ :title | self setTitle: title ].
	self addMethod: 'ping' block: [ :data :callback | self ping: data then: callback ].
	self addMethod: 'quit' block: [ self quit ].
	self exposeInMainWorld.
!
setTitle: title
	self log: 'MyElectronApi: Sending "setTitle" to ipcRenderer with title: ', title.
	self send: 'setTitle' with: title.
!
ping: data then: callback
	self log: 'MyElectronApi: Invoking "ping" on ipcRenderer with data: ', data.
	self invoke: 'ping' with: data then: callback.
!
quit
	self log: 'MyElectronApi: Sending "quit" to ipcRenderer'.
	self send: 'quit'.
!
CLASS MyElectronApp EXTENDS ElectronApp MODULE MyElectronMain CLASSVARS ''
	VARS 'browserWindow'

start
	self whenReady: [ self start2 ].
!
start2
	self setListeners.
	self setMenu.
	self createWindow.
	self loadHtml.

	"Uncomment this to open the devtools in the view."
	"self openDevTools."
!

"Listeners"

setListeners
	self on: 'setTitle' then: [ :event :title | self onSetTitle: title ].
	self handle: 'ping' then: [ :event :data | self onPing: data ].
	self on: 'quit' then: [ self onQuit ].
!
onSetTitle: title
	self log: 'MyElectronApp: Received new title: ', title.
	browserWindow setTitle: title.
!
onPing: data
	| result |
	self log: 'MyElectronApp: Received ping with data: ', data.

	result := 'Pong'.
	self log: 'MyElectronApp: Replying with result data: ', result.
	^ result.
!
async onQuit
	self log: 'MyElectronApp: Received quit request.'.
	await Timer timeout: 1000.
	self quit.
!

"Menu"

setMenu
	| fileMenu mainMenu |

	fileMenu := ElectronMenu new.
	fileMenu append: ( ElectronMenuItemOptions new label: 'Exit'; click: [ self onFileExit ] ).

	mainMenu := ElectronMenu new.
	mainMenu append: ( ElectronMenuItemOptions new label: 'File'; submenu: fileMenu ).

	ElectronMenu setApplicationMenu: mainMenu.
!
onFileExit
	self quit.
!

"Create window"

createWindow
	| webPreferences options  |

	webPreferences := WebPreferences new
		nodeIntegration: true;
		nodeIntegrationInWorker: true;
		nodeIntegrationInSubFrames: true;
		contextIsolation: true;
		sandbox: false;
		preload: ( Path resolve: 'preload.mjs' ).

	options := BrowserWindowOptions new
		width: 1000;
		height: 800;
		webPreferences: webPreferences.

	browserWindow := BrowserWindow new: options.
!

"HTML"

loadHtml
	browserWindow loadFile: 'index.html' options: self loadOptions
		then: [ self log: 'MyElectronApp: HTML file loaded in browser window' ]
		error: [ :error | self log: error ].
!
loadOptions
	| options |
	options := ElectronLoadFileOptions new.
	self testMode ifTrue: [
		options search: '?test' ].
	^ options.
!

"Testing"

openDevTools
	browserWindow openDevTools.
!

CLASS TestMyElectronApp EXTENDS Object MODULE TestMyElectronMain CLASSVARS ''
	VARS 'myElectronApp'

"Test ShopServer units and API.
 This class is not a subclass of Test so is not called automatically with Test all."

start
	myElectronApp := MyElectronApp new start.

	"Run sync and async unit tests of all imported Test* classes and log results."
	TestWebPreferences all.
!
CLASS MyElectronView EXTENDS ElectronView MODULE MyElectronRenderer CLASSVARS ''
	VARS 'colorTextButton colorTextResultSpan
		setTitleButton setTitleResultSpan
		pingButton pingResultSpan'

start
	self log: 'MyView: Start'.
	self bindElements.
!
bindElements
	colorTextButton := Document getElementById: 'colorTextButton' class: HtmlButtonElement.
	colorTextButton onClick: [ self colorText ].
	colorTextResultSpan := Document getElementById: 'colorTextResultSpan' class: HtmlSpanElement.

	setTitleButton := Document getElementById: 'setTitleButton' class: HtmlButtonElement.
	setTitleButton onClick: [ self setTitle ].
	setTitleResultSpan := Document getElementById: 'setTitleResultSpan' class: HtmlSpanElement.

	pingButton := Document getElementById: 'pingButton' class: HtmlButtonElement.
	pingButton onClick: [ self ping ].
	pingResultSpan := Document getElementById: 'pingResultSpan' class: HtmlSpanElement.
!
colorText
	self log: 'MyElectronView: Color text button clicked.'.
	colorTextResultSpan style setProperty: 'background' value: 'lightgreen'.
	colorTextResultSpan textContent: 'Colored text'.
!
setTitle
	| title |
	self log: 'MyElectronView: Modify title button clicked.'.
	title := 'Hello Electron! (modified title)'.
	self callApi: 'myApi' method: 'setTitle' with: title.
	setTitleResultSpan textContent: 'Title modified'.
!
ping
	| data |
 	self log: 'MyElectronView: Ping button clicked.'.
	data := 'Ping'.
	self callApi: 'myApi' method: 'ping' with: data
		then: [ :result | self onPing: result ].
!
onPing: result
	self log: 'MyElectronView: Received result from API: ', result.
	pingResultSpan textContent: result.
!
quit
	self log: 'MyElectronView: Requesting app to quit.'.
	self callApi: 'myApi' method: 'quit'.
!

"Accessing - Used by tests"

colorTextButton
	^ colorTextButton.
!
colorTextResultSpan
	^ colorTextResultSpan.
!
setTitleButton
	^ setTitleButton.
!
setTitleResultSpan
	^ setTitleResultSpan.
!
pingButton
	^ pingButton.
!
pingResultSpan
	^ pingResultSpan.
!
CLASS TestMyElectronView EXTENDS Object MODULE TestMyElectronRenderer CLASSVARS ''
	VARS 'myElectronView'

"Test MyElectronView units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	myElectronView := MyElectronView new start.
	await Timer timeout: 2000.
	Console log: 'TestMyElectronView: running GUI tests.'.

	"Click on the buttons 'Color Text', 'Modify Title' and 'Ping'
	 and check for the expected results in span elements."

	await self testButton: myElectronView colorTextButton
		resultSpan: myElectronView colorTextResultSpan
		result: 'Colored text'.

	await self testButton: myElectronView setTitleButton
		resultSpan: myElectronView setTitleResultSpan
		result: 'Title modified'.

	await self testButton: myElectronView pingButton
		resultSpan: myElectronView pingResultSpan
		result: 'Pong'.

	await Timer timeout: 1000.

	myElectronView quit.
!
async testButton: button resultSpan: resultSpan result: result
	"Press argument button and check result text result span."
	button click.
	await Timer timeout: 1000.
	self assert: [ resultSpan textContent = result ].
!
CLASS Counter EXTENDS Object MODULE CounterApp CLASSVARS '' VARS 'value'

constructor
	value := 0.
!
value
	^ value.
!
increment
	value := value + 1.
!
reset
	value := 0.
!
CLASS CounterApp EXTENDS BrowserApp MODULE CounterApp CLASSVARS ''
	VARS 'counter counterSpan incrementButton resetButton'

start
	counter := Counter new.
	self bindElements.
	self update.
!
bindElements
	"Bind HTML elements to vars, set defaults, set event listeners."

	counterSpan := Document getElementById: 'counterSpan' class: HtmlSpanElement.

	incrementButton := Document getElementById: 'incrementButton' class: HtmlButtonElement.
	incrementButton onClick: [ self increment ].

	resetButton := Document getElementById: 'resetButton' class: HtmlButtonElement.
	resetButton onClick: [ self reset ].
!
update
	"Update counter in HTML page."

	counterSpan textContent: counter value toString.
!
increment
	"Increase the counter and update the view."

	counter increment.
	self update.
!
reset
	"Increase the counter and update the view."

	counter reset.
	self update.
!

"Accessing (used by tests)"

counterSpan
	^ counterSpan.
!
incrementButton
	^ incrementButton.
!
resetButton
	^ resetButton.
!
CLASS TestCounter EXTENDS Test MODULE TestCounterApp CLASSVARS '' VARS ''

test
	| counter |

	counter := Counter new.

	self assert: [ counter value = 0 ].

	counter increment increment.
	self assert: [ counter value = 2 ].

	counter reset.
	self assert: [ counter value = 0 ].
!
CLASS TestCounterApp EXTENDS Object MODULE TestCounterApp CLASSVARS ''
	VARS 'counterApp'

"Test CounterApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	counterApp := CounterApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestCounter all.
	await self testGui.
!
async testGui
	"Click increase counter button 2 times then click reset.
	 For every click check if counter label is updated correctly.
	 Exit if all tests succeed."

	await self testButton: counterApp incrementButton result: '1'.
	await self testButton: counterApp incrementButton result: '2'.
	await self testButton: counterApp resetButton  result: '0'.

	await Timer timeout: 500.
	counterApp stop.
!
async testButton: button result: result
	"Press argument button and check result in counter label."
	button click.
	await Timer timeout: 500.
	self assert: [ counterApp counterSpan textContent = result ].
!
CLASS Benchmark EXTENDS Object MODULE Benchmark CLASSVARS '' VARS 'size jsTime stTime'

"Abstract base class for benchmark implementations.
 The following 3 methods should be overridden in subclasses."

name
	self subclassResponsibility.
!
runJs: size
	self subclassResponsibility.
!
runSt: size
	self subclassResponsibility.
!

"Size indicates the number of 'iterations' in the benchmark.
 For higher values is should take more time to complete the benchmark.
 E.g.: In the PrimesBenchmark, size is the number of primes that are calculated."

size
	^ size.
!
size: aSize
	size := aSize.
!

"Stored times of benchmarks that have run."

stTime
	^ stTime.
!
jsTime
	^ jsTime.
!
factor
	^ jsTime = 0 ifTrue: [ 0.0 ] ifFalse: [ stTime toFloat / jsTime ].
!

"Time the running ot JS and ST benchmarks."

timeRunJs
	^ jsTime := self time: [ self runJs ].
!
timeRunSt
	^ stTime := self time: [ self runSt ].
!

time: block
	| start end |

	start := Date new toMilliseconds.
	"self log: block value."
	block value.
	end := Date new toMilliseconds.

	^ end - start
!
CLASS BenchmarkApp EXTENDS BrowserApp MODULE BenchmarkApp CLASSVARS ''
	VARS 'benchmarks size resultsTable runAllButton'

start
	self initializeBenchmarks: self benchmarkConfigs.
	self bindElements.
	self clearBenchmarks.
!
initializeBenchmarks: configs
	| benchmark |

	benchmarks := Array new.
	configs do: [ :benchmarkConfig |
		benchmark := ( benchmarkConfig at: 0 ) new.
		benchmark size: ( benchmarkConfig at: 1 ).
		benchmarks add: benchmark ].
!
benchmarkConfigs
	"Array of benchmark configurations, each containing benchmark class and size to run."
	^ #(
		#( PrimesBenchmark 20000 )
		#( FibonacciBenchmark 100000 )
		#( PiBenchmark 4000 )
	)
!
bindElements
	resultsTable := Document getElementById: 'resultsTable' class: HtmlTableElement.
	runAllButton := Document getElementById: 'runAllButton' class: HtmlButtonElement.
	runAllButton onClick: [ self runAllButtonClicked ].
!
clearBenchmarks
	"(Re)load benchmarkClasses into table and clear results."
	| row |
	resultsTable tBody innerHtml: ''.
	benchmarks do: [ :benchmark |
		row := resultsTable tBody insertRow: -1.
		row insertCell textContent: benchmark name.
		row insertCell textContent: benchmark size.
		3 timesRepeat: [ row insertCell ] ].
!
runAllButtonClicked
	self clearBenchmarks.
	self setCursor: 'wait'.
	self runBenchmarks.
!
setCursor: value
	Document default body style setProperty: 'cursor' value: value.
	runAllButton style setProperty: 'cursor' value: value.
	resultsTable style setProperty: 'cursor' value: value.
!
async runBenchmarks
	| benchmark row |

	0 to: benchmarks length - 1 do: async [ :index |
		"Pause shortly between benchmarks to allow async GUI updates."
		await Timer timeout: 100.
		benchmark := benchmarks at: index.
		row := resultsTable rows at: index + 1.
		self runBenchmark: benchmark row: row ].
!
runBenchmark: benchmark row: row
		benchmark timeRunJs.
		( row cells at: 2 ) textContent: benchmark jsTime toString.

		benchmark timeRunSt.
		( row cells at: 3 ) textContent: benchmark stTime toString.

		( row cells at: 4 ) textContent: ( benchmark factor toFixed: 1 ).

		"Restrore cursor after last benchmark."
		benchmark = benchmarks last ifTrue: [
			self setCursor: 'default' ].
!

"Accessing (used by tests)"

benchmarks
	^ benchmarks.
!
resultsTable
	^ resultsTable.
!
runAllButton
	^ runAllButton.
!
CLASS FibonacciBenchmark EXTENDS Benchmark MODULE Benchmark CLASSVARS '' VARS ''

"Implements JS and ST benchmark for calculating Fibonacci numbers."

INLINE 'import { Fibonacci } from "./JavaScript/Fibonacci.js";'

constructor
	"Number of Fibonacci numbers to find."
	size := 1000.
!
name
	^ 'Fibonacci'.
!
runJs
	^ BigInt fromJs: INLINE 'Fibonacci.fib( this.size.js )'.
!
runSt
	"Return the n-th fibonacci number indicated by size."
	| a b c |

	size = 0 ifTrue: [ ^ 0 ].

	a := 0.
	b := 1.

	size - 1 timesRepeat: [
		c := a + b.
		a := b.
		b := c ].

	^ b.
!
CLASS PiBenchmark EXTENDS Benchmark MODULE Benchmark CLASSVARS '' VARS ''

"Implements JS and ST benchmark for calculating digits of PI."

INLINE 'import { Pi } from "./JavaScript/Pi.js";'

constructor
	"Number of digits to find."
	size := 20.
!
name
	^ 'Pi'.
!
runJs
	^ String fromJs: INLINE 'Pi.digits( this.size.js )'.
!
runSt
	| digits q r t i digit u |

	digits := ''.
	q := 1.
	r := 180.
	t := 60.
	i := 2.

	self size timesRepeat: [
		digit := i * 27 - 12 * q + ( r * 5 ) // ( t * 5 ).
		digits := digits, digit toString.

		u := i * 3.
		u := u + 1 * 3 * ( u + 2 ).
		r := i * 5 - 2 * q + r - ( t * digit ) * u * 10.
		q := i * 2 - 1 * q * 10 * i.
		t := t * u.
		i increment ].

	^ digits.
!
CLASS PrimesBenchmark EXTENDS Benchmark MODULE Benchmark CLASSVARS '' VARS ''

"Implements JS and ST benchmark for calculating primes."

INLINE 'import { Primes } from "./JavaScript/Primes.js";'

constructor
	"Number upto which to find all primes."
	size := 100000.
!
name
	^ 'Primes'.
!
runJs
	^ Integer fromJs: INLINE 'Primes.primes( this.size.js )'.
!
runSt
	| count |
	count := 0.

	1 to: size do: [ :num |
		num isPrime ifTrue: [
			count increment ] ].

	^ count.
!
CLASS TestBenchmark EXTENDS Test MODULE TestBenchmark CLASSVARS '' VARS ''

testPrimes
	| benchmark result |

	benchmark := PrimesBenchmark new size: 1000.
	result := 168.

	self assert: [ benchmark runJs = result ].
	self assert: [ benchmark runSt = result ].
!
testFibonacci
	| benchmark result |

	benchmark := FibonacciBenchmark new size: 50.
	result := 12586269025.

	self assert: [ benchmark runJs = result ].
	self assert: [ benchmark runSt = result ].
!
testPi
	| benchmark result |

	benchmark := PiBenchmark new size: 20.
	result := '31415926535897932384'.

	self assert: [ benchmark runJs = result ].
	self assert: [ benchmark runSt = result ].
!
CLASS TestBenchmarkApp EXTENDS Object MODULE TestBenchmarkApp CLASSVARS ''
	VARS 'benchmarkApp'

"Test BenchmarkApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	benchmarkApp := BenchmarkApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestBenchmark all.
	await self testGui.
	self stop.
!
async testGui
	"Click increase counter button 2 times then click reset.
	 For every click check if counter label is updated correctly.
	 Exit if all tests succeed."

	"Check if benchmarks are loaded in banchmark table."
	self assert: [ benchmarkApp resultsTable rows length - 1 = benchmarkApp benchmarks length ].

	benchmarkApp runAllButton click.
	await Timer timeout: 8000.

	"Check if all benchmark results contain numbers."
	benchmarkApp resultsTable tBody rows do: [ :row |
		self assert: [ ( row cells at: 1 ) textContent toInteger >= 1000 ].
		self assert: [ ( row cells at: 2 ) textContent toInteger >= 0 ].
		self assert: [ ( row cells at: 3 ) textContent toInteger >= 0 ].
		self assert: [ ( row cells at: 4 ) textContent toFloat >= 0.0 ] ].
!
stop
	benchmarkApp stop.
!
CLASS Ball EXTENDS Object MODULE BallsApp CLASSVARS '' VARS 'radius position speed color'

CLASSMETHODS

"Creating"

newIn: bounds
	| ball speed |
	ball := Ball new.
	ball radius: 16.
	ball position: ( Integer randomFrom: ball radius to: bounds x - ball radius ) @
			( Integer randomFrom: ball radius to: bounds y - ball radius ).
	ball speed: ( self randomSpeed ) @ ( self randomSpeed ).
	ball color: ( #( 'red' 'blue' 'green' ) at: ( Integer randomFrom: 0 to: 2 ) ).
	^ ball.
!
randomSpeed
	"Random speed for single direction, x or y."
	| speed |
	speed := Integer randomFrom: 2 to: 10.
	^ Float random < 0.5 ifTrue: [ speed ] ifFalse: [ speed negated ].
!
METHODS

"Accessing"

color
	^ color.
!
color: aColor
	color := aColor.
!
radius
	^ radius.
!
radius: aSize
	radius := aSize.
!
position
	^ position.
!
position: aPosition
	position := aPosition.
!
speed
	^ speed.
!
speed: aDelta
	speed := aDelta.
!

"Moving"

moveIn: bounds
	| x y |
	"Move the position of this ball with speed within the argument bounds point.
	 Bounce the ball if it goes outside bounds.I.e.: Reverse x and/or y speed."

	speed x < 0 & ( position x - radius + speed x < 0 ) ifTrue: [ speed x: speed x negated ].
	speed x > 0 & ( position x + radius + speed x > bounds x ) ifTrue: [ speed x: speed x negated ].
	speed y < 0 & ( position y - radius + speed y < 0 ) ifTrue: [ speed y: speed y negated ].
	speed y > 0 & ( position y + radius + speed y > bounds y ) ifTrue: [ speed y: speed y negated ].

	position := position + speed.
!
CLASS BallsApp EXTENDS BrowserApp MODULE BallsApp CLASSVARS ''
	VARS 'balls stopRequested timer
		canvas context ballsInput startButton stopButton'

start
	self bindElements.
	self initialize.
!
bindElements
	"Bind HTML elements to vars, set defaults, set event listeners."

	canvas := Document getElementById: 'canvas' class: HtmlCanvasElement.

	ballsInput := Document getElementById: 'ballsInput' class: HtmlInputElement.

	startButton := Document getElementById: 'startButton' class: HtmlButtonElement.
	startButton onClick: [ self startMoving ].

	stopButton := Document getElementById: 'stopButton' class: HtmlButtonElement.
	stopButton onClick: [ self stopMoving ].
!
initialize
	context := canvas getContext: '2d'.
	timer := Timer new.
!
startMoving
	| ballCount |

	"Stop timer in case it was running."
	timer clearTimeout.

	"Create balls."
	balls := Array new.
	ballCount := ballsInput value toInteger max: 1.
	ballCount timesRepeat: [
		balls add: ( Ball newIn: canvas size ) ].

	stopRequested := false.
	self move.
!
move
	"Move balls and redraw canvas"

	stopRequested ifTrue: [ ^ self ].

	context clearRect: ( Rect origin: 0 @ 0 extent: canvas size ).

	balls do: [ :ball |
		ball moveIn: canvas size.
		self drawBall: ball ].

	timer timeout: 100 then: [ self move ].
!
drawBall: ball
	| radius topRight bottomLeft gradient |

	radius := ball radius.
	topRight := ball position + ( Point x: radius y: radius negated ).
	bottomLeft := ball position + ( Point x: radius negated y: radius ).

	gradient := context createLinearGradientFrom: topRight to: bottomLeft.
	gradient addColorStop: 0 color: 'white'.
	gradient addColorStop: 0.4 color: ball color.
	gradient addColorStop: 1 color: '#101010'.

	context beginPath.
	context fillStyle: gradient.
	context arc: ball position radius: ball radius startAngle: 0 endAngle: Float pi * 2 counterclockwise: false.
	context fill.
	context closePath.
!
stopMoving
	stopRequested := true.
!

"Accessing elements (used by tests)"

ballsInput
	^ ballsInput.
!
startButton
	^ startButton.
!
stopButton
	^ stopButton.
!

"Accessing variables (used by tests)"

balls
	^ balls.
!
stopRequested
	^ stopRequested.
!
timer
	^ timer.
!
CLASS TestBall EXTENDS Test MODULE TestBallsApp CLASSVARS '' VARS ''

test
	| ball |

	ball := Ball new.

	ball color: 'red'.
	self assert: [ ball color = 'red' ].

	ball radius: 10.
	self assert: [ ball radius = 10 ].

	ball position: 30 @ 20.
	self assert: [ ball position = ( 30 @ 20 ) ].

	ball speed: 3 @ 2.
	self assert: [ ball speed = ( 3 @ 2 ) ].

	"Bounce off lower right corner."
	ball moveIn: 30 @ 20.
	self assert: [ ball position = ( 27 @ 18 ) ].
	self assert: [ ball speed = ( -3 @ -2 ) ].

	"Bounce off top left."
	ball position: 0 @ 0.
	ball moveIn: 30 @ 20.
	self assert: [ ball position = ( 3 @ 2 ) ].
	self assert: [ ball speed = ( 3 @ 2 ) ].

	ball := Ball newIn: 200 @ 100.
	self assert: [ ball class = Ball ].
	self assert: [ ball radius = 16 ].
	self assert: [ ball position x >= 0 ].
	self assert: [ ball position y >= 0 ].
	self assert: [ self checkSpeedCoordinate: ball speed x ].
	self assert: [ self checkSpeedCoordinate: ball speed y ].
	self assert: [ #( 'red' 'blue' 'green' ) includes: ball color ].
!
checkSpeedCoordinate: speed
	^ ( speed >= -10 ) & ( speed <= -2 ) |
	  ( speed >= 2 ) & ( speed <= 10 ).
!
CLASS TestBallsApp EXTENDS Object MODULE TestBallsApp CLASSVARS '' VARS 'ballsApp'

"Test BallsApp units and GUI.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	ballsApp := BallsApp new start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestBall all.
	await self testGui.
!
async testGui
	"Set the ball count to 4.
	Press the start button.
	Check if app is running.
	Press stop button. Wait 3 sec.
	Check if the app has stopped and ran with 4 balls.
	Terminate app."

	ballsApp ballsInput value: 4.
	ballsApp startButton click.
	await Timer timeout: 3000.
	self assert: [ ballsApp stopRequested not ].
	self assert: [ ballsApp timer id notNil ].

	ballsApp stopButton click.
	await Timer timeout: 2000.
	self assert: [ ballsApp stopRequested ].
	self assert: [ ballsApp balls length = 4 ].

	ballsApp stop.
!
CLASS AiServer EXTENDS Object MODULE AiServer CLASSVARS '' VARS 'express server port aiMap'

	"This app provides an AI API for its clients in the /api route.
	 It also provides a static web server for client web content.
	 It uses AI providers that are enabled in the '.env' file."

	"Note: This example app does not have user authentication.
		See the Shop server example for an implementation of that."

METHODS

start
	self log: 'Starting AI server.'.
	self connectAis.
	self startServer.
!
connectAis
	| aiName |
	aiMap := Map new.
	AiFactory aiClasses do: [ :aiClass |
		aiClass available ifTrue: [
			aiName := aiClass name toLowerCase.
			self log: 'Enabling: ', aiName.
			aiMap set: aiName value: aiClass new ]	].

	aiMap size >= 1 ifFalse: [
		self error: 'No AIs available, check file: .env (and .env.example)' ].
!
startServer
	| portString |

	express := Express new.
	express useSession.
	express static: '../Client/web'.
	express get: '/api/providers'
		then: [ :request :response | self onProviders: request response: response ].
	express get: '/api/chat'
		then: [ :request :response | self onChat: request response: response ].

	portString := Environment at: 'AI_SERVER_PORT'.
	portString ifNil: [
		self error: 'Environment variable "AI_SERVER_PORT" not set.' ].
	port := portString toInteger.
	( port > 0 ) & ( port < 65536 ) ifFalse: [
		self error: 'Invalid port number: ', portString ].

	self log: 'Starting web server on port: ', portString.
	server := express listen: port
		then: [ self onListen ].
!
onListen
	self log: 'Web server started.'.
!

"Respond with an array of AI provides and their available models,
a JSON instance of class AiProviders.

Example request:
	http://localhost:3000/api/providers
There are no arguments.

For an example result see class AiProviders."

onProviders: request response: response
	| providers |
	providers := AiFactory providers.
	response send: providers toObject.
	self log: 'AiServer: Sent providers: ', providers toString.
!

"For the text AI chat request answer a text reponse from the selected AI.

Example request:
	http://localhost:3000/api/chat/?ai=openai&text=Say%20this%20is%20a%20test
Example result:
 	{ success: true, text: 'This is a test.' }"

async onChat: request response: response
	| chatResponse chatRequest provider ai text |

	chatResponse := AiChatResponse new success: false; text: ''.

	chatRequest := AiChatRequest fromObject: request query.
	self log: 'AiServer: Received chat request: ', chatRequest toString.

	chatRequest provider ifNil: [
		^ response send: ( chatResponse text: 'Chat request parameter "provider" missing' ) ].
	chatRequest model ifNil: [
		^ response send: ( chatResponse text: 'Chat request parameter "model" missing' ) ].
	chatRequest messages ifNil: [
		^ response send: ( chatResponse text: 'Chat request parameter "messages" missing' ) ].

	provider := chatRequest provider toLowerCase.
	ai := aiMap get: provider.
	ai ifNil: [
		^ response send: ( chatResponse text: 'AI provider not available: ', provider ) ].

	text := await ai chat: chatRequest messages.
	chatResponse success: true; text: text.
	response send: chatResponse.
	self log: 'AiServer: Sent chat response: ', chatResponse toString.
!
stop
	server terminate.
!

"Accessing - used in tests"

express
	^ express.
!
server
	^ server.
!
port
	^ port.
!
aiMap
	^ aiMap.
!
CLASS TestAiServer EXTENDS Object MODULE TestAiServer CLASSVARS ''
	VARS 'aiServer chatReponseCount'

"AiServer unit and API tests.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	aiServer := AiServer new start.

	"Run sync and async unit tests of all imported Test* classes and log results."
	TestAiFactory.
	TestAiProviders.
	await Test all.
	await self testApi.
!
async testApi
	self log: 'TestAiServer: Starting API tests.'.

	"Tests execution is chained to facilite debugging."
	await self testProviders.
	await self testChat.
	await self stopServer.
!
async testProviders
	| url object providers provider ai models |

	url := 'http://localhost:', aiServer port toString, '/api/providers'.
	object := await Fetch object: url.
	providers := AiProviders fromObject: object.
	self assert: [ providers size > 0 ].

	provider := providers map keys first.
	ai := aiServer aiMap get: provider.
	self assert: [ ai notNil ].

	models := providers modelsFor: provider.
	self assert: [ models = ai class models ].
!
async testChat
	| aiCount |
	chatReponseCount := 0.
	aiServer aiMap values do: [ :ai |
		self chatRequest: ai ].

	await Timer timeout: 10000.
	aiCount := aiServer aiMap size.
	chatReponseCount = aiCount ifFalse: [
		self log: 'TestAiServer: Warning: Incorrect chat response count: ', chatReponseCount toString, ' expected: ', aiCount toString ].
!
async chatRequest: ai
	| id chatRequest url object chatResponse |

	id := ai nextId.
	chatRequest := AiChatRequest new
		provider: ai name;
		model: ai class models first;
		messages: #( 'Say exactly: This is a test' ).
	url := 'http://localhost:', aiServer port toString, '/api/chat', chatRequest toUrlQuery.
	object := await Fetch object: url.
	self log: 'TestAiServer: Resonse received with id: ', id.
	self assert: [ id endsWith: '-1' ].

	chatResponse := AiChatResponse fromObject: object.
	self assert: [ chatResponse success ].
	self assert: [ chatResponse text toLowerCase includes: 'test' ].

	chatReponseCount := chatReponseCount + 1.
!
async stopServer
	self log: 'TestAiServer: API tests successful.'.
	self log: 'TestAiServer: Stopping server.'.

	await Timer timeout: 1000.
	aiServer stop.
!
CLASS OllamaRag EXTENDS Object MODULE RagApp CLASSVARS ''
	VARS 'ollama store'

CLASSMETHODS

store: store
	^ self new
		store: store.
!

METHODS

constructor
	ollama := Ollama new.
!
async deleteDocuments
	await store deleteDocuments.
!
async insertDocument: content
	| embedding |
	embedding := await self embed: content.
	await store insertDocument: content embedding: embedding.
!
async embed: content
	| request response |
	request := OllamaEmbedRequest new
		model: ollama embeddingModel;
		input: content.
	response := await ollama embed: request.

	^ response embedding.
!
async ask: question
	| documentRows documents context prompt response |
	documentRows := await self search: question limit: 1.
	documents := documentRows map: [ :documentRow | documentRow atProperty: 'content' ].
	context := documents join: '\n\n'.

	prompt := 'You are a helpful assistant.\n\n',
		'Context:\n', context, '\n\n',
		'Question:\n', question, '\n\n',
		'Answer using only the provided context.\n'.

	^ await ollama chat: #( prompt ).
!
async search: query limit: limit
	| queryEmbedding |
	queryEmbedding := await self embed: query.
	^ await store search: queryEmbedding limit: limit.
!
async end
	await store disconnect.
!

"Acccessing"

store
	^ store.
!
store: aStore
	store := aStore.
!
CLASS RagApp EXTENDS Object MODULE RagApp CLASSVARS ''
	VARS 'rag'

async start
	await self createRag.

	await ( Process argv includes: '-index' )
		ifTrueAwait: async [ await self indexDocuments ]
		ifFalseAwait: async [ await self queryRag: 'What is RAG?' ].

	self end.
!
async createRag
	| store |
	store := await self connectStore.
	rag := OllamaRag store: store.
!
async connectStore
	| config store |
	config := self getEnv: 'STORE_CONFIG'.
	( config toLowerCase startsWith: 'postgres:' )
		ifTrue: [ store := PostgresRagStore new ]
		ifFalse: [ store := SqliteRagStore new ].

	^ await store connect: config.
!
getEnv: variable
	"Return environment variable value or throw error if not found."
	| value |
	( value := Environment at: variable ) ifNil: [
		Error throw: 'Environment variable not set: ', variable ].
	^ value.
!
async indexDocuments
	| json documents |

	Console log: 'Indexing documents.'.

	await rag deleteDocuments.
	json := ( Fs readFileSync: 'documents.json' ) toString.
	documents := Object fromJson: json.
	await documents doAwait: async [ :document |
		await rag insertDocument: document ].

	Console log: 'Completed.'.
!
async queryRag: question
	| answer |
	Console log: 'Question: ', question.
	answer := await rag ask: question.
	Console log: 'Answer: ', answer.

	^ answer.
!
async end
	await rag end.
!

"Accessing - used in tests"

rag
	^ rag.
!
CLASS TestRagApp EXTENDS Object MODULE TestRagApp CLASSVARS ''
	VARS 'ragApp'

"AiServer unit and API tests.
This class is not a subclass of Test so is not called automatically with Test all."

async start
	| answer |

	ragApp := RagApp new.
	await ragApp createRag.

	await ragApp indexDocuments.
	answer := await ragApp queryRag: 'What is RAG?'.
	self assert: [ answer toLowerCase includes: 'rag'].

	ragApp end.
!
CLASS PostgresRagStore EXTENDS RagStore MODULE RagApp CLASSVARS '' VARS ''

async connect: connectionString
	database := await PostgresDatabase new connect: connectionString.
!
async insertDocument: content embedding: embedding
	await database
		query: 'INSERT INTO documents ( content, embedding ) VALUES ( $1, $2 )'
		with: #( content ( embedding toJson ) ).
!
async search: embedding limit: limit
	| result |
	"<=> calculates vector cosine distance with pgvector."
	result := await database
		query:
			'SELECT id, content, embedding <=> $1::vector AS distance\n',
			'\tFROM documents ORDER BY embedding <=> $1::vector LIMIT $2'
		with: #( ( embedding toJson ) limit ).

	^ result rows.
!
CLASS RagStore EXTENDS Object MODULE RagApp CLASSVARS ''
	VARS 'database'

"Abstract base class for RAG vector store implementations."

async connect: connectionString
	Error throw: 'Subclass responsibility'.
!
async disconnect
	database end.
!
async deleteDocuments
	await database query: 'DELETE FROM documents'.
!
async insertDocument: content embedding: embedding
	Error throw: 'Subclass responsibility'.
!
async search: embedding limit: limit
	Error throw: 'Subclass responsibility'.
!
CLASS SqliteRagStore EXTENDS RagStore MODULE RagApp CLASSVARS '' VARS ''

INLINE 'import * as sqliteVec$ from "sqlite-vec";'

async connect: connectionString
	| options |
	options := SqliteDatabaseOptions new
		allowExtension: true.
	database := await SqliteDatabase new
		connect: connectionString options: options.
	"Enable the vector extension for the database."
	INLINE 'sqliteVec$.load( this.database.js )'.
!
async insertDocument: content embedding: embedding
	await database
		query: 'INSERT INTO documents ( content, embedding ) VALUES ( ?, ? )'
		with: #( content ( embedding toJson ) ).
!
async search: embedding limit: limit
	| result |
	"'match' calculates the vector cosine distances with the vec0 extension."
	result := await database
		query:
			'SELECT * FROM documents\n',
			'\tWHERE embedding match ?\n',
			'\tORDER BY distance LIMIT ?'
		with: #( ( embedding toJson ) limit ).

	^ result.
!
CLASS AiClientApp EXTENDS BrowserApp MODULE AiClientApp CLASSVARS ''
	VARS 'aiProviders providerSelect modelSelect
		conversationQuestions conversationTable conversationQuestionTemplate conversationAnswerTemplate conversationClearButton
		questionTextArea questionAskButton errorSpan'

"Note:
	The variable 'conversationQuestions' is an string array that holds the user questions.
	It's is needed to resend it to an AI with every question, to allow the AI to have the conversation context."

METHODS

async start
	self bindElements.
	await self loadData.
!
bindElements
	providerSelect := Document getElementById: 'providerSelect' class: HtmlSelectElement.
	providerSelect addEventListener: 'change' then: [ self onOnProviderChange ].
	modelSelect := Document getElementById: 'modelSelect' class: HtmlSelectElement.
	modelSelect addEventListener: 'change' then: [ self onModelChange ].

	conversationTable := Document getElementById: 'conversationTable' class: HtmlTableElement.
	conversationQuestionTemplate := Document getElementById: 'conversationQuestionTemplate' class: HtmlTemplateElement.
	conversationAnswerTemplate := Document getElementById: 'conversationAnswerTemplate' class: HtmlTemplateElement.
	conversationClearButton := Document getElementById: 'conversationClearButton' class: HtmlButtonElement.
	conversationClearButton onClick: [ :event | self clearConversation ].

	questionTextArea := Document getElementById: 'questionTextArea' class: HtmlTextAreaElement.
	questionTextArea value: 'Say this is a test'.
	questionAskButton := Document getElementById: 'questionAskButton' class: HtmlButtonElement.
	questionAskButton onClick: [ :event | self askQuestion ].

	errorSpan := Document getElementById: 'errorSpan' class: HtmlSpanElement.
!
async loadData
	| object providers option |
	providerSelect length: 0.

	object := await Fetch object: self url, '/api/providers'.
	aiProviders := AiProviders fromObject: object.
	providers := aiProviders providers.
	providers length > 0 ifFalse: [
		errorSpan textContent: 'No AI providers available. Check .env file on server.'.
		^ nil ].

	providers do: [ :provider |
		option := Document default createElement: 'option'.
		option text: provider.
		option value: provider.
		providerSelect add: option ].

	self onOnProviderChange.
!
onOnProviderChange
	"Set models for selected provider"
	|  provider |

	provider := providerSelect value.
	provider ifNotNil: [
		self setModelsFor: provider ].
!
setModelsFor: provider
	| models option |

	modelSelect length: 0.

	models := aiProviders modelsFor: provider.
	models do: [ :model |
		option := Document default createElement: 'option'.
		option value: model.
		option text: model.
		modelSelect add: option ].

	self onModelChange.
!
onModelChange
	self clearConversation.
!
clearConversation
	conversationQuestions := #().
	conversationTable removeChildren.
!
async askQuestion
	| request url object response |

	conversationQuestions add: questionTextArea value.

	request := AiChatRequest new
		provider: providerSelect value;
		model: modelSelect value;
		messages: conversationQuestions.

	url := self url, '/api/chat', request toUrlQuery.
	object := await Fetch object: url.

	response := AiChatResponse fromObject: object.
	response success
		ifTrue: [ self displayResponse: response ]
		ifFalse: [ errorSpan textContent: response text ].
!
displayResponse: response
	|  questionRow questionSpan answerRow answerSpan |

	questionRow := conversationQuestionTemplate cloneContent firstElementChild.
	questionSpan := questionRow cells first firstElementChild.
	questionSpan textContent: questionTextArea value.
	conversationTable appendChild: questionRow.

	answerRow := conversationAnswerTemplate cloneContent firstElementChild.
	answerSpan := answerRow cells first lastElementChild.
	answerSpan textContent: response text.
	conversationTable appendChild: answerRow.
!
onError: error
	errorSpan textContent: 'Error: ', error message.
!

"Accessing (used by tests)"

providerSelect
	^ providerSelect.
!
modelSelect
	^ modelSelect.
!
conversationTable
	^ conversationTable.
!
conversationClearButton
	^ conversationClearButton.
!
questionTextArea
	^ questionTextArea.
!
questionAskButton
	^ questionAskButton.
!
errorSpan
	^ errorSpan.
!
CLASS TestAiClientApp EXTENDS Object MODULE TestAiClientApp CLASSVARS '' VARS 'aiClientApp'

"Tests the GUI of the AI client login page.
 This class is not a subclass of Test so is not called automatically with Test all."

async start
	aiClientApp := AiClientApp new.
	await aiClientApp start.

	"Run sync and async tests of all imported Test* classes and log results."
	await TestAiProviders all.
	await self testGui.
	self stop.
!
async testGui
	"Check if login fields are filled correctly and then press login button.
	 Should navigate tot producs page then."

	await Timer timeout: 500.
	self testLoadedFields.
	await self testAskQuestion.

!
testLoadedFields
	self assert: [ aiClientApp modelSelect value length > 0 ].
	self assert: [ aiClientApp providerSelect value length > 0 ].
!
async testAskQuestion
	| conversationTable questionSpan answerSpan |

	aiClientApp questionTextArea value: 'Say exactly: This is a test'.
	aiClientApp questionAskButton click.
	await Timer timeout: 8000.

	conversationTable := aiClientApp conversationTable.
	self assert: [ conversationTable rows length = 2 ].

	questionSpan := conversationTable rows first cells first firstElementChild.
	self assert: [ questionSpan textContent = 'Say exactly: This is a test' ].

	answerSpan := conversationTable rows last cells first lastElementChild.
	self assert: [ answerSpan textContent toLowerCase includes: 'test' ].

	self testClearConversation.
!
async testClearConversation
	aiClientApp conversationClearButton click.
	await Timer timeout: 1000.

	self assert: [ aiClientApp conversationTable rows length = 0 ].
!
stop
	aiClientApp stop.
!
# SmallJS documentation

Click on the headings to open further documentation.

## [Installing](Installing/Installing.md)

How to install SmallJS.

## [SmallJS language](Language/Language.md)

Design choices and tutorial for SmallJS.

## Folders in the repo

The repo has the following other subfolders in the root:

### [Smalltalk](../Smalltalk/Smalltalk.md)

The main Smalltalk library source code of the system,\
for browser and Node.js environments and classes shared by both.

### [Compiler](../Compiler/Compiler.md)

The compiler (transpiler) compiles from ST to JS, running in Node.js.\
It is called from other projects, like ./Node and ./Browser.

### [Browser](../Browser/Browser.md)

Test application for running SmallJS code in web browsers.

### [Node](../Node/Node.md)

Test application for running SmallJS code in Node.js.

### [Database](../Database/Database.md)

A guide to installing and using supported databases with SmallJS.

### [Examples](../Examples/Examples.md)

Example projects written in SmallJS: Counter, Todo and Shop.

### [Extension](../Extension/Extension.md)

The SmallJS language extension for syntax coloring and debugging in VSCode.

### [Playground](../Playground/Playground.md)

A playground app where you can evaluate arbitrary Smalltalk (ST) expressions.\
The playground is available online too: [small-js.org/Playground](https://small-js.org/Playground)

## [Contributions](../Contributions/Contributions.md)

Contributions to SmallJS that are not part of the main system.
but show interesting applications.

# Testing in SmallJS

## Unit tests

### Naming test classes and methods

The convention is to create a `./Test` folder for *every* folder within `./Smalltalk`.
In this folder, there should be a test class for every class in the parent folder,
named `Test<classname>`, e.g.: `TestInteger`. A test class should extend the base class `Test`.
The module name should be `Test` followed by the module name of the class being tested, e.g.: `TestCore`.
Testing methods should be named `test<method>`, e.g.: `testAddition`.
Other methods can be added as utility methods, and will not be called automatically.

### Writing tests

In a test* method there are 2 main functions to call:

#### True assertions
For these standard tests, the argument block must evaluate to true for a succesful test, e.g.:
> `self assert: [ 1 + 2 = 3 ].`

Any other result will throw an error.

#### Error assertions
In these tests, the argument block intentionally triggers an error.
If an error occurs the test succeeds, e.g.:
> `self assertError: [ 'a' * 2 ].`

If no error occurs, an error with be thrown...

### Running tests

To run all tests (all test* methods) of a test class instance call the 'all' method, e.g.:
> `TestInteger new all`

To run *all* tests on *all* test classes call:
> `Test all`

This will automatcally find all classes named Test* and call their methods named test*.
To be able to 'see' the classes within a test module, that module needs te be loaded.
This can be forced by referencing any class within the test module, e.g. by this code line:
> `TestInteger.`
# async / await / promises

## async / await / promises in JS

Unfortunately in JS, the *called* method decides if it should (always) be executed async.\
It is not possible to circumvent this by just adding a `fork` method to the Block class,\
as is the ST standard.

In JS, it is possible to execute an 'async' method synchrounously by using the keyword `await`.\
Unfortunately the calling function using `await` *must* itself then become `async` too.\
So if there is a single async method deep down in a call stack, e.g. a file operation,\
it is common for all methods in the call stack to become `async` using `await`'s,\
to be table to execute the topmost method body sync.

An `async` JS function *alwas* returns a JS Promise, \
which resolves to the return value of that function when is it fulfilled.\
I.e.: when the async function was executed and produces a result.

## async / await / promises in SmallJS

So given the limitations above, how is async implemented in SmallJS?\
Well, it follows JS as closely as possible.\
If you know JS promises already, the following will be straightforward.

### Basic use of async / await

The `async` and `await` keywords are directly support in SmallJS.\
Here's a code example using the FS promises API:

```
	async logFileText: fileName
		| text |
		text := await Fsp readFile: fileName options: nil.
		Console log: text.
	!
```

Here, the async `readFile:options:` operation on class `Fsp` is awaited.\
Variable `text` will contain the final result of reading operation.\
Note that the funtion `logFileText:` containing `await` must now also be `async`.

### Async blocks

Next to methods, blocks can also be async by putting the `async` keyword before them:
```
	async [ object doSomething ]
```
The result of of an async block can also be awaited.\
And an async block can await internal async operations:
```
	result := await async [ await object doSometingAsync ] value.
```

Catching an error form an async block can ***only*** be done,\
if the block is awaited using the `tryAwaitCatch:` method:\
(The first `await` is optional for getting the error result)
```
	result := await async [ Object missingMethod ]
		tryAwaitCatch: [ :error | self onTryCatch: error ].
```
### Awaiting async blocks in while loops

To await the results of async funtions in `while` loops\
the special await versions should be called:\
(The first `await`'s are optional for awaiting the whole loop to finish)
```
	await async [ await object asyncBooleanMethod ] whileTrueAwait.
```
```
	await [ num < 3 ] whileTrueAwait:
		async [ await Timer timeout: 10. num := num + 1. ].
```

### Awaiting async blocks in counting loops

To await the execution of async funtions in counting loops\
their special await versions must be called:\
(The first `await`'s are optional for awaiting the whole loop to finish)
```
	await 1 to: 4 doAwait: async [ :num |
		await object asyncMethodWith: num ].
```
```
	await 4 to: 1 by: -1 doAwait: async [ :num |
		await object asyncMethodWith: num ].
```
```
	await 3 timesRepeatAwait: async [
		await object asyncMethod ].
```

### Using class Promise

If you do not want to `await` an `async` function right away,\
you can catch the JS promise it returns into an ST Promise.\
(So  return value of `async` funcitons is a *JS* `promise`, not a ST `Promise`.\
there is no way around that)

```
	async logFileText: fileName
		| promise |
		promise := Promise fromJs:
			( await Fetch: 'https://somesite.com/api` )
			then: [ :response | self handleFetch: response  ]
			catch: [ :error | self handleError: error ].
	!
```
So this code constructs a ST Promise from the JS one\
and then attaches handlers from it after completion and catches errors.
# SmallJS language

## SmallJS

SmallJS is an implementation of the pure object oriented language [Smalltalk](https://en.wikipedia.org/wiki/Smalltalk) (ST).\
Everything in ST is an object, including integers, strings and classes themselves.\
ST objects communicate by sending messages to each other.\
This allows ST to be very readable, expressive and elegant,\
while maintaining maximum customizability at every level.

## Why SmallJS?

So why create SmallJS, when there are already good and free Smalltalks out there?\
The short answer is: web development.

In a web browser, you eventually will have to run some form of JavaScript (JS).\
SmallJS transpiles to JS shielding you from JS's (ahem) 'quirks',\
while enabling you to run and debug ST code *inside* your browser.\
And wouldn't it be nice to also use that same ST language in the back-end?\
You can, because SmallJS also runs in Node.js using the same core library.

## SmallJS tutorial

If you're new to SmallJS or Smalltalk, no worries.\
You can start by walking through this online tutorial:
[small-js.org/Tutorial](https://small-js.org/Tutorial) .\
You can testing you own code live in the online playground:
[small-js.org/Playground](https://small-js.org/Playground) .

## SmallJS syntax

Here's a quick overview of the [syntax of SmallJS](Syntax.md).\
It shows all language features in a single page.\
Use the tutorial for a more gradual introduction.

## Asynchronous execution

To enable async execution, alas the JS model must be strictly followed.\
Here's how it's implemented in SmallJS: [Async](Async.md)

# SmallJS syntax

Here's an example SmallJS class declaration\
containing

![Syntax](Syntax.png)

Explanation of syntax used:

- `CLASS` : Is followed by the class name.

- `EXTENDS` : Indicates the base class. `Object` is the root class.
- `MODULE` : The JS module this class should be put in.
- `CLASSVARS` : Variables of the class itself (not its instances). Like JS static class vars.
- `VARS` : Instance variables of objects created from the class, e.g.: `MyTest new`.
- `"This is a comment ..."` : Comments are put in double quotes.
- `CLASSMETHODS` : Following methods will be added to the (meta)class, like JS static class methods.
- `METHODS` : Following methods will be added to class **instances**, like JS regular class methods.\
  (Is the default method type if neither `CLASSMETHODS` nor `METHODS` is specified.)
- Message sending types, ordered from highest to lowest evaluation precedence:
	- `method1` : Unary method, has no arguments.
	- `++ var` : Binary (operator) method, has one argument.
	- `method2Arg1: aVar1 arg2: aVar2` : Keyword method, has one or more arguments.
- `| locVar lv2 lv3 |` : Local variables declaration.
- `!` : End of method
- Constants
	- `'aaa'`: String, uses single quotes
	- `1` : Integer
	- `3.14` : Float
	- `true`, `false`: Boolean
	- `nil` : Nil singelton, like JS `null`.
	- `$c` : Character
- `var1 := 3` : variable assignment
	- `var1 = 3` tests for equality.
- `^ 42` : Return a value.
- `#( 1 3.14 'aaa' )` : array with 3 values.
- `[ 1 + 2 ]` : block, like JS lambda functions.
	- `[ :a | :b | ^ a + b ]` : block with 2 arguments returning sum from **method** (not block).
- `INLINE` : Inline JS code, not transpiled.\
  ST variables can be accessed in it using the same name
- Control flow statements in ST use messages and blocks from above.
	- `1 + 2 = 3 ifTrue: [ 'Checks out' ]`\
	  Like JS: if( 1 + 2 == 3 ) { ... }
	- `a > 0 ifTrue: [ 'Positive' ] ifFalse: [ 'Zero or negative' ]`\
	  Like JS: if( a > 0 ) { ... } else { ... }
	- `1 to: 10 do: [ :n | self log: n ]`\
	  Like JS: for( n = 1; n <= 10; ++n ) { ... }
	- `[ a > 0 ] whileTrue: [ self log: a. a decrement ]`\
	  Like JS: while( a > 0 ) { ... }
	- `[ self log: a. a decrement ] doWhile: [ a > 0 ]`\
	  Like JS: do { ... } while( a > 0 )
# Building & running tests

Run the bash script: `./build.sh`, that:
- Builds the Smalltalk to JS `./Compiler`.
- Builds other core ST projects and runs their unit, API and browser (GUI) tests\
  by calling the `build.sh` script in the project folders.

Run the bash script: `./buildAll.sh`, to also build all examples.

## Browser testing

To enable GUI testing of web browser based projects,\
you first need to copy the file `.env.example` to `.env`\
and then uncomment the browsers you want to test with on your OS.\

### NOTE 1: Browser testing on MacOS

MacOS will not quit a newly started browser process\
after tests have completed successfully, causing `build.sh` scripts to hang.\
A workaround is to open the browser(s) you want to test with,\
before running `build.sh`.\
Then the script will test in newly opened tabs and close them after success.

### NOTE 2: Debugging with Firefox

To be able to debug in VSCode with Firefox,
you have to install the VSCode extension "Debugger for Firefox".
When starting Firefox from VSCode it may not stop on breakpoints the first time.
This is a known issue that is noted in the Troubleshooting section
on the GitHub page of the debugger extension.
Reload the the page in Firefox to hit the breakpoint in a second try.

Also the Firefox debugger sometimes erroneously jumps to JS source instead of staying in the ST source.

On Ubuntu launching Firefox debugger from VSCode ye give the error:
"Your Firefox profile cannot be loaded".
This is because VSCode does not work with the snap sandbox.
It's recommended to change your Firefox installation from snap to deb with this procedure:
https://www.omgubuntu.co.uk/2022/04/how-to-install-firefox-deb-apt-ubuntu-22-04

Alternatively, you can use this VSCode workaround in `launch.json`.
(But you'll have to redo that every time you get the source from GitHub)
https://askubuntu.com/questions/1409069/unable-to-launch-firefox-debugger-from-vscode-your-firefox-profile-cannot-be-lo

It's recommended to first test/debug your app in Chrome or Edge
and then test on Firefox for any incompatibilities.
# Installing SmallJS

## Copying the SmallJS repo

First download a copy of the current repo: [SmallJS-main.zip](https://github.com/Small-JS/SmallJS/archive/refs/heads/main.zip)\
and unzip it to a working folder on your system.

You can also use your favorite Git tool to fork the repo.\
Then you have version control and can even contributute to SmallJS development.\
If you don't know Git yet, [GitHub Desktop](https://desktop.github.com/download/)
is user friendly way to use its functionality.

## Installing Prerequisites

To install all the prerequisite delopment tools, look at: [Prerequisites.md](Prerequisites.md)

## Install npm modules

Now run the bash script `./install.sh`.
On Windows, the `.sh` extension should be associated with Git Bash once.
Do this by clicking on the file in the explorer and then choose open with Git Bash always.

This script:
- Checks if the prerequisites are present.
- Installs the SmallJS language extension in VSCode.
- Installs npm modules for all Node.js projects.

### Build SmallJS compiler and core projects

Run the bash script: `./build.sh`, that:
- Builds the Smalltalk to JS `./Compiler`.
- Builds the core ST projects and runs their unit tests.

Notes:
- Browser GUI testing is disabled by default. To enable it, check out:
  > [Building.md](Building.md)

Check if everything builds tests successfully before going to the next step.
# Installing SmallJS prerequisites

To install SmallJS prerequisites, see below.\
To update components, check [Updating](Updating.md)

### Git

On Windows you need this for Git bash to be able to run the *.sh scripts.

Download the latest version here:
> [https://git-scm.com/downloads](https://git-scm.com/downloads)

### Visual Studio Code (VSCode)

Download the latest version here:
> [https://code.visualstudio.com/download](https://code.visualstudio.com/download)

On MacOS you should add VSCode to the path, this way:\
In VSCode, open the Command Palette (Cmd+Shift+P) type 'shell command' to find:\
`Shell Command: Install 'code' command in PATH command`\
click on to add VSCode to the path.

### VSCode Firefox extension

From Chrome and Edge, step debugging is built into VSCode.
For debugging in Firefox you should install this extension: Debugger for Firefox.

Note:
If you are using Ubuntu with Firefox installed in a Snap container,\
the extension wil not work because it does not have access to the `/tmp` dir.\
To fix this, these lines should be added to the FireFox configurations  in  `launch.json`:

        "timeout": 90000,
        "tmpDir": "/some/folder/of/yours/with/write/perms",

### Node.js

SmallJS implements the latest Node.js features
so you should install the latest version, currently V25.x.x, not the LTS version.
Note: There are options for running different Node.js versions side by side.

Download the latest version here:
> [nodejs.org/en/download](https://nodejs.org/en/download)

### TypeScript

To use TypeScript (tsc) from VSCode it needs to be installed globally, with:

`npm -g install typescript`

### OpenGL support (under Linux)

If you see a build error under Linux related to OpenGL, you may need to install it yourself using:
> `sudo apt install libopengl0`
# Updating SmallJS components

## Visual Studio Code
In VSCode click the menu: Help > Check for updates...

## Node.js
Install an updated version from:
> [nodejs.org/en/download](https://nodejs.org/en/download)

## Global Node.js packages
To check for outdated global npm packages:
> `npm outdated -g`

To update all global packages:
> `npm update -g`

For updating specific global packages:

### TypeScript
> `npm update -g typescript`

### HTTP server
> `npm update -g http-server`

## npm packages with the "npm Check Updates" package
To install the npm global package updater (once):
> `npm i -g npm-check-updates`

To force update of dependencies in Node.js based projects (Node, Shop/Server), \
type these lines in a terminal:
> `ncu -u`\
> `npm install`
# SmallJS design

There are other Smalltalks out there like, Pharo, Squeak, Dolphin and Cincom.
SmallJS takes a different approach to these in de following ways:

- It compiles to JavaScript that can run in any modern browser and on Node.js.

SmallJS is source file based (not 'image based')

- So you can use your favorite, powerful IDE.
- Apps can remain small an modular, no need for 'image stripping'
- The IDE is safely separated from your app.
- The ST to JS compiler is written in TypeScript, not ST. So there are no 'bootstrapping' issues, even when ST is modified at a low level.

Here's a small PowerPoint presentation with the points above and more,\
if you want to learn more or tell others: [Why_SmallJS.pdf](Why_SmallJS.pdf)

## [Design details](DesignDetails.md)

These are some detailed design decisions for the SmallJS system.\
They differ from other Smalltalk implementations...

## [Design improvements](DesignImprovements.md)

Documents where SmallJS attempts to improve on the design of the underlying (encapsulated) JavaScript / DOM / HTML implementation.
# SmallJS design details

These are some detailed design decisions for the SmallJS system.\
They differ from other Smalltalk implementations...

- SmallJS overall design goals
	- Runs in any modern browser and on Node.js.
	- Lightweight implementation. Fast startup times.
	- Pure ST language behavior, hiding JS pitfalls.
	- Fast direct DOM manipulation in MVC model, no HTML rendering.
	- Implement only 1 way of doing something in ST when there are multiple JS options.
<br><br>
- File based development, using VSCode as the IDE
- Leverage the powerful and mature IDE features of VSCode, including step debugging.
	- Facilitates source code control, needed anyway.
	- Keep runtime small and modular, no need for "image stripping".
<br><br>
- The Compiler is written in TypeScript
	- Not JS, for type safety of course!
	- The compiler is not written in ST itself, to prevent bootstrapping issues.
<br><br>
- Compiles (transpiles) to high level JS
	- Not to bytecodes, interpreter on interpreter would slow and hard to debug.
	- Not to TS, preventing need for extra transpiler step.
	- Adding new JS primitives is easy this way.
<br><br>
- Compiler targets latest JS version (esNext).
	- Will give cleaner, easier to debug output.
	- Browsers on all devices are updated regularly nowadays.
<br><br>
- JS native types are wrapped in ST classes
	- Makes implementation simpler and cleaner.
	- Prevents unwanted leaking of JS behavior to ST.
	- BigInt support can be transparent, like it should be.
<br><br>
- Smalltalk library
	- Standardize on JS naming of methods, because of familiarity.
	- Wrap high level JS classes i.s.o. re-implementing them in ST. E.g.: class Date.
	- Capitalized JS abbreviations are converted to ST camel-case.\
	  E.g.: HTLMElement -> HtmlElement.
<br><br>
- HTML - DOM
	- Support for direct DOM manipulation, not HTML generation.
	- HTML & CSS used as starting templates, dynamic behavior implemented in ST for full control.
	- Only support latest HTML version, no poly-fills, quirks or deprecated features.
	- Only international English language support, for now.
	- Event handling all done through single *addEventHandler* method.
	- Only implement HTML elements for *GUI* features,\
		other stuff (data) should be done directly in ST.
	- All documents are HTML documents.\
		Lesser used XML, SVG, XSLT, XPath, Animations are not implemented yet.
	- DOM / HTML classes that mimic basic JS data types are not implemented.\
		Their use is replaced with ST basic data types. E.g.: DOMString > String.
	- DOM collection and iterator classes are not implemented.
		Use ST collections in stead, mostly Array.
	- ST Namespaces are not implemented yet.
	- No automatic conversion from strings to string nodes.\
		Use objects of proper classes.
	- ST class Document contains merged functionality of the JS Document and HTMLDocument classes.
## SmallJS design improvements over JavaScript / DOM / HTML

Documents perceived design flaws in JavaScript / DOM / HTML.
These can be a basis for implementing cleaner structures in SmallJS, maintaining functionality.
When implementing cleaner structures would deviate too far from expected JS / DOM behavior,
no optimization will be provided, and that choice will be documented here.

# JavaScript

- Numbers are always floats, with some test for "integer floats".\
	ST: Implement integers separate from floats.
- BitInts are limited in use and are treated very differently from Numbers\
	ST: Implement LargeInteger class in unified Magnitude hierarchy
		with automatic scaling between small and large integers.
- The value "undefined" is returned for methods that do not return a specific value, preventing message chaining.\
	ST: Return 'self' ('this') as default for easier message changing.
	ST: Use ';' operator to ignore unneeded return values.
	ST: Always return self when no return value is created. (Don't return an unchanged argument as a pass-through.)
- JS deals with screen coordinates a lot, put does not have an Point class.
	ST: Implement Point class and use this iso passing around separate X and Y coordinates.
- JS has different classes for rectangles, with "loose" x, y and w, h coordinates.
	ST: Implement single Rectangle class using Point objects for origin and extent.
- JS methods can have substantially different behavior depending on argument types given.
	ST: Implement these behaviors as separate methods with clear names.
- JS has 'null' and 'undefined' which is unnecessary and requires extra checking.
	ST: Implement both as 'nil'.

# DOM / HTML

- Using different string type DOMString makes things complex.\
	ST: Implement all behaviors in single String class.
- Using different list, map and iterator types makes things complex.\
	ST: Implement all behaviors in Array and Map (todo) class.\
	Note: Iterating over live HTML lists is not implemented yet.
- Having separate 'tree element' abstract base classes Node and Element is unneeded.\
	ST: No solution, is too embedded in the whole DOM.
- Having separate document classes Document, DocumentFragment, ShadowRoot seems unneeded.\
	ST: No solution, is too embedded in the whole DOM.
- JS dynamic import() function does not support modules.\
	Needed when evaluating ST expressions.\
	ST: Workaround by adding a script node to the current document and starting that.# Deploying a SmallJS app

To deploy MyApp, you only need to copy the following files:
	- All single files from the root folder.
	- The ..\\Smalltalk folder with the runtime and ST packages you need. \
	   Need: MyApp.js, RunTime.js, Core.js, Dom.js (probably) .\
	   Don't need: Test*.js.