dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ScriptFu tests: Add some tests and remove hardcoded ID's 

Buffer, palette, parasite, unit, context

Also test only a prefix of error message.
This commit is contained in:
bootchk 2023-08-31 04:36:55 -04:00 committed by Lloyd Konneker
parent 6b2cdb3154
commit 14c30f6514
28 changed files with 1053 additions and 402 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
plug-ins/script-fu/test/frameworks/testing.scm
View File

@ -7,7 +7,7 @@
; Testing language
; AssertStmt ~ (assert '(<code>))
; AssertErrorStmt ~ (assert-error '(<code>) <expected error string>)
; AssertErrorStmt ~ (assert-error '(<code>) <prefix of expected error string>)
; ReportStmt ~ (testing:report)
; LoadStmt ~ (testing:load-test <filename>)
; AllPassedPredicate ~ (testing:all-passed?)
@ -23,6 +23,7 @@
; 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.
@ -38,6 +39,13 @@
; to yield an overall testing result,
; when testing is automated.
; Testing error messages
;
; Error messages may have details such as line number of error
; that may change over time.
; Testing expects that details will be a suffix of the error message.
; Passing is measured by comparing given expected prefix of error
; with actual error message.
; Notes on implementation:
@ -182,21 +190,23 @@
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 <foo>
; This knows that a passed assert-error test has don't care result.
; Instead, this knows the test passes if given <expected-error>
; matches a prefix of the actual error message yielded by eval.
; <result> is dynamic type returned by eval
; <error-message> is type string
; <code is> a an object? a Scheme text, is a boolean proposition.
; <code> is a an object? a Scheme text, is a boolean proposition.
; <expected-error> 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)
; expected error string a prefix of actual error string?
(if (string-prefix?
expected-error
(evalresult-get-error eval-result))
; passed
(begin
(testing:log-passed!)
#t)
@ -208,6 +218,11 @@
expected-error)
#f)))
; Strict equality of error strings:
;(if (equal?
; (evalresult-get-error eval-result)
; expected-error)
; Statments in the testing DSL.
@ -226,7 +241,7 @@
; A test of abnormality.
; <code> is not expected to yield any particular value
; <error> is a string for an error that <code> is expected to throw.
; <error> is a prefix of error string that <code> is expected to throw.
(define (assert-error code expected-error)
(let* ((eval-result (harnessed-eval code)))
; eval-result is tuple
@ -235,7 +250,7 @@
eval-result
code
expected-error)
; Returns whether error matches expected error.
; Returns whether error matches expected error prefix.
))
@ -331,24 +346,45 @@
str))))
(rtrim (to-string any))))
; FIXME this is not robust to str2 shorter than str1
; string-prefix? is in R5RS but not tinyscheme.
(define (string-prefix? str1 str2)
(string=?
str1
(substring str2 0 (string-length str1))))
; filesystem utility
; Return the fullpath of a test script
; Return the fullpath of a test script.
; When fileScm is empty, returns path to dir of test scripts.
; 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)
(define (path-to-test-scripts fileScm)
(let* ( (path (string-append gimp-data-directory DIR-SEPARATOR "tests")))
(if (zero? (string-length fileScm)) path (string-append path DIR-SEPARATOR fileScm))))
(define (path-to-test-images fileScm)
(let* ( (path (string-append gimp-data-directory DIR-SEPARATOR "images")))
(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
; 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)))
(gimp-message (path-to-test-scripts filename))
(load (path-to-test-scripts filename)))
; Tell Gimp to load a test image
; Returns ID of image
; Knows installed image directory (not dedicated to testing but always there.)
; Accepts image suffixes that Gimp can load.
; Typical is /usr/local/share/gimp/2.99/images/wilber.png
(define (testing:load-test-image filename)
(gimp-message (path-to-test-images filename))
; unpack ID via car
(car (gimp-file-load RUN-NONINTERACTIVE (path-to-test-images filename))))

12
plug-ins/script-fu/test/meson.build
View File

@ -12,6 +12,8 @@ if not stable
'tests' / 'PDB' / 'image' / 'image-indexed.scm',
'tests' / 'PDB' / 'image' / 'image-grayscale.scm',
'tests' / 'PDB' / 'image' / 'image-ops.scm',
'tests' / 'PDB' / 'image' / 'image-layers.scm',
'tests' / 'PDB' / 'layer' / 'layer-new.scm',
'tests' / 'PDB' / 'layer' / 'layer-ops.scm',
'tests' / 'PDB' / 'layer' / 'layer-mask.scm',
@ -21,10 +23,16 @@ if not stable
'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' / 'resource' / 'resource.scm',
'tests' / 'PDB' / 'resource' / 'brush.scm',
'tests' / 'PDB' / 'resource' / 'palette.scm',
'tests' / 'PDB' / 'context' / 'context-get-set.scm',
# TODO context push pop list-paint-methods
'tests' / 'PDB' / 'buffer.scm',
'tests' / 'PDB' / 'misc.scm',
'tests' / 'PDB' / 'enums.scm',
'tests' / 'PDB' / 'refresh.scm',
'tests' / 'PDB' / 'bind-args.scm',
# comprehensive, total test
'tests' / 'PDB' / 'pdb.scm',

83
plug-ins/script-fu/test/tests/PDB/bind-args.scm
View File

@ -4,11 +4,84 @@
; 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.
; The test is only that no error is thrown, not necessarily that the call is effective.
; Test binding in both directions: args passed and args returned.
; Testing is not complete, but illustrative of special cases.
; Testing is not blindly exhaustive of every type declarable for PDB procedures.
; Testing is with knowledge of the code.
; Only testing representatives for cases in switch statement of scheme-wrapper.c.
; For example, the code has a case for GObject that covers most subclasses
; of GimpItem, so we only test once, say for GimpLayer.
; Also, we don't test all primitive types.
; We know they are tested drive-by in other tests,
; so we don't necessarily test them here.
; Int, String, Double, UInt
; Note that no PDB procedure takes or returns:
; gchar (the type for a single character.)
; GParam or GimpParam
; There is no case in scheme-wrapper.c.
; 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))
; GimpRGB is tested e.g. with Palette
; GimpRGBArray is tested e.g.
; from palette-get-colormap
; to is not tested: not an arg to any PDB proc
; GStrv string array
; from brushes-get-list
; to file-gih-save or extension-gimp-help
; TODO test GStrv to file-gih-save
; GBytes
; from image-get-colormap
; to image-set-colormap
; FloatArray
; from gimp-context-get-line-dash-pattern
; to gimp-context-set-line-dash-pattern
; GimpResource
; see resource.scm and context.scm
; GFile
; GimpParasite
; ScriptFu takes and returns a list of attributes of a GimpParasite
; A GimpParasite is a named string having a flags attribute ?
; Also tested elsewhere, many objects can have parasites.
; This tests the global parasites, on the gimp instance.
; to
(assert '(gimp-attach-parasite (list "foo" 1 "zed")))
; from
(assert `(equal? (car (gimp-get-parasite "foo"))
'("foo" 1 "zed")))
; GimpUnit
; A GimpUnit is both an enum and an object???
; ScriptFu converts to int. More or less an ID.
; to
; unit index 0 is px
(assert '(string=? (car (gimp-unit-get-abbreviation 0))
"px"))
; from
; default line width unit is px
(assert '(= (car (gimp-context-get-line-width-unit))
0))

93
plug-ins/script-fu/test/tests/PDB/buffer.scm Normal file
View File

@ -0,0 +1,93 @@
; Test methods of Buffer class of the PDB
; aka NamedBuffer i.e. the clipboard saved with a name.
; Edit methods that create buffers is tested elsewhere.
; The names of those methods is hard to understand:
; because they used "named" to mean "buffer"
; E.G. gimp-edit-named-copy might be better named:
; gimp-edit-copy-to-named-buffer
; Prereq: no buffer exists yet.
; setup
; Load test image that already has drawable
(define testImage (testing:load-test-image "wilber.png"))
; the layer is the zeroeth element in the vector which is the second element
; but cadr returns the second element!!
; TODO make this a library routine: get-first-layer
; (1 #(<layerID>))
(define testDrawable (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
; Create new named buffer
; There is no gimp-buffer-new method,
; instead it is a method of the Edit class so-to-speak
; You can't: #(testDrawable)
(define testBuffer (car (gimp-edit-named-copy
1
(make-vector 1 testDrawable)
"bufferName")))
; Since no selection, the buffer is same size as image
; Creation was effective: gimp knows the buffer
; get-list takes a regex, here empty ""
; get-list returns (("bufferName")) : a list of strings
; and the first string is "bufferName"
(assert `(string=? (caar (gimp-buffers-get-list ""))
"bufferName"))
; buffer has same size as image when created with no selection
; test image is 256x256
(assert `(= (car (gimp-buffer-get-width "bufferName"))
256))
(assert `(= (car (gimp-buffer-get-height "bufferName"))
256))
; new buffer has alpha: the image is RGB but the buffer has bpp 4
; This is not well documented.
; FIXME the docs and the method name should say "bpp"
; or "bytes per pixel" instead of "bytes"
(assert `(= (car (gimp-buffer-get-bytes "bufferName"))
4))
; image type is RGBA
; FIXME: the docs erroneously say "ImageBaseType" => "ImageType"
(assert `(= (car (gimp-buffer-get-image-type "bufferName"))
RGBA-IMAGE))
; renaming
; Renaming returns the given name if it doesn't clash with existing name.
(assert `(string=? (car (gimp-buffer-rename "bufferName" "renamedName"))
"renamedName"))
; Effect renaming: gimp knows the renamed name
(assert `(string=? (caar (gimp-buffers-get-list ""))
"renamedName"))
; Renaming does not add another buffer
; TODO list-length 1
; deleting
; Delete evaluates but is void
(assert `(gimp-buffer-delete "renamedName"))
; Delete was effective: gimp no longer knows
; and returns nil i.e. empty list (())
(assert `(null? (car (gimp-buffers-get-list ""))))
; TODO test two buffers
; TODO test renaming when name already in use

21
plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm
View File

@ -3,32 +3,32 @@
; setup
; Reusing image 10
(define testImage 10)
; new, empty image
(define testImage (car (gimp-image-new 21 22 RGB)))
; new image has no custom channels
(assert `(= (car (gimp-image-get-channels ,testImage))
0))
; setup (not in an assert and not quoted)
; vectors-new succeeds
(assert `(car (gimp-channel-new
,testImage ; image
(define testChannel (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
; get-channels yields (0 #())
(assert `(= (car (gimp-image-get-channels ,testImage))
0))
; channel ID is valid
(assert `(= (car (gimp-item-id-is-channel ,testChannel))
1)) ; #t
; attributes
@ -51,6 +51,7 @@
0)) ; position in stack
; insert was effective
; testImage now has one channel
(assert `(= (car (gimp-image-get-channels ,testImage))
1))

42
plug-ins/script-fu/test/tests/PDB/context/context-get-set.scm Normal file
View File

@ -0,0 +1,42 @@
; test getters and setters of GimpContext
; (sic its not an object or class)
; set-line-dash-pattern
; tests binding of FloatArray
; Default is no pattern
; Even if user has stroked already and chosen a stroke>line>pattern
(assert `(= (car (gimp-context-get-line-dash-pattern))
0))
; setter succeeds
(assert `(gimp-context-set-line-dash-pattern 2 #(5.0 11.0)))
; setter effective
(assert `(= (car (gimp-context-get-line-dash-pattern))
2))
(assert `(equal? (cadr (gimp-context-get-line-dash-pattern))
#(5.0 11.0)))
; get-line-dash-offset
;tests binding of float i.e. gdouble
; defaults to 0.0 until set
; FIXME why doesn't it persist in settings?
(assert `(= (car (gimp-context-get-line-dash-offset))
0.0))
; setter succeeds
(assert `(gimp-context-set-line-dash-offset 3.3 ))
; setter effective
(assert `(= (car (gimp-context-get-line-dash-offset))
3.3))

36
plug-ins/script-fu/test/tests/PDB/image/image-grayscale.scm
View File

@ -1,9 +1,5 @@
; 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
@ -11,44 +7,46 @@
; Basic grayscale tests
; method new from fresh GIMP state returns ID 5
(assert '(=
(car (gimp-image-new 21 22 RGB))
5))
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
; method gimp-image-convert-grayscale does not error
(assert '(gimp-image-convert-grayscale 5))
(assert `(gimp-image-convert-grayscale ,testImage))
; conversion was effective:
; basetype of grayscale is GRAY
(assert '(=
(car (gimp-image-get-base-type 5))
(assert `(=
(car (gimp-image-get-base-type ,testImage))
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 '(=
(assert `(=
(vector-length
(car (gimp-image-get-colormap 5)))
(car (gimp-image-get-colormap ,testImage)))
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))
(assert `(=
(car (gimp-image-get-precision ,testImage))
PRECISION-U8-NON-LINEAR ))
; TODO
; drawable of grayscale image is also grayscale
;(assert '(car (gimp-drawable-is-grayscale
;(assert `(car (gimp-drawable-is-grayscale
; ()
; 5)
; ,testImage)
; convert precision of grayscale image succeeds
(assert '(gimp-image-convert-precision
5
(assert `(gimp-image-convert-precision
,testImage
PRECISION-DOUBLE-GAMMA))

117
plug-ins/script-fu/test/tests/PDB/image/image-indexed.scm
View File

@ -1,23 +1,41 @@
; 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
; Now independent of image ID
; Basic indexed tests
; method new from fresh GIMP state returns ID 4
(assert '(=
(car (gimp-image-new 21 22 RGB))
4))
; an empty image for testing
(define newTestImage (car (gimp-image-new 21 22 RGB)))
; Load test image that already has drawable
(define testImage (testing:load-test-image "wilber.png"))
; testImage is mode RGB
(assert `(=
(car (gimp-image-get-base-type ,testImage))
RGB))
; method gimp-image-convert-indexed yields truthy (now yields (#t) )
(assert '(gimp-image-convert-indexed
4
(assert `(gimp-image-convert-indexed
,testImage
CONVERT-DITHER-NONE
CONVERT-PALETTE-GENERATE
2 ; color count
1 ; alpha-dither. FUTURE: #t
1 ; remove-unused. FUTURE: #t
"myPalette" ; ignored
))
; method gimp-image-convert-indexed works even on empty image
(assert `(gimp-image-convert-indexed
,newTestImage
CONVERT-DITHER-NONE
CONVERT-PALETTE-GENERATE
25 ; color count
@ -27,37 +45,84 @@
))
; conversion was effective:
; basetype of indexed is INDEXED
(assert '(=
(car (gimp-image-get-base-type 4))
; basetype of indexed image is INDEXED
(assert `(=
(car (gimp-image-get-base-type ,testImage))
INDEXED))
; conversion was effective:
; basetype of indexed image is INDEXED
(assert `(=
(car (gimp-image-get-base-type ,newTestImage))
INDEXED))
; testImage has a layer named same as file "wilber.png"
; TODO Why does "Background" work but app shows "wilber.png"
; drawable of indexed image is also indexed
(assert `(= (car (gimp-drawable-is-indexed
; unwrap the drawable ID
(car (gimp-image-get-layer-by-name ,testImage "Background"))))
1)) ; FUTURE #t
; colormaps of indexed images
; conversion was effective:
; indexed image has-a colormap
; colormap is-a vector of length zero, when image has no drawable.
; get-colormap returns (#( <bytes of color>))
; FIXME doc says num-bytes is returned, obsolete since GBytes
(assert '(=
(assert `(=
(vector-length
(car (gimp-image-get-colormap 4)))
(car (gimp-image-get-colormap ,newTestImage)))
0))
; colormap is-a vector of length 3*<color count given during conversion>,
; when image has a drawable.
; 3*2=6
; FIXME doc says num-bytes is returned, obsolete since GBytes
(assert `(=
(vector-length
(car (gimp-image-get-colormap ,testImage)))
(* 3 2)))
; set-colormap succeeds
; This tests marshalling of GBytes to PDB
(assert `(gimp-image-set-colormap ,testImage #(1 1 1 9 9 9)))
; TODO set-colormap effective
; colormap vector is same as given
(assert `(equal?
(car (gimp-image-get-colormap ,testImage))
#(1 1 1 9 9 9)))
; precision of indexed images
; indexed images have precision PRECISION-U8-NON-LINEAR
; FIXME annotation of PDB procedure says GIMP_PRECISION_U8
(assert '(=
(car (gimp-image-get-precision 4))
(assert `(=
(car (gimp-image-get-precision ,testImage))
PRECISION-U8-NON-LINEAR ))
; TODO
; drawable of indexed image is also indexed
;(assert '(car (gimp-drawable-is-indexed
; ()
; 4)
; !!! This depends on ID 4 for image
; convert precision of indexed images yields error
(assert-error '(car (gimp-image-convert-precision
4
(assert-error `(car (gimp-image-convert-precision
,newTestImage
PRECISION-DOUBLE-GAMMA))
"Procedure execution of gimp-image-convert-precision failed on invalid input arguments: Image '[Untitled]' (4) must not be of type 'indexed'")
"Procedure execution of gimp-image-convert-precision failed on invalid input arguments: ")
; "Image '[Untitled]' (4) must not be of type 'indexed'"

58
plug-ins/script-fu/test/tests/PDB/image/image-layers.scm Normal file
View File

@ -0,0 +1,58 @@
; test Image methods of PDB
; where methods deal with layers owned by image.
; setup
; Load test image that already has drawable
(define testImage (testing:load-test-image "wilber.png"))
; get-layers
; procedure returns (1 #(<layerID>)) ....in the REPL
; the testImage has one layer
(assert `(= (car (gimp-image-get-layers ,testImage ))
1))
; get-layers returns second result a vector of ID's
; !!! use cadr to get second result
(assert `(vector? (cadr (gimp-image-get-layers ,testImage ))))
; the vector also has one element
(assert `(= (vector-length (cadr (gimp-image-get-layers ,testImage )))
1))
; the vector can be indexed at first element
; and is a numeric ID
(assert `(number?
(vector-ref (cadr (gimp-image-get-layers ,testImage ))
0)))
; store the layer ID
(define testLayer (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
; FIXME seems to fail??? because name is actually "Background"
; the same layer can be got by name
; FIXME app shows layer name is "wilber.png" same as image name
(assert `(= (car (gimp-image-get-layer-by-name ,testImage "Background"))
,testLayer))
; the single layer's position is zero
; gimp-image-get-layer-position is deprecated
(assert `(= (car (gimp-image-get-item-position ,testImage ,testLayer))
0))
; TODO gimp-image-get-layer-by-tattoo
; the single layer is selected in freshly opened image
(assert `(= (car (gimp-image-get-selected-layers ,testImage ))
1))
; TODO test selected layer is same layer

89
plug-ins/script-fu/test/tests/PDB/image/image-new.scm
View File

@ -2,64 +2,64 @@
; loading this file changes testing state
; depends on fresh GIMP state
; !!!! tests hardcode image ID 1
; Using numeric equality operator '=' on numeric ID's
; setup
; method new from fresh GIMP state returns ID 1
(assert '(=
(car (gimp-image-new 21 22 RGB))
1 ))
(define testImage (car (gimp-image-new 21 22 RGB)))
; 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))
(assert `(=
(car (gimp-image-id-is-valid ,testImage))
1))
; Ensure attributes of new image are correct
; method is_dirty on new image is true
(assert '(=
(car (gimp-image-is-dirty 1))
(assert `(=
(car (gimp-image-is-dirty ,testImage))
1))
; method get_width on new image yields same width given when created
(assert '(=
(car (gimp-image-get-width 1))
(assert `(=
(car (gimp-image-get-width ,testImage))
21))
; method get_height on new image yields same height given when created
(assert '(=
(car (gimp-image-get-height 1))
(assert `(=
(car (gimp-image-get-height ,testImage))
22))
; method get-base-type yields same image type given when created
(assert '(=
(car (gimp-image-get-base-type 1))
(assert `(=
(car (gimp-image-get-base-type ,testImage))
RGB))
; new image is known to gimp
; Returns (<length> #(1))
(assert '(= (car (gimp-get-images))
1))
(assert `(= (car (gimp-get-images))
,testImage))
; new image has no components
; new image has zero layers
(assert '(= (car (gimp-image-get-layers 1))
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
; new image has zero vectors
(assert '(= (car (gimp-image-get-vectors 1))
(assert `(= (car (gimp-image-get-vectors ,testImage))
0))
; new image has no parasites
(assert '(= (length
(car (gimp-image-get-parasite-list 1)))
(assert `(= (length
(car (gimp-image-get-parasite-list ,testImage)))
0))
@ -67,11 +67,11 @@
; new image has-a selection
(assert '(gimp-image-get-selection 1))
(assert `(gimp-image-get-selection ,testImage))
; new image has no floating selection
(assert '(=
(car (gimp-image-get-floating-sel 1))
(assert `(=
(car (gimp-image-get-floating-sel ,testImage))
-1))
; TODO floating-sel-attached-to
@ -79,22 +79,22 @@
; new image has unit having ID 1
(assert '(=
(car (gimp-image-get-unit 1))
(assert `(=
(car (gimp-image-get-unit ,testImage))
1))
; new image has name
(assert '(string=?
(car (gimp-image-get-name 1))
(assert `(string=?
(car (gimp-image-get-name ,testImage))
"[Untitled]"))
; new image has empty metadata string
(assert '(string=?
(car (gimp-image-get-metadata 1))
(assert `(string=?
(car (gimp-image-get-metadata ,testImage))
""))
; has an effective color profile
(assert '(gimp-image-get-effective-color-profile 1))
(assert `(gimp-image-get-effective-color-profile ,testImage))
@ -103,10 +103,10 @@
; 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)) ""))
(assert `(string=? (car (gimp-image-get-file ,testImage)) ""))
(assert `(string=? (car (gimp-image-get-xcf-file ,testImage)) ""))
(assert `(string=? (car (gimp-image-get-imported-file ,testImage)) ""))
(assert `(string=? (car (gimp-image-get-exported-file ,testImage)) ""))
@ -115,21 +115,21 @@
; method delete succeeds on new image
; returns 1 for true. FUTURE returns #t
(assert `(car (gimp-image-delete 1)))
(assert `(car (gimp-image-delete ,testImage)))
; ensure id invalid for deleted image
; returns 0 for false. FUTURE returns #f
(assert `(=
(car (gimp-image-id-is-valid 1))
(car (gimp-image-id-is-valid ,testImage))
0))
; deleted image is not in gimp
; Returns (<length> #())
; FUTURE Returns empty list '()
(assert '(=
; FUTURE Returns empty list `()
(assert `(=
(car (gimp-get-images))
0))
; !!! This only passes when testing is from fresh Gimp restart
; Test abnormal args to image-new
@ -137,8 +137,11 @@
; 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." )
(assert-error `(gimp-image-new 0 0 RGB)
(string-append
"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."

50
plug-ins/script-fu/test/tests/PDB/image/image-ops.scm
View File

@ -1,36 +1,34 @@
; Test various operations on image
; method new from fresh GIMP state returns ID 2
(assert '(=
(car (gimp-image-new 21 22 RGB))
6))
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
; transformations
; flip
(assert '(gimp-image-flip 6 ORIENTATION-HORIZONTAL))
(assert '(gimp-image-flip 6 ORIENTATION-VERTICAL))
(assert `(gimp-image-flip ,testImage ORIENTATION-HORIZONTAL))
(assert `(gimp-image-flip ,testImage ORIENTATION-VERTICAL))
; TODO rotate scale resize policy
(assert-error '(gimp-image-flip 6 ORIENTATION-UNKNOWN)
(assert-error `(gimp-image-flip ,testImage 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))
(assert `(gimp-image-rotate ,testImage ROTATE-90))
(assert `(gimp-image-rotate ,testImage ROTATE-180))
(assert `(gimp-image-rotate ,testImage ROTATE-270))
; scale
; up
(assert '(gimp-image-scale 6 100 100))
(assert `(gimp-image-scale ,testImage 100 100))
; down to min
(assert '(gimp-image-scale 6 1 1))
(assert `(gimp-image-scale ,testImage 1 1))
; up to max
; Performance:
@ -38,33 +36,33 @@
; 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))
(assert `(gimp-image-scale ,testImage 524288 524288))
; down to min
(assert '(gimp-image-scale 6 1 1))
(assert `(gimp-image-scale ,testImage 1 1))
; policy ops
; 0 means non-interactive
(assert '(gimp-image-policy-color-profile 6 0))
(assert '(gimp-image-policy-rotate 6 0))
(assert `(gimp-image-policy-color-profile ,testImage 0))
(assert `(gimp-image-policy-rotate ,testImage 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))
(assert `(gimp-image-freeze-channels ,testImage))
(assert `(gimp-image-freeze-layers ,testImage))
(assert `(gimp-image-freeze-vectors ,testImage))
(assert `(gimp-image-thaw-channels ,testImage))
(assert `(gimp-image-thaw-layers ,testImage))
(assert `(gimp-image-thaw-vectors ,testImage))
; clean-all makes image not dirty
(assert '(gimp-image-clean-all 6))
(assert '(=
(car (gimp-image-is-dirty 6))
(assert `(gimp-image-clean-all ,testImage))
(assert `(=
(car (gimp-image-is-dirty ,testImage))
0))
; TODO test flatten is effective
@ -81,5 +79,5 @@
; airbrush
; cannot flatten empty image
(assert-error '(gimp-image-flatten 6)
(assert-error `(gimp-image-flatten ,testImage)
"Procedure execution of gimp-image-flatten failed: Cannot flatten an image without any visible layer.")

45
plug-ins/script-fu/test/tests/PDB/image/image-precision.scm
View File

@ -1,23 +1,18 @@
; test Image precision methods of PDB
; depends on fresh GIMP state
; !!!! tests hardcode image ID 2
; Using numeric equality operator '=' on numeric ID's
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
; 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))
(assert `(=
(car (gimp-image-get-precision ,testImage))
PRECISION-U8-NON-LINEAR ))
@ -25,21 +20,22 @@
; Convert precision
; method convert-precision yields true, with side effect on image
(assert '(car (gimp-image-convert-precision
2
(assert `(car (gimp-image-convert-precision
,testImage
PRECISION-U8-LINEAR)))
; converted image is the precision
(assert '(=
(car (gimp-image-get-precision 2))
(assert `(=
(car (gimp-image-get-precision ,testImage))
PRECISION-U8-LINEAR ))
; converting to the same precision yields error message
(assert-error '(gimp-image-convert-precision
2
(assert-error `(gimp-image-convert-precision
,testImage
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'")
"Procedure execution of gimp-image-convert-precision failed on invalid input arguments: ")
; "Image '[Untitled]' (2) must not be of precision 'u8-linear'"
@ -49,12 +45,11 @@
; 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 ))
; setup
(define testImageWithPrecision (car (gimp-image-new-with-precision 21 22 RGB PRECISION-DOUBLE-GAMMA)))
; image has given precision
(assert '(=
(car (gimp-image-get-precision 3))
(assert `(=
(car (gimp-image-get-precision ,testImageWithPrecision))
PRECISION-DOUBLE-GAMMA ))

94
plug-ins/script-fu/test/tests/PDB/item/item.scm
View File

@ -124,38 +124,90 @@
)
; use image,item instance extant from previous tests.
; OLD use image,item instance extant from previous tests.
; text layer
(test-bare-item 15)
(test-item-in-image 8 15)
(test-item-parasite 15)
; setup
; All the items in the same testImage
; See earlier tests, where setup is lifted from
(define testImage (testing:load-test-image "wilber.png"))
(define testLayer (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
(define testSelection (car (gimp-image-get-selection testImage)))
(define
testTextLayer
(car (gimp-text-fontname
testImage
-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" )))
(define testChannel (car (gimp-channel-new
testImage ; image
23 24 ; width, height
"Test Channel" ; name
50.0 ; opacity
"red" ))) ; compositing color
; must add to image
(gimp-image-insert-channel
testImage
testChannel
0 ; parent, moot since channel groups not supported
0)
(define
testLayerMask
(car (gimp-layer-create-mask
testLayer
ADD-MASK-WHITE)))
; must add to layer
(gimp-layer-add-mask
testLayer
testLayerMask)
(define testPath (car (gimp-vectors-new testImage "Test Path")))
; must add to image
(gimp-image-insert-vectors
testImage
testPath
0 0) ; parent=0 position=0
; tests start here
; layer
(test-bare-item 12)
(test-item-in-image 9 12)
(test-item-parasite 12)
(test-bare-item testLayer)
(test-item-in-image testImage testLayer)
(test-item-parasite testLayer)
; text layer
(test-bare-item testTextLayer)
(test-item-in-image testImage testTextLayer)
(test-item-parasite testTextLayer)
; layerMask
(test-bare-item 14)
(test-item-in-image 9 14)
(test-item-parasite 14)
(test-bare-item testLayerMask)
(test-item-in-image testImage testLayerMask)
(test-item-parasite testLayerMask)
; vectors
; ID 16 is also a vectors named "foo"
(test-bare-item 19)
(test-item-in-image 10 19)
(test-item-parasite 19)
(test-bare-item testPath)
(test-item-in-image testImage testPath)
(test-item-parasite testPath)
; channel
(test-bare-item 20)
(test-item-in-image 10 20)
(test-item-parasite 20)
(test-bare-item testChannel)
(test-item-in-image testImage testChannel)
(test-item-parasite testChannel)
; selection
(test-bare-item 18)
(test-item-in-image 10 18)
(test-item-parasite 18)
(test-bare-item testSelection)
(test-item-in-image testImage testSelection)
(test-item-parasite testSelection)
; TODO other item types e.g. ?

86
plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm
View File

@ -6,65 +6,62 @@
; setup
; Image owns Layers
;
(define testImage (car (gimp-image-new 21 22 RGB)))
; 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
(define
testLayer (car (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL))
12))
LAYER-MODE-NORMAL)))
; assert layer is not inserted in image
; assert layerMask not on the layer yet!!!
(define
testLayerMask (car (gimp-layer-create-mask
testLayer
ADD-MASK-WHITE)))
; 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))
(assert `(= (car (gimp-layer-mask ,testLayer))
-1))
; add layerMask created on a layer to that layer succeeds
(assert '(gimp-layer-add-mask
12 ; layer
13)) ; layer mask
(assert `(gimp-layer-add-mask
,testLayer
,testLayerMask))
; add layerMask to layer was effective:
; Getting the mask for the layer yields layerMask ID
(assert '(= (car (gimp-layer-mask 12))
13))
(assert `(= (car (gimp-layer-mask ,testLayer))
,testLayerMask))
; and vice versa
(assert '(= (car (gimp-layer-from-mask 13))
12))
(assert `(= (car (gimp-layer-from-mask ,testLayerMask))
,testLayer))
; creating and adding second mask
; creating a second mask from layer succeeds
(assert '(= (car (gimp-layer-create-mask
12
ADD-MASK-WHITE))
14))
(define
testLayerMask2
(car (gimp-layer-create-mask
testLayer
ADD-MASK-WHITE)))
; adding a second layerMask fails
(assert-error '(gimp-layer-add-mask
12 ; layer
14) ; layer mask
(assert-error `(gimp-layer-add-mask
,testLayer
,testLayerMask2)
(string-append
"Procedure execution of gimp-layer-add-mask failed: "
"Unable to add a layer mask since the layer already has one."))
@ -74,35 +71,34 @@
; mask removal
; remove-mask fails if the layer is not on image
(assert-error '(gimp-layer-remove-mask
12 ; layer
(assert-error `(gimp-layer-remove-mask
,testLayer
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"))
"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
(assert `(gimp-image-insert-layer
,testImage
,testLayer
0 ; parent
0 )) ; position within parent
; remove-mask succeeds
; when layer is in image
(assert '(gimp-layer-remove-mask
12 ; layer
(assert `(gimp-layer-remove-mask
,testLayer
MASK-APPLY)) ; removal mode
; and is effective
; layer no longer has a mask
(assert '(= (car (gimp-layer-mask 12))
(assert `(= (car (gimp-layer-mask ,testLayer))
-1))
; and now we can add the second mask
(assert '(gimp-layer-add-mask
12 ; layer
14)) ; second layer mask
(assert `(gimp-layer-add-mask
,testLayer
,testLayerMask2))
; fails when mask different size from layer?

79
plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm
View File

@ -2,32 +2,25 @@
; setup
; Image owns Layers
; method new from fresh GIMP state returns ID
(assert '(=
(car (gimp-image-new 21 22 RGB))
7 ))
(define testImage (car (gimp-image-new 21 22 RGB)))
; new method yields layer ID 8
(assert '(= (car (gimp-layer-new
7
(define testLayer
(car (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL))
8))
LAYER-MODE-NORMAL)))
; new layer is not in the image until inserted
(assert '(= (car (gimp-image-get-layers 7))
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
@ -37,61 +30,61 @@
; defaulted attributes
; apply-mask default false
(assert '(=
(car (gimp-layer-get-apply-mask 8))
(assert `(=
(car (gimp-layer-get-apply-mask ,testLayer))
0))
; blend-space default LAYER-COLOR-SPACE-AUTO
(assert '(=
(car (gimp-layer-get-blend-space 8))
(assert `(=
(car (gimp-layer-get-blend-space ,testLayer))
LAYER-COLOR-SPACE-AUTO))
; composite-mode default LAYER-COMPOSITE-AUTO
(assert '(=
(car (gimp-layer-get-composite-mode 8))
(assert `(=
(car (gimp-layer-get-composite-mode ,testLayer))
LAYER-COMPOSITE-AUTO))
; composite-space default LAYER-COLOR-SPACE-AUTO
(assert '(=
(car (gimp-layer-get-composite-space 8))
(assert `(=
(car (gimp-layer-get-composite-space ,testLayer))
LAYER-COLOR-SPACE-AUTO))
; edit-mask default false
(assert '(=
(car (gimp-layer-get-edit-mask 8))
(assert `(=
(car (gimp-layer-get-edit-mask ,testLayer))
0))
; lock-alpha default false
; deprecated? gimp-layer-get-preserve-trans
(assert '(=
(car (gimp-layer-get-lock-alpha 8))
(assert `(=
(car (gimp-layer-get-lock-alpha ,testLayer))
0))
; mask not exist, ID -1
; deprecated? gimp-layer-mask
(assert '(=
(car (gimp-layer-get-mask 8))
(assert `(=
(car (gimp-layer-get-mask ,testLayer))
-1))
; mode default LAYER-MODE-NORMAL
(assert '(=
(car (gimp-layer-get-mode 8))
(assert `(=
(car (gimp-layer-get-mode ,testLayer))
LAYER-MODE-NORMAL))
; show-mask default false
(assert '(=
(car (gimp-layer-get-show-mask 8))
(assert `(=
(car (gimp-layer-get-show-mask ,testLayer))
0))
; visible default true
; FIXME doc says default false
(assert '(=
(car (gimp-layer-get-visible 8))
(assert `(=
(car (gimp-layer-get-visible ,testLayer))
1))
; is-floating-sel default false
(assert '(=
(car (gimp-layer-is-floating-sel 8))
(assert `(=
(car (gimp-layer-is-floating-sel ,testLayer))
0))
; !!! No get-offsets
@ -102,12 +95,12 @@
; attributes are as given when created
; name is as given
assert '(string=? (car (gimp-layer-get-name 8))
"LayerNew")
(assert `(string=? (car (gimp-layer-get-name ,testLayer))
"LayerNew"))
; opacity is as given
(assert '(=
(car (gimp-layer-get-opacity 8))
(assert `(=
(car (gimp-layer-get-opacity ,testLayer))
50.0))
@ -115,8 +108,8 @@ assert '(string=? (car (gimp-layer-get-name 8))
; tattoo
; tattoo is generated unique within image?
(assert '(=
(car (gimp-layer-get-tattoo 8))
(assert `(=
(car (gimp-layer-get-tattoo ,testLayer))
2))

52
plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm
View File

@ -3,76 +3,66 @@
; 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)
(define testImage (car (gimp-image-new 21 22 RGB)))
(assert '(= (car (gimp-image-new 21 22 RGB))
8 ))
; new method yields layer ID 10
(assert '(= (car (gimp-layer-new
8
(define
testLayer (car (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew#2"
50.0
LAYER-MODE-NORMAL))
10))
LAYER-MODE-NORMAL)))
; 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)
(assert-error `(gimp-layer-resize ,testLayer 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"))
"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
(assert-error `(gimp-layer-scale ,testLayer
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"))
"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
(assert-error `(gimp-layer-remove-mask
,testLayer
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"))
"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))
(assert `(gimp-layer-add-alpha ,testLayer))
; and is effective
; Note method on superclass Drawable
(assert '(= (car (gimp-drawable-has-alpha 10))
(assert `(= (car (gimp-drawable-has-alpha ,testLayer))
1))
; flatten succeeds
(assert '(gimp-layer-flatten 10))
(assert `(gimp-layer-flatten ,testLayer))
; flatten was effective: no longer has alpha
; flatten a layer means "remove alpha"
(assert '(= (car (gimp-drawable-has-alpha 10))
(assert `(= (car (gimp-drawable-has-alpha ,testLayer))
0))
@ -81,10 +71,10 @@
; delete
; delete succeeds
(assert '(gimp-layer-delete 10))
(assert `(gimp-layer-delete ,testLayer))
; delete second time fails
(assert-error '(gimp-layer-delete 10)
(assert-error `(gimp-layer-delete ,testLayer)
"runtime: invalid item ID")
; Error for flatten:

32
plug-ins/script-fu/test/tests/PDB/pdb.scm
View File

@ -8,22 +8,22 @@
; The test files might be organized in directories in the repo,
; but all flattened into the /tests directory when installed.
; creates images 1-6
; images
(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 "image-layers.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
(testing:load-test "layer-new.scm")
(testing:load-test "layer-ops.scm")
(testing:load-test "layer-mask.scm")
; 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 "text-layer-new.scm")
(testing:load-test "vectors-new.scm")
(testing:load-test "channel-new.scm")
; TODO channel-ops.scm
@ -41,24 +41,32 @@
(testing:load-test "resource.scm")
(testing:load-test "brush.scm")
(testing:load-test "palette.scm")
; TODO other resources gradient, etc
(testing:load-test "buffer.scm")
; TODO edit ops
; TODO undo
; TODO unit
; TODO progress
; pdb
; context
; tested in bind-args.scm:
; unit
; parasite
; pdb the object
; 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")
(testing:load-test "refresh.scm")
(testing:load-test "context-get-set.scm")
(testing:load-test "bind-args.scm")
; report the result
(testing:report)
; yield the session result
; yield the session overall result
(testing:all-passed?)

69
plug-ins/script-fu/test/tests/PDB/refresh.scm Normal file
View File

@ -0,0 +1,69 @@
; test refresh methods
; make the app read resources from configuration files
; methods of the app
; the app manages collections of resources
; app can refresh and list the resources.
; A collection is named by the plural of the singular element,
; i.e. brushes is a collection of brush.
; Deprecations:
; gimp-palette-refresh
; gimp-brushes-list => gimp-brushes-get-list etc.
; gimp-parasite-list => gimp-get-parasite-list
; refresh
; always succeeds
; FIXME but wraps result in list (#t)
(assert `(car (gimp-brushes-refresh)))
(assert `(car (gimp-dynamics-refresh)))
(assert `(car (gimp-fonts-refresh)))
(assert `(car (gimp-gradients-refresh)))
(assert `(car (gimp-palettes-refresh)))
(assert `(car (gimp-patterns-refresh)))
; list
; always succeeds
; take an optional regex string
(assert `(list? (car (gimp-brushes-get-list ""))))
(assert `(list? (car (gimp-dynamics-get-list ""))))
(assert `(list? (car (gimp-fonts-get-list ""))))
(assert `(list? (car (gimp-gradients-get-list ""))))
(assert `(list? (car (gimp-palettes-get-list ""))))
(assert `(list? (car (gimp-patterns-get-list ""))))
; listing app's collection of things not resources
; But taking a regex
(assert `(list? (car (gimp-buffers-get-list ""))))
; listing app's other collections not resources
; Not taking a regex
; FIXME the naming does not follow the pattern, should be plural parasites
; Not: (gimp-parasites-get-list "")
(assert `(list? (car (gimp-get-parasite-list))))
; the app, images, vectors, drawables, items
; can all have parasites.
; Tested elsewhere.
; gimp-get-images does not follow the pattern:
; it doesn't take a regex
; and it returns a vector of image objects (0 #())
(assert `(vector? (cadr (gimp-get-images))))

0
plug-ins/script-fu/test/tests/PDB/brush.scm → plug-ins/script-fu/test/tests/PDB/resource/brush.scm
View File

147
plug-ins/script-fu/test/tests/PDB/resource/palette.scm Normal file
View File

@ -0,0 +1,147 @@
; Test methods of palette 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 palettees in GIMP.
; The existing palette may have the same name as hard coded in tests.
; In future, will be possible to create new palette with same name as existing.
; new and delete
; new returns palette of given name
(assert '(string=?
(car (gimp-palette-new "testPaletteNew"))
"testPaletteNew"))
; TODO delete
; can delete a new palette
; FAIL _gimp_gp_param_def_to_param_spec: GParamSpec type unsupported 'GimpParamResource'
;(assert '(string=?
; (car (gimp-resource-delete "testPaletteNew"))
; "testPaletteNew"))
; attributes of new palette
; gimp-palette-get-background deprecated => gimp-context-get-background
; ditto foreground
; new palette has zero colors
(assert '(= (car (gimp-palette-get-color-count "testPaletteNew"))
0))
; new palette has empty colormap
; (0 #())
(assert '(= (car (gimp-palette-get-colors "testPaletteNew"))
0))
; new palette has zero columns
; (0 #())
(assert '(= (car (gimp-palette-get-columns "testPaletteNew"))
0))
; TODO is editable resource-is-editable
; attributes of existing palette
; Max size palette 256
; Bears palette has 256 colors
(assert '(= (car (gimp-palette-get-color-count "Bears"))
256))
; Bears palette colormap is size 256
; (256)
(assert '(= (car (gimp-palette-get-color-count "Bears"))
256))
; Bears palette colormap array is size 256 vector of 3-tuple lists
; (256 #((8 8 8) ... ))
(assert '(= (vector-length (cadr (gimp-palette-get-colors "Bears")))
256))
; Bears palette has zero columns
; (0 #())
(assert (= (car (gimp-palette-get-columns "Bears"))
0))
; TODO is not editable resource-is-editable
; setting attributes of existing palette
; Can not change column count on system palette
(assert-error `(gimp-palette-set-columns "Bears" 1)
"Procedure execution of gimp-palette-set-columns failed")
; setting attributes of new palette
; succeeds
(assert `(gimp-palette-set-columns "testPaletteNew" 1))
; effective
(assert `(= (car (gimp-palette-get-columns "testPaletteNew"))
1))
; adding color "entry" to new palette
; add first entry returns index 0
; result is wrapped (0)
(assert `(= (car (gimp-palette-add-entry "testPaletteNew" "fooEntryName" "red"))
0))
; was effective on color
; FIXME returns ((0 0 0)) which is not "red"
(assert `(equal? (car (gimp-palette-entry-get-color "testPaletteNew" 0))
(list 0 0 0)))
; was effective on name
(assert `(equal? (car (gimp-palette-entry-get-name "testPaletteNew" 0))
"fooEntryName"))
; delete entry
; succeeds
; FIXME: the name seems backward, could be entry-delete
(assert `(gimp-palette-delete-entry "testPaletteNew" 0))
; effective, color count is back to 0
(assert '(= (car (gimp-palette-get-color-count "testPaletteNew"))
0))
; adding color "entry" to new palette which is full
; adding color "entry" to system palette
; TODO
; TODO locked palette? See issue about locking palette?
; see context.scm
; same as context-set-palette ?
;gimp-palettes-set-palette deprecated

1
plug-ins/script-fu/test/tests/PDB/resource/readme.md Normal file
View File

@ -0,0 +1 @@
See also a plugin in scripts/test/resource-class/

0
plug-ins/script-fu/test/tests/PDB/resource.scm → plug-ins/script-fu/test/tests/PDB/resource/resource.scm
View File

12
plug-ins/script-fu/test/tests/PDB/selection/selection.scm
View File

@ -2,18 +2,18 @@
; setup
; Reusing image 10
(define testImage 10)
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
; 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 (car (gimp-image-get-selection testImage)))
(define testSelection 18)
; The returned ID is-a Selection
(assert `(= (car (gimp-item-id-is-selection ,testSelection))

84
plug-ins/script-fu/test/tests/PDB/text-layer/text-layer-new.scm
View File

@ -6,22 +6,21 @@
; No setup
; Reuses image 8 from prior testing
; Require it has no layer
; setup
; Require image has no layer
(define testImage (car (gimp-image-new 21 22 RGB)))
; new
; new yields ID 15
(assert '(= (car (gimp-text-layer-new
8 ; image
; setup (not an assert )
(define
testTextLayer
(car (gimp-text-layer-new
testImage
"textOfTestTextLayer" ; text
"fontName" ; fontname
30 ; fontsize
UNIT-PIXEL))
15))
UNIT-PIXEL)))
; !!!! fontName is not valid
; The text displays anyway, using some font family, without error.
@ -37,17 +36,17 @@
; is-a TextLayer
(assert '(= (car (gimp-item-id-is-text-layer 15))
(assert `(= (car (gimp-item-id-is-text-layer ,testTextLayer))
1))
; text layer is not in image yet
(assert '(= (car (gimp-image-get-layers 8))
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
; adding layer to image succeeds
(assert '(gimp-image-insert-layer
8 ; image
15 ; layer
(assert `(gimp-image-insert-layer
,testImage
,testTextLayer ; layer
0 ; parent
0 )) ; position within parent
@ -58,15 +57,15 @@
; antialias default true
; FIXME doc says false
(assert '(= (car (gimp-text-layer-get-antialias 15))
(assert `(= (car (gimp-text-layer-get-antialias ,testTextLayer))
1))
; base-direction default TEXT-DIRECTION-LTR
(assert '(= (car (gimp-text-layer-get-base-direction 15))
(assert `(= (car (gimp-text-layer-get-base-direction ,testTextLayer))
TEXT-DIRECTION-LTR))
; language default "C"
(assert '(string=? (car (gimp-text-layer-get-language 15))
(assert `(string=? (car (gimp-text-layer-get-language ,testTextLayer))
"C"))
; TODO other attributes
@ -76,13 +75,13 @@
; attributes as given
; text
(assert '(string=? (car (gimp-text-layer-get-text 15))
(assert `(string=? (car (gimp-text-layer-get-text ,testTextLayer))
"textOfTestTextLayer"))
; font
(assert '(string=? (car (gimp-text-layer-get-font 15))
(assert `(string=? (car (gimp-text-layer-get-font ,testTextLayer))
"fontName"))
; font-size
(assert '(= (car (gimp-text-layer-get-font-size 15))
(assert `(= (car (gimp-text-layer-get-font-size ,testTextLayer))
30))
; is no method to get fontSize unit
@ -90,11 +89,12 @@
; misc ops
; vectors from text yields ID 16
(assert '(= (car (gimp-vectors-new-from-text-layer
8 ; image
15)) ; text layer
16))
; vectors from text succeeds
(assert `(gimp-vectors-new-from-text-layer
,testImage
,testTextLayer))
; not capturing returned ID of vectors
@ -104,7 +104,7 @@
; 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
(assert `(= (car (gimp-text-get-extents-fontname
"zed" ; text
32 ; fontsize
POINTS ; size units. !!! See UNIT-PIXEL
@ -117,9 +117,12 @@
; alternate method for creating text layer
; gimp-text-fontname creates text layer and inserts it into image
(assert '(= (car (gimp-text-fontname
8 ; image
; gimp-text-fontname creates text layer AND inserts it into image
; setup, not assert
(define
testTextLayer2
(car (gimp-text-fontname
testImage
-1 ; drawable. -1 means NULL means create new text layer
0 0 ; coords
"bar" ; text
@ -127,22 +130,21 @@
1 ; antialias true
31 ; fontsize
PIXELS ; size units. !!! See UNIT-PIXEL
"fontName" )) ; fontname
17))
;
"fontName" )))
; error to insert layer created by gimp-text-fontname
(assert-error '(gimp-image-insert-layer
8 ; image
17 ; layer
; TODO make the error message matching by prefix only
(assert-error `(gimp-image-insert-layer
,testImage
,testTextLayer2
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"))
"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))
(assert `(= (car (gimp-display-new ,testImage))
1))

43
plug-ins/script-fu/test/tests/PDB/vectors-new.scm
View File

@ -5,12 +5,9 @@
; 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))
(define testImage (car (gimp-image-new 21 22 RGB)))
(gimp-message "testImage is:" (number->string testImage))
@ -32,58 +29,58 @@
; ensure get-vectors from image having no vectors yields zero vectors
; FUTURE: returns just #(), not (0 #())
(assert `(= (car (gimp-image-get-vectors ,test-image))
(assert `(= (car (gimp-image-get-vectors ,testImage))
0))
; setup, not an assert
; vectors-new succeeds
(assert `(car (gimp-vectors-new
,test-image
"Test Path")))
; from fresh GIMP state, path ID is 19
(define test-path 19)
(define testPath (car (gimp-vectors-new
testImage
"Test Path")))
; !!! id is valid even though vectors is not inserted in image
(assert `(= (car (gimp-item-id-is-vectors ,test-path))
(assert `(= (car (gimp-item-id-is-vectors ,testPath))
1)) ; #t
; new path name is as given
(assert `(string=?
(car (gimp-item-get-name ,test-path))
(car (gimp-item-get-name ,testPath))
"Test Path"))
; new vectors is not in image yet
; image still has count of vectors == 0
(assert `(= (car (gimp-image-get-vectors ,test-image))
(assert `(= (car (gimp-image-get-vectors ,testImage))
0))
; new path has no strokes
; path has stroke count == 0
(assert `(= (car (gimp-vectors-get-strokes ,test-path))
(assert `(= (car (gimp-vectors-get-strokes ,testPath))
0))
; insert vector in image yields (#t)
(assert `(car (gimp-image-insert-vectors
,test-image
,test-path
,testImage
,testPath
0 0))) ; parent=0 position=0
; image with inserted vectors now has count of vectors == 1
(assert `(= (car (gimp-image-get-vectors ,test-image))
(assert `(= (car (gimp-image-get-vectors ,testImage))
1))
; FIXME: crashes in gimpvectors-export.c line 234
; possibly because path has no strokes?
; export to string succeeds
(assert `(gimp-vectors-export-to-string
,test-image
,test-path))
;(assert `(gimp-vectors-export-to-string
; ,testImage
; ,testPath))
; 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
; ,testImage
; 0))

3
plug-ins/script-fu/test/tests/TS/no-memory.scm
View File

@ -9,6 +9,8 @@
; explaining the limits.
; The limits here are from experiments.
; These only test the limits.
; Methods on the objects (string, vector, etc.) are tested elsewhere.
; Symbol limits
@ -37,6 +39,7 @@
; succeeds
(assert '(make-vector 25000))
; REPL shows as #(() () ... ()) i.e. a vector of NIL, not initialized
; might not crash?
(define testVector (make-vector 25001))

1
plug-ins/script-fu/test/tests/TS/vector.scm
View File

@ -6,6 +6,7 @@
; make-vector succeeds
(assert '(make-vector 25))
; Note vector is anonymous and will be garbage collected
; make-vector of size 0 succeeds
(assert '(make-vector 0))

40
plug-ins/script-fu/test/tests/readme.md
View File

@ -2,7 +2,7 @@
## Quick start
0. Rebuild GIMP with the ScriptFu compile option 'no line numbers in error messages' (see below.)
0. Rebuild GIMP.
The build must be a non-stable build (nightly/development version.)
1. View the Gimp Error Console dockable
2. Open the SF Console
@ -95,11 +95,17 @@ The test framework and test scripts are only installed in a non-stable build.
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.
When testing error conditions (using assert-error)
the testing framework compares expected prefix of error messages
with actual error messages.
To do that requires either that TinyScheme be built without the compile option
to display file and line number in error messages,
OR that TinyScheme puts details such as line number as the suffix of error message.
In other words, the testing of error conditions is not exact,
only a prefix of the error message is compared.
When you are writing such a test,
write an expected error string that is a prefix that omits details.
In libscriptfu/tinyscheme/scheme.h :
```
@ -148,13 +154,29 @@ 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
### Tests can be order independent and repeated
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.
Often, you can run tests in any order and repeat tests, up to a point.
Then test objects that have accumulated
might start to interfere with certain tests.
Tests generally should not hardcode GIMP ID's that GIMP assigns.
In general, run a large test, such as pdb.scm or tinyscheme.scm.
But you can also run a small test such as layer-new.scm.
Just be aware that if you run tests in an order of your choice,
and if you repeat tests in the same session,
you might start to see more errors than on the first run of a test
after a fresh start of Gimp.
### Some tests require a clean install
Tests of resources may try to create a resource (e.g. brush)
that a prior run of the test already created
and that was saved by Gimp as a setting.
For such tests, you may need to test only after a fresh install of Gimp
(when the set of resources is the set that Gimp installs.)
### The test framework does not name or number tests