Initial checkin of Pika from heckimp

plug-ins/script-fu/scripts/test/README

@@ -0,0 +1,42 @@
+Scripts to test various cases for ScriptFu subsystem.
+
+Not usually installed.
+
+Should not be localized i18n : for developers only.
+
+## Install
+
+To use, install them:
+
+1. Old style scripts: copy to /scripts.
+
+2. New style independently interpreted scripts:
+copy a dir containing the test script into /plugins
+and ensure the .scm files have execute permission.
+
+Old style scripts test and are interpreted by extension-script-fu.
+When a script crashes extension-script-fu, you must restart Pika.
+
+New style scripts are interpreted in a separate process
+running binary script-fu-interpreter-3.0.
+
+## Invoke
+
+Any installed script can be tested in the SF Console
+by just calling it from the PDB: "(script-fu-test-foo)"
+since they are PDB procedures.
+
+Scripts that have menu items can be tested from the Pika GUI.
+
+Any test script can be called by another script.
+
+## Testing framework
+
+test9.scm has a built-in testing framework.
+
+FUTURE: extract the framework to a Scheme extension
+that is in the Pika repo,
+that other scripts can load and use.
+
+
+

plug-ins/script-fu/scripts/test/always-fail/always-fail.scm

@@ -0,0 +1,30 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; A script that always fails
+;
+; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
+; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
+
+; Expect "Test>Always fail" in the menus
+; Expect when chosen, message on PIKA message bar "Failing"
+; Expect a dialog in PIKA app that requires an OK
+
+(define (script-fu-always-fail)
+  (begin
+    (pika-message "Failing")
+    ; since last expression, the result, and should mean error
+    #f
+  )
+)
+
+(script-fu-register "script-fu-always-fail"
+  "Always fail"
+  "Expect error dialog in Gimp, or PDB execution error when called by another"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; requires no image
+  ; no arguments or dialog
+)
+
+(script-fu-menu-register "script-fu-always-fail" "<Image>/Test")

plug-ins/script-fu/scripts/test/call-always-fail/call-always-fail.scm

@@ -0,0 +1,29 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; A script that calls a script that always fails
+;
+; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
+; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
+
+; Expect "Test>Call always fail" in the menus
+; Expect when chosen, message on PIKA message bar "Failing" (from script-fu-always-fail)
+; Expect a dialog in PIKA app that requires an OK
+
+(define (script-fu-call-always-fail)
+  ; call a script that always fails
+  (script-fu-always-fail)
+  ; we have not checked the result and declaring the error on our own.
+  ; since this is the last expression, the #f from the call should propogate.
+)
+
+(script-fu-register "script-fu-call-always-fail"
+  "Call always fail"
+  "Expect error dialog in Gimp, having concatenated error messages"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; requires no image
+  ; no arguments or dialog
+)
+
+(script-fu-menu-register "script-fu-call-always-fail" "<Image>/Test")

plug-ins/script-fu/scripts/test/resource-class/resource-class.scm

@@ -0,0 +1,161 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; A script that tests resource classes in PIKA
+; Tests the marshalling of parameters and return values in ScriptFu
+;
+; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
+; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
+
+; Delete .config/PIKA so that resources are in a standard state.
+
+; Expect various resource names in the console
+; Expect no "Fail" in the console
+
+
+(define (script-fu-test-resource-class)
+
+  (define (expect expression
+                  expected-value )
+      ; use equal?, don't use eq?
+      (if (equal? expression expected-value)
+          #t
+          (pika-message "Fail")
+      )
+  )
+
+  ; redirect messages to the console
+  (pika-message-set-handler 1)
+
+  (let* (
+        ; Test as a return value
+        ; These calls return a list with one element, use car
+        (brush    (car (pika-context-get-brush)))
+        (font     (car (pika-context-get-font)))
+        (gradient (car (pika-context-get-gradient)))
+        (palette  (car (pika-context-get-palette)))
+        (pattern  (car (pika-context-get-pattern)))
+
+        ; font and pattern cannot be new(), duplicate(), delete()
+
+        ; new() methods
+        (brushnew    (car (pika-brush-new    "Brush New")))
+        (gradientnew (car (pika-gradient-new "Gradient New")))
+        (palettenew  (car (pika-palette-new  "Palette New")))
+
+        ; copy() methods
+        ; copy method is named "duplicate"
+        ; Takes an existing brush and a desired name
+        (brushcopy    (car (pika-brush-duplicate    brushnew    "brushcopy")))
+        (gradientcopy (car (pika-gradient-duplicate gradientnew "gradientcopy")))
+        (palettecopy  (car (pika-palette-duplicate  palettenew  "palettecopy")))
+
+        ; See below, we test rename later
+        )
+
+    ; write names to console
+    (pika-message brush)
+    (pika-message font)
+    (pika-message gradient)
+    (pika-message palette)
+    (pika-message pattern)
+
+    (pika-message brushnew)
+    (pika-message gradientnew)
+    (pika-message palettenew)
+
+    (pika-message brushcopy)
+    (pika-message gradientcopy)
+    (pika-message palettecopy)
+
+    ; Note equal? works for strings, but eq? and eqv? do not
+    (pika-message "Expect resources from context have de novo installed PIKA names")
+    (expect (equal? brush "2. Hardness 050")   #t)
+    (expect (equal? font "Sans-serif")         #t)
+    (expect (equal? gradient "FG to BG (RGB)") #t)
+    (expect (equal? palette "Color History")   #t)
+    (expect (equal? pattern "Pine") #t)
+
+    (pika-message "Expect new resource names are the names given when created")
+    (expect (equal? brushnew    "Brush New")    #t)
+    (expect (equal? gradientnew "Gradient New") #t)
+    (expect (equal? palettenew  "Palette New")  #t)
+
+    (pika-message "Expect copied resources have names given when created")
+    ; !!! TODO PIKA appends " copy" and does not use the given name
+    ; which contradicts the docs for the procedure
+    (expect (equal? brushcopy    "Brush New copy")    #t)
+    (expect (equal? gradientcopy "Gradient New copy") #t)
+    (expect (equal? palettecopy  "Palette New copy")  #t)
+
+    ; rename() methods
+    ; Returns new resource proxy, having possibly different name than requested
+    ; ScriptFu marshals to a string
+    ; !!! Must assign it to the same var,
+    ; else the var becomes an invalid reference since it has the old name
+    (set! brushcopy    (car (pika-brush-rename    brushcopy    "Brush Copy Renamed")))
+    (set! gradientcopy (car (pika-gradient-rename gradientcopy "Gradient Copy Renamed")))
+    (set! palettecopy  (car (pika-palette-rename  palettecopy  "Palette Copy Renamed")))
+
+    ; write renames to console
+    (pika-message brushcopy)
+    (pika-message gradientcopy)
+    (pika-message palettecopy)
+
+    (pika-message "Expect renamed have new names")
+    (expect (equal? brushcopy    "Brush Copy Renamed")    #t)
+    (expect (equal? gradientcopy "Gradient Copy Renamed") #t)
+    (expect (equal? palettecopy  "Palette Copy Renamed")  #t)
+
+    (pika-message  "Expect class method id_is_valid of the PikaResource class")
+    ; the class method takes a string.
+    ; ScriptFu already has a string var, and marshalling is trivial
+    ; For now, returns (1), not #t
+    (expect (car (pika-brush-id-is-valid    brush))    1)
+    (expect (car (pika-font-id-is-valid     font))     1)
+    (expect (car (pika-gradient-id-is-valid gradient)) 1)
+    (expect (car (pika-palette-id-is-valid  palette))  1)
+    (expect (car (pika-pattern-id-is-valid  pattern))  1)
+
+    (pika-message "Expect class method id_is_valid for invalid name")
+    ; Expect false, but no error dialog from PIKA
+    ; Returns (0), not #f
+    (expect (car (pika-brush-id-is-valid    "invalid_name")) 0)
+    (expect (car (pika-font-id-is-valid     "invalid_name")) 0)
+    (expect (car (pika-gradient-id-is-valid "invalid_name")) 0)
+    (expect (car (pika-palette-id-is-valid  "invalid_name")) 0)
+    (expect (car (pika-pattern-id-is-valid  "invalid_name")) 0)
+
+    (pika-message "Expect as a parameter to context works")
+    ; Pass each resource class instance back to Gimp
+    (pika-context-set-brush    brush)
+    (pika-context-set-font     font)
+    (pika-context-set-gradient gradient)
+    (pika-context-set-palette  palette)
+    (pika-context-set-pattern  pattern)
+
+    (pika-message "Expect delete methods work without error")
+    (pika-brush-delete brushnew)
+    (pika-gradient-delete gradientnew)
+    (pika-palette-delete palettenew)
+
+    (pika-message "Expect var holding deleted resource is still defined, but is invalid reference")
+    ;  Returns (0), not #f
+    (expect (car (pika-brush-id-is-valid    brushnew))    0)
+    (expect (car (pika-gradient-id-is-valid gradientnew)) 0)
+    (expect (car (pika-palette-id-is-valid  palettenew))  0)
+
+    ; We don't test the specialized methods of the classes here, see elsewhere
+  )
+)
+
+(script-fu-register "script-fu-test-resource-class"
+  "Test resource classes of Pika"
+  "Expect no errors in the console"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; requires no image
+  ; no arguments or dialog
+)
+
+(script-fu-menu-register "script-fu-test-resource-class" "<Image>/Test")

plug-ins/script-fu/scripts/test/test-install-fail/test-install-fail.scm

@@ -0,0 +1,33 @@
+; An old style script, not an independent plugin
+
+; A script that fails at install time: has syntax error
+;
+; Setup: copy this file w/ executable permission, to one of the /scripts dirs.
+; Example: to ~/snap/393/.config/PIKA/2.10/scripts/test-quit.scm
+
+; Start Gimp, configure to have Error Console open, and quit.
+; Install this plugin.
+; Restart Pika from a terminal
+; Expect:
+;   - an error in the Pika Error Console
+;   - an error in the terminal
+; !!! the first is currently failing.  So this script is to test FUTURE.
+
+(define (script-fu-test-install-fail )
+  (   ; <= syntax error
+)
+
+; Much is moot, since this should fail to install
+(script-fu-register "script-fu-test-install-fail"
+  "Moot"
+  "Moot"
+  "lkk"
+  "lkk"
+  "2023"
+  ""  ; requires no image
+  ; no args
+)
+
+(script-fu-menu-register "script-fu-test-install-fail"
+                         "<Image>/Filters/Development/Script-Fu/Test")
+

plug-ins/script-fu/scripts/test/test-quit/test-quit.scm

@@ -0,0 +1,49 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; A script to test calls to Scheme function: (quit 1)
+;
+; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
+; Example: to ~/.pika-2.99/plug-ins/test-quit/test-quit.scm
+
+; Expect "Filters>Dev>Script-Fu>Test>Quit with code" in the menus
+
+; Test interactive:
+; Choose "Quit with code".  Expect the plugin's dialog.
+; Choose OK.
+; Expect:
+;   1. a message in stderr
+;   2. an error dialog in PIKA that must be OK'd
+;      OR a message in Pika Error Console when it is open.)
+; !!! FIXME: this fails now, for reasons unrelated to (quit)
+
+; Repeat, but enter 0.
+; Expect:
+;   No error in stderr OR Gimp
+
+; Test non-interactive:
+; Enter "(script-fu-test-quit 1)" in SF Console
+; Expect:
+;    1. a message in stderr
+     2. SF Console to print the error message.
+
+; In both test case, the error message is like:
+; "Execution error for 'Quit with code': script quit with code: 1"
+
+(define (script-fu-test-quit code)
+  (quit code)
+)
+
+(script-fu-register "script-fu-test-quit"
+  "Quit with code"
+  "Expect error in Gimp, or PDB execution error when called by another"
+  "lkk"
+  "lkk"
+  "2023"
+  ""  ; requires no image
+  ; The argument is an integer, defaulting to 1, that the script will call quit with.
+  SF-ADJUSTMENT "Return code" '(1 -5 5 1 2 0 0)
+)
+
+(script-fu-menu-register "script-fu-test-quit"
+                         "<Image>/Filters/Development/Script-Fu/Test")
+

plug-ins/script-fu/scripts/test/test-run-error-PDB/test-run-error-PDB.scm

@@ -0,0 +1,53 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; test-run-error-PDB.scm
+
+; A script that throws a run-time error calling PDB with wrong signature
+; The script has a dialog so it can run INTERACTIVE
+;
+; Setup: copy this file to /scripts
+; Example: to ~/.pika-2.99/scripts/test-run-error-PDB.scm
+
+; Expect "Filters>Dev>Script-Fu>Test>Runtime PDB error" in the menus
+
+; !!! Do not export G_DEBUG=fatal-warnings
+
+; Test interactive:
+; Choose "Runtime PDB error".  Expect the plugin's dialog.
+; Choose OK.
+; Expect:
+;   an error dialog in PIKA that must be OK'd
+;   OR a CRITICAL and WARNING message in Pika Error Console when it is open.)
+
+; Test non-interactive:
+; Enter "(script-fu-test-run-error-PDB 1)" in SF Console
+; Expect SF Console to print the error message.
+
+; In both test case, the error message is like:
+; PIKA CRITICAL pika_procedure_real_execute: assertion 'pika_value_array_length (args) >= procedure->num_args' failed
+; PIKA WARNING pika_procedure_execute: no return values, shouldn't happen
+
+; The root error is "not enough args to a PDB procedure"
+; ScriptFu will warn but proceed to call the PDB procedure.
+; Pika will throw CRITICAL but proceed
+; On return, Pika will throw WARNING that the procedure did not return values.
+; ???? Why does it crash and give a backtrace???
+
+(define (script-fu-test-run-error-PDB code)
+  (pika-message)  ; <= run-time error signature mismatch
+)
+
+(script-fu-register "script-fu-test-run-error-PDB"
+  "Runtime PDB error"
+  "Expect error in Gimp, or PDB execution error when called by another"
+  "lkk"
+  "lkk"
+  "2023"
+  ""  ; requires no image
+  ; The argument here just to ensure a dialog
+  SF-ADJUSTMENT "Not used" '(1 -2 2 1 2 0 0)
+)
+
+(script-fu-menu-register "script-fu-test-run-error-PDB"
+                         "<Image>/Filters/Development/Script-Fu/Test")
+

plug-ins/script-fu/scripts/test/test0/test0.scm

@@ -0,0 +1,31 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Basic test of a .scm file interpreted by script-fu-interpreter
+;
+; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
+; Example: to ~/.pika-2.99/plug-ins/test0/test0.scm
+; (That is custom to one user.)
+
+; Expect "Test>Test SF interpreter 0" in the menus
+; Expect when chosen, message on PIKA message bar.
+
+; Also, remove the execute permission.
+; Then expect not appear in PIKA menus (not queried.)
+
+; Also, make the name different from its parent dir.
+; Then expect not appear in PIKA menus (not queried.)
+
+(define (script-fu-test0)
+  (pika-message "Hello script-fu-test0")
+)
+
+(script-fu-register "script-fu-test0"
+  "Test SF interpreter 0"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "script-fu-test0" "<Image>/Test")

plug-ins/script-fu/scripts/test/test1/test1.scm

@@ -0,0 +1,43 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Basic test that a second .scm file is also queried.
+; Expect "Test>Test SF interpreter 1" in the menus
+; Expect when chosen, message on PIKA message bar.
+
+; Also tests that one .scm file can define two PDB procedures
+; File is queried once, yielding two names.
+; Two separate procedures created.
+
+
+(define (script-fu-test1)
+  (pika-message "Hello script-fu-test1")
+)
+
+(script-fu-register "script-fu-test1"
+  "Test SF interpreter 01"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "script-fu-test1" "<Image>/Test")
+
+
+
+
+(define (script-fu-test2)
+  (pika-message "Hello script-fu-test2")
+)
+
+(script-fu-register "script-fu-test2"
+  "Test SF interpreter 02"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "script-fu-test2" "<Image>/Test")

plug-ins/script-fu/scripts/test/test1/test3.scm

@@ -0,0 +1,31 @@
+; !!! No shebang here
+
+; Test a second .scm file in the same directory as a queried .scm.
+; The second .scm file need not be executable.
+; The second .scm file need not have a shebang.
+; The pika-script-fu-interpreter will nevertheless load the second .scm
+; while it is querying the first, executable .scm in the dir.
+; The plugin manager queries the first executable,
+; and pika-script-fu-interpreter loads (and returns defined names in)
+; the second during the query of the first.
+
+; Expect "Test>Test SF interpreter 3" in the menus
+; Expect when chosen, message on PIKA message bar.
+
+; plug-ins/test1/test1.scm is executable
+; plug-ins/test1/test3.scm is NOT executable
+
+(define (script-fu-test3)
+  (pika-message "Hello script-fu-test3")
+)
+
+(script-fu-register "script-fu-test3"
+  "Test SF interpreter 3"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "script-fu-test3" "<Image>/Test")

plug-ins/script-fu/scripts/test/test4/test4.scm

@@ -0,0 +1,25 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Test a .scm file that does not call script-fu-menu-register
+; The menu will NOT default.
+; Expect "Test SF interpreter 4" to NOT EXIST in any menu
+; Expect the PDB proc "script-fu-test4" does appear in the PDB Brower
+
+; Two test cases:
+;    Alongside an executable script:  plug-ins/test4/test4.scm NOT executable
+;    Executable, in its own directory: plug-ins/test1/test4.scm is executable
+
+(define (script-fu-test4)
+  (pika-message "Hello script-fu-test4")
+)
+
+(script-fu-register "script-fu-test4"
+  "Test SF interpreter 4"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+; !!! No call to script-fu-menu-register

plug-ins/script-fu/scripts/test/test5/test5.scm

@@ -0,0 +1,16 @@
+#!/usr/bin/env pika-script-fu-interpreter
+
+; Test a .scm file with an invalid shebang
+; Note "-3.0" missing above.
+
+; The test depends on platform and env and .interp
+; Must not be a file system link from pika-script-fu-interpreter to pika-script-fu-interpreter-3.0
+; Must not be a .interp file having  "pika-script-fu-interpreter=pika-script-fu-interpreter-3.0"
+
+; Expect in the console: "/usr/bin/env: 'script-fu-interpreter': No such file or directory"
+
+(define (script-fu-test5)
+  (pika-message "Hello script-fu-test5")
+)
+
+; !!! No call to script-fu-menu-register

plug-ins/script-fu/scripts/test/test6/test6.scm

@@ -0,0 +1,12 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Test a .scm file that does not register any procedure
+
+; Expect in the console:
+; "(test6.scm:164): scriptfu-WARNING **: 10:06:07.966: No procedures defined in /work/.home/.config/PIKA/2.99/plug-ins/test6/test6.scm"
+
+(define (script-fu-test6)
+  (pika-message "Hello script-fu-test6")
+)
+
+; !!! No call to script-fu-register

plug-ins/script-fu/scripts/test/test7/test7.scm

@@ -0,0 +1,28 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Test non-canonical name for PDB procedure
+; pika-script-fu-interpreter does not enforce canonical name.
+; Other parts of PIKA (PDB) does not enforce canonical name
+; for PDB procedures defined by .scm scripts.
+
+; Canonical means starts with "script-fu-"
+; Here the name doesn't, its just "test7"
+
+; Expect "Test>Test SF interpreter 7" in the menus
+; Expect when chosen, message on PIKA message bar.
+
+
+(define (test7)
+  (pika-message "Hello test7")
+)
+
+(script-fu-register "test7"
+  "Test SF interpreter 7"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "test7" "<Image>/Test")

plug-ins/script-fu/scripts/test/test8/test8.scm

@@ -0,0 +1,39 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Test mismatch between name of defined run function and name for PDB procedure
+; Not a high priority: a rare syntax error in a plugin text.
+; If authors follow a template, they won't make this mistake.
+
+; The names must match exactly.
+; Here, "mismatch" the name of the defined run function
+; does not match "script-fu-test8" the name of the PDB proc.
+
+; Expect a warning in the text console as the plugin text is queried:
+; script-fu: WARNING: Run function not defined, or does not match PDB procedure name: script-fu-test8.
+; Expect the PDB procedure to not exist
+
+; If we don't detect this syntax error:
+; A PDB procedure is created.
+; When invoked from Test>Test SF interpreter 8"
+; the interpreter enters an infinite loop.
+; There is no harm to the PIKA app, but the interpreter process can only be killed.
+; During the run phase, the "(define foo)"
+; should re-define an existing definition in the interpreter state.
+; Instead, since the name is mismatched,
+; the foo function remains defined to be a call to the PDB procedure named foo.
+; So script-fu-script-proc instead calls the PDB again, an infinite loop.
+
+(define (mismatch)
+  (pika-message "mismatch")
+)
+
+(script-fu-register "script-fu-test8"
+  "Test SF interpreter 8"
+  "Just gives a message from Pika"
+  "lkk"
+  "lkk"
+  "2022"
+  ""  ; all image types
+)
+
+(script-fu-menu-register "script-fu-test8" "<Image>/Test")

plug-ins/script-fu/scripts/test/test9/test9.scm

@@ -0,0 +1,547 @@
+#!/usr/bin/env pika-script-fu-interpreter-3.0
+
+; Test byte, file/string ports and string handling.
+
+(define temp-path
+  (string-append (car (pika-pikarc-query "temp-path")) "/"))
+
+(define (plugin-tmp-filepath name)
+  (string-append temp-path "script-fu-test9-" name ".txt"))
+
+; ---------- Helper functions ----------
+
+(define (make-testresult success error-message)
+  (list success error-message))
+(define (testresult-success x) (car x))
+(define (testresult-error x) (cadr x))
+
+(define (displayln msg)
+  (display msg)
+  (newline))
+
+(define (trim char chars)
+  (if (= (char->integer char) (char->integer (car chars)))
+      (trim char (cdr chars))
+      chars))
+
+(define (rtrim str)
+  (list->string (reverse (trim #\space (reverse (string->list str))))))
+
+(define (any->string any)
+  (let* ((to-string
+           (lambda (any)
+             (let* ((str (make-string 256)))
+               (call-with-output-string str
+                 (lambda (port) (write any port)))
+               str))))
+    (rtrim (to-string any))))
+
+(define (write-all-bytes port bytes)
+  (if (null? bytes)
+    '()
+    (begin
+      (write-byte (car bytes) port)
+      (write-all-bytes port (cdr bytes)))))
+
+(define (bytes->string bytes)
+  (let* ((str (make-string (length bytes))))
+    (call-with-output-string str
+      (lambda (port) (map (lambda (b) (write-byte b port)) bytes)))
+    str))
+
+(define (with-string open-function str function)
+  (let ((port (open-function str)))
+    (if (port? port)
+      (let ((result '()))
+        (set! result (function port))
+        (close-port port)
+        result)
+      (make-testresult #f "Failed to open string for string port!"))))
+
+(define (call-with-input-string str function)
+  (with-string open-input-string str function))
+
+(define (call-with-output-string str function)
+  (with-string open-output-string str function))
+
+; Loops from i to n-1.
+(define (loop i n function)
+  (if (< i n)
+    (begin
+      (function i)
+      (loop (+ i 1) n function))
+    #t))
+
+(define (assert code)
+  (let* ((old-error-hook *error-hook*)
+         (exceptions '())
+         (append-exception
+           (lambda (x)
+             (if (null? exceptions)
+               (set! exceptions "Exception: ")
+               '())
+             (set! exceptions (string-append exceptions " " (any->string x)))))
+         (assert-error-hook
+           (lambda (xs)
+             (map append-exception xs)
+             (old-error-hook xs)))
+         (result #f))
+    (set! *error-hook* assert-error-hook)
+    (catch '() (set! result (eval code)))
+    (set! *error-hook* old-error-hook)
+    (if (and (null? exceptions)
+             result)
+      (make-testresult result '())
+      (make-testresult #f
+        (if (null? exceptions)
+          (string-append "Assertion failed: " (any->string code))
+          exceptions)))))
+
+; ---------- Test data ----------
+
+(define test-data-1byte
+  (map integer->byte (list 65))) ; 65 = A
+
+(define test-data-256bytes
+  (let ((result '()))
+    (loop 0 256 (lambda (i) (set! result (cons i result))))
+  (reverse (map integer->byte result))))
+
+(define test-data-1char
+  (map integer->byte (list 228 189 160))) ; 你 (UTF-8)
+
+(define test-data-2chars
+  (map integer->byte
+    (list 228 189 160    ; 你 (UTF-8)
+          229 165 189))) ; 好 (UTF-8)
+
+; ---------- Tests start here ---------
+
+; Each test function should be individually executable or
+; have a wrapper function that can be individually executed.
+
+; ----- Test byte functions -----
+
+; Ensure all integers with values in the range 0-255
+; can be converted to a byte and then back successfully.
+(define (test-byte-conversion)
+  (let* ((errors '())
+         (failed
+           (lambda (error)
+             (if (null? errors)
+               (set! errors "")
+               '())
+             (set! errors (string-append errors error))))
+         (test-conversion
+           (lambda (i)
+             (let ((result (assert `(= (byte->integer (integer->byte ,i)) ,i))))
+               (if (not (testresult-success result))
+                 (failed (testresult-error result))
+                 '())))))
+    (loop 0 256 test-conversion)
+    (make-testresult (null? errors) errors)))
+
+; Ensure byte? returns true with bytes.
+(define (test-byte?-byte)
+  (assert '(byte? (integer->byte 10))))
+
+; Ensure byte? returns false with integers.
+(define (test-byte?-integer)
+  (assert '(not (byte? 10))))
+
+; Ensure byte? returns false with characters.
+(define (test-byte?-char)
+  (assert '(not (byte? #\A))))
+
+; Ensure atom? works with bytes.
+(define (test-byte-atom?)
+  (assert '(atom? (integer->byte 128))))
+
+; Ensure atom->string works with bytes.
+(define (test-byte-atom->string)
+  (assert '(string=? (atom->string (integer->byte 65)) "A")))
+
+; ----- Read tests for ports -----
+
+; The same tests are used for file and string ports,
+; as they must behave identically. These do not have to be
+; individually executable, as they require the port to be set up.
+
+; Ensure that we can read a single byte.
+; Test data: test-data-1byte
+(define (test-read-byte-single port)
+  (assert `(= (byte->integer (read-byte ,port)) 65))) ; 65 = A
+
+; Ensure peek-byte returns the correct value and does not remove bytes from the port.
+; Test data: test-data-1byte
+(define (test-read-byte-peek port)
+  (assert
+    `(and (= (byte->integer (peek-byte ,port)) 65) ; 65 = A
+          (not (eof-object? (peek-byte ,port))))))
+
+; Ensure every single possible byte value can be read.
+; Test data: test-data-256bytes
+(define (test-read-byte-all-values port)
+  (let* ((errors '())
+         (failure (lambda () ))
+         (try
+           (lambda (i)
+             (let ((result (assert `(= (byte->integer (read-byte ,port)) ,i))))
+               (if (not (testresult-success result))
+                 (failure (testresult-error result))
+                 '())))))
+    (loop 0 256 try)
+    (make-testresult (null? errors) errors)))
+
+; Ensure that we can read a single char (not multi-byte).
+; Test data: test-data-1byte
+(define (test-read-char-single-ascii port)
+  (assert `(= (char->integer (read-char ,port)) 65))) ; 65 = A
+
+; Ensure that we can read a single multi-byte char.
+; Note: char->integer returns the integer value of a gunichar,
+; which is a UTF-32 or UCS-4 character code.
+; Test data: test-data-1char
+(define (test-read-char-single port)
+  (assert `(= (char->integer (read-char ,port)) 20320))) ; 20320 = 你 (UTF-32)
+
+; Ensure peek-char returns the correct value and does not
+; remove chars from the port.
+; Test data: test-data-1char
+(define (test-read-char-peek port)
+  (assert
+    `(and (= (char->integer (peek-char ,port)) 20320) ; 20320 = 你 (UTF-32)
+          (not (eof-object? (peek-char ,port))))))
+
+; Ensure that we can read multiple multi-byte chars from a file.
+; Test data: test-data-2chars
+(define (test-read-char-multiple port)
+  (assert
+    `(and (= (char->integer (read-char ,port)) 20320)    ; 20320 = 你 (UTF-32)
+          (= (char->integer (read-char ,port)) 22909)))) ; 22909 = 好 (UTF-32)
+
+; Ensure read-byte can not read past EOF.
+; Test data: test-data-1byte
+(define (test-read-byte-overflow port)
+  (assert `(begin (read-byte ,port) (eof-object? (read-byte ,port)))))
+
+; Ensure read-char can not read past EOF.
+; Test data: test-data-1char
+(define (test-read-char-overflow port)
+  (assert `(begin (read-char ,port) (eof-object? (read-char ,port)))))
+
+; ----- Write tests for ports -----
+
+; These tests come in pairs, we write to a port and then read from it to verify.
+
+(define (test-write-byte-single port)
+  (assert `(begin (write-byte (integer->byte 77) ,port) #t))) ; 77 == M
+(define (test-write-byte-single-verify port)
+  (assert `(= (byte->integer (read-byte ,port)) 77))) ; 77 == M
+
+(define (test-write-char-single port)
+  (assert `(begin (write-char (car (string->list "你")) ,port) #t)))
+(define (test-write-char-single-verify port)
+  (assert `(= (char->integer (read-char ,port)) 20320))) ; 20320 = 你 (UTF-32)
+
+; ----- String port tests -----
+
+; Wrapper functions for the port read and write tests.
+
+(define (test-input-string-port test-data test-function)
+  (call-with-input-string (bytes->string test-data) test-function))
+
+(define (test-string-port-read-byte-single)
+  (test-input-string-port test-data-1byte test-read-byte-single))
+
+(define (test-string-port-read-byte-peek)
+  (test-input-string-port test-data-1byte test-read-byte-peek))
+
+(define (test-string-port-read-byte-all-values)
+  (test-input-string-port test-data-256bytes test-read-byte-all-values))
+
+(define (test-string-port-read-char-single-ascii)
+  (test-input-string-port test-data-1byte test-read-char-single-ascii))
+
+(define (test-string-port-read-char-single)
+  (test-input-string-port test-data-1char test-read-char-single))
+
+(define (test-string-port-read-char-peek)
+  (test-input-string-port test-data-1char test-read-char-peek))
+
+(define (test-string-port-read-char-multiple)
+  (test-input-string-port test-data-2chars test-read-char-multiple))
+
+(define (test-string-port-read-byte-overflow)
+  (test-input-string-port test-data-1byte test-read-byte-overflow))
+
+(define (test-string-port-read-char-overflow)
+  (test-input-string-port test-data-1char test-read-char-overflow))
+
+(define (test-string-port-write test-data write-test verify-write-test)
+  (let* ((str (make-string (length test-data)))
+         (write-result (call-with-output-string str write-test))
+         (read-result (call-with-input-string str verify-write-test)))
+    (if (and (testresult-success write-result)
+             (testresult-success read-result))
+      (make-testresult #t '())
+      (make-testresult #f
+        (string-append
+          "write-error: " (any->string (testresult-error write-result)) ", "
+         "read-error: " (any->string (testresult-error read-result)))))))
+
+(define (test-string-port-write-byte-single)
+  (test-string-port-write test-data-1byte test-write-byte-single test-write-byte-single-verify))
+
+(define (test-string-port-write-char-single)
+  (test-string-port-write test-data-1char test-write-char-single test-write-char-single-verify))
+
+; ----- File port tests -----
+
+; Wrapper functions for the port read and write tests.
+
+(define (test-input-file-port test-data test-function)
+  (let ((filepath (plugin-tmp-filepath "fileport")))
+    (call-with-output-file filepath (lambda (port) (write-all-bytes port test-data)))
+    (call-with-input-file filepath test-function)))
+
+(define (test-file-port-read-byte-single)
+  (test-input-file-port test-data-1byte test-read-byte-single))
+
+(define (test-file-port-read-byte-single)
+  (test-input-file-port test-data-1byte test-read-byte-single))
+
+(define (test-file-port-read-byte-peek)
+  (test-input-file-port test-data-1byte test-read-byte-peek))
+
+(define (test-file-port-read-byte-all-values)
+  (test-input-file-port test-data-256bytes test-read-byte-all-values))
+
+(define (test-file-port-read-char-single-ascii)
+  (test-input-file-port test-data-1byte test-read-char-single-ascii))
+
+(define (test-file-port-read-char-single)
+  (test-input-file-port test-data-1char test-read-char-single))
+
+(define (test-file-port-read-char-peek)
+  (test-input-file-port test-data-1char test-read-char-peek))
+
+(define (test-file-port-read-char-multiple)
+  (test-input-file-port test-data-2chars test-read-char-multiple))
+
+(define (test-file-port-read-byte-overflow)
+  (test-input-file-port test-data-1byte test-read-byte-overflow))
+
+(define (test-file-port-read-char-overflow)
+  (test-input-file-port test-data-1char test-read-char-overflow))
+
+(define (test-file-port-write test-data write-test verify-write-test)
+  (let* ((filepath (plugin-tmp-filepath "fileport"))
+         (write-result (call-with-output-file filepath write-test))
+         (read-result (call-with-input-file filepath verify-write-test)))
+    (if (and (testresult-success write-result)
+             (testresult-success read-result))
+      (make-testresult #t '())
+      (make-testresult #f
+        (string-append
+          "write-error: " (any->string (testresult-error write-result)) ", "
+          "read-error: " (any->string (testresult-error read-result)))))))
+
+(define (test-file-port-write-byte-single)
+  (test-string-port-write
+    test-data-1byte test-write-byte-single test-write-byte-single-verify))
+
+(define (test-file-port-write-char-single)
+  (test-string-port-write
+    test-data-1char test-write-char-single test-write-char-single-verify))
+
+; ----- Generic string tests -----
+
+; Ensure basic string functions work.
+
+(define (test-string-length)
+  (assert '(= (string-length "Hello") 5)))
+
+(define (test-string-length-multibyte)
+  (assert '(= (string-length "你好") 2)))
+
+(define (test-string->list-length)
+  (assert '(= (length (string->list "Hello")) 5)))
+
+(define (test-string->list-length-multibyte)
+  (assert '(= (length (string->list "你好")) 2)))
+
+(define (test-string-first-char)
+  (assert '(= (char->integer (car (string->list "Hello"))) 72))) ; 72 = H
+
+(define (test-string-first-char-multibyte)
+  (assert '(= (char->integer (car (string->list "你好"))) 20320))) ; 20320 = 你 (UTF-32)
+
+(define (test-string-overflow)
+  (assert '(null? (cdr (string->list "H")))))
+
+(define (test-string-overflow-multibyte)
+  (assert '(null? (cdr (string->list "你")))))
+
+; ----- Generic string tests on strings created using string port -----
+
+; Test string functions on strings which are created by writing bytes into
+; a string port.
+
+; Write byte sequence of 你 into a string and ensure string-count returns 1.
+(define (test-string-port-string-count)
+  (let* ((str (make-string 3))
+     (port (open-output-string str)))
+  (begin
+    ; 你 = E4 BD A0 = 228 189 160
+    (write-byte (integer->byte 228) port)
+    (write-byte (integer->byte 189) port)
+    (write-byte (integer->byte 160) port)
+    (close-port port)
+    (assert
+      `(and (= (char->integer (car (string->list ,str))) 20320) ; 20320 = 你 (UTF-32)
+            (= (string-length ,str) 1))))))
+
+; ---------- Test Execution ----------
+
+; Count test results.
+(define tests-succeeded 0)
+(define tests-failed 0)
+
+(define (test-succeeded)
+  (set! tests-succeeded (+ tests-succeeded 1))
+  (display "SUCCESS")
+  (newline))
+(define (test-failed msg)
+  (set! tests-failed (+ tests-failed 1))
+  (display "FAILED") (newline)
+  (display msg) (newline))
+
+(define (run-test test)
+  (display test) (display ": ")
+  (let ((result ((eval test))))
+    (if (car result)
+      (test-succeeded)
+      (test-failed (cdr result)))))
+
+(define (run-tests . tests)
+  (map run-test tests))
+
+(define (run-byte-tests)
+  (run-tests
+    'test-byte-conversion
+    'test-byte?-byte
+    'test-byte?-integer
+    'test-byte?-char
+    'test-byte-atom?
+    'test-byte-atom->string))
+
+(define (run-string-port-tests)
+  (run-tests
+    'test-string-port-read-byte-single
+    'test-string-port-read-byte-peek
+    'test-string-port-read-byte-all-values
+    'test-string-port-read-char-single-ascii
+    'test-string-port-read-char-single
+    'test-string-port-read-char-peek
+    'test-string-port-read-char-multiple
+    'test-string-port-read-byte-overflow
+    'test-string-port-read-char-overflow
+    'test-string-port-write-byte-single
+    'test-string-port-write-char-single))
+
+(define (run-file-port-tests)
+  (run-tests
+    'test-file-port-read-byte-single
+    'test-file-port-read-byte-peek
+    'test-file-port-read-byte-all-values
+    'test-file-port-read-char-single-ascii
+    'test-file-port-read-char-single
+    'test-file-port-read-char-peek
+    'test-file-port-read-char-multiple
+    'test-file-port-read-byte-overflow
+    'test-file-port-read-char-overflow
+    'test-file-port-write-byte-single
+    'test-file-port-write-char-single))
+
+(define (run-string-tests)
+  (run-tests
+    'test-string-length
+    'test-string-length-multibyte
+    'test-string->list-length
+    'test-string->list-length-multibyte
+    'test-string-first-char
+    'test-string-first-char-multibyte
+    'test-string-overflow
+    'test-string-overflow-multibyte))
+
+(define (run-string-tests-string-port)
+  (run-tests
+    'test-string-port-string-count))
+
+(define (run-string-tests-string-port)
+  (run-test 'test-string-port-string-count))
+
+(define (run-all-tests)
+  (displayln "========== Information ==========")
+  (displayln "To run a single test individually, specify the name of the test.")
+  (displayln (string-append "Temporary files with format 'script-fu-test9-*.txt' can be found in: " temp-path))
+  (newline)
+  (displayln "========== Testing byte functions ==========")
+  (run-byte-tests)
+  (newline)
+  (displayln "========== Testing string port ==========")
+  (run-string-port-tests)
+  (newline)
+  (displayln "========== Testing string functions ==========")
+  (run-string-tests)
+  (newline)
+  (displayln "========== Testing string functions on strings created using string ports ==========")
+  (run-string-tests-string-port)
+  (newline)
+  (displayln "========== Testing file port ==========")
+  ; All file port tests will fail if writing to a file doesn't work properly,
+  ; as test data is written to a temporary file. This was done so that the test
+  ; data only exists in one place (in this file as list of bytes).
+  (run-file-port-tests)
+  (newline)
+  (if (= tests-failed 0)
+    (displayln "ALL tests passed!")
+    (displayln
+      (string-append
+        "Test 9: " (number->string tests-failed)
+        " tests FAILED. Run tests in Script-Fu console for details."))))
+
+(define (with-log-to-pika-message function)
+  (let ((test-log (make-string 4096)))
+    (call-with-output-string test-log
+      (lambda (port)
+        (set-output-port port)
+        (function)))
+    (pika-message (rtrim test-log))))
+
+(define (name->function name)
+  (eval (call-with-input-string (string-append "'" name) read)))
+
+(define (select-run-function testname)
+  (if (> (string-length testname) 0)
+    (lambda () (run-test (name->function testname)))
+    run-all-tests))
+
+(define (script-fu-test9 testname)
+  (with-log-to-pika-message (select-run-function testname)))
+
+; ---------- Script registration ----------
+
+(script-fu-register
+  "script-fu-test9"
+  "Test SF interpreter 9"
+  "Test byte and utf8 char handling. Must print SUCCESS for each test case."
+  "Richard Szibele"
+  "Copyright (C) 2022, Richard Szibele"
+  "2022"
+  ""
+  SF-STRING "Test (optional)" ""
+)
+
+(script-fu-menu-register "script-fu-test9" "<Image>/Test")