procyberian/gimp
2
0
Fork 0
mirror of https://gitlab.gnome.org/GNOME/gimp.git synced 2025-07-03 17:33:25 +00:00
Code Issues 1 Projects 1 Releases Packages Wiki Activity Actions

ScriptFu: Test: maintenance, fix tests broken by changes to Gimp, add tests.

Browse source 
Fix tests broken by changes to gimp_data, wilber.png=>gimp-logo.png

Uncomment failing tests whose issue was fixed.

Remove calls to deprecated functions.

Make more test files use v3 binding script-fu-use-v3

Compare floats relatively by epsilon.

Add some missing tests.
This commit is contained in:
bootchk 2024-04-20 08:19:40 -04:00
parent a0d040bddc
commit 2914fd40ff
24 changed files with 571 additions and 346 deletions
Download patch file Download diff file Expand all files Collapse all files

35
plug-ins/script-fu/test/frameworks/testing.scm
View file

@ -411,7 +411,7 @@
(gimp-message (path-to-test-scripts filename))
(load (path-to-test-scripts filename)))
; Tell Gimp to load a test image
; Tell Gimp to load a test image by name
; Returns ID of image
; Knows installed image directory (not dedicated to testing but always there.)
; Accepts image suffixes that Gimp can load.
@ -421,9 +421,42 @@
; unpack ID via car
(car (gimp-file-load RUN-NONINTERACTIVE (path-to-test-images filename))))
; Tell Gimp to load a basic image always distributed with Gimp
; This hides the name of the file.
; Many tests use this, so you can temporarily change the file name
; and many tests will then use a different image.
; But some tests expect the image to have certain properties, like 256x256.
(define (testing:load-test-image-basic)
(testing:load-test-image "gimp-logo.png"))
; Load a basic image while we are using v3 binding: no car
(define (testing:load-test-image-basic-v3)
(gimp-file-load RUN-NONINTERACTIVE (path-to-test-images "gimp-logo.png")))
; Returns path to file containing named color profile
; Currently, assumes color profiles downloaded to /work dir.
; FUTURE: platform indpendent path
; FUTURE: color profile test files in the repo
(define (testing:path-to-color-profile name)
(string-append "/work/" name))
; float comparison utility
; are a and b relatively equal, to within epsilon?
(define (equal-relative? a b epsilon)
(<= (abs (- a b))
(* epsilon (max (abs a) (abs b)))))
; graphical result utility
; When testing is in the GUI environment and not in batch mode,
; show an image result of testing.
; Now commented out.
; The PDB API has no predicate answering "can open display?"
(define (testing:show image)
;(gimp-display-new image)
)

53
plug-ins/script-fu/test/tests/PDB/channel/channel-attributes.scm
View file

@ -1,55 +1,63 @@
; Test get/set methods of Channel class of the PDB
(script-fu-use-v3)
; setup (not in an assert and not quoted)
; new, empty image
(define testImage (car (gimp-image-new 21 22 RGB)))
(define testImage (gimp-image-new 21 22 RGB))
(define testChannel (car (gimp-channel-new
(define testChannel
(gimp-channel-new
testImage ; image
23 24 ; width, height
"Test Channel" ; name
50.0 ; opacity
"red" ))) ; compositing color
"red" )) ; compositing color
(test! "insert-channel")
; new channel is not in image until inserted
(gimp-image-insert-channel
testImage
testChannel
(assert `(gimp-image-insert-channel
,testImage
,testChannel
0 ; parent, moot since channel groups not supported
0) ; position in stack
0)) ; position in stack
; tests
(test! "set/get channel attributes")
; color
(assert `(gimp-channel-set-color ,testChannel "red"))
; effective, getter returns same color: red
(assert `(equal?
(car (gimp-channel-get-color ,testChannel))
(gimp-channel-get-color ,testChannel)
'(255 0 0)))
; opacity
(assert `(gimp-channel-set-opacity ,testChannel 0.7))
; effective
(assert `(equal?
(car (gimp-channel-get-opacity ,testChannel))
0.7))
; numeric equality
; Compare floats to some fixed epsilon precision
; Otherwise, the test is fragile to changes in the tested code babl, gimp etc.
; Actual result is 0.7000000216
(assert `(equal-relative?
(gimp-channel-get-opacity ,testChannel)
0.7
0.0001))
; show-masked
(assert `(gimp-channel-set-show-masked ,testChannel TRUE))
; effective
(assert `(=
(car (gimp-channel-get-show-masked ,testChannel))
TRUE))
; procedure returns boolean, #t
(assert `(gimp-channel-get-show-masked ,testChannel))
; item methods applied to channel
(test! "item methods applied to channel")
; gimp-channel-set-name is deprecated
; gimp-channel-set-visible is deprecated
@ -59,21 +67,22 @@
(assert `(gimp-item-set-name ,testChannel "New Name"))
; effective
(assert `(string=?
(car (gimp-item-get-name ,testChannel))
(gimp-item-get-name ,testChannel)
"New Name"))
; visible
(assert `(gimp-item-set-visible ,testChannel FALSE))
; effective
(assert `(=
(car (gimp-item-get-visible ,testChannel))
FALSE))
; procedure returns boolean #f
(assert `(not (gimp-item-get-visible ,testChannel)))
; tattoo
(assert `(gimp-item-set-tattoo ,testChannel 999))
; effective
(assert `(=
(car (gimp-item-get-tattoo ,testChannel))
(gimp-item-get-tattoo ,testChannel)
999))
; TODO other item methods
(script-fu-use-v2)

8
plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm
View file

@ -35,8 +35,9 @@
(assert `(equal?
(car (gimp-channel-get-color ,testChannel))
'(255 0 0))) ; red
; gimp-channel-get-name is deprecated
(assert `(string=?
(car (gimp-channel-get-name ,testChannel))
(car (gimp-item-get-name ,testChannel))
"Test Channel"))
@ -80,7 +81,8 @@
(assert-PDB-false `(gimp-item-id-is-channel ,testChannel))
; Delete throws error when channel already removed
(assert-error `(gimp-channel-delete ,testChannel)
; gimp-channel-delete is deprecated
(assert-error `(gimp-item-delete ,testChannel)
"runtime: invalid item ID" )
@ -96,7 +98,7 @@
"red" ))) ; compositing color
; Does not throw
(assert `(gimp-channel-delete ,testChannel2))
(assert `(gimp-item-delete ,testChannel2))
; Effective: ID is not valid
(assert-PDB-false `(gimp-item-id-is-channel ,testChannel))

5
plug-ins/script-fu/test/tests/PDB/channel/channel-ops.scm
View file

@ -82,7 +82,7 @@
; channel stack ordering operations
(test! "channel stack ordering operations")
; The first created channel is at the bottom of the two
; The second created channel is initially at top
@ -99,7 +99,8 @@
"Procedure execution of gimp-image-raise-item failed: Channel cannot be raised higher.")
; Can be lowered
(assert `(gimp-image-lower-channel ,testImage ,testChannel))
; gimp-image-lower-channel is deprecated
(assert `(gimp-image-lower-item ,testImage ,testChannel))
; TODO test effectiveness by checking position now

23
plug-ins/script-fu/test/tests/PDB/drawable/drawable-ops.scm
View file

@ -3,16 +3,19 @@
; operations change pixels of the drawable without reference to other objects,
; or with passed non-drawable args such as curves
; So that #t binds to boolean arg to PDB
(script-fu-use-v3)
; setup
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
; Wilber has one layer
; cadr is vector, first element is a drawable
(define testDrawable (vector-ref (cadr (gimp-image-get-layers testImage)) 0))
(test! "drawable operations")
; tests in alphabetic order
@ -22,19 +25,20 @@
(assert `(gimp-drawable-colorize-hsl ,testDrawable 360 50 -50))
; TODO requires vector of size 256
; (assert `(gimp-drawable-curves-explicit ,testDrawable HISTOGRAM-RED 2 #(1 2)))
; requires vector of size 256 of floats
(assert `(gimp-drawable-curves-explicit ,testDrawable HISTOGRAM-RED
256 (make-vector 256 1.0)))
;(assert `(gimp-drawable-curves-spline ,testDrawable DESATURATE-LUMA))
; two pairs of float control points of a spline, four floats in total
(assert `(gimp-drawable-curves-spline ,testDrawable HISTOGRAM-RED 4 #(0 0 25.0 25.0) ))
(assert `(gimp-drawable-desaturate ,testDrawable DESATURATE-LUMA))
(assert `(gimp-drawable-equalize ,testDrawable 1)) ; boolean mask-only
;(assert `(gimp-drawable-extract-component ,testDrawable DESATURATE-LUMA))
(assert `(gimp-drawable-extract-component ,testDrawable SELECT-CRITERION-HSV-SATURATION #t #t))
; FIXME crashes
;(assert `(gimp-drawable-fill ,testDrawable FILL-CIELAB-MIDDLE-GRAY))
(assert `(gimp-drawable-fill ,testDrawable FILL-CIELAB-MIDDLE-GRAY))
(assert `(gimp-drawable-foreground-extract ,testDrawable FOREGROUND-EXTRACT-MATTING ,testDrawable))
@ -69,5 +73,6 @@
(assert `(gimp-drawable-desaturate ,testDrawable DESATURATE-LUMA))
(assert `(gimp-drawable-desaturate ,testDrawable DESATURATE-LUMA))
(gimp-display-new testImage)
(testing:show testImage)
(script-fu-use-v2)

10
plug-ins/script-fu/test/tests/PDB/drawable/drawable.scm
View file

@ -30,11 +30,11 @@
2147483648 2147483648 ; width height of region
))
; FIXME: throws CRITICAL but doesn't crash
(assert `(gimp-drawable-merge-shadow
,testDrawable
1 ; push merge to undo stack
))
; FIXME: throws CRITICAL and sometimes crashes
;(assert `(gimp-drawable-merge-shadow
; ,testDrawable
; 1 ; push merge to undo stack
; ))
(assert `(gimp-drawable-offset
,testDrawable

43
plug-ins/script-fu/test/tests/PDB/edit/buffer.scm
View file

@ -5,18 +5,20 @@
; 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
; E.G. gimp-edit-named-copy might be better named: "edit-copy-to-named-buffer"
; The API has no method to determine if the clipboard is empty
; buffers-get-list only gets the named buffers
; Prereq: no buffer exists yet.
(script-fu-use-v3)
; setup
; Load test image that already has drawable
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
; the layer is the zeroeth element in the vector which is the second element
; but cadr returns the second element!!
@ -25,69 +27,72 @@
(define testDrawable (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
; Create new named buffer
(test! "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
(define testBuffer (gimp-edit-named-copy
1
(make-vector 1 testDrawable)
"bufferName")))
"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 ""))
(assert `(string=? (car (gimp-buffers-get-list ""))
"bufferName"))
; buffer has same size as image when created with no selection
; test image is 128x128
(assert `(= (car (gimp-buffer-get-width "bufferName"))
(assert `(= (gimp-buffer-get-width "bufferName")
128))
(assert `(= (car (gimp-buffer-get-height "bufferName"))
(assert `(= (gimp-buffer-get-height "bufferName")
128))
; 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"))
(assert `(= (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"))
(assert `(= (gimp-buffer-get-image-type "bufferName")
RGBA-IMAGE))
; renaming
(test! "buffer-rename")
; Renaming returns the given name if it doesn't clash with existing name.
(assert `(string=? (car (gimp-buffer-rename "bufferName" "renamedName"))
(assert `(string=? (gimp-buffer-rename "bufferName" "renamedName")
"renamedName"))
; Effect renaming: gimp knows the renamed name
(assert `(string=? (caar (gimp-buffers-get-list ""))
(assert `(string=? (car (gimp-buffers-get-list ""))
"renamedName"))
; Renaming does not add another buffer
; TODO list-length 1
(assert `(= (length (gimp-buffers-get-list ""))
1))
; deleting
(test! "buffer-delete")
; 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 ""))))
(assert `(null? (gimp-buffers-get-list "")))
; TODO test two buffers
; TODO test renaming when name already in use
(script-fu-use-v2)

55
plug-ins/script-fu/test/tests/PDB/edit/edit-multi-layer.scm
View file

@ -9,21 +9,24 @@
; - no selection
(script-fu-use-v3)
; setup
; Load test image that already has drawable
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
(assert `(= (gimp-image-get-width ,testImage)
128))
; Add a layer
(define testLayer2
(car (gimp-layer-new
(define testLayer2 (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL)))
LAYER-MODE-NORMAL))
; Insert new layer
(assert `(gimp-image-insert-layer
,testImage
@ -38,11 +41,13 @@
; capture a ref to the first layer
(define testLayer (vector-ref testLayers 0))
; check the image has two layers
(test! "insert layer was effective")
; the image has two layers
(assert `(= (car (gimp-image-get-layers ,testImage))
2))
; check our local list of layers is length 2
; our local list of layers is length 2
(assert `(= (vector-length ,testLayers)
2))
@ -51,17 +56,21 @@
; tests
; copy when no selection
(test! "copy when no selection")
; copy returns true when no selection and copies entire drawables
; FIXME this should fail? the passed length does not match the length of list
; copy first of two
(assert-PDB-true `(gimp-edit-copy 1 ,testLayers))
; returns #t in v3 binding
(assert `(gimp-edit-copy
1 ; how many to copy
,testLayers))
; copy both of two
(assert-PDB-true `(gimp-edit-copy 2 ,testLayers))
(assert `(gimp-edit-copy 2 ,testLayers))
(test! "paste with clip of two layers")
; paste when:
; - clip is not empty
; - clip has two layers
@ -79,12 +88,13 @@
(assert `(= (car (gimp-image-get-layers ,testImage))
4))
; the new layers were pasted centered at (0,0)
; the new layers are partially off the canvas
; The new layers were pasted centered at (0,0)
; The new layers are partially off the canvas.
; The image i.e. canvas is NOT larger now
(assert `(= (car (gimp-image-get-width ,testImage))
256))
; Original test image was 128
(assert `(= (gimp-image-get-width ,testImage)
128))
; !!! Note that some layers, when selected,
; might not be visible, since the scrollbars are on the current canvas
; not the size of the bounding box of all the layers.
@ -96,36 +106,43 @@
(test! "paste off canvas layers")
; test pasting into a layer whose origin is off the canvas
; don't resize and then paste into the new layer that is off canvas.
; the clip still has two layers
; get reference to one of the new layers
; Get reference to one of the new layers
; it is top of stack, the first element in the vector of layers
(define testOffCanvasLayer (vector-ref (cadr (gimp-image-get-layers testImage))
0))
; returns (2 <vector>)
(assert `(= (car (gimp-edit-paste
,testOffCanvasLayer
TRUE)) ; paste-into
2))
; The image now has six layers, extending to the upper left.
(assert `(gimp-image-resize-to-layers ,testImage))
(assert `(= (car (gimp-image-get-width ,testImage))
490))
; ??? TODO I don't understand this test nor the results
(assert `(= (gimp-image-get-width ,testImage)
234))
; copy-visible when image has many layers
; only puts one layer on clip
(assert-PDB-true `(gimp-edit-copy-visible ,testImage))
; returns #t
(assert `(gimp-edit-copy-visible ,testImage))
; TODO get the clipboard and check its size
; TODO this tested elsewhere
; paste when:
; - clip is not empty
; - clip has one layers
; - no selection
; returns the pasted layers, a vector of length one
; returns (1 <vector>) a vector of length one
(assert `(= (car (gimp-edit-paste
,testLayer
TRUE)) ; paste-into
@ -142,3 +159,5 @@
; for debugging individual test file:
;(gimp-display-new testImage)
(script-fu-use-v2)

106
plug-ins/script-fu/test/tests/PDB/edit/edit.scm
View file

@ -9,10 +9,12 @@
; are not in the PDB
(script-fu-use-v3)
; setup
; Load test image that already has drawable
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
; get all the root layers
; testImage has exactly one root layer.
@ -27,7 +29,21 @@
; So these tests might not pass when you run this test file
; in the wrong order.
; paste
(test! "named-copy")
(define testBuffer (gimp-edit-named-copy
1
(make-vector 1 testLayer)
"testBufferName"))
; There is one named buffer
(assert `(= (length (gimp-buffers-get-list "")) 1))
(test! "paste")
; ordinary paste is to a drawable
@ -41,18 +57,19 @@
; paste-as-new-image returns NULL image when clipboard empty
; paste-as-new is deprecated
(assert `(= (car (gimp-edit-paste-as-new-image))
(assert `(= (gimp-edit-paste-as-new-image)
-1)) ; the NULL ID
; named-paste-as-new-image returns a new image
(assert `(gimp-image-id-is-valid (gimp-edit-named-paste-as-new-image "testBufferName")))
; copy
(test! "copy")
; copy when:
; - no selection
; - image has one drawable
; - one drawable is passed
; returns true and clip has one drawable
(assert-PDB-true `(gimp-edit-copy 1 ,testLayers))
(assert `(gimp-edit-copy 1 ,testLayers))
; paste when clipboard is not empty returns a vector of length one
(assert `(= (car (gimp-edit-paste
@ -65,37 +82,51 @@
; !!! this is not what happens in the GUI, the pasted layer is NOT floating
; The pasted layer is floating
(assert-PDB-true `(gimp-layer-is-floating-sel ,testPastedLayer))
(assert `(gimp-layer-is-floating-sel ,testPastedLayer))
(test! "copy-visible")
; copy-visible takes only an image
; it puts one drawable on clip
(assert-PDB-true `(gimp-edit-copy-visible ,testImage))
(assert `(gimp-edit-copy-visible ,testImage))
(test! "named-paste")
; There is one named buffer
(assert `(= (length (gimp-buffers-get-list "")) 1))
; named-paste returns just the floating sel
(assert `(gimp-edit-named-paste
,testLayer
"testBufferName"
#f)) ; paste-into
(test! "paste into")
; paste when clipboard is not empty returns a vector of length one
; returns (1 #(x))
(assert `(= (car (gimp-edit-paste ,testLayer TRUE)) ; paste-into
1))
; The first pasted floating layer was anchored (merged into) first layer
; The ID of the floating sel is now invalid
(assert-PDB-false `(gimp-item-id-is-valid ,testPastedLayer))
(assert `(not (gimp-item-id-is-valid ,testPastedLayer)))
; Can't do this, it throws CRITICAL
;(assert-error `(gimp-layer-is-floating-sel ,testPastedLayer)
; "Procedure")
; There are now two layers
(assert `(= (car (gimp-image-get-layers ,testImage))
2))
(assert `(= (car (gimp-image-get-layers ,testImage)) 2))
(define testPastedLayer2 (vector-ref (cadr (gimp-image-get-layers testImage))
0))
; the new layer is now floating.
(assert-PDB-true `(gimp-layer-is-floating-sel ,testPastedLayer2))
(assert `(gimp-layer-is-floating-sel ,testPastedLayer2))
@ -109,9 +140,46 @@
; TODO test paste-into FALSE
; TODO test cut
(test! "edit-cut when selection")
; setup, create a selection
(assert `(gimp-selection-all ,testImage))
(assert `(not (gimp-selection-is-empty ,testImage)))
(assert `(gimp-edit-cut 1 (make-vector 1 (vector-ref ,testLayers 0))))
; There are still two layers
(assert `(= (car (gimp-image-get-layers ,testImage)) 2))
; !!! No API method is-clipboard-empty
(test! "edit-named-cut when selection")
(assert `(gimp-edit-named-cut 1 (make-vector 1 (vector-ref ,testLayers 0)) "testbufferName2"))
; There are still two layers
(assert `(= (car (gimp-image-get-layers ,testImage)) 2))
; There is two named buffer
(assert `(= (length (gimp-buffers-get-list ""))
2))
(test! "cut when no selection")
; setup, delete selection
(assert `(gimp-selection-none ,testImage))
(assert `(gimp-selection-is-empty ,testImage))
; cut when no selection cuts given layers out of image
; Cut one of two layers.
; returns #t when succeeds
(assert `(gimp-edit-cut 1 (make-vector 1 (vector-ref ,testLayers 0))))
; effective: count layers now 0
; FIXME, the count of layers should be 1, since we cut only one of 2
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
; TODO test cross image paste, of different modes
@ -123,10 +191,8 @@
; TODO
; for debugging individual test file
(testing:show testImage)
; for debugging individual test file:
(gimp-display-new testImage)
(script-fu-use-v2)

44
plug-ins/script-fu/test/tests/PDB/image/image-ops.scm
View file

@ -4,11 +4,14 @@
; For paint operations (changing a subset of the image) see paint.scm
(script-fu-use-v3)
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
(define testImage (gimp-image-new 21 22 RGB))
; transformations
(test! "image transformations")
; flip
(assert `(gimp-image-flip ,testImage ORIENTATION-HORIZONTAL))
@ -39,16 +42,15 @@
; but then seems to slow down testing
; unless we scale down afterwards.
; This seems glacial if not scaled to 1,1 prior.
; FIXME commented out, crashes with:
; (gimp-2.99:129): GLib-GObject-CRITICAL **: 13:19:28.145:
; value "524288.000000" of type 'gdouble' is invalid or out of range for property 'x' of type 'gdouble'
; FIXME throws GLib-GObject-CRITICAL value "524288.000000" of type 'gdouble'
; is invalid or out of range for property 'x' of type 'gdouble'
; but docs say 524288 is the max
; (assert `(gimp-image-scale ,testImage 524288 524288))
; down to min does not throw
(assert `(gimp-image-scale ,testImage 1 1))
; effective
(assert `(= (car (gimp-image-get-height ,testImage))
(assert `(= (gimp-image-get-height ,testImage)
1))
; Note there is no get-size, only get-height and width, the origin is always (0,0)
@ -58,23 +60,32 @@
30 30 ; width height
0 0)) ; offset
; effective
(assert `(= (car (gimp-image-get-height ,testImage))
(assert `(= (gimp-image-get-height ,testImage)
30))
; resize to layers when image is empty of layers does not throw
(assert `(gimp-image-resize-to-layers ,testImage))
; not effective: height remains the same
; effective
(assert `(= (car (gimp-image-get-height ,testImage))
(assert `(= (gimp-image-get-height ,testImage)
30))
; TODO resize to layers when there is a layer smaller than canvas
; TODO crop
; TODO policy
; policy ops
; TODO crops that are plugins plug-in-zealouscrop et al
(test! "crop")
(assert `(gimp-image-crop ,testImage
2 2 ; width height
2 2 ; x y offset
))
(test! "image transformation by policy ops")
; These perform operations (convert or rotate) using a policy in preferences
; 0 means non-interactive, else shows dialog in some cases
@ -84,7 +95,8 @@
; freezing and unfreezing (avoid updates to dialogs)
(test! "freezing and unfreezing (avoid updates to dialogs)")
; Used for performance.
(assert `(gimp-image-freeze-channels ,testImage))
(assert `(gimp-image-freeze-layers ,testImage))
@ -93,13 +105,15 @@
(assert `(gimp-image-thaw-layers ,testImage))
(assert `(gimp-image-thaw-vectors ,testImage))
; clean-all makes image not dirty
(test! "clean-all makes image not dirty")
(assert `(gimp-image-clean-all ,testImage))
(assert-PDB-false `(gimp-image-is-dirty ,testImage))
(assert `(not (gimp-image-is-dirty ,testImage)))
; TODO test flatten is effective
; flatten is tested in layer-ops.scm
; cannot flatten empty image
(assert-error `(gimp-image-flatten ,testImage)
"Procedure execution of gimp-image-flatten failed: Cannot flatten an image without any visible layer.")
(script-fu-use-v2)

66
plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm
View file

@ -4,34 +4,47 @@
; but the methods are named strangely,
; e.g. there is no gimp-layer-mask-get-layer
; gimp-layer-mask is deprecated
(script-fu-use-v3)
; setup
;
(define testImage (car (gimp-image-new 21 22 RGB)))
(define testImage (gimp-image-new 21 22 RGB))
(define
testLayer (car (gimp-layer-new
(define testLayer (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL)))
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)))
(test! "layer-create-mask")
(define
testLayerMask (gimp-layer-create-mask
testLayer
ADD-MASK-WHITE))
; assert layerMask not on the layer yet!!!
; mask is not on layer until added.
; Getting the mask for the layer yields -1.
(assert `(= (car (gimp-layer-mask ,testLayer))
(assert `(= (gimp-layer-get-mask ,testLayer)
-1))
; ID is-a layerMask
(assert `(gimp-item-id-is-layer-mask ,testLayerMask))
(test! "layer-add-mask")
; add layerMask created on a layer to that layer succeeds
(assert `(gimp-layer-add-mask
,testLayer
@ -39,23 +52,22 @@
; add layerMask to layer was effective:
; Getting the mask for the layer yields layerMask ID
(assert `(= (car (gimp-layer-mask ,testLayer))
(assert `(= (gimp-layer-get-mask ,testLayer)
,testLayerMask))
; and vice versa
(assert `(= (car (gimp-layer-from-mask ,testLayerMask))
(assert `(= (gimp-layer-from-mask ,testLayerMask)
,testLayer))
; creating and adding second mask
(test! "creating and adding second mask")
; creating a second mask from layer succeeds
(define
testLayerMask2
(car (gimp-layer-create-mask
(define testLayerMask2
(gimp-layer-create-mask
testLayer
ADD-MASK-WHITE)))
ADD-MASK-WHITE))
; adding a second layerMask fails
@ -68,7 +80,7 @@
; mask removal
(test! "remove-mask")
; remove-mask fails if the layer is not on image
(assert-error `(gimp-layer-remove-mask
@ -84,15 +96,14 @@
0 ; parent
0 )) ; position within parent
; remove-mask succeeds
; when layer is in image
; remove-mask succeeds when layer is in image
(assert `(gimp-layer-remove-mask
,testLayer
MASK-APPLY)) ; removal mode
; and is effective
; layer no longer has a mask
(assert `(= (car (gimp-layer-mask ,testLayer))
(assert `(= (gimp-layer-get-mask ,testLayer)
-1))
; and now we can add the second mask
@ -101,10 +112,21 @@
,testLayerMask2))
(test! "variations of layer-create-mask")
; fails when mask different size from layer?
; fails create layerMask when ADD-CHANNEL-MASK and no active channel
(assert-error `(gimp-layer-create-mask
,testLayer
ADD-MASK-CHANNEL)
"Procedure execution of gimp-layer-create-mask failed")
; create layerMask ADD-ALPHA-MASK works even when no alpha channel
(assert `(gimp-layer-create-mask
,testLayer
ADD-MASK-ALPHA))
; TODO many variations of create
(script-fu-use-v2)

59
plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm
View file

@ -1,95 +1,92 @@
; test Layer methods of PDB
(script-fu-use-v3)
; setup
(define testImage (gimp-image-new 21 22 RGB))
(define testImage (car (gimp-image-new 21 22 RGB)))
(define testLayer
(car (gimp-layer-new
(define testLayer (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL)))
LAYER-MODE-NORMAL))
; new layer is not in the image until inserted
(test! "new layer is not in the image until inserted")
; returns (length, list), check length is 0
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
; attributes of new layer
(test! "attributes of new layer")
; defaulted attributes
; apply-mask default false
(assert-PDB-false `(gimp-layer-get-apply-mask ,testLayer))
(assert `(not (gimp-layer-get-apply-mask ,testLayer)))
; blend-space default LAYER-COLOR-SPACE-AUTO
(assert `(=
(car (gimp-layer-get-blend-space ,testLayer))
(assert `(= (gimp-layer-get-blend-space ,testLayer)
LAYER-COLOR-SPACE-AUTO))
; composite-mode default LAYER-COMPOSITE-AUTO
(assert `(=
(car (gimp-layer-get-composite-mode ,testLayer))
(assert `(= (gimp-layer-get-composite-mode ,testLayer)
LAYER-COMPOSITE-AUTO))
; composite-space default LAYER-COLOR-SPACE-AUTO
(assert `(=
(car (gimp-layer-get-composite-space ,testLayer))
(assert `(= (gimp-layer-get-composite-space ,testLayer)
LAYER-COLOR-SPACE-AUTO))
; edit-mask default false
(assert-PDB-false `(gimp-layer-get-edit-mask ,testLayer))
(assert `(not (gimp-layer-get-edit-mask ,testLayer)))
; lock-alpha default false
; deprecated? gimp-layer-get-preserve-trans
(assert-PDB-false `(gimp-layer-get-lock-alpha ,testLayer))
(assert `(not (gimp-layer-get-lock-alpha ,testLayer)))
; mask not exist, ID -1
; deprecated? gimp-layer-mask
(assert `(=
(car (gimp-layer-get-mask ,testLayer))
; gimp-layer-mask is deprecated
(assert `(= (gimp-layer-get-mask ,testLayer)
-1))
; mode default LAYER-MODE-NORMAL
(assert `(=
(car (gimp-layer-get-mode ,testLayer))
(assert `(= (gimp-layer-get-mode ,testLayer)
LAYER-MODE-NORMAL))
; show-mask default false
(assert-PDB-false `(gimp-layer-get-show-mask ,testLayer))
(assert `(not (gimp-layer-get-show-mask ,testLayer)))
; visible default true
; FIXME doc says default false
(assert-PDB-true `(gimp-layer-get-visible ,testLayer))
; gimp-layer-get-visible is deprecated.
(assert `(gimp-item-get-visible ,testLayer))
; is-floating-sel default false
(assert-PDB-false `(gimp-layer-is-floating-sel ,testLayer))
(assert `(not (gimp-layer-is-floating-sel ,testLayer)))
; !!! No get-offsets
; attributes are as given when created
(test! "new layer attributes are as given when created")
; name is as given
(assert `(string=? (car (gimp-layer-get-name ,testLayer))
; gimp-layer-get-name is deprecated
(assert `(string=? (gimp-item-get-name ,testLayer)
"LayerNew"))
; opacity is as given
(assert `(=
(car (gimp-layer-get-opacity ,testLayer))
(assert `(= (gimp-layer-get-opacity ,testLayer)
50.0))
@ -97,12 +94,14 @@
; tattoo
; tattoo is generated unique within image?
(assert `(=
(car (gimp-layer-get-tattoo ,testLayer))
; gimp-layer-get-tattoo is deprecated
(assert `(= (gimp-item-get-tattoo ,testLayer)
2))
(script-fu-use-v2)

40
plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm
View file

@ -2,23 +2,26 @@
; where methods are operations
(script-fu-use-v3)
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
(define testImage (gimp-image-new 21 22 RGB))
(define
testLayer (car (gimp-layer-new
(define testLayer (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew#2"
50.0
LAYER-MODE-NORMAL)))
LAYER-MODE-NORMAL))
; assert layer is not inserted in image
; errors when layer not in image
(test! "errors when layer not in image")
; resize fails
(assert-error `(gimp-layer-resize ,testLayer 23 24 0 0)
@ -34,10 +37,9 @@
"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
; UNTESTED gimp-layer-resize-to-image-size fails when layer not in image
; gimp-layer-remove-mask fails when layer has no mask
; gimp-layer-remove-mask fails when layer not in image
(assert-error `(gimp-layer-remove-mask
,testLayer
MASK-APPLY)
@ -54,27 +56,29 @@
; and is effective
; Note method on superclass Drawable
(assert `(= (car (gimp-drawable-has-alpha ,testLayer))
1))
; returns #t
(assert `(gimp-drawable-has-alpha ,testLayer))
; flatten succeeds
(assert `(gimp-layer-flatten ,testLayer))
; flatten was effective: no longer has alpha
; flatten a layer means "remove alpha"
(assert `(= (car (gimp-drawable-has-alpha ,testLayer))
0))
; returns #f
(assert `(not (gimp-drawable-has-alpha ,testLayer)))
; delete
(test! "layer-delete")
; delete succeeds
(assert `(gimp-layer-delete ,testLayer))
; gimp-layer-delete is deprecated
; succeeds
(assert `(gimp-item-delete ,testLayer))
; delete second time fails
(assert-error `(gimp-layer-delete ,testLayer)
(assert-error `(gimp-item-delete ,testLayer)
"runtime: invalid item ID")
; Error for flatten:
@ -82,7 +86,5 @@
; "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
(script-fu-use-v2)

32
plug-ins/script-fu/test/tests/PDB/paint/paint-methods.scm
View file

@ -4,14 +4,15 @@
; then painting (stroking) with it.
(script-fu-use-v3)
; setup
; an image, drawable, and path
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
(define testLayer (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
(define testPath (car (gimp-vectors-new testImage "Test Path")))
(define testPath (gimp-vectors-new testImage "Test Path"))
; must add to image
(gimp-image-insert-vectors
testImage
@ -27,14 +28,16 @@
; paint-methods are introspectable to a list
(test! "paint-methods are introspectable to a list of strings")
(assert `(list? (gimp-context-list-paint-methods)))
; setup
(define paintMethods (gimp-context-list-paint-methods))
; TODO
; test their names all have "gimp-" prefix and lower case.
; Test that every returned name is valid to set on the context
(define paintMethods (car (gimp-context-list-paint-methods)))
; TODO this doesn't seem to work: illegal function
; Probably the assert wrapper screws something up
; (assert `(map gimp-context-set-paint-method ,paintMethods))
@ -42,12 +45,12 @@
; paint-method get/set on context
(test! "get/set paint-method on context")
(assert `(gimp-context-set-paint-method "gimp-ink"))
; getter succeeds and setter was effective
(assert `(string=? (car (gimp-context-get-paint-method))
(assert `(string=? (gimp-context-get-paint-method)
"gimp-ink"))
@ -59,30 +62,35 @@
; stroke a drawable along a path with the paint method
; (except some paintMethods not painted with)
; set context to stroke with paint (versus line)
(test! "set context to stroke with paint (versus line)")
(assert `(gimp-context-set-stroke-method STROKE-PAINT-METHOD))
; iterate over paintMethods, testing that they seem to work
(test! "iterate over paintMethods, loosely testing they seem to work")
; test function that paints a path using a paint method.
; paintMethod is string
(define (testPaintMethod paintMethod)
; Test that every paintMethod can be set on the context
; paintMethod can be set on the context
(gimp-context-set-paint-method paintMethod)
; Don't paint with paint methods that need a source image set
; The API does not have a way to set source image
; TODO this is still failing with "Set a source first"
(if (not (or
(string=? paintMethod "gimp-clone")
(string=? paintMethod "gimp-heal")
(string=? paintMethod "gimp-perspective-clone")))
(display paintMethod)
; paint with the method, under the test harness
(assert `(gimp-drawable-edit-stroke-item ,testLayer ,testPath))
(begin
(test! paintMethod)
(assert `(gimp-drawable-edit-stroke-item ,testLayer ,testPath)))
; else skip
(test! (string-append "Skipping: " paintMethod))
))
; apply testPaintMethod to each paintMethod
(for-each
testPaintMethod
paintMethods)
(script-fu-use-v2)

52
plug-ins/script-fu/test/tests/PDB/paint/paint.scm
View file

@ -62,7 +62,7 @@
; airbrush
(test! "airbrush")
(assert `(gimp-airbrush
,testLayer
@ -86,25 +86,25 @@
; clone
(test! "clone")
; where source and target are same.
; stroke coords in the target.
; FIXME crashes
;(assert `(gimp-clone
; ,testLayer ; affected i.e. target
; ,testLayer ; source
; CLONE-IMAGE ; clone type
; 1.0 1.0 ; source coord x,y is not a vector
; 2 ; num-strokes
; #(4.0 4.0))) ; float array
; FIXME throws GLib CRITICAL
(assert `(gimp-clone
,testLayer ; affected i.e. target
,testLayer ; source
CLONE-IMAGE ; clone type
1.0 1.0 ; source coord x,y is not a vector
2 ; num-strokes
#(4.0 4.0))) ; float array
; TODO CLONE-PATTERN
; eraser
(test! "eraser")
(assert `(gimp-eraser
,testLayer ; target
@ -121,18 +121,17 @@
; FIXME crashes
; heal
;(assert `(gimp-heal
; ,testLayer ; affected i.e. target
; ,testLayer ; source
; 1.0 1.0 ; source coord x,y is not a vector
; 2 ; num-strokes
; #(4.0 4.0))) ; float array
(test! "heal")
; FIXME throws GLib CRITICAL "has no property named 'src-x'"
(assert `(gimp-heal
,testLayer ; affected i.e. target
,testLayer ; source
1.0 1.0 ; source coord x,y is not a vector
2 ; num-strokes
#(4.0 4.0))) ; float array
; convolve
(test! "convolve")
(assert `(gimp-convolve
,testLayer ; affected i.e. target
99.9999999999 ; pressure
@ -141,8 +140,7 @@
#(4.0 4.0))) ; float array
; dodgeburn
(test! "dodgeburn")
(assert `(gimp-dodgeburn
,testLayer ; affected i.e. target
66.0 ; exposure
@ -157,7 +155,7 @@
; smudge
(test! "smudge")
(assert `(gimp-smudge
,testLayer ; affected i.e. target
0.0 ; pressure
@ -174,11 +172,11 @@
; In alphabetic order
(test-paint-op-default gimp-airbrush-default)
; FIXME crashes
;(test-paint-op-default gimp-clone-default)
(test-paint-op-default gimp-convolve-default)
(test-paint-op-default gimp-dodgeburn-default)
; FIXME crashes
; FIXME fails "Set a source image first"
; The API has no way to set the source image
;(test-paint-op-default gimp-clone-default)
;(test-paint-op-default gimp-heal-default)
(test-paint-op-default gimp-paintbrush-default)
; !!! gimp-pencil is not named gimp-pencil-default

3
plug-ins/script-fu/test/tests/PDB/pdb.scm
View file

@ -83,7 +83,8 @@
; test methods on PDBProcedure
(testing:load-test "procedures.scm")
(testing:load-test "display.scm")
; Only run when not headless
; (testing:load-test "display.scm")
; TODO undo
; TODO progress

23
plug-ins/script-fu/test/tests/PDB/pixel.scm
View file

@ -26,15 +26,15 @@
; Setup
(define testImage (testing:load-test-image "wilber.png"))
; wilber.png has one layer
(define testImage (testing:load-test-image-basic))
; image has one layer
(define testDrawable (vector-ref (cadr (gimp-image-get-layers testImage)) 0))
(define testImageGray (testing:load-test-image "wilber.png"))
(define testImageGray (testing:load-test-image-basic))
(gimp-image-convert-grayscale testImageGray)
(define testDrawableGray (vector-ref (cadr (gimp-image-get-layers testImageGray)) 0))
(define testImageIndexed (testing:load-test-image "wilber.png"))
(define testImageIndexed (testing:load-test-image-basic))
(gimp-image-convert-indexed
testImageIndexed
CONVERT-DITHER-NONE
@ -48,13 +48,15 @@
; RGBA image
(test! "get-pixel of RGBA image")
; returned pixel of image of mode RGBA is missing alpha component
; Test is fragile to chosen testImage.
; Formerly: (71 71 71)
(assert `(equal? (car (gimp-drawable-get-pixel ,testDrawable 1 1))
'(71 71 71)))
'(0 0 0)))
; Can set a pixel in RGBA image from a 3 component list.
(test! "set-pixel of RGBA image from a 3 component list.")
; ScriptFu sets alpha to opaque.
(assert `(gimp-drawable-set-pixel ,testDrawable 1 1 '(2 2 2)))
; effective
@ -67,12 +69,12 @@
; GRAY image
(test! "get-pixel of GRAY image")
; returned pixel of image of mode GRAY has extra components
; You might think it only has one component.
(assert `(equal? (car (gimp-drawable-get-pixel ,testDrawableGray 1 1))
'(71 71 71)))
'(0 0 0)))
; Can set a pixel in GRAY image from a 3 component list.
; You might think it only takes component
@ -86,7 +88,8 @@
; GRAYA TODO
; INDEXED image
(test! "get-pixel of INDEXED image")
; pixel of image of mode INDEXED has extra components
; FIXME this crashes in babl_fatal
;(assert `(equal? (car (gimp-drawable-get-pixel ,testDrawableIndexed 1 1))

60
plug-ins/script-fu/test/tests/PDB/resource/brush.scm
View file

@ -8,12 +8,16 @@
; In future, will be possible to create new brush with same name as existing?
; new
; !!! Less car's.
; Restored at end of this script
(script-fu-use-v3)
(test! "brush-new")
; new succeeds
; setup, not an assert
(define testNewBrush (car (gimp-brush-new "TestBrushNew")))
(define testNewBrush (gimp-brush-new "TestBrushNew"))
; a resource is an int ID in ScriptFu
(assert `(number? ,testNewBrush))
@ -21,56 +25,55 @@
; new returns brush of given name
; note call superclass method
(assert `(string=?
(car (gimp-resource-get-name ,testNewBrush))
(gimp-resource-get-name ,testNewBrush)
"TestBrushNew"))
; attributes of new brush
(test! "attributes of new brush")
; new brush is kind generated versus raster
(assert `(= (car (gimp-brush-is-generated ,testNewBrush))
1))
(assert `(gimp-brush-is-generated ,testNewBrush))
; angle default is 0
(assert `(=
(car (gimp-brush-get-angle ,testNewBrush))
(gimp-brush-get-angle ,testNewBrush)
0))
; aspect-ratio default is 1.0
; FIXME: the doc says 0.0
(assert `(=
(car (gimp-brush-get-aspect-ratio ,testNewBrush))
(gimp-brush-get-aspect-ratio ,testNewBrush)
1.0))
; hardness default is 0.5
; FIXME: the doc says 0
(assert `(=
(car (gimp-brush-get-hardness ,testNewBrush))
(gimp-brush-get-hardness ,testNewBrush)
0.5))
; shape default is GENERATED-CIRCLE
(assert `(=
(car (gimp-brush-get-shape ,testNewBrush))
(gimp-brush-get-shape ,testNewBrush)
BRUSH-GENERATED-CIRCLE))
; spikes default is 2
; FIXME: docs says 0
(assert `(=
(car (gimp-brush-get-spikes ,testNewBrush))
(gimp-brush-get-spikes ,testNewBrush)
2))
; get-radius default 5.0
; FIXME: docs says 0
(assert `(=
(car (gimp-brush-get-radius ,testNewBrush))
(gimp-brush-get-radius ,testNewBrush)
5.0))
; spacing default 20
; FIXME: docs says 0
(assert `(=
(car (gimp-brush-get-spacing ,testNewBrush))
(gimp-brush-get-spacing ,testNewBrush)
20))
; get-info returns a list of attributes
@ -85,16 +88,15 @@
; delete
(test! "resource-delete")
; can delete a new brush
; PDB returns void, ScriptFu returns wrapped truth i.e. (#t)
(assert `(car (gimp-resource-delete ,testNewBrush)))
(assert `(gimp-resource-delete ,testNewBrush))
; delete was effective
; ID is now invalid
(assert `(= (car (gimp-resource-id-is-valid ,testNewBrush))
0))
(assert `(not (gimp-resource-id-is-valid ,testNewBrush)))
@ -103,7 +105,7 @@
; Brush named "z Pepper" is non-generated and is a system brush always installed
; setup, not an assert
(define testNongenBrush (car (gimp-resource-get-by-name "GimpBrush" "z Pepper")))
(define testNongenBrush (gimp-resource-get-by-name "GimpBrush" "z Pepper"))
; brush says itself is not generated
@ -121,16 +123,14 @@
; TODO all the other attributes
; Non-generated brush attributes
(test! "Non-generated brush attributes")
; is not generated
(assert `(=
(car (gimp-brush-is-generated ,testNongenBrush))
0))
(assert `(not (gimp-brush-is-generated ,testNongenBrush)))
; spacing
(assert `(=
(car (gimp-brush-get-spacing ,testNongenBrush))
(gimp-brush-get-spacing ,testNongenBrush)
100))
; pixels returns a list of attributes
@ -146,6 +146,16 @@
; miscellaneous
(test! "brush-get-by-name on non-existent name")
; Formerly, returned a PDB error, now returns NULL i.e. ID -1
; 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")
;(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")
(assert `(= (gimp-brush-get-by-name "foo")
-1))
; !!! Restore
(script-fu-use-v2)

101
plug-ins/script-fu/test/tests/PDB/resource/palette.scm
View file

@ -8,21 +8,16 @@
; In future, will be possible to create new palette with same name as existing.
(script-fu-use-v3)
; setup, not assert
; but tests the -new method
(define testNewPalette (car (gimp-palette-new "testNewPalette")))
(define testNewPalette (gimp-palette-new "testNewPalette"))
; attributes of new palette
(test! "attributes of new palette")
; gimp-palette-get-background deprecated => gimp-context-get-background
; ditto foreground
@ -30,67 +25,62 @@
; new palette has given name
; !!! Fails if not a fresh install, then name is like "testNewPalette #2"
(assert `(string=?
(car (gimp-resource-get-name ,testNewPalette))
(gimp-resource-get-name ,testNewPalette)
"testNewPalette"))
; new palette has zero colors
(assert `(= (car (gimp-palette-get-color-count ,testNewPalette))
(assert `(= (gimp-palette-get-color-count ,testNewPalette)
0))
; new palette has empty colormap
; v2 returns (0 #())
; v3 returns (#())
(assert `(= (vector-length (car (gimp-palette-get-colors ,testNewPalette)))
; v3 returns #()
(assert `(= (vector-length (gimp-palette-get-colors ,testNewPalette))
0))
; new palette has zero columns
; (0 #())
(assert `(= (car (gimp-palette-get-columns ,testNewPalette))
(test! "new palette has zero columns")
; procedure returns just the column count
(assert `(= (gimp-palette-get-columns ,testNewPalette)
0))
; new palette is-editable
; method on Resource class
(assert `(= (car (gimp-resource-is-editable ,testNewPalette))
1))
(assert `(gimp-resource-is-editable ,testNewPalette))
; can set new palette in context
; Despite having empty colormap
; returns void
(assert `(gimp-context-set-palette ,testNewPalette))
; attributes of existing palette
(test! "attributes of existing palette named Bears")
; setup
(define testBearsPalette (car (gimp-palette-get-by-name "Bears")))
(define testBearsPalette (gimp-palette-get-by-name "Bears"))
; Max size palette is 256
; Bears palette has 256 colors
(assert `(= (car (gimp-palette-get-color-count ,testBearsPalette))
256))
; Bears palette colormap is size 256
; (256)
(assert `(= (car (gimp-palette-get-color-count ,testBearsPalette))
(assert `(= (gimp-palette-get-color-count ,testBearsPalette)
256))
; Bears palette colormap array is size 256 vector of 3-tuple lists
; v2 get_colors returns (256 #((8 8 8) ... ))
; v3 returns (#((8 8 8) ... ))
(assert `(= (vector-length (car (gimp-palette-get-colors ,testBearsPalette)))
; v3 returns #((8 8 8) ... )
(assert `(= (vector-length (gimp-palette-get-colors ,testBearsPalette))
256))
; Bears palette has zero columns
; (0 #())
(assert `(= (car (gimp-palette-get-columns ,testBearsPalette))
; Bears palette has zero column count
; The procedure returns a count, and not the columns
(assert `(= (gimp-palette-get-columns ,testBearsPalette)
0))
; system palette is not editable
(assert `(= (car (gimp-resource-is-editable ,testBearsPalette))
0))
; returns #f
(assert `(not (gimp-resource-is-editable ,testBearsPalette)))
; setting attributes of existing palette
@ -114,34 +104,36 @@
(assert `(gimp-palette-set-columns ,testNewPalette 1))
; effective
(assert `(= (car (gimp-palette-get-columns ,testNewPalette))
(assert `(= (gimp-palette-get-columns ,testNewPalette)
1))
; adding color "entry" to new palette
(test! "adding color entry to new palette")
; add first entry returns index 0
; result is wrapped (0)
(assert `(= (car (gimp-palette-add-entry ,testNewPalette "fooEntryName" "red"))
; v2 result is wrapped (0)
(assert `(= (gimp-palette-add-entry ,testNewPalette "fooEntryName" "red")
0))
; was effective: color is as given when entry created
(assert `(equal? (car (gimp-palette-entry-get-color ,testNewPalette 0))
; v3 returns (255 0 0)
(assert `(equal? (gimp-palette-entry-get-color ,testNewPalette 0)
(list 255 0 0))) ; red
; was effective on name
(assert `(equal? (car (gimp-palette-entry-get-name ,testNewPalette 0))
(assert `(string=? (gimp-palette-entry-get-name ,testNewPalette 0)
"fooEntryName"))
; delete colormap entry
(test! "delete colormap entry")
; succeeds
; FIXME: the name seems backward, could be entry-delete
; returns void
(assert `(gimp-palette-delete-entry ,testNewPalette 0))
; effective, color count is back to 0
(assert `(= (car (gimp-palette-get-color-count ,testNewPalette))
(assert `(= (gimp-palette-get-color-count ,testNewPalette)
0))
@ -154,22 +146,23 @@
; delete palette
(test! "delete palette")
; can delete a new palette
(assert `(gimp-resource-delete ,testNewPalette))
; delete was effective
; ID is now invalid
(assert `(= (car(gimp-resource-id-is-palette ,testNewPalette))
0))
(assert `(not (gimp-resource-id-is-palette ,testNewPalette)))
; delete was effective
; not findable by name anymore
; If the name DOES exist (because not started fresh) yields "substring out of bounds"
(assert-error `(gimp-palette-get-by-name "testNewPalette")
"Procedure execution of gimp-palette-get-by-name failed on invalid input arguments: Palette 'testNewPalette' not found")
; Formerly returned error, now returns NULL i.e. -1
;(assert-error `(gimp-palette-get-by-name "testNewPalette")
; "Procedure execution of gimp-palette-get-by-name failed on invalid input arguments: Palette 'testNewPalette' not found")
(assert `(= (gimp-palette-get-by-name "testNewPalette")
-1))
@ -183,14 +176,14 @@
; These should give warnings in Gimp Error Console.
; Now they are methods on Context, not Palette.
(gimp-palettes-set-palette testBearsPalette)
(gimp-palette-swap-colors)
(gimp-palette-set-foreground "pink")
(gimp-palette-set-background "purple")
;(gimp-palettes-set-palette testBearsPalette)
;(gimp-palette-swap-colors)
;(gimp-palette-set-foreground "pink")
;(gimp-palette-set-background "purple")
(script-fu-use-v2)

5
plug-ins/script-fu/test/tests/PDB/resource/resource-ops.scm
View file

@ -4,6 +4,8 @@
; This tests the generic methods named like gimp-resource-<op>
; !!! Using v3 binding, which we restore to v2 at the end of this file
; since subsequent test scripts expect v2
(script-fu-use-v3)
; setup
@ -91,3 +93,6 @@
; can delete a duplicated font
(assert `(gimp-resource-delete ,duplicatedSystemBrush))
(script-fu-use-v2)

7
plug-ins/script-fu/test/tests/PDB/selection/selection-by-shape.scm
View file

@ -2,7 +2,7 @@
; setup
(define testImage (testing:load-test-image "wilber.png"))
(define testImage (testing:load-test-image-basic))
(define testLayer (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
@ -16,9 +16,9 @@
; new image has no selection
(assert-PDB-true `(gimp-selection-is-empty ,testImage))
; but selection bounds equal bounds of image
; returns (0 0 0 256 256)
; returns (0 0 0 128 128)
(assert `(equal? (cdr (gimp-selection-bounds ,testImage))
'(0 0 256 256)))
'(0 0 128 128)))
@ -42,6 +42,7 @@
; polygon
; TODO

63
plug-ins/script-fu/test/tests/PDB/selection/selection-by.scm
View file

@ -1,76 +1,87 @@
; test PDB methods that change selection by another object
; such as a color or a channel
; Function to reset the selection
; (define testResetSelection )
(script-fu-use-v3)
; Function to reset the selection
(define (testResetSelection testImage)
(test! "Resetting selection to none")
(assert `(gimp-selection-none ,testImage))
(assert `(gimp-selection-is-empty ,testImage))
; The value of the selection mask at coords 64,64 is 0
; A value of the selection mask is in range [0,255]
(assert `(= (gimp-selection-value ,testImage 64 64)
0)))
; setup
(define testImage (testing:load-test-image "gimp-logo.png"))
(define testImage (testing:load-test-image-basic-v3))
(define testLayer (vector-ref (cadr (gimp-image-get-layers testImage ))
0))
; a layer mask from alpha
(define testLayerMask (car (gimp-layer-create-mask
(define testLayerMask (gimp-layer-create-mask
testLayer
ADD-MASK-ALPHA)))
ADD-MASK-ALPHA))
(gimp-layer-add-mask testLayer testLayerMask)
; new image has no initial selection
(assert-PDB-true `(gimp-selection-is-empty ,testImage))
(test! "new image has no initial selection")
; returns #t
(assert `(gimp-selection-is-empty ,testImage))
; test selection by given color
(test! "selection by given color")
; returns void
(assert `(gimp-image-select-color ,testImage CHANNEL-OP-ADD ,testLayer "black"))
; effective: test image has some black pixels, now selection is not empty
(assert-PDB-false `(gimp-selection-is-empty ,testImage))
(assert `(not (gimp-selection-is-empty ,testImage)))
(testResetSelection testImage)
; test selection by picking coords
(test! "selection by picking coords")
; !!! This is not the same as the menu item Select>By Color
; That menu item selects all pixels of a picked color.
; The PDB procedure selects a contiguous area (not disconnected pixels)
; and is more affected by settings in the context particularly sample-transparent.
; This test fails if you pick a coord that is transparent,
; since sample-transparent defaults to false?
;
; The test image has a non-transparent pixel at 64,64
; but a transparent pixel at 125,125
; Reset to no selection
(assert `(gimp-selection-none ,testImage))
(assert-PDB-true `(gimp-selection-is-empty ,testImage))
(assert `(= (car (gimp-selection-value ,testImage 125 125))
0))
; gimp-image-select-contiguous-color does not throw
(assert `(gimp-image-select-contiguous-color ,testImage CHANNEL-OP-ADD ,testLayer 125 125))
(assert `(gimp-image-select-contiguous-color ,testImage CHANNEL-OP-ADD ,testLayer 64 64))
; effective, now selection is not empty
(assert-PDB-false `(gimp-selection-is-empty ,testImage))
(assert `(not (gimp-selection-is-empty ,testImage)))
; effective, the selection value at the picked coords is "totally selected"
(assert `(= (car (gimp-selection-value ,testImage 125 125))
(assert `(= (gimp-selection-value ,testImage 64 64)
255))
(testResetSelection testImage)
; selection from item
(test! "selection from item same layer")
; selection from the layer itself: selects same as layer's alpha
(assert `(gimp-selection-none ,testImage))
(assert `(gimp-image-select-item ,testImage CHANNEL-OP-ADD ,testLayer))
; effective: selection is not empty
(assert-PDB-false `(gimp-selection-is-empty ,testImage))
(assert `(not (gimp-selection-is-empty ,testImage)))
; selection from layer mask
(testResetSelection testImage)
(test! "selection from layer mask")
(gimp-selection-none testImage)
; layer mask to selection succeeds
(assert `(gimp-image-select-item ,testImage CHANNEL-OP-ADD ,testLayerMask))
; effective: selection is not empty
(assert-PDB-false `(gimp-selection-is-empty ,testImage))
(assert `(not (gimp-selection-is-empty ,testImage)))
; TODO selection from
; channel, vectors
@ -79,3 +90,5 @@
; for debugging individual test file:
; (gimp-display-new testImage)
(script-fu-use-v2)

9
plug-ins/script-fu/test/tests/PDB/selection/selection-from.scm
View file

@ -1,6 +1,8 @@
; test PDB methods that change selection from existing selection
;(script-fu-use-v3)
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
@ -49,13 +51,13 @@
; test selection methods that change by a pixel amount
(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! "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)
@ -86,7 +88,8 @@
; Can't do it without knowing how many pixels are selected?
; Knowing bounds is not adequate.
; Simple tests of success
(test! "selection flood, invert, sharpen, translate")
; Simple tests of success, not testing effectiveness
(assert `(gimp-selection-flood ,testImage))
(assert `(gimp-selection-invert ,testImage))
(assert `(gimp-selection-sharpen ,testImage))

13
plug-ins/script-fu/test/tests/readme.md
View file

@ -289,5 +289,18 @@ To test that ScriptFu properly internationalizes,
you must change the locale and retest.
The printing of numbers is known to fail in German.
## Test coverage
You can get an approximate list of the internal PDB procedures tested:
```
>cd test/tests/PDB
>find . -name "*.scm" -exec grep -o "gimp-[a-z\-]*" {} \; | sort | uniq
```
That is, for all files with suffix .scm in the PDB directory,
grep for calls to the GIMP PDB which are like "gimp-", sort them, and get the unique names.
We strive to not use the gimp- prefix on names in comments,
exactly so this will find only actual calls.