
Add canonical/idiomatic functions call-with-output-string, call-with-input-string, any->string to the library init.scm. Since they are useful, especially in test scripts and frameworks. Remove their definitions from test scripts and test frameworks. Also comment out failing test in test script string-escape.scm.
588 lines
20 KiB
Scheme
Executable File
588 lines
20 KiB
Scheme
Executable File
#!/usr/bin/env gimp-script-fu-interpreter-3.0
|
|
|
|
; Test byte, file/string ports and string handling.
|
|
|
|
(define temp-path
|
|
(string-append (car (gimp-gimprc-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 (write-all-bytes port bytes)
|
|
(if (null? bytes)
|
|
'()
|
|
(begin
|
|
(write-byte (car bytes) port)
|
|
(write-all-bytes port (cdr bytes)))))
|
|
|
|
; !!! bytes->string works for any byte except NUL 0x00
|
|
; In that case, it returns a string the prefix of the sequence of bytes up to the NUL.
|
|
; Also, the returned string might not be properly UTF-8 encoded
|
|
; and therefore might not display correctly.
|
|
(define (bytes->string bytes)
|
|
(call-with-output-string
|
|
(lambda (port) (map (lambda (b) (write-byte b port)) bytes))))
|
|
|
|
; Returns a testresult, a list of (success errmsg)
|
|
; Calls open-function to open a port on str
|
|
; Then calls function, which is a test function taking a port.
|
|
; The test function reads from the port.
|
|
; The test function returns a test-result object.
|
|
;
|
|
; We don't absolutely need this except that it captures failure to open string-port.
|
|
; Instead we could just call-with-input-string
|
|
(define (call-test-with-string str function)
|
|
(let ((port (open-input-string str)))
|
|
(if (port? port)
|
|
(function port)
|
|
(begin
|
|
(gimp-message "Fail open string-port")
|
|
(make-testresult #f "Failed to open string for string port!")))))
|
|
|
|
|
|
; any->string, call-with-input-string, and call-with-output-string are in init.scm
|
|
|
|
; Loops from i to n-1.
|
|
; Using recursion.
|
|
(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))))
|
|
|
|
; all bytes except NUL
|
|
; returns list of bytes in range 1..255
|
|
(define test-data-255bytes
|
|
(let ((result '()))
|
|
(loop 1 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)))
|
|
|
|
; This is improper test function.
|
|
; It aborts testing by call error instead of continuing
|
|
; An earlier version using loop suffered runaway memory exhaustion.
|
|
(define (test-read-byte-all-values-except-NUL port)
|
|
(let* ((errors '())
|
|
(try
|
|
(lambda (i)
|
|
(let ((result (assert `(= (byte->integer (read-byte ,port)) ,i))))
|
|
(if (not (testresult-success result))
|
|
(error "failed test-read-byte-all-values-except-NUL")
|
|
'())))))
|
|
(do ((i 1 (+ i 1)))
|
|
((< i 256) i)
|
|
(try i))
|
|
(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)
|
|
(let ((test-string (bytes->string test-data)))
|
|
(call-with-input-string test-string test-function)))
|
|
; WAS
|
|
; (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-except-NUL)
|
|
(test-input-string-port test-data-255bytes test-read-byte-all-values-except-NUL))
|
|
|
|
(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))
|
|
|
|
; On a string port,
|
|
; check that what first function writes to port
|
|
; is what second function reads from port.
|
|
;
|
|
; test-data is not used, the verify function knows expected string.
|
|
;
|
|
; Either the write or read may fail but this version loses the write failure,
|
|
; so you should also test the write by itself.
|
|
(define (test-string-port-write test-data write-test verify-write-test)
|
|
; With SF v2 semantics for call-with-output-string
|
|
; (let* ((str (make-string (length test-data)))
|
|
; (write-result (call-with-output-string "" write-test))
|
|
; (read-result (call-with-input-string str verify-write-test)))
|
|
(let* ((written-str (call-with-output-string write-test))
|
|
(write-result (make-testresult #t written-str))
|
|
(read-result (call-test-with-string written-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-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-file-port-write
|
|
test-data-1byte test-write-byte-single test-write-byte-single-verify))
|
|
|
|
(define (test-file-port-write-char-single)
|
|
(test-file-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-port
|
|
; and ensure string-length of string from the port returns 1.
|
|
(define (test-string-port-string-count)
|
|
(let* ((port (open-output-string)))
|
|
(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)
|
|
; not close port, it goes out of scope and is gc
|
|
(assert
|
|
`(and (= (char->integer (car (string->list (get-output-string ,port)))) 20320) ; 20320 = 你 (UTF-32)
|
|
(= (string-length (get-output-string ,port)) 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)
|
|
; log the test to Gimp Error Console when executed.
|
|
; So severe errors leave a trace.
|
|
; And until we fix SF hijacking stdout.
|
|
(gimp-message (symbol->string 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-except-NUL
|
|
'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))
|
|
|
|
; SF hijacks stdout so all calls to display just write to SF (as an error msg)
|
|
; so it usually disappears.
|
|
; This is a hack, writing a few lines to Gimp Error Console using gimp-message.
|
|
; We should not need to redirect display to a string-port
|
|
; using with-log-to-gimp-message see below.
|
|
(define (run-all-tests)
|
|
(gimp-message "Begin 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!")
|
|
(gimp-message "ALL tests passed!")
|
|
;(displayln
|
|
(gimp-message
|
|
(string-append
|
|
"Test 9: " (number->string tests-failed)
|
|
" tests FAILED. Run tests in Script-Fu console for details."))))
|
|
|
|
; wrapper that redirects display to gimp-message.
|
|
; Not used because buffering messages makes it hard to debug this test program.
|
|
; FUTURE: fix ScriptFu to not hijack the output port
|
|
; and display function will write to stdout as it should.
|
|
(define (with-log-to-gimp-message function)
|
|
(gimp-message (call-with-output-string
|
|
(lambda (port)
|
|
(set-output-port port)
|
|
(function)))))
|
|
|
|
(define (name->function name)
|
|
(eval (call-with-input-string (string-append "'" name) read)))
|
|
|
|
(define (script-fu-test9 testname)
|
|
; OLD (with-log-to-gimp-message (select-run-function testname)))
|
|
; NEW log to gimp later, at each test
|
|
(gimp-message testname)
|
|
(if (> (string-length testname) 0)
|
|
(run-test (name->function testname))
|
|
(run-all-tests)))
|
|
|
|
; ---------- Script registration ----------
|
|
|
|
(script-fu-register
|
|
"script-fu-test9"
|
|
"Test TinyScheme byte and UTF-8 char handling."
|
|
"Logs tests to Gimp Error Console and stdout."
|
|
"Richard Szibele"
|
|
"Copyright (C) 2022, Richard Szibele"
|
|
"2022"
|
|
""
|
|
SF-STRING "Test name (optional)" ""
|
|
)
|
|
|
|
(script-fu-menu-register "script-fu-test9" "<Image>/Test")
|