diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h b/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h index 1fd7e5e28c..27a2039855 100644 --- a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h +++ b/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h @@ -72,7 +72,7 @@ extern "C" { #endif #ifndef USE_TRACING -# define USE_TRACING 1 +#define USE_TRACING 1 #endif #ifndef USE_PLIST diff --git a/plug-ins/script-fu/meson.build b/plug-ins/script-fu/meson.build index 41643f8770..8f2745905f 100644 --- a/plug-ins/script-fu/meson.build +++ b/plug-ins/script-fu/meson.build @@ -12,6 +12,7 @@ subdir('scripts') subdir('server') subdir('interpreter') subdir('console') +subdir('test') executable_name = 'script-fu' diff --git a/plug-ins/script-fu/test/frameworks/testing.scm b/plug-ins/script-fu/test/frameworks/testing.scm new file mode 100644 index 0000000000..d730e78fe1 --- /dev/null +++ b/plug-ins/script-fu/test/frameworks/testing.scm @@ -0,0 +1,354 @@ +; A testing framework +; +; Independent of GIMP except for gimp_message, +; which you can redefine + + +; Testing language + +; AssertStmt ~ (assert '()) +; AssertErrorStmt ~ (assert-error '() ) +; ReportStmt ~ (testing:report) +; LoadStmt ~ (testing:load-test ) +; AllPassedPredicate ~ (testing:all-passed?) +; +; AssertStmt and AssertErrorStmt have side effects on the testing state, +; and the other statements yield or display the state. +; +; AssertStmt and AssertErrorStmt also have side effects on the display, +; displaying failures. +; +; AssertStmt and AssertErrorStmt also yield #t or #f +; meaning pass or fail. + + +; Syntax errors +; The test framework WILL NOT handle syntax errors. +; The quoted code under tests must parse without syntax errors. +; Some errors that TinyScheme throws ARE syntax errors, but not named such. +; For example '#\xzzz is a syntax error (z is not a hex digit). +; Thus the test framework won't handle '#\xzzz . + + +; Algebra of calls +; +; Typically one or more AssertStmt followed by a ReportStmt +; when viewed in the console. +; Or one or more AssertStmt followed by AllPassedPredicate +; to yield an overall testing result, +; when testing is automated. + + + +; Notes on implementation: +; +; Debug stream for testing is gimp-message + + +; EvalResult object +; is-a tuple (result, error) +; is dynamic type returned by eval +; is type string + +(define (make-evalresult result errors) + ;(gimp-message "make-evalresult") + (list result errors)) +(define (evalresult-get-result x) (car x)) +(define (evalresult-get-error x) (cadr x)) +(define (evalresult-has-no-error? x) + (= (string-length (cadr x)) 0)) + + +; state + +(define testing:passed 0) ; counter +(define testing:failed '()) ; list + +(define (testing:reset!) + (set! testing:passed 0) + (set! testing:failed '())) + +(define (testing:log-passed!) + ; Not announce success to console, but can debug + (gimp-message "Passed") + (set! testing:passed (+ testing:passed 1))) + +; log any failure +(define (testing:log-fail! failure-string) + ; Announce fail as it happens + (displayln "") + (display "Failed: ") + (displayln failure-string) + ; save in state: prepend to list of failures + (set! testing:failed + (cons failure-string + testing:failed))) + + +(define (testing:log-fail-assert! code eval-result) + (testing:log-fail! (testing:format-fail-assert code eval-result))) + +(define (testing:log-fail-assert-error! code actual-error expected-error) + (testing:log-fail! (testing:format-fail-assert-error + code + actual-error + expected-error))) + +; reset testing state when test framework is loaded +(testing:reset!) + + + +; reporting +; These methods encapsulate formatting of strings and reports + +; A report is a summary of counts +; followed by line for each failure +(define (testing:report) + (testing:display-summary) + (testing:display-fails)) + +(define (testing:display-summary) + (displayln "") + (display "Passed: ") + (display testing:passed) + (display " Failed: ") + (displayln (length testing:failed))) + +; Display list of failures in time order +; This does not iterate over the list. +; It relies on newlines in the individual failure formats. +(define (testing:display-fails) + (if (> (length testing:failed) 0) + (begin + (displayln "Failures:") + ; reverse list so it displays in time order + (display (reverse testing:failed))) + '())) + +; returns a string for failed assert-error +; Of form: Code: foo Actual: bar Expected: zed +(define (testing:format-fail-assert-error code actual-error expected-error) + (string-append + " " + (any->string code) + (string #\newline) + " " + actual-error + (string #\newline) + " " + expected-error + (string #\newline) + (string #\newline)) +) + +; returns a string for failed assert +; Of form Code: foo Error: bar +(define (testing:format-fail-assert code eval-result) + (string-append + "" + (any->string code) + (string #\newline) + ; Any error message. + "" + (evalresult-get-error eval-result) + (string #\newline) + (string #\newline) + ; We don't display result, it must be false + ; because were given a boolean proposition + ) +) + + +; boolean result for entire testing session + +(define (testing:all-passed? ) + (not (= (length testing:failed) 0))) + + + +; Record eval-result, a tuple, from eval of code. +; This knows that a passed normal test has true result and empty error. +; a an object? a Scheme text, is a boolean proposition, +(define (testing:record-assert-result eval-result code) + ;(gimp-message "record-assert-result") + ; passed when has no error and result is #t + (if (and (evalresult-has-no-error? eval-result) + (evalresult-get-result eval-result)) + (testing:log-passed!) + ; fail + (testing:log-fail-assert! + code + eval-result))) + +; Record eval-result, a tuple, from eval of code. +; This knows that a passed assert-error test has don't care result +; and error-message matching given +; is dynamic type returned by eval +; is type string +; a an object? a Scheme text, is a boolean proposition. +; is type string +(define (testing:record-assert-error-result eval-result code expected-error) + ; debug + ;(displayln "record-assert-error-result") + ;(displayln eval-result) + + ; passed? + (if (equal? + (evalresult-get-error eval-result) + expected-error) + (begin + (testing:log-passed!) + #t) + ; fail, pass asserted code, actual error, expected error + (begin + (testing:log-fail-assert-error! + code + (evalresult-get-error eval-result) + expected-error) + #f))) + + +; Statments in the testing DSL. + +; The usual or normal test. +; is a boolean proposition expected to yield #t +(define (assert code) + (let* ((eval-result (harnessed-eval code))) + ; eval-result is tuple + ; record normal result i.e. error not expected + (testing:record-assert-result + eval-result + code) + ; Statements have side-effect on testing state, + ; but also return boolean result of predicate. + (evalresult-get-result eval-result ))) + +; A test of abnormality. +; is not expected to yield any particular value +; is a string for an error that is expected to throw. +(define (assert-error code expected-error) + (let* ((eval-result (harnessed-eval code))) + ; eval-result is tuple + ; record normal result i.e. error not expected + (testing:record-assert-error-result + eval-result + code + expected-error) + ; Returns whether error matches expected error. + )) + + +; eval code, returning tuple of result and errors +; This knows how to capture errors +; but not what result and errors mean for testing. +; Harnessed means: surrounded by code to capture error messages. +; +; Assert the pre-condition *error-hook* is (throw msg) see script-fu.init. +; So any call (error msg) is (throw msg) +; But we are not using (catch handler code). +; We are only overriding *error-hook* +; +; Any given eval of code under test may yield many calls to the error hook. +; We only record the first error message in an eval of the code under test. + +(define (harnessed-eval code) + ;(gimp-message "harnessed-eval") + (let* ((old-error-hook *error-hook*) ; save original handler, which is throw + (errors "") ; initial empty string + (result #f) ; initial result is #f, not () which is truthy + + (testing-error-hook + (lambda (xs) + ;(gimp-message "testing-error-hook") + + ; Only record the first error + (if (= (string-length errors) 0) + (if (string? xs) + (begin + ;(gimp-message "xs is string") + (set! errors xs)) + (set! errors "Non-string error"))) + + ; Do not chain up to old handler: (old-error-hook xs) + ; Old handler is usually throw, which is error, + ; and that infinite loops + ; + ; This returns to current eval, + ; which may call this error hook again. + ;(gimp-message "returning from error hook") + ))) + ;(gimp-message "override error hook") + (set! *error-hook* testing-error-hook) + ;(gimp-message "eval test code") + (set! result (eval code)) + ;(gimp-message "restore error hook") + ; restore the error hook for any code in a test script between asserts + (set! *error-hook* old-error-hook) + ; return an EvalResult + (make-evalresult result errors))) + + + + + +; port utility + + +(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) + ; Testing internal error. Hijack the testing framework + (testing:log-fail! "Failed to open string for string port!" '() )))) + +(define (call-with-output-string str function) + (with-string open-output-string str function)) + + + +; string utility + +(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)))))) + +; any is code +; Not using atom->string. Using write +(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)))) + + + +; filesystem utility + +; Return the fullpath of a test script +; From gimp-data-directory i.e. the shared install dir for GIMP +; Require filename is string +; Require suffix, usually ".scm" on the filename + +(define (path-user-script fileScm) + (let* ( (path (string-append gimp-data-directory DIR-SEPARATOR "tests"))) + (if (zero? (string-length fileScm)) path (string-append path DIR-SEPARATOR fileScm)))) + + +; load a test file, which executes it +; This knows where GIMP installs test scripts +; +; Subsequently, testing:report will say results +(define (testing:load-test filename) + (gimp-message (path-user-script filename)) + (load (path-user-script filename))) diff --git a/plug-ins/script-fu/test/meson.build b/plug-ins/script-fu/test/meson.build new file mode 100644 index 0000000000..0e8ef46115 --- /dev/null +++ b/plug-ins/script-fu/test/meson.build @@ -0,0 +1,68 @@ + +# Install ScriptFu testing framework and test scripts + +if not stable + test_framework_scripts = [ + 'frameworks' / 'testing.scm', + ] + + test_scripts = [ + 'tests' / 'PDB' / 'image' / 'image-new.scm', + 'tests' / 'PDB' / 'image' / 'image-precision.scm', + 'tests' / 'PDB' / 'image' / 'image-indexed.scm', + 'tests' / 'PDB' / 'image' / 'image-grayscale.scm', + 'tests' / 'PDB' / 'image' / 'image-ops.scm', + 'tests' / 'PDB' / 'layer' / 'layer-new.scm', + 'tests' / 'PDB' / 'layer' / 'layer-ops.scm', + 'tests' / 'PDB' / 'layer' / 'layer-mask.scm', + 'tests' / 'PDB' / 'text-layer' / 'text-layer-new.scm', + 'tests' / 'PDB' / 'item' / 'item.scm', + 'tests' / 'PDB' / 'channel' / 'channel-new.scm', + 'tests' / 'PDB' / 'vectors-new.scm', + 'tests' / 'PDB' / 'selection' / 'selection.scm', + 'tests' / 'PDB' / 'selection' / 'selection-from.scm', + 'tests' / 'PDB' / 'resource.scm', + 'tests' / 'PDB' / 'brush.scm', + 'tests' / 'PDB' / 'misc.scm', + 'tests' / 'PDB' / 'enums.scm', + # comprehensive, total test + 'tests' / 'PDB' / 'pdb.scm', + + 'tests' / 'TS' / 'sharp-expr.scm', + 'tests' / 'TS' / 'sharp-expr-char.scm', + 'tests' / 'TS' / 'sharp-expr-unichar.scm', + 'tests' / 'TS' / 'unichar.scm', + 'tests' / 'TS' / 'cond-expand.scm', + 'tests' / 'TS' / 'atom2string.scm', + 'tests' / 'TS' / 'integer2char.scm', + 'tests' / 'TS' / 'string-port.scm', + 'tests' / 'TS' / 'testing.scm', + 'tests' / 'TS' / 'vector.scm', + 'tests' / 'TS' / 'no-memory.scm', + # comprehensive, total test + 'tests' / 'TS' / 'tinyscheme.scm', + ] + +endif + +# Install test framework to shared /scripts +# Assert: SFConsole, SFExtension, and standalong SFInterpreter will read them. +# SFConsole is primary testing interface. +# Some plugins in /scripts (SFExtension) +# and in /plug-ins (SFInterpreter) may also be interface for testing. + +install_data( + test_framework_scripts, + install_dir: gimpdatadir / 'scripts', +) + +# Install test scripts to shared /tests +# Install flattening the dir structure. + +install_data( + test_scripts, + install_dir: gimpdatadir / 'tests', +) + + + diff --git a/plug-ins/script-fu/test/tests/PDB/bind-args.scm b/plug-ins/script-fu/test/tests/PDB/bind-args.scm new file mode 100644 index 0000000000..ddea325284 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/bind-args.scm @@ -0,0 +1,14 @@ + +; Test ScriptFu's binding to all Gimp C arg types of the PDB + + +; The PDB procedures called are arbitrary, chosen for the type of their args. + +; The test is only that no error is thrown, not that the call is effective. + +; int +; 1 is image ID and 1,1 is an int coord +(assert '(gimp-image-add-sample-point 1 1 1)) + +; float +(assert '(= (car (gimp-item-id-is-valid -1)) 0)) \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/brush.scm b/plug-ins/script-fu/test/tests/PDB/brush.scm new file mode 100644 index 0000000000..94e6191c53 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/brush.scm @@ -0,0 +1,130 @@ +; Test methods of Brush subclass of Resource class + +; !!! See also resource.scm +; Currently using string names instead of numeric ID + +; !!! Testing depends on a fresh install of GIMP. +; A prior testing failure may leave brushes in GIMP. +; The existing brush may have the same name as hard coded in tests. +; In future, will be possible to create new brush with same name as existing. + + +; new and delete + +; new returns brush of given name +(assert '(string=? + (car (gimp-brush-new "TestBrushNew")) + "TestBrushNew")) + +; TODO delete +; can delete a new brush +; FAIL _gimp_gp_param_def_to_param_spec: GParamSpec type unsupported 'GimpParamResource' +;(assert '(string=? +; (car (gimp-resource-delete "TestBrushNew")) +; "TestBrushNew")) + + +; Kind generated vesus raster + +; new brush is kind generated +(assert '(equal? + (car (gimp-brush-is-generated "TestBrushNew")) + 1)) + +; angle default is 0 +(assert '(= + (car (gimp-brush-get-angle "TestBrushNew")) + 0)) + +; aspect-ratio default is 1.0 +; FIXME: the doc says 0.0 +(assert '(= + (car (gimp-brush-get-aspect-ratio "TestBrushNew")) + 1.0)) + +; hardness default is 0.5 +; FIXME: the doc says 0 +(assert '(= + (car (gimp-brush-get-hardness "TestBrushNew")) + 0.5)) + +; shape default is GENERATED-CIRCLE +(assert '(= + (car (gimp-brush-get-shape "TestBrushNew")) + BRUSH-GENERATED-CIRCLE)) + +; spikes default is 2 +; FIXME: docs says 0 +(assert '(= + (car (gimp-brush-get-spikes "TestBrushNew")) + 2)) + +; get-radius default 5.0 +; FIXME: docs says 0 +(assert '(= + (car (gimp-brush-get-radius "TestBrushNew")) + 5.0)) + + +; spacing default 20 +; FIXME: docs says 0 +(assert '(= + (car (gimp-brush-get-spacing "TestBrushNew")) + 20)) + +; get-info returns a list of attributes +; For generated, color bytes is zero +(assert '(equal? (gimp-brush-get-info "TestBrushNew") + '(11 11 1 0))) + +; get-pixels returns a list of attributes +; It is is long so we don't compare. +; This test is just that it doesn't crash or return #f. +(assert '(gimp-brush-get-pixels "TestBrushNew")) + + + + + +; Kind non-generated brush + +; "z Pepper" is non-generated and is a system brush always installed + +; Certain attributes of non-generated brush yield errors +; angle, aspect-ratio, hardness, shape, spikes, radius + +; angle +(assert-error + '(gimp-brush-get-angle "z Pepper") + "Procedure execution of gimp-brush-get-angle failed") + +; TODO all the other attributes + + +; Non-generated brush attributes + +; is not generated +(assert '(= + (car (gimp-brush-is-generated "z Pepper")) + 0)) + +; spacing +(assert '(= + (car (gimp-brush-get-spacing "z Pepper")) + 100)) + +; pixels returns a list of attributes +; FAIL: CRASH Inconsistency detected by ld.so: dl-runtime.c: 63: _dl_fixup: Assertion `ELFW(R_TYPE)(reloc->r_info) == ELF_MACHINE_JMP_SLOT' failed! +; (assert '(gimp-brush-get-pixels "z Pepper")) + +; get-info returns a list of attributes +(assert '(equal? (gimp-brush-get-info "z Pepper") + '(180 220 1 3))) + + + + + + + + diff --git a/plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm b/plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm new file mode 100644 index 0000000000..cd7d61f12c --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm @@ -0,0 +1,56 @@ +; Test methods of Channel class of the PDB + + + +; setup +; Reusing image 10 +(define testImage 10) + + +; new image has no custom channels +(assert `(= (car (gimp-image-get-channels ,testImage)) + 0)) + +; vectors-new succeeds +(assert `(car (gimp-channel-new + ,testImage ; image + 23 24 ; width, height + "Test Channel" ; name + 50.0 ; opacity + "red" ))) ; compositing color + +(define testChannel 20) + +; new returns a valid ID +(assert `(= (car (gimp-item-id-is-channel ,testChannel)) + 1)) ; #t + +; new channel is not in image until inserted +(assert `(= (car (gimp-image-get-channels ,testImage)) + 0)) + + +; attributes + +; get-color +; FIXME: this passes but should test return red ??? +(assert `(equal? + (car (gimp-channel-get-color ,testChannel)) + '(0 0 0))) + + + + +; insert + +; insert succeeds +(assert `(gimp-image-insert-channel + ,testImage + ,testChannel + 0 ; parent, moot since channel groups not supported + 0)) ; position in stack + +; insert was effective +(assert `(= (car (gimp-image-get-channels ,testImage)) + 1)) + diff --git a/plug-ins/script-fu/test/tests/PDB/enums.scm b/plug-ins/script-fu/test/tests/PDB/enums.scm new file mode 100644 index 0000000000..711b84e75c --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/enums.scm @@ -0,0 +1,19 @@ + +; Test enums of the PDB + +; These test and illustrate enums + + +; ImageBaseType +(assert '(= RGB 0)) +(assert '(= GRAY 1)) +(assert '(= INDEXED 2)) + +; ImageType is not same as ImageBaseType +(assert '(= RGB-IMAGE 0)) +(assert '(= RGBA-IMAGE 1)) +(assert '(= GRAY-IMAGE 2)) +(assert '(= GRAYA-IMAGE 3)) +(assert '(= INDEXED-IMAGE 4)) +(assert '(= INDEXEDA-IMAGE 5)) + diff --git a/plug-ins/script-fu/test/tests/PDB/image/image-grayscale.scm b/plug-ins/script-fu/test/tests/PDB/image/image-grayscale.scm new file mode 100644 index 0000000000..5093558418 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/image/image-grayscale.scm @@ -0,0 +1,56 @@ +; test Image of mode grayscale methods of PDB + + +; depends on fresh GIMP state +; !!!! tests hardcode image ID 5 + +; !!! Note inconsistent use in GIMP of GRAY versus GRAYSCALE + + + +; Basic grayscale tests + + +; method new from fresh GIMP state returns ID 5 +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 5)) + +; method gimp-image-convert-grayscale does not error +(assert '(gimp-image-convert-grayscale 5)) + +; conversion was effective: +; basetype of grayscale is GRAY +(assert '(= + (car (gimp-image-get-base-type 5)) + GRAY)) + +; conversion was effective: +; grayscale image has-a colormap +; colormap is-a vector of length zero, when image has no drawable. +; FIXME doc says num-bytes is returned, obsolete since GBytes +(assert '(= + (vector-length + (car (gimp-image-get-colormap 5))) + 0)) + +; grayscale images have precision PRECISION-U8-NON-LINEAR +; FIXME annotation of PDB procedure says GIMP_PRECISION_U8 +(assert '(= + (car (gimp-image-get-precision 5)) + PRECISION-U8-NON-LINEAR )) + +; TODO +; drawable of grayscale image is also grayscale +;(assert '(car (gimp-drawable-is-grayscale +; () +; 5) + +; convert precision of grayscale image succeeds +(assert '(gimp-image-convert-precision + 5 + PRECISION-DOUBLE-GAMMA)) + + + + diff --git a/plug-ins/script-fu/test/tests/PDB/image/image-indexed.scm b/plug-ins/script-fu/test/tests/PDB/image/image-indexed.scm new file mode 100644 index 0000000000..0f0237ade8 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/image/image-indexed.scm @@ -0,0 +1,63 @@ +; test Image of mode indexed methods of PDB + + +; depends on fresh GIMP state +; !!!! tests hardcode image ID 4 + +; Using numeric equality operator '=' on numeric ID's + + +; Basic indexed tests + + +; method new from fresh GIMP state returns ID 4 +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 4)) + +; method gimp-image-convert-indexed yields truthy (now yields (#t) ) +(assert '(gimp-image-convert-indexed + 4 + CONVERT-DITHER-NONE + CONVERT-PALETTE-GENERATE + 25 ; color count + 1 ; alpha-dither. FUTURE: #t + 1 ; remove-unused. FUTURE: #t + "myPalette" ; ignored + )) + +; conversion was effective: +; basetype of indexed is INDEXED +(assert '(= + (car (gimp-image-get-base-type 4)) + INDEXED)) + +; conversion was effective: +; indexed image has-a colormap +; colormap is-a vector of length zero, when image has no drawable. +; FIXME doc says num-bytes is returned, obsolete since GBytes +(assert '(= + (vector-length + (car (gimp-image-get-colormap 4))) + 0)) + +; indexed images have precision PRECISION-U8-NON-LINEAR +; FIXME annotation of PDB procedure says GIMP_PRECISION_U8 +(assert '(= + (car (gimp-image-get-precision 4)) + PRECISION-U8-NON-LINEAR )) + +; TODO +; drawable of indexed image is also indexed +;(assert '(car (gimp-drawable-is-indexed +; () +; 4) + +; convert precision of indexed images yields error +(assert-error '(car (gimp-image-convert-precision + 4 + PRECISION-DOUBLE-GAMMA)) +"Procedure execution of gimp-image-convert-precision failed on invalid input arguments: Image '[Untitled]' (4) must not be of type 'indexed'") + + + diff --git a/plug-ins/script-fu/test/tests/PDB/image/image-new.scm b/plug-ins/script-fu/test/tests/PDB/image/image-new.scm new file mode 100644 index 0000000000..254b429308 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/image/image-new.scm @@ -0,0 +1,145 @@ +; test Image methods of PDB + +; loading this file changes testing state + +; depends on fresh GIMP state +; !!!! tests hardcode image ID 1 + +; Using numeric equality operator '=' on numeric ID's + + +; method new from fresh GIMP state returns ID 1 +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 1 )) + +; FUTURE method is_valid on new image yields #t +; method is_valid on new image yields 1 i.e. true +(assert '(= + (car (gimp-image-id-is-valid 1)) + 1)) + +; Ensure attributes of new image are correct + +; method is_dirty on new image is true +(assert '(= + (car (gimp-image-is-dirty 1)) + 1)) + +; method get_width on new image yields same width given when created +(assert '(= + (car (gimp-image-get-width 1)) + 21)) + +; method get_height on new image yields same height given when created +(assert '(= + (car (gimp-image-get-height 1)) + 22)) + +; method get-base-type yields same image type given when created +(assert '(= + (car (gimp-image-get-base-type 1)) + RGB)) + +; new image is known to gimp +; Returns ( #(1)) +(assert '(= (car (gimp-get-images)) + 1)) + + +; new image has no components + +; new image has zero layers +(assert '(= (car (gimp-image-get-layers 1)) + 0)) + +; new image has zero vectors +(assert '(= (car (gimp-image-get-vectors 1)) + 0)) + +; new image has no parasites +(assert '(= (length + (car (gimp-image-get-parasite-list 1))) + 0)) + + + + + +; new image has-a selection +(assert '(gimp-image-get-selection 1)) + +; new image has no floating selection +(assert '(= + (car (gimp-image-get-floating-sel 1)) + -1)) + +; TODO floating-sel-attached-to + + + +; new image has unit having ID 1 +(assert '(= + (car (gimp-image-get-unit 1)) + 1)) + +; new image has name +(assert '(string=? + (car (gimp-image-get-name 1)) + "[Untitled]")) + +; new image has empty metadata string +(assert '(string=? + (car (gimp-image-get-metadata 1)) + "")) + +; has an effective color profile +(assert '(gimp-image-get-effective-color-profile 1)) + + + +; new image has no associated files + +; GFile is string in ScriptFu + +; no file, xcf file, imported file, or exported file +(assert '(string=? (car (gimp-image-get-file 1)) "")) +(assert '(string=? (car (gimp-image-get-xcf-file 1)) "")) +(assert '(string=? (car (gimp-image-get-imported-file 1)) "")) +(assert '(string=? (car (gimp-image-get-exported-file 1)) "")) + + + +; Test delete method. +; !!! ID 1 is no longer valid + +; method delete succeeds on new image +; returns 1 for true. FUTURE returns #t +(assert `(car (gimp-image-delete 1))) + +; ensure id invalid for deleted image +; returns 0 for false. FUTURE returns #f +(assert `(= + (car (gimp-image-id-is-valid 1)) + 0)) + +; deleted image is not in gimp +; Returns ( #()) +; FUTURE Returns empty list '() +(assert '(= + (car (gimp-get-images)) + 0)) + + + +; Test abnormal args to image-new + + +; Dimension zero yields error +; It does NOT yield invalid ID -1 +(assert-error '(gimp-image-new 0 0 RGB) +"Procedure execution of gimp-image-new failed on invalid input arguments: Procedure 'gimp-image-new' has been called with value '0' for argument 'width' (#1, type gint). This value is out of range." ) + + + + diff --git a/plug-ins/script-fu/test/tests/PDB/image/image-ops.scm b/plug-ins/script-fu/test/tests/PDB/image/image-ops.scm new file mode 100644 index 0000000000..dceef91a85 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/image/image-ops.scm @@ -0,0 +1,85 @@ +; Test various operations on image + + +; method new from fresh GIMP state returns ID 2 +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 6)) + + +; transformations + +; flip +(assert '(gimp-image-flip 6 ORIENTATION-HORIZONTAL)) +(assert '(gimp-image-flip 6 ORIENTATION-VERTICAL)) +; TODO rotate scale resize policy + +(assert-error '(gimp-image-flip 6 ORIENTATION-UNKNOWN) + (string-append + "Procedure execution of gimp-image-flip failed on invalid input arguments: " + "Procedure 'gimp-image-flip' has been called with value 'GIMP_ORIENTATION_UNKNOWN'" + " for argument 'flip-type' (#2, type GimpOrientationType). This value is out of range.")) + +; rotate +(assert '(gimp-image-rotate 6 ROTATE-90)) +(assert '(gimp-image-rotate 6 ROTATE-180)) +(assert '(gimp-image-rotate 6 ROTATE-270)) + +; scale +; up +(assert '(gimp-image-scale 6 100 100)) + +; down to min +(assert '(gimp-image-scale 6 1 1)) + +; up to max +; Performance: +; This seems to work fast when previous scaled to 1,1 +; but then seems to slow down testing +; unless we scale down afterwards. +; This seems glacial if not scaled to 1,1 prior. +(assert '(gimp-image-scale 6 524288 524288)) + +; down to min +(assert '(gimp-image-scale 6 1 1)) + + +; policy ops + +; 0 means non-interactive +(assert '(gimp-image-policy-color-profile 6 0)) +(assert '(gimp-image-policy-rotate 6 0)) + + + +; freezing and unfreezing (avoid updates to dialogs) +; Used for performance. +(assert '(gimp-image-freeze-channels 6)) +(assert '(gimp-image-freeze-layers 6)) +(assert '(gimp-image-freeze-vectors 6)) +(assert '(gimp-image-thaw-channels 6)) +(assert '(gimp-image-thaw-layers 6)) +(assert '(gimp-image-thaw-vectors 6)) + +; clean-all makes image not dirty +(assert '(gimp-image-clean-all 6)) +(assert '(= + (car (gimp-image-is-dirty 6)) + 0)) + +; TODO test flatten is effective +; crop + + +; painting ops +; TODO +; heal +; erase +; smudge +; pencil +; clone +; airbrush + +; cannot flatten empty image +(assert-error '(gimp-image-flatten 6) + "Procedure execution of gimp-image-flatten failed: Cannot flatten an image without any visible layer.") diff --git a/plug-ins/script-fu/test/tests/PDB/image/image-precision.scm b/plug-ins/script-fu/test/tests/PDB/image/image-precision.scm new file mode 100644 index 0000000000..9b197ac306 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/image/image-precision.scm @@ -0,0 +1,60 @@ +; test Image precision methods of PDB + + +; depends on fresh GIMP state +; !!!! tests hardcode image ID 2 + +; Using numeric equality operator '=' on numeric ID's + + +; Basic precision tests + + +; method new from fresh GIMP state returns ID 2 +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 2 )) + +; method get_precision on new image yields PRECISION-U8-NON-LINEAR 150 +(assert '(= + (car (gimp-image-get-precision 2)) + PRECISION-U8-NON-LINEAR )) + + + +; Convert precision + +; method convert-precision yields true, with side effect on image +(assert '(car (gimp-image-convert-precision + 2 + PRECISION-U8-LINEAR))) + + +; converted image is the precision +(assert '(= + (car (gimp-image-get-precision 2)) + PRECISION-U8-LINEAR )) + +; converting to the same precision yields error message +(assert-error '(gimp-image-convert-precision + 2 + PRECISION-U8-LINEAR) +"Procedure execution of gimp-image-convert-precision failed on invalid input arguments: Image '[Untitled]' (2) must not be of precision 'u8-linear'") + + + +; Indexed images precision tested elsewhere + + + +; New with precision + +; method new-with-precision from fresh GIMP state returns ID 3 +(assert '(= + (car (gimp-image-new-with-precision 21 22 RGB PRECISION-DOUBLE-GAMMA)) + 3 )) + +; image has given precision +(assert '(= + (car (gimp-image-get-precision 3)) + PRECISION-DOUBLE-GAMMA )) \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/item/item.scm b/plug-ins/script-fu/test/tests/PDB/item/item.scm new file mode 100644 index 0000000000..7e5f94b196 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/item/item.scm @@ -0,0 +1,166 @@ +; test item methods of PDB + +; Define function that is a sequence of tests. +; Iterate over items of different types, applying test function. +; 1. test attributes of a minimal item +; 2. test transformations of item + +; Test of gimp-item-is- are elsewhere + +; Test of tree/group (raise/lower, reorder) are elsewhere + + + + +; Implementation of test: +; function using assert must backquote ` and unquote , item. + + + +; Test methods of bare, minimal item. +(define (test-bare-item item) + ; item is a numeric ID is valid + (assert `(gimp-item-id-is-valid ,item)) + + ; item is not a group (can have no children) + (assert `(= (car (gimp-item-is-group ,item)) + 0)) + + ; item has no color tag + (assert `(= (car (gimp-item-get-color-tag ,item)) + COLOR-TAG-NONE)) + + ; item is not expanded + (assert `(= (car (gimp-item-get-expanded ,item)) + 0)) + + ; item has name, tattoo + ; Test does not check returned value + (assert `(gimp-item-get-name ,item)) + (assert `(gimp-item-get-tattoo ,item)) + + ; item has no parasites, yields no list of string + ; !!! C GStrv marshaled to empty list + ; Scheme null? tests for empty list + (assert `(null? (car (gimp-item-get-parasite-list ,item)))) + + ; item has no parent + ; yields -1 for NULL ID + (assert `(= (car (gimp-item-get-parent ,item)) + -1)) + + ; item has-a image + ; Test does not compare item ID + (assert `(gimp-item-get-image ,item)) + + ; item's content, position, visibility is not locked + (assert `(= (car (gimp-item-get-lock-content ,item)) + 0)) + (assert `(= (car (gimp-item-get-lock-position ,item)) + 0)) + (assert `(= (car (gimp-item-get-lock-visibility ,item)) + 0)) +) + + +; Test methods of image,item +(define (test-item-in-image image item) + ; item can produce a selection + (assert `(gimp-image-select-item + ,image + CHANNEL-OP-ADD + ,item)) +) + + + +; !!! GimpParasite does not have method new in PDB. +; But you can create one in ScriptFu as (list "name" "data") +; +; 0 - Not persistent and not UNDOable +; 1 - Persistent and not UNDOable +; 2 - Not persistent and UNDOable +; 3 - Persistent and UNDOable + +; https://www.gimpusers.com/forums/gimp-user/12970-how-are-parasites-represented-in-script-fu +; https://www.mail-archive.com/gimp-user@lists.xcf.berkeley.edu/msg20099.html + +; A returned parasite in ScriptFu is-a list (list "name" "data") + +; You can use this in testing but requires (quote ,testParasite) ??? +;(define testParasite (list "Parasite New" 1 "Parasite Data")) + +(define (test-item-parasite item) + + ; not has-a parasite + ; !!! procedure expected to fail when no parasite + (assert-error `(gimp-item-get-parasite + ,item + "Test Parasite") ; name + "Procedure execution of gimp-item-get-parasite failed") + + ; can attach parasite + (assert `(gimp-item-attach-parasite + ,item + (list "Parasite New" 1 "Parasite Data"))) + ; attach was effective: now item has parasite + ; and its name is as previously given + (assert `(string=? + ; !!! Parasite is list in list, and first element is name + (caar (gimp-item-get-parasite + ,item + "Parasite New")) ; name + "Parasite New")) + + ; can detach parasite + (assert `(gimp-item-detach-parasite + ,item + "Parasite New")) + ; detach was effective + (assert-error `(gimp-item-get-parasite + ,item + "Test Parasite") ; name + "Procedure execution of gimp-item-get-parasite failed") +) + + +; use image,item instance extant from previous tests. + +; text layer +(test-bare-item 15) +(test-item-in-image 8 15) +(test-item-parasite 15) + +; layer +(test-bare-item 12) +(test-item-in-image 9 12) +(test-item-parasite 12) + +; layerMask +(test-bare-item 14) +(test-item-in-image 9 14) +(test-item-parasite 14) + +; vectors +; ID 16 is also a vectors named "foo" +(test-bare-item 19) +(test-item-in-image 10 19) +(test-item-parasite 19) + +; channel +(test-bare-item 20) +(test-item-in-image 10 20) +(test-item-parasite 20) + +; selection +(test-bare-item 18) +(test-item-in-image 10 18) +(test-item-parasite 18) + +; TODO other item types e.g. ? + +; gimp-image-get-item-position +; gimp-image-raise-item +; gimp-image-raise-item-to-top +; lower +; reorder diff --git a/plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm b/plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm new file mode 100644 index 0000000000..afd758a345 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm @@ -0,0 +1,114 @@ +; tests of methods re masks on layers + +; masks are a separate class in Gimp GimpLayerMask +; but the methods are named strangely, +; e.g. there is no gimp-layer-mask-get-layer + + +; setup +; Image owns Layers + +; method new from fresh GIMP state returns ID +(assert '(= (car (gimp-image-new 21 22 RGB)) + 9 )) + +; new method yields layer ID 12 +(assert '(= (car (gimp-layer-new + 9 + 21 + 22 + RGB-IMAGE + "LayerNew" + 50.0 + LAYER-MODE-NORMAL)) + 12)) +; assert layer is not inserted in image + + +; gimp-layer-create-mask yields ID 13 +; Creating for the layer, but not on the layer yet!!! +(assert '(= (car (gimp-layer-create-mask + 12 + ADD-MASK-WHITE)) + 13)) + +; mask is not on layer until added. +; Getting the mask for the layer yields -1. +(assert '(= (car (gimp-layer-mask 12)) + -1)) + +; add layerMask created on a layer to that layer succeeds +(assert '(gimp-layer-add-mask + 12 ; layer + 13)) ; layer mask + +; add layerMask to layer was effective: +; Getting the mask for the layer yields layerMask ID +(assert '(= (car (gimp-layer-mask 12)) + 13)) + +; and vice versa +(assert '(= (car (gimp-layer-from-mask 13)) + 12)) + + + +; creating and adding second mask + +; creating a second mask from layer succeeds +(assert '(= (car (gimp-layer-create-mask + 12 + ADD-MASK-WHITE)) + 14)) + +; adding a second layerMask fails +(assert-error '(gimp-layer-add-mask + 12 ; layer + 14) ; layer mask + (string-append + "Procedure execution of gimp-layer-add-mask failed: " + "Unable to add a layer mask since the layer already has one.")) + + + +; mask removal + +; remove-mask fails if the layer is not on image +(assert-error '(gimp-layer-remove-mask + 12 ; layer + MASK-APPLY) ; removal mode + (string-append + "Procedure execution of gimp-layer-remove-mask failed on invalid input arguments: " + "Item 'LayerNew' (12) cannot be used because it has not been added to an image")) + +; adding layer to image succeeds +(assert '(gimp-image-insert-layer + 9 ; image + 12 ; layer + 0 ; parent + 0 )) ; position within parent + +; remove-mask succeeds +; when layer is in image +(assert '(gimp-layer-remove-mask + 12 ; layer + MASK-APPLY)) ; removal mode + +; and is effective +; layer no longer has a mask +(assert '(= (car (gimp-layer-mask 12)) + -1)) + +; and now we can add the second mask +(assert '(gimp-layer-add-mask + 12 ; layer + 14)) ; second layer mask + + +; fails when mask different size from layer? + +; fails create layerMask when ADD-CHANNEL-MASK and no active channel + +; create layerMask ADD-ALPHA-MASK works even when no alpha channel + +; TODO many variations of create diff --git a/plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm b/plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm new file mode 100644 index 0000000000..864e562204 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm @@ -0,0 +1,127 @@ +; test Layer methods of PDB + + +; setup +; Image owns Layers + +; method new from fresh GIMP state returns ID +(assert '(= + (car (gimp-image-new 21 22 RGB)) + 7 )) + + + + + + +; new method yields layer ID 8 +(assert '(= (car (gimp-layer-new + 7 + 21 + 22 + RGB-IMAGE + "LayerNew" + 50.0 + LAYER-MODE-NORMAL)) + 8)) + + +; new layer is not in the image until inserted +(assert '(= (car (gimp-image-get-layers 7)) + 0)) + + + +; attributes of new layer + +; defaulted attributes + +; apply-mask default false +(assert '(= + (car (gimp-layer-get-apply-mask 8)) + 0)) + +; blend-space default LAYER-COLOR-SPACE-AUTO +(assert '(= + (car (gimp-layer-get-blend-space 8)) + LAYER-COLOR-SPACE-AUTO)) + +; composite-mode default LAYER-COMPOSITE-AUTO +(assert '(= + (car (gimp-layer-get-composite-mode 8)) + LAYER-COMPOSITE-AUTO)) + +; composite-space default LAYER-COLOR-SPACE-AUTO +(assert '(= + (car (gimp-layer-get-composite-space 8)) + LAYER-COLOR-SPACE-AUTO)) + +; edit-mask default false +(assert '(= + (car (gimp-layer-get-edit-mask 8)) + 0)) + +; lock-alpha default false +; deprecated? gimp-layer-get-preserve-trans +(assert '(= + (car (gimp-layer-get-lock-alpha 8)) + 0)) + +; mask not exist, ID -1 +; deprecated? gimp-layer-mask +(assert '(= + (car (gimp-layer-get-mask 8)) + -1)) + +; mode default LAYER-MODE-NORMAL +(assert '(= + (car (gimp-layer-get-mode 8)) + LAYER-MODE-NORMAL)) + +; show-mask default false +(assert '(= + (car (gimp-layer-get-show-mask 8)) + 0)) + +; visible default true +; FIXME doc says default false +(assert '(= + (car (gimp-layer-get-visible 8)) + 1)) + +; is-floating-sel default false +(assert '(= + (car (gimp-layer-is-floating-sel 8)) + 0)) + +; !!! No get-offsets + + + + +; attributes are as given when created + +; name is as given +assert '(string=? (car (gimp-layer-get-name 8)) + "LayerNew") + +; opacity is as given +(assert '(= + (car (gimp-layer-get-opacity 8)) + 50.0)) + + +; generated attributes + +; tattoo +; tattoo is generated unique within image? +(assert '(= + (car (gimp-layer-get-tattoo 8)) + 2)) + + + + + + + diff --git a/plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm b/plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm new file mode 100644 index 0000000000..6bf24ac48c --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm @@ -0,0 +1,98 @@ +; test Layer methods of PDB +; where methods are operations + + +; setup +; Image owns Layers + +; method new from fresh GIMP state returns ID +;(define testImage 1) +;(set! testImage (car (gimp-image-new 21 22 RGB))) +;(displayln testImage) + +(assert '(= (car (gimp-image-new 21 22 RGB)) + 8 )) + + + +; new method yields layer ID 10 +(assert '(= (car (gimp-layer-new + 8 + 21 + 22 + RGB-IMAGE + "LayerNew#2" + 50.0 + LAYER-MODE-NORMAL)) + 10)) +; assert layer is not inserted in image + + +; errors when layer not in image + +; resize fails +(assert-error '(gimp-layer-resize 10 23 24 0 0) + (string-append + "Procedure execution of gimp-layer-resize failed on invalid input arguments: " + "Item 'LayerNew#2' (10) cannot be used because it has not been added to an image")) + +; scale fails +(assert-error '(gimp-layer-scale 10 + 23 24 ; width height + 0) ; is local origin? + (string-append + "Procedure execution of gimp-layer-scale failed on invalid input arguments: " + "Item 'LayerNew#2' (10) cannot be used because it has not been added to an image")) + +; gimp-layer-resize-to-image-size fails +; TODO + +; gimp-layer-remove-mask fails when layer has no mask +(assert-error '(gimp-layer-remove-mask + 10 + MASK-APPLY) + (string-append + "Procedure execution of gimp-layer-remove-mask failed on invalid input arguments: " + "Item 'LayerNew#2' (10) cannot be used because it has not been added to an image")) + + + +; alpha operations + +; add-alpha succeeds +(assert '(gimp-layer-add-alpha 10)) + +; and is effective +; Note method on superclass Drawable +(assert '(= (car (gimp-drawable-has-alpha 10)) + 1)) + +; flatten succeeds +(assert '(gimp-layer-flatten 10)) + +; flatten was effective: no longer has alpha +; flatten a layer means "remove alpha" +(assert '(= (car (gimp-drawable-has-alpha 10)) + 0)) + + + + +; delete + +; delete succeeds +(assert '(gimp-layer-delete 10)) + +; delete second time fails +(assert-error '(gimp-layer-delete 10) + "runtime: invalid item ID") + +; Error for flatten: +; "Procedure execution of gimp-layer-delete failed on invalid input arguments: " +; "Procedure 'gimp-layer-delete' has been called with an invalid ID for argument 'layer'. " +; "Most likely a plug-in is trying to work on a layer that doesn't exist any longer.")) + +; delete layer when image already deleted fails +; TODO + + diff --git a/plug-ins/script-fu/test/tests/PDB/misc.scm b/plug-ins/script-fu/test/tests/PDB/misc.scm new file mode 100644 index 0000000000..34d6cabb9c --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/misc.scm @@ -0,0 +1,13 @@ + +; Miscellaneous tests of the PDB +; These are not associated with an object class + + +; 0 is an invalid item id +; FUTURE gimp returns #f instead of 0 +; FUTURE gimp doesn't wrap in extra list +(assert '(= (car (gimp-item-id-is-vectors 0)) 0)) + +; -1 is an invalid item id +; FUTURE: '(not (gimp-item-id-is-valid -1)) +(assert '(= (car (gimp-item-id-is-valid -1)) 0)) \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/pdb.scm b/plug-ins/script-fu/test/tests/PDB/pdb.scm new file mode 100644 index 0000000000..c244e4ecdf --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/pdb.scm @@ -0,0 +1,64 @@ +; Complete test of PDB + +; to run in SF Console: +; (testing:load-test "pdb.scm") +; Expect a report of passed and failed + +; This knows the set of files which are tests. +; The test files might be organized in directories in the repo, +; but all flattened into the /tests directory when installed. + +; creates images 1-6 +(testing:load-test "image-new.scm") +(testing:load-test "image-precision.scm") +(testing:load-test "image-indexed.scm") +(testing:load-test "image-grayscale.scm") +(testing:load-test "image-ops.scm") + +(testing:load-test "layer-new.scm") ; image 7 and layer 8 +(testing:load-test "layer-ops.scm") ; image 8 and layer 10 +(testing:load-test "layer-mask.scm") ; image 9 and layer 12 and layerMask 13, 14 +; TODO layer stack ops + +(testing:load-test "text-layer-new.scm") ; image 8, layer 15, vectors 16 + +(testing:load-test "vectors-new.scm") ; image 10 and vectors 19 + +(testing:load-test "channel-new.scm") +; TODO channel-ops.scm + +(testing:load-test "selection.scm") +(testing:load-test "selection-from.scm") + +; Test superclass methods. +; Drawable and Item are superclasses +; Testing Drawable and Item uses extant instances; +; must be after instances of subclasses are created. +(testing:load-test "item.scm") +; todo item order + +; TODO drawable + +(testing:load-test "resource.scm") +(testing:load-test "brush.scm") +; TODO other resources gradient, etc + +; TODO edit ops +; TODO undo +; TODO unit +; TODO progress +; pdb +; context +; gimp the class, gimp-get, gimp-parasite + +; parasite is not a class, only methods of other classes + +(testing:load-test "misc.scm") +(testing:load-test "enums.scm") + +; report the result +(testing:report) + +; yield the session result +(testing:all-passed?) + diff --git a/plug-ins/script-fu/test/tests/PDB/resource.scm b/plug-ins/script-fu/test/tests/PDB/resource.scm new file mode 100644 index 0000000000..43631f2cd7 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/resource.scm @@ -0,0 +1,43 @@ +; Test methods of Resource class + +; Testing may depend on fresh install. +; Depends on the default context. + +; !!! ScriptFu currently traffics in string names of resources +; FUTURE traffic in numeric ID +; FIXME numerous script-fu/scripts that deal with brush using name strings + +; a brush from context is a string +(assert '(string=? + (car (gimp-context-get-brush)) + "2. Hardness 050")) + +; gimp-brush-get-by-name returns same string, when brush of that name exists +(assert '(string=? + (car (gimp-brush-get-by-name "2. Hardness 050")) + "2. Hardness 050")) + +; gimp-brush-get-by-name returns error, when brush of that name not exists +(assert-error '(gimp-brush-get-by-name "foo") + "Procedure execution of gimp-brush-get-by-name failed on invalid input arguments: Brush 'foo' not found") + + + +; TODO the rest of these require ScriptFu to traffic in numeric ID + +;(assert '(= (gimp-resource-id-is-valid +; (car (gimp-context-get-brush)) +; 1)) + +;gimp-resource- +;delete +;duplicate +;get-name +;id-is-brush +;id-is-font +;id-is_gradient +;id-is-palette +;id-is-pattern +;id-is-valid +;is-editable +;rename \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/selection/selection-from.scm b/plug-ins/script-fu/test/tests/PDB/selection/selection-from.scm new file mode 100644 index 0000000000..e95452c18a --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/selection/selection-from.scm @@ -0,0 +1,107 @@ +; test PDB methods that change selection from existing selection + + +; setup +; Reusing image 10 +(define testImage 10) + + +; Test a selection-changing function +; starting from selection None. +; +; The testFunction takes a "step" arg +; and does not change the selection bounds. + +; {none is-empty} yields true +; {none } is not an error + +(define (test-selection-change-from-none testFunction testImage) + ; Starting state: selection none + (assert `(gimp-selection-none ,testImage)) + ; test the testFunction + (assert `(,testFunction + ,testImage + 4 )) ; radius or step + ; expect selection is still empty + (assert `(= (car (gimp-selection-is-empty ,testImage)) + 1)) + ; expect since there is no selection, the bounds are the entire image + (assert `(equal? (cdr (gimp-selection-bounds ,testImage)) + '(0 0 21 22))) +) + +(define (test-selection-change-from-all testFunction testImage isIdempotent) + ; Starting state: selection all + (assert `(gimp-selection-all ,testImage)) + ; test the testFunction + (assert `(,testFunction + ,testImage + 4 )) ; radius or step + + (if isIdempotent + (begin + ; expect selection is still not empty + (assert `(= (car (gimp-selection-is-empty ,testImage)) + 0)) + ; expect selection bounds are still entire image + (assert `(equal? (cdr (gimp-selection-bounds ,testImage)) + '(0 0 21 22))))) +) + + + + + +; test selection methods that change by a pixel amount +(test-selection-change-from-none gimp-selection-feather testImage) +(test-selection-change-from-none gimp-selection-grow testImage) +(test-selection-change-from-none gimp-selection-shrink testImage) +(test-selection-change-from-none gimp-selection-border testImage) + +; feather and grow from all are idempotent +(test-selection-change-from-all gimp-selection-feather testImage #t) +(test-selection-change-from-all gimp-selection-grow testImage #t) + +(test-selection-change-from-all gimp-selection-shrink testImage #f) +; shrink from all changes bounds +(assert `(equal? (cdr (gimp-selection-bounds ,testImage)) + '(4 4 17 18))) +(test-selection-change-from-all gimp-selection-border testImage #f) +; border from all empties the selection +(assert `(= (car (gimp-selection-is-empty ,testImage)) + 1)) + + + + +; Effectiveness +; When starting from a typical selection (not empty, not all) + +; TODO feather effective? +; Might feather change bounds? + +; grow is effective +; bounds are larger +; TODO +(assert `(equal? (cdr (gimp-selection-bounds ,testImage)) + '(0 0 21 22))) + +; TODO test flood effective: holes were filled +; Can't do it without knowing how many pixels are selected? +; Knowing bounds is not adequate. + +; Simple tests of success +(assert `(gimp-selection-flood ,testImage)) +(assert `(gimp-selection-invert ,testImage)) +(assert `(gimp-selection-sharpen ,testImage)) +(assert `(gimp-selection-translate + ,testImage + 4 4)) + +; TODO invert none is all and vice versa + +; TODO translate effective +; TODO translate by large offset is empty selection +; TODO sharpen is effective at removing antialiasing + +; save creates a new channel \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/selection/selection.scm b/plug-ins/script-fu/test/tests/PDB/selection/selection.scm new file mode 100644 index 0000000000..3a4e5f0936 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/selection/selection.scm @@ -0,0 +1,111 @@ +; Test methods of selection class of the PDB + + + +; setup +; Reusing image 10 +(define testImage 10) + + +; get-selection yields an ID. +; Image always yields a selection object. +; It is a singleton. +(assert `(= (car (gimp-image-get-selection ,testImage)) + 18)) + +(define testSelection 18) + +; The returned ID is-a Selection +(assert `(= (car (gimp-item-id-is-selection ,testSelection)) + 1)) + +; !!! Note there is little use for a Selection instance. +; There are no methods on the class per se i.e. taking the instance ID. +; Except for methods on the superclass Item of subclass Selection. +; +; Instead the methods seem to be on an image. +; Its not clear whether changing the selection in an image +; also changes the singleton Selection instance, +; and there is no way of knowing, since the Selection instance +; has no methods. + +; selection on new image is empty +; !!! Requre no prior test on this image selected +; !!! Arg is the image, not the selection object instance. +(assert `(= (car (gimp-selection-is-empty ,testImage)) + 1)) + +; selection bounds yields (1 0 0 21 22) +; First element of tuple is 0 (false) +; indicates user or program has not made selection +(assert `(= (car (gimp-selection-bounds ,testImage)) + 0)) +; selection bounds equal bounds of image +(assert `(equal? (cdr (gimp-selection-bounds ,testImage)) + '(0 0 21 22))) + + + + + +; select all and none + +; select all succeeds +(assert `(gimp-selection-all ,testImage)) +; !!! A selection operation does not create a new selection object +; i.e. ID is the same. +; get-selection yields same singleton on image +(assert `(= (car (gimp-image-get-selection ,testImage)) + ,testSelection)) +; after select all, selection bound indicates selection created +(assert `(= (car (gimp-selection-bounds ,testImage)) + 1)) +; and now is-empty is false +(assert `(= (car (gimp-selection-is-empty ,testImage)) + 0)) + + +; clear and none are the synonyms + +; clear does not invalidate a prior selection object +; i.e. get-selection returns same ID + +; clear makes selection bounds equal entire image +; TODO + +; select none succeeds +(assert `(gimp-selection-none ,testImage)) +; effective: is-empty is true +(assert `(= (car (gimp-selection-is-empty ,testImage)) + 1)) +; same singleton on image exists +(assert `(= (car (gimp-image-get-selection ,testImage)) + ,testSelection)) + + +; misc selection operations + +; gimp-selection-value + + +; change selection to totally new selection +; Not a function of existing selection, by color or shape. + +;gimp-image-select-color +; ,testImage + ; CHANNEL-OP-ADD +; drawable +; "red") + +; gimp-image-select-contiguous-color +; ellipse +; polygon +; rectangle +; round-rectangle + + + + +; gimp-selection-float is tested elsewhere +; It is not an op on the selection, but an op on the image that uses the selection. +; See gimp-image-floating-selection \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/text-layer/text-layer-new.scm b/plug-ins/script-fu/test/tests/PDB/text-layer/text-layer-new.scm new file mode 100644 index 0000000000..42bb34d524 --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/text-layer/text-layer-new.scm @@ -0,0 +1,148 @@ +; tests of TextLayer class + +; !!! Some methods tested here are named strangely: +; text-fontname returns a new TextLayer + + + + +; No setup +; Reuses image 8 from prior testing +; Require it has no layer + + + +; new + +; new yields ID 15 +(assert '(= (car (gimp-text-layer-new + 8 ; image + "textOfTestTextLayer" ; text + "fontName" ; fontname + 30 ; fontsize + UNIT-PIXEL)) + 15)) + +; !!!! fontName is not valid +; The text displays anyway, using some font family, without error. +; The docs don't seem to say which font family is used. +; TODO better documentation +; The text layer still says it is using the given font family. +; TODO yield actual font family used. + +; !!! UNIT-PIXEL GimpUnitsType is distinct from PIXELS GimpSizeType + + +; TODO test UNIT-POINT + + +; is-a TextLayer +(assert '(= (car (gimp-item-id-is-text-layer 15)) + 1)) + +; text layer is not in image yet +(assert '(= (car (gimp-image-get-layers 8)) + 0)) + +; adding layer to image succeeds +(assert '(gimp-image-insert-layer + 8 ; image + 15 ; layer + 0 ; parent + 0 )) ; position within parent + + + + +; attributes + +; antialias default true +; FIXME doc says false +(assert '(= (car (gimp-text-layer-get-antialias 15)) + 1)) + +; base-direction default TEXT-DIRECTION-LTR +(assert '(= (car (gimp-text-layer-get-base-direction 15)) + TEXT-DIRECTION-LTR)) + +; language default "C" +(assert '(string=? (car (gimp-text-layer-get-language 15)) + "C")) + +; TODO other attributes + +; TODO setters effective + +; attributes as given + +; text +(assert '(string=? (car (gimp-text-layer-get-text 15)) + "textOfTestTextLayer")) +; font +(assert '(string=? (car (gimp-text-layer-get-font 15)) + "fontName")) +; font-size +(assert '(= (car (gimp-text-layer-get-font-size 15)) + 30)) + +; is no method to get fontSize unit + + +; misc ops + +; vectors from text yields ID 16 +(assert '(= (car (gimp-vectors-new-from-text-layer + 8 ; image + 15)) ; text layer + 16)) + + + +; misc method + +; gimp-text-get-extents-fontname +; Yields extent of rendered text, independent of image or layer. +; Extent is (width, height, ascent, descent) in unstated units, pixels? +; Does not affect image. +(assert '(= (car (gimp-text-get-extents-fontname + "zed" ; text + 32 ; fontsize + POINTS ; size units. !!! See UNIT-PIXEL + "fontName" )) ; fontname + 57)) +; usual result is (57 38 30 -8) + + + +; alternate method for creating text layer + + +; gimp-text-fontname creates text layer and inserts it into image +(assert '(= (car (gimp-text-fontname + 8 ; image + -1 ; drawable. -1 means NULL means create new text layer + 0 0 ; coords + "bar" ; text + 1 ; border size + 1 ; antialias true + 31 ; fontsize + PIXELS ; size units. !!! See UNIT-PIXEL + "fontName" )) ; fontname + 17)) +; + +; error to insert layer created by gimp-text-fontname +(assert-error '(gimp-image-insert-layer + 8 ; image + 17 ; layer + 0 ; parent + 0 ) ; position within parent + (string-append + "Procedure execution of gimp-image-insert-layer failed on invalid input arguments: " + "Item 'bar' (17) has already been added to an image")) + + + +; for debugging: display +(assert '(= (car (gimp-display-new 8)) + 1)) \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/PDB/vectors-new.scm b/plug-ins/script-fu/test/tests/PDB/vectors-new.scm new file mode 100644 index 0000000000..296f60296f --- /dev/null +++ b/plug-ins/script-fu/test/tests/PDB/vectors-new.scm @@ -0,0 +1,89 @@ + +; Test methods of vector class of the PDB + +; aka Path. Image has set of Paths. Path has strokes. + + +; setup +; Not all tests here use this image +; test-image is no immutable and can be redefined? + +; from fresh GIMP state returns ID 10 +(define test-image (car (gimp-image-new 21 22 RGB))) +(assert `(= ,test-image 10)) + + + + + +; ID methods + +; ensure ID 0 and negative are not vectors +; FIXME #f/#t +(assert '(= (car (gimp-item-id-is-vectors 0)) + 0)) ; FUTURE #f + +; Test valid ID is tested drive-by + + + +; image get/set vectors methods +; This sequence of tests requires image 6 has no vectors yet + +; ensure get-vectors from image having no vectors yields zero vectors +; FUTURE: returns just #(), not (0 #()) +(assert `(= (car (gimp-image-get-vectors ,test-image)) + 0)) + + +; vectors-new succeeds +(assert `(car (gimp-vectors-new + ,test-image + "Test Path"))) + +; from fresh GIMP state, path ID is 19 +(define test-path 19) + + +; !!! id is valid even though vectors is not inserted in image +(assert `(= (car (gimp-item-id-is-vectors ,test-path)) + 1)) ; #t + +; new path name is as given +(assert `(string=? + (car (gimp-item-get-name ,test-path)) + "Test Path")) + +; new vectors is not in image yet +; image still has count of vectors == 0 +(assert `(= (car (gimp-image-get-vectors ,test-image)) + 0)) + +; new path has no strokes +; path has stroke count == 0 +(assert `(= (car (gimp-vectors-get-strokes ,test-path)) + 0)) + + +; insert vector in image yields (#t) +(assert `(car (gimp-image-insert-vectors + ,test-image + ,test-path + 0 0))) ; parent=0 position=0 + +; image with inserted vectors now has count of vectors == 1 +(assert `(= (car (gimp-image-get-vectors ,test-image)) + 1)) + +; export to string succeeds +(assert `(gimp-vectors-export-to-string + ,test-image + ,test-path)) + +; export-to-string all +; FAIL: crashes +; PDB doc says 0 should work, and ScriptFu is marshalling to a null GimpVectors* +; so the PDB function in C is at fault? +;(assert `(gimp-vectors-export-to-string +; ,test-image +; 0)) diff --git a/plug-ins/script-fu/test/tests/TS/atom2string.scm b/plug-ins/script-fu/test/tests/TS/atom2string.scm new file mode 100644 index 0000000000..2251111719 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/atom2string.scm @@ -0,0 +1,173 @@ + +; test atom->string function + +; atom->string is not R5RS +; Instead, it is TinyScheme specific. + +; atom->string works for atoms of type: number, char, string, byte, symbol. +; This is not the usual definition of atom. +; Others define atom as anything but list and pair. + +; For atom of type number, +; accepts an optional second arg: in [2,8,10,16] +; Meaning arithmetic base binary, octal, decimal, hexadecimal. +; For atoms of other types, passing a base returns an error. + + +; The REPL uses an internal C function atom2str() +; which is not exposed in the TS language. +; It *DOES* represent every object (all atoms) as strings. +; But the representation is sometimes a string that can +; be turned around and evaluated, +; which is not the same string as atom->string produces. + +; !!! Note readstring() internal function +; accepts and reduces C "escaped" string representations +; i.e. \x07 or \t for tab. +; Thus in a test, a double-quoted string enclosing +; an escape sequence can be equivalent to a +; string for a char atom. + + + +; normal tests (without error) + + +; number + +; number, integer aka fixnum +(assert `(string=? (atom->string 1) + "1")) + +; number, float aka flonum +(assert `(string=? (atom->string 1.0) + "1.0")) + +; FIXME the above is known to fail in German +; currently prints 1,0 +; FIXME need a test with other locale? + +; There are no other numeric types in TinyScheme. +; Refer to discussions of "Lisp numeric tower" + + + +; char + +; ASCII, i.e. fits in 8-bit byte + +; char, ASCII, printing and visible +(assert `(string=? (atom->string 'a) + "a")) + +; char, ASCII, non-printing, whitespace +(assert `(string=? (atom->string #\space) + " ")) + +; Note the char between quotes is a tab char +; whose display when viewing this source depends on editor. +; Some editors will show just a single white glyph. +; +; Note also that the SF Console will print "\t" +; i.e. this is not a test of the REPL. +(assert `(string=? (atom->string #\tab) + " ")) +; Note the char between quotes is a newline char +(assert `(string=? (atom->string #\newline) + " +")) +; TODO #\return + +; char, ASCII, non-printing control +; FIXME, should yield a single glyph. +; !!! It should not yield a sharp constant "#\x7" +(assert `(string=? (atom->string #\x7) + "")) +; !!! This also passes, because readstring interprets +; the \x.. escape sequence. +(assert `(string=? (atom->string #\x7) + "\x07")) + + +; multi-byte UTF-8 encode chars + +; char, unichar outside the ASCII range +; FIXME: needs unichar fixes +; (assert `(string=? (atom->string 'a) +; "a")) + + + + + +; symbol +(assert `(string=? (atom->string 'gimp-message) + "gimp-message")) +; symbol having multibyte char +(assert `(string=? (atom->string 'λ) + "λ")) + +; string +(assert `(string=? (atom->string "foo") + "foo")) +; string having multibyte char +(assert `(string=? (atom->string "λ") + "λ")) + + +; byte + +; Note that readstring() accepts and reduces \x.. notation. + +; Test against a glyph +(assert `(string=? (atom->string (integer->byte 31)) + "")) +;Test for equivalence to reduced string +(assert `(string=? (atom->string (integer->byte 1)) + "\x01")) +(assert `(string=? (atom->string (integer->byte 255)) + "\xff")) +; integer->byte truncates a number that does not fit in 8-bits +(assert `(string=? (atom->string (integer->byte 256)) + "\xff")) + +; Note some TinyScheme C code uses printf ("%lu", var) where var is unsigned char, +; and that prints unsigned char in this format. +; The above tests are not a test of that code path. + + +; test optional base arg for numeric atom + +; binary, octal, decimal, hexadecimal +(assert `(string=? (atom->string 15 2) + "1111")) +(assert `(string=? (atom->string 15 8) + "17")) +(assert `(string=? (atom->string 15 10) + "15")) +(assert `(string=? (atom->string 15 16) + "f")) + +; passing arg for non-numeric atom is error +(assert-error `(atom->string (integer->byte 255) 2) + "atom->string: bad base:") + + + + + +; tests of abnormality i.e. error messages + +; atom->string does not work for [#t, nil, closure, port, list, vector, foreign function] + +; foreign function +(assert-error `(atom->string gimp-message) + "atom->string: not an atom:") +; nil aka '() +(assert-error `(atom->string '() ) + "atom->string: not an atom:") +; #t +(assert-error `(atom->string #t ) + "atom->string: not an atom:") + +; TODO port etc. diff --git a/plug-ins/script-fu/test/tests/TS/cond-expand.scm b/plug-ins/script-fu/test/tests/TS/cond-expand.scm new file mode 100644 index 0000000000..db7dfe0ff4 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/cond-expand.scm @@ -0,0 +1,78 @@ + +; Test cases for cond-expand in ScriptFu interpreter of GIMP app. + +; cond-expand is SRFI-0 +; https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/cond_002dexpand-_0028SRFI-0_0029.html + +; ScriptFu cond-expand is defined in the tail of script-fu.init + +; This tests existing ScriptFu code, which is not a full implementation of cond-expand. +; ScriptFu omits "else" clause. +; GIMP issue #9729 proposes an enhancement that adds else clause to cond-expand, etc. + + +; *features* is a defined symbol that names features of language +(assert '(equal? + *features* + '(srfi-0 tinyscheme))) + +; srfi-0 is not a defined symbol +(assert-error '(srfi-0) + "eval: unbound variable:") +; Note that *error-hook* erroneously omits tail of error message + + + +; simple condition on one supported feature +(assert '(equal? + (cond-expand (tinyscheme "implements tinyscheme")) + "implements tinyscheme")) + +; simple clause on one unsupported feature +; Since the condition fails there is no expansion. +; Since there is no 'else clause', there is no expansion for false condition. +; The cond-expand doc says: +; "It either expands into the body of one of its clauses or signals an error during syntactic processing." +; Yielding #t is not "signals an error" so is not correct. +; This documents what ScriptFu does, until we decide whether and how to fix it. +(assert '(equal? + (cond-expand (srfi-38 "implements srfi-38")) + #t)) + +; multiple clauses +(assert '(equal? + (cond-expand + (srfi-38 "implements srfi-38") + ((not srfi-38) "not implements srfi-38")) + "not implements srfi-38")) + + +; clauses start with 'and', 'or', or 'not' + +; 'not clause' +(assert '(equal? + (cond-expand ((not srfi-38) "not implements srfi-38")) + "not implements srfi-38")) + +; 'and clause' having two logical conditions that are true +(assert '(equal? + (cond-expand ((and tinyscheme srfi-0) "implements both tinyscheme and srfi-0")) + "implements both tinyscheme and srfi-0")) + +; 'or clause' having two logical conditions, one of which is false +(assert '(equal? + (cond-expand ((or tinyscheme srfi-38) "implements tinyscheme or srfi-38")) + "implements tinyscheme or srfi-38")) + + +; nested logical clauses +(assert '(equal? + (cond-expand ((or srfi-38 (and tinyscheme srfi-0)) "implements srfi-38 or tinyscheme and srfi-0")) + "implements srfi-38 or tinyscheme and srfi-0")) + + + + + + + diff --git a/plug-ins/script-fu/test/tests/TS/integer2char.scm b/plug-ins/script-fu/test/tests/TS/integer2char.scm new file mode 100644 index 0000000000..3cac4104d5 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/integer2char.scm @@ -0,0 +1,80 @@ +; test integer->char function + +; Is R5RS, but with unicode + + +; General test strategy: +; Generate char atom using integer->char. +; Convert each such char atom to string. +; In all cases where it was possible to create such a string, test length is 1. + +; See also number->string which is similar to (atom->string (integer->char ) ) + + +; integer->char takes only unsigned (positive or zero) codepoints +; -1 in twos complement is out of range of UTF-8 +(assert-error `(integer->char -1) + "integer->char: argument 1 must be: non-negative integer") + + + +; ASCII NUL character. + +; 0 is a valid codepoint +; whose repr in the REPL is #\x0 +; > (integer->char 0) +; "#\x0" + +; Converting the atom to string yields an empty string +(assert `(string=? (atom->string (integer->char 0)) + "")) + +; ASCII null terminates the string early, so to speak. + +; You can also represent as escaped hex "x\00" +(assert `(string=? "\x00" + "")) +; Escaped hex must have more than one hex digit. +; Can't be tested: (assert-error `(string? "\x0") "Error reading string ") +; In REPL: +; > "\x0" +; Error: Error reading string + + +; the first non-ASCII character; + +; TODO (integer->char 128), + + +; first Unicode character outside the 8-bit range; + +; evaluates without complaint +(assert (integer->char 256)) + +; length of converted string is 1 +; The length is count of characters, not the count of bytes. +(assert `(= (string-length (atom->string (integer->char 256))) + 1)) + +; converted string is equivalent to a string literal that displays +(assert `(string=? (atom->string (integer->char 256)) + "Ā")) + + +; first Unicode character outside the Basic Multilingual Plane + +(assert (integer->char 65536)) + +(assert `(= (string-length (atom->string (integer->char 65536))) + 1)) + +; The usual glyph in some editors is a wide box with these digits inside: +; 010 +; 000 +; Other editors may display a small empty box. +(assert `(string=? (atom->string (integer->char 65536)) + "𐀀")) + +; !!! Note the SF Console REPL yields #\ +; which is not the correct representation. +; FIXME \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/TS/no-memory.scm b/plug-ins/script-fu/test/tests/TS/no-memory.scm new file mode 100644 index 0000000000..55be106c5a --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/no-memory.scm @@ -0,0 +1,52 @@ +; test memory limits in TS + +; TS is known to be non-robust in face of memory exhaustion. +; See Manual.txt which says "TinyScheme is known to misbehave when memory is exhausted." + +; numeric constants from tinyscheme-private.h + +; There is no document (only the source code itself) +; explaining the limits. +; The limits here are from experiments. + + +; Symbol limits + +; There is no defined limit on count of symbols. +; The objlist is a hash table, entries allocated from cells. +; The lists in the hash table are practically unlimited. + + +; String limits + +; Strings are malloced. +; Limit on string size derives from OS malloc limits. +; No practical limit in ScriptFu. + +; Seems to work +; (make-string 260000 #\A) + + +; Vector limits. + +; A vector is contiguous cells. +; TS allocates in segments. + + +; A vector can be no larger than two segments? + +; succeeds +(assert '(make-vector 25000)) + +; might not crash? +(define testVector (make-vector 25001)) + +; ???? +(assert `(vector-fill! ,testVector 1)) + +; seems to hang +; (assert '(make-vector 50001)) + +; seems to crash +; (assert '(make-vector 200000)) + diff --git a/plug-ins/script-fu/test/tests/TS/sharp-expr-char.scm b/plug-ins/script-fu/test/tests/TS/sharp-expr-char.scm new file mode 100644 index 0000000000..4e94cf5722 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/sharp-expr-char.scm @@ -0,0 +1,236 @@ +; Tests of sharp char expressions in ScriptFu + +; This only tests: +; "sharp character" #\ +; "sharp character hex" #\x +; sharp expressions for whitespace +; See also: +; sharp-expr.scm +; sharp-expr-number.scm + +; This also only tests a subset: the ASCII subset. +; See also: sharp-expr-unichar.scm + +; #\ denotes a character constant where is one character +; The one character may be multiple bytes in UTF-8, +; but should appear in the display as a single glyph, +; but may appear as a box glyph for unichar chars outside ASCII. + +; #\x denotes a character constant where is a sequence of hex digits +; See mk_sharp_const() + +; #\space #\newline #\return and #\tab also denote character constants. + +; FIXME: sharp followed by space parses as a token, +; but I don't know that it is legal syntax +; See the code, there is a space here: " tfodxb\\" + +; #U+ notation for unichar character constants is not in ScriptFu + +; Any sharp character followed by characters not described above +; MAY optionally be a sharp expression when a program +; uses the "sharp hook" by defining symbol *sharp-hook* . + + + + +; sharp constants for whitespace + +; codepoints tab 9, newline 10, return 13, space 32 (aka whitespace) +; TinyScheme and ScriptFu prints these solitary unichars by a string representation, +; but only when they are not in a string! +; This subset of codepoints are ignored by the parser as whitespace. +; It is common for older scripts to use sharp expression constants for these codepoints. +(assert '(equal? (integer->char 9) #\tab)) +(assert '(equal? (integer->char 10) #\newline)) +(assert '(equal? (integer->char 13) #\return)) +(assert '(equal? (integer->char 32) #\space)) + + + +; sharp constant character + +; Unicode codepoints in range [33, 126] +; e.g. the letter A, ASCII 65 +(assert '(equal? (integer->char 65) #\A)) +(assert '(char? #\A)) +(assert '(atom? #\A)) + +; Tests of functions using a non-printing, control character ASCII +; Codepoint BEL \x7 +(assert '(equal? (integer->char 7) #\)) +(assert '(char? #\)) +(assert '(atom? #\)) +; string function takes sequence of chars +(assert (equal? (string #\) "")) + +; Unicode codepoints [0-8][11-12][14-31] +; (less than 32 excepting tab 9, newline 10, return 13) +; The "non-printing" characters +; e.g. 7, the character that in ancient times rang a bell sound + +; Upstream TinyScheme prints these differently from ScriptFu, as a string repr of the char. +; since TinyScheme default compiles with option "USE_ASCII_NAMES" +;>(integer->char 7) +;#\bel +;>(integer->char 127) +;#\del + +; ScriptFu prints solitary Unichars +; for codepoints below 32 and also 127 differently than upstream TinyScheme. +; Except ScriptFu is same as TinyScheme for tab, space, newline, return codepoints. +; ScriptFu shows a glyph that is a box with a hex number. +; Formerly (before the fixes for this test plan) Scriptfu printed these like TinyScheme, +; by a sharp constant hex e.g. #\x1f for 31 + + +; Edge codepoint tests +; Tests of edge cases, near a code slightly different + +; Codepoint US Unit Separator, edge case to 32, space +(assert '(equal? (integer->char 31) #\)) +(assert '(equal? #\ #\x1f)) + +; codepoint 127 x7f (DEL), edge case to 128 +(assert '(equal? (integer->char 127) #\x7f)) + + + + +; sharp constant hex character + +; Sharp char expr hex denotes char atom +; But not the REPL printed representation of characters. + +; is-a char +(assert '(char? #\x65)) +; equals a sharp character: lower case e +(assert '(equal? #\x65 #\e)) + +; sharp char hex notation accepts a single hex digit +(assert '(char? #\x3)) +; sharp char hex notation accepts two hex digits +(assert '(char? #\x33)) +; edge case, max hex that fits in 8-bits +; FIXME currently is syntax error, untestable. +; It should not be a syntax error. +; (assert '(char? #\xff)) + +; sharp car expr hex accepts three digits +; when they are leading zeroes +(assert '(char? #\x033)) + +; Otherwise, three digits not leading zeros +; are unicode. + + +; codepoint x3bb is a valid character (greek lambda) +; but is outside ASCII range. +; See sharp-expr-unichar.scm + + + + + + +; sharp constant hex character: invalid unichar + +; Unicode has a range, but sparsely populated with valid codes. +; Unicode is unsigned, range is [0,x10FFF] +; Greatest valid codepoint is x10FFFF (to match UTF-16) +; Sparsely populated: some codepoints in range are not valid +; because they are incorrectly encoded using UTF-8 algorithm. +; (This is a paraphrase: please consult the standard.) + +; These tests are not a complete test of UTF-8 compliance !!! + +; Edge case: max valid codepoint +; FIXME (assert (equal? #\x10FFFF #\􏿿)) + +; Edge case: zero is considered a valid codepoint +; !!! Although also a string terminator. +(assert '(equal? + (integer->char 0) + #\x0)) + + +; sharp constants for delimiter characters + +; These test the sharp constant notation for characters space and parens +; These are in the ASCII range + + +; !!! A space char in a sharp constant expr +(assert (char? #\ )) +; Whose representation is a space character. +(assert (string=? (atom->string #\ ) + " ")) + +; !!! A right paren char in a sharp constant expr +; Note that backslash captures the first right paren: +; the parens do not appear to match. +(assert (char? #\))) +; Ditto for left paren +(assert (char? #\()) +; !!! But easy for author to confuse the parser +; assert-error can't catch syntax errors. +; So can only test in the REPL. +; > (char? #\) +; Error: syntax error: expected right paren, found EOF" + +; #\# is the sharp or pound sign char +(assert (char? #\#)) +(assert (string=? (atom->string #\# ) + "#")) +; #\x is lower case x +(assert (char? #\x)) +(assert (string=? (atom->string #\x ) + "x")) + + + +; see also integer2char.scm + + + +; Common misunderstandings or typos + +; #\t is a character, lower case t + +; It is not the denotation for truth. +(assert `(not (equal? #\t #t))) + +; It is not the denotation for #\tab. +(assert `(not (equal? #\t #\tab))) + +; It is a char +(assert `(char? #\t)) + +; Its string representation is lower case t character +(assert `(string=? (atom->string #\t) + "t")) + + + +; a number converted to string that is representation in base 16 +; !!! This is not creating a Unichar. +; It is printing the hex representation of decimal 955, without a leading "\x" +(assert `(string=? (number->string 955 16) + "3bb")) + + +; Untestable sharp constant hex character + +; Test framework can't test, these cases are syntax errors. +; These cases yield "undefined sharp expression" in REPL +; FIXME: the error message should be more specific, should say "syntax" + +; sharp constant hex having non-hex digit is an error +; z is not in [a-f0-9] +; Only testable in REPL +; > #\xz +; Error: undefined sharp expression +; Not testable here since it is syntax + + + diff --git a/plug-ins/script-fu/test/tests/TS/sharp-expr-unichar.scm b/plug-ins/script-fu/test/tests/TS/sharp-expr-unichar.scm new file mode 100644 index 0000000000..e130f31112 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/sharp-expr-unichar.scm @@ -0,0 +1,105 @@ +; Test cases for sharp char expr for unicode chars outside ASCII range + +; See sharp-expr-char.scm for sharp char expr inside ASCII range. + +; See unichar.scm for tests of unichar without using sharp char expr + +; This is NOT a test of the REPL: ScriptFu Console. +; A REPL displays using obj2str, +; or internal atom2str() which this doesn't test. + +; ScriptFu Console (the REPL) displays a "sharp char expression" to represent +; all atoms which are characters, e.g. #\a . +; A "sharp hex char expression" also +; represents a character, e.g. #\x32. +; But the REPL does not display that representation. + + +; conversion from number to character equal sharp char expr unicode +(assert `(equal? (integer->char 955) #\λ)) + +; hex sharp char is same as sharp char +(assert (equal? #\x3bb #\λ)) +(assert '(char? #\x3bb)) + +; Unichar extracted from string equals sharp char expr unicode +(assert (equal? (string-ref "λ" 0) #\λ)) + + +; Omitted, a test of the REPL +; quoted Unichar is equal to its usual representation +(assert `(equal? ,λ #\λ)) + +; a sharp char expr unicode is-a char +(assert (char? #\λ)) + + +; sharp char expr unicode passed to string function +(assert (equal? (string #\λ) "λ") + +; sharp char expr unicode in a list +(assert (equal? (list (string-ref "λ" 0)) '(#\λ)) + +; sharp char expr unicode in vector +(assert (equal? (vector (string-ref "λ" 0)) '#(#\λ)) + + +; Omitted: a test of REPL +; display unichar +; > (display (string-ref "λ" 0)) +; λ#t + + +; This is 0x7 BEL +; TODO for greek lambda unicode char +; string function takes sequence of chars +(assert (equal? (string #\) "")) + + + + + + + +; unichar in context of other expressions + +; unichar evaluated after evaluating display. +; Prints side effect of display +; followed by value of the last expression, a unichar +;> (begin (display "Unicode lambda char: ") (string-ref "λ" 0)) +;Unicode lambda char: #\λ + +; Single Unicode character outside of string can be displayed in error +;>(display "Unicode lambda char: ")(error "testUnicodeKo1: " (string-ref "λ" 0)) +;Unicode lambda char: #tError: testUnicodeKo1: #\λ +; TODO this test seems to infinite loop +; Maybe the problems is catting string to char +;(assert-error `(error "Error: " (string-ref "λ" 0)) +; "Error: λ") +;(assert-error `(error "Error: " "λ") + ; "Error: λ") +;(assert-error `(error "Error λ") +; "Error: λ") +; Seems to be flaw in testing framework + + + +; Edge case: first invalid codepoint greater than max valid +; '#\x110000 +; TODO + +; A codepoint that fits in 32 bits but invalid UTF-8 encoding +; '#\xd800 +; TODO + +; sharp constant hex exceeding max range of int 32 codepoint +; longer than 8 hex digits \xf87654321 + +; FIXME currently this fails to pass or fail +; Yields #\! in the REPL ???? +; (assert '#\xf87654321 ) + +; FIXME This passes but it should not. +; It should be a syntax or other error +; If syntax, not testable here. +(assert `(not (null? #\xf87654321 ))) \ No newline at end of file diff --git a/plug-ins/script-fu/test/tests/TS/sharp-expr.scm b/plug-ins/script-fu/test/tests/TS/sharp-expr.scm new file mode 100644 index 0000000000..c014eb3516 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/sharp-expr.scm @@ -0,0 +1,86 @@ +; Tests of sharp expressions in ScriptFu + +; This only tests: +; miscellaneous sharp expressions +; See also: +; sharp-expr-char.scm +; sharp-expr-number.scm + +; Some "sharp expressions" e.g. #t and #f might not be explicitly tested, +; but tested "driveby" by other tests. + +; Terminology: +; The code says "sharp constant expression". +; A "sharp expression" is text in the language that denotes a "sharp constant." +; A constant is an atom of various types: char, byte, number. +; The expression is distinct from the thing it denotes. + +; A "sharp expression" is *recognized* by the interpreter. +; But also *printed* by the interpreter REPL. +; Mostly these are tests of recognition. +; The testing framework cannot test the REPL. + +; See scheme.c, the token() function, about line 2000 +; and the mk_sharp_constant() function, for sharp character constant + +; #( token denotes start of a vector + +; #! token denotes start of a comment terminated by newline +; aka shebang or hashbang, a notation that OS shells read + +; #t denotes true +; #f denotes false + +; #odxb denotes a numeric constant in octal, decimal, hex, binary base +; where are digits of that base + +; #\ denotes a character constant where is one character +; The one character may be multiple bytes in UTF-8, +; but should appear in the display as a single glyph, +; but may appear as a box glyph for unichar chars outside ASCII. + +; #\x denotes a character constant where is a sequence of hex digits +; See mk_sharp_const() + +; #\space #\newline #\return and #\tab also denote character constants. + +; FIXME: sharp followed by space parses as a token, +; but I don't know that it is legal syntax +; See the code, there is a space here: " tfodxb\\" + +; #U+ notation for unichar character constants is not in ScriptFu + +; Any sharp character followed by characters not described above +; MAY optionally be a sharp expression when a program +; uses the "sharp hook" by defining symbol *sharp-hook* . + + +; block quote parses +; TODO only testable in REPL? +; Note there is a newline after foo +;(assert '#! foo +; ) + +; #t denotes truth +(assert #t) + +; #t denotes an atom +(assert (atom? #t)) + +; #t is type boolean +(assert (boolean? #t)) +; #t is neither type number or symbol +(assert (not (number? #t))) +(assert (not (symbol? #t))) + +; #t denotes constant, and constant means immutable +; You cannot redefine #t +(assert-error `(define #t 1) + "variable is not a symbol") +; You cannot set #t +(assert-error `(set! #t 1) + "set!: unbound variable:") +; error-hook omits suffix: #t + +; There is no predicate immutable? in Scheme language? + diff --git a/plug-ins/script-fu/test/tests/TS/string-port.scm b/plug-ins/script-fu/test/tests/TS/string-port.scm new file mode 100644 index 0000000000..49ff437bcb --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/string-port.scm @@ -0,0 +1,56 @@ +; Test cases for string ports + +; a string port is-a port (having read and write methods). +; a string port stores its contents in memory (unlike device ports). +; A read returns contents previously written. +; A string port is practically infinite. + +; a string port is like a string +; a sequence of writes are like a sequence of appends to a string + + +; Note that each assert is in its own environment, +; so we can't define a global port outside???? +; Why shouldn't this work? +; (define aStringPort (open-output-string)) +; (assert `(port? aStringPort)) + + +; open-output-string yields a port +(assert '(port? (open-output-string))) + +; string read from port equals string written to port +; !!! with escaped double quote +(assert '(string=? + (let* ((aStringPort (open-output-string))) + (write "foo" aStringPort) + (get-output-string aStringPort)) + "\"foo\"")) + +; string read from port equals string repr of symbol written to port +; !!! without escaped double quote +(assert '(string=? + (let* ((aStringPort (open-output-string))) + ; !!! 'foo is-a symbol whose repr is three characters: foo + ; write to a port writes the repr + (write 'foo aStringPort) + (get-output-string aStringPort)) + (symbol->string 'foo))) + +; What is read equals the string written. +; For edge case: writing more than 256 characters in two tranches +; where second write crosses end boundary of 256 char buffer. + +; issue #9495 +; Failing +;(assert '(string=? +; (let* ((aStringPort (open-output-string))) +; (write (string->symbol (make-string 250 #\A)) aStringPort) +; (write (string->symbol (make-string 7 #\B)) aStringPort) +; (get-output-string aStringPort)) +; (string-append +; (make-string 250 #\A) +; (make-string 7 #\B)))) + + + diff --git a/plug-ins/script-fu/test/tests/TS/testing.scm b/plug-ins/script-fu/test/tests/TS/testing.scm new file mode 100644 index 0000000000..d8d1068184 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/testing.scm @@ -0,0 +1,52 @@ +; test the testing framework + +; assert stmt + + +; a result that is #t passes +(assert #t) + +; other truthy results pass +(assert 1) + +; 0 is truthy and passes +(assert 0) + +; If you really want to assert that exactly #t is the result, +; you should eval a topmost predicate that yields only #t or #f +; For example, where eq? is equality of pointers: +(assert '(not (eq? 0 #t))) + +; a symbol defined outside an assert is visible +; when you backquote and unquote it. +(define aTrue #t) +(assert `,aTrue) + +; Here +; backquote passes the following expression as data without evaluating it +; singlequote makes a list literal instead of a function call +; unquote i.e. comma evaluates the following symbol before backquote passes expression as data +(assert `(car '(,aTrue))) + + + +; assert-error statment + +; assert-error tests for error messages +; assert-error omits the "Error: " prefix printed by the REPL + +; case: Error1 called with pointer to errant atom +; symbol aFalse is not bound +(assert-error 'aFalse + "eval: unbound variable:") + +; assert-error currently omits the suffix +; printed by the usual error mechanism. +; (Since I think error hook mechanism is broken.) + +; case: Error0 called with null pointer +; numeric literal 1 is not a function +(assert-error '(1) + "illegal function") + + diff --git a/plug-ins/script-fu/test/tests/TS/tinyscheme.scm b/plug-ins/script-fu/test/tests/TS/tinyscheme.scm new file mode 100644 index 0000000000..f59fade91b --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/tinyscheme.scm @@ -0,0 +1,36 @@ +; Complete test of TinyScheme + +; This does NOT KNOW the directory organization of the test files in repo. + +; When you add a test file, also add it to meson.build, +; which DOES KNOW the dirs of the repo, but flattens into /test. + +; Name clash must be avoided on the leaf filenames. + + +; test the testing framework itself +(testing:load-test "testing.scm") + +(testing:load-test "cond-expand.scm") +(testing:load-test "atom2string.scm") +(testing:load-test "integer2char.scm") + +(testing:load-test "string-port.scm") + +(testing:load-test "sharp-expr.scm") +(testing:load-test "sharp-expr-char.scm") +; Currently failing badly (testing:load-test "sharp-expr-unichar.scm") + +; test unichar without using sharp char expr +(testing:load-test "unichar.scm") + +(testing:load-test "vector.scm") + +(testing:load-test "no-memory.scm") + +; report the result +(testing:report) + +; yield the session result +(testing:all-passed?) + diff --git a/plug-ins/script-fu/test/tests/TS/unichar.scm b/plug-ins/script-fu/test/tests/TS/unichar.scm new file mode 100644 index 0000000000..130f777f90 --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/unichar.scm @@ -0,0 +1,58 @@ +; Test cases for unicode chars outside ASCII range + +; !!! These tests don't use sharp char expr, but the chars themselves. +; See sharp-expr-unichar.scm for sharp char expr denoting unichars +; outside ASCII range. + +; History: we avoid sharp char expr for unicode here +; because of bug #9660. +; Loosely speaking, ScriptFu was handling unichars, +; but not sharp char expr for them. + +; Most test cases are for atoms that are type "char", +; meaning a component of a string. +; ScriptFu implementation uses a C type: gunichar, +; which holds a UTF-8 encoding of any Unicode code point.) +; A unichar is as many as four bytes, not always one byte. + +; This is NOT a test of the REPL: ScriptFu Console. +; A REPL displays using obj2str, +; or internal atom2str() which this doesn't test. + +; ScriptFu Console (the REPL) displays a "sharp char expression" to represent +; all atoms of type char, e.g. #\a . +; A "sharp hex char expression" also +; represents a character, e.g. #\x32. +; But the REPL does not display that representation. + + +; conversion from number to character equal sharp char +(assert `(equal? (integer->char 955) + (string-ref "λ" 0))) + + +; Unichar itself (a wide character) can be in the script +; but is unbound +(assert-error `(eval λ) "eval: unbound variable:") +; Note the error message is currently omitting the errant symbol + + +; Unichar in a string +(assert (string=? (string (string-ref "λ" 0)) "λ")) + + +; Omitted: a test of REPL +; display unichar +; > (display (string-ref "λ" 0)) +; λ#t + + +; Quoted unichar +; These test that the script can contain unichars +; versus test that a script can process unichars. + +; quoted unichar is not type char +(assert `(not (char? 'λ))) + +; quoted unichar is type symbol +(assert (symbol? 'λ)) diff --git a/plug-ins/script-fu/test/tests/TS/vector.scm b/plug-ins/script-fu/test/tests/TS/vector.scm new file mode 100644 index 0000000000..ec2b259e4b --- /dev/null +++ b/plug-ins/script-fu/test/tests/TS/vector.scm @@ -0,0 +1,84 @@ +; test vector methods of TS + + + +; make-vector + +; make-vector succeeds +(assert '(make-vector 25)) + +; make-vector of size 0 succeeds +(assert '(make-vector 0)) + +(define testVector (make-vector 25)) + +; make-vector yields a vector +(assert `(vector? ,testVector)) + +; make-vector yields a vector of given length +(assert `(= (vector-length ,testVector) + 25)) + +; make-vector initializes each element to empty list +(assert `(equal? + (vector-ref ,testVector 0) + '())) + + +; other vector construction methods + +(assert '(equal? + (vector 'a 'b 'c) + #(a b c))) + +(assert '(equal? + (list->vector '(dididit dah)) + #(dididit dah))) + + +; fill + +; fill succeeds +(assert `(vector-fill! ,testVector 99)) + +; fill effective +(assert `(= + (vector-ref ,testVector 0) + 99)) + + +; referencing out of bounds + +; past end fails +(assert-error `(vector-ref ,testVector 25) + "vector-ref: out of bounds:") +; error msg omits repr of atom + +; negative index fails +(assert-error `(vector-ref ,testVector -1) + "vector-ref: argument 2 must be: non-negative integer") + + + + +; undefined vector ops in TS + +; make-initialized-vector +(assert-error '(equal? + (make-initialized-vector 5 (lambda (x) (* x x))) + #(0 1 4 9 16)) + "eval: unbound variable:") +; error msg omits prefix "Error: " and suffix "make-initialized-vector" + +; vector-copy +; equals the original +(assert-error + `(equal? + (vector-copy ,testVector) + ,testVector) + "eval: unbound variable:") + + + + + diff --git a/plug-ins/script-fu/test/tests/readme.md b/plug-ins/script-fu/test/tests/readme.md new file mode 100644 index 0000000000..09796fac06 --- /dev/null +++ b/plug-ins/script-fu/test/tests/readme.md @@ -0,0 +1,271 @@ +# Testing ScriptFu using the testing framework + +## Quick start + +0. Rebuild GIMP with the ScriptFu compile option 'no line numbers in error messages' (see below.) +The build must be a non-stable build (nightly/development version.) +1. View the Gimp Error Console dockable +2. Open the SF Console +3. Enter '(testing:load-test "tinyscheme.scm")' + +Expect to finally see a report of testing in the SF Console. +Also expect to see "Passed" messages, as progress indicators, +in the Gimp Error Console. +You may also see much extraneous data in the SF Console, +since as a REPL, it prints the value yielded by each expression. + +Some extreme test cases may take about a minute. +If you see a "Gimp is not responding" dialog, choose Wait. + +"tinyscheme.scm" tests the embedded interpreter. +You can also try "pdb.scm" to test the PDB. +Or another test script to test a smaller portion. + +## Organization and naming + +The test language itself does not name a test. + +The test scripts are in the repo at /plug-ins/script-fu/test/tests. + +The filesystem of the repo organizes and names the tests. +The name of a file or directory indicates what is tested. +The tests don't know their own names. + +A test script is usually many tests of one GIMP or ScriptFu object or function. +There may be many test script files for the same object. + +Tests and test groups can be organized in directories in the source repo. +A directory of tests can be named for the GIMP object under test. + +The leaf files and directories +are coded into larger test files. +The larger test files simply load all the files for a GIMP object. +Loading a file executes the tests and alters testing state. + +The test files when installed are flattened into one directory. +Thus a test file that loads many tests loads them from the same top directory. + +### Major test groups + +1. PDB: Tests ScriptFu binding to the GIMP PDB. +2. tinyscheme: Tests the embedded TinyScheme interpreter. +3. other: Special test programs, often contributed with a new feature of ScriptFu. + +## Testing State + +The process of testing produces a state in the testing framework and in Gimp. + +### Testing framework state + +The test framework state is the count of tests and info about failed tests. +It accumulates over a session of Gimp +(more precisely, over a session of ScriptFu Console +or over a session of any plugin that loads the testing framework.) + +The tests themselves do not usually reset the test state using '(testing:reset)'. + +You can get a boolean of the total testing framework state +using the predicate (testing:all-passed?) . + +### Gimp State + +Gimp state includes open images, installed resources, the selection, etc. +Testing has side effects on Gimp state. + +To ensure tests succeed, you should test a new install of Gimp. +If you don't mind a few failed tests, +you can test later than a new install. + +Tests may require that GIMP be newly started: + +1. PDB tests may hardcode certain constant ID's and rely on GIMP +to consistently number ID's. + +Tests may require that GIMP be newly installed: + +1. PDB tests may depend on the initial set of Gimp resources in ~/.config/GIMP + +## Building for testing + +### Non stable build + +The test framework and test scripts are only installed in a non-stable build. + +### Line numbers in error messages + +The test scripts are intended to be portable across platforms +and robust to changes in the test scripts. +To do that requires that TinyScheme be built without the compile option +to display file and line number in error messages. +Since file paths change across platforms, +and since the test scripts should not reference line numbers. + + +In libscriptfu/tinyscheme/scheme.h : +``` +# define SHOW_ERROR_LINE 0 +``` +## Test flavors + +The testing framework can test normal operation and some error detection. +The test framework does not test detection of syntax errors because parsing errors +prevent the test framework from starting. + +### Unit tests of small fragments + +1. Normal operation: "assert" +2. Expected runtime errors: "assert-error" + + + +### Functional tests of plugins + +The tests are plugins themselves. +They are not usually automated, but require manual running and visual inspection. +They are found in /scripts/test + +## Testing framework features + +The "testing.scm" framework is simple. +Mostly it keeps stats for tests passed/failed +and some information about failed tests. + +This section describes the "testing.scm" framework. +In the future, other test frameworks may coexist. + +Some contributed tests have their own testing code +e.g. "byte IO". + +### Tests are not embedded in the tested source + +Any tests of Scheme code are NOT annotations +in the Scheme code they test. +Tests are separate scripts. + +### Tests are declarative + +Tests are declarative, short, and readable. +They may be ordered or have ordered expressions, +especially when they test side effects on the Gimp state. + +### Tests are order dependent + +Generally, you cannot run the tests in any order. +The tests may hardcode GIMP ID's that GIMP assigns, +thus the test order is also fixed. + +In general, run a large test, such as pdb.scm or tinyscheme.scm. + +### The test framework does not name or number tests + +The filesystem names the test files. + +You identify a test by the code it executes and its order in a file. + +### Progress + +The test framework logs progress to the GIMP Error Console +using gimp-message. + +The test framework displays failures, but not successes, as they occur. +Display is usually to the SF Console. + +### History of test results + +The test framework does not keep a permanent history of test results. +The test framework does not write into the file system. + +It does not alter the testing scripts, +so you can load test scripts by name from a git repo +without dirtying the repo. + +Test scripts may test Gimp features that write the file system. + +### Known to fail tests + +The test framework does not have a feature to ignore tests that fail. +That is, the framework does not support a third category of test result: known-to-fail. +Other frameworks might report success even though a known-to-fail test did fail. + +You can comment out tests that fail. + +### Tests cannot catch syntax errors + +The test framework can not test detection of syntax errors +because parsing errors +prevent the test framework from starting. + +## Writing tests + +See /test/frameworks/testing.scm for more explanation of the testing language. + +### Writing tests from examples + +In the "MIT Scheme Reference" you might see examples like: + +``` +(vector 'a 'b 'c) => #(a b c) +``` + +The '=>' symbol should be read as 'yields.' + +You can convert to this test: +``` +(assert '(equal? + (vector 'a 'b 'c) + #(a b c))) +``` + +Note the left and right hand sides of the MIT spec +go directly into the test. + +### Equality in tests + +The testing framework does not choose the notion of equality. + +You can choose from among equal? string=? and other predicates. +Generally you should prefer equal? +since it tests for object sameness, component by component, +instead of pointer equality. + +Often you don't need an equality predicate, +when the test expression itself has a boolean result. + +### Quoting in tests + +Note the use of backquote ` (backtick) and unquote , (comma). +When writing tests, +you must often do this to make certain expressions evaluate later, +after the assert statement starts and installs an error-hook. + +The backquote makes an expression into data to pass to assert, +which will evaluate the expression. +Otherwise, if the expression is evaluated before passing, an error may come before the assert function starts, +and the test is not properly caught or logged. + +The unquote undoes the effect of the backquote: it makes the unquoted expression evaluate before passing it to an assert statement. + +### Defining symbols outside a test expression + +You can define symbols (say a variable or a function) +before a test expression +and refer to that symbol in the test expression +but you might need to unquote it so it evaluates +before the test expression function (assert or assert-error) +is evaluated. + +## Internationalization + +We intend the tests are independent of locale +(the user's preferred language.) + +There is no test that changes the locale +as part of the test process. +(There is no API such as gimp-set-locale.) + +To test that ScriptFu properly internationalizes, +you must change the locale and retest. +The printing of numbers is known to fail in German. + + +