548 lines
18 KiB
Scheme
548 lines
18 KiB
Scheme
#!/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")
|
