# add.test -*- tcl -*-
# -------------------------------------------------------------------------
source [file join \
[file dirname [file join [pwd] [info script]]] \
testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 2
support {}
testing {
useC [mainPath _test/lib]/crimp_core* crimp::core no
}
# -------------------------------------------------------------------------
## Core manipulation: Conversion between images and Tcl data structures.
## Note: If these do not work all other tests won't either, as they
## all require some way of creating inputs and inspecting results.
test crimp-core-1.0 {Basic conversion from Tcl and back, integer} -body {
set image [crimp read tcl grey8 {{1 2} {3 4}}]
crimp write 2string tcl $image
} -cleanup {
unset image
} -result {{1 2} {3 4}}
test crimp-core-1.1 {Basic conversion from Tcl and back, floating point} -body {
set image [crimp read tcl float {{1 2} {3 4}}]
crimp write 2string tcl $image
} -cleanup {
unset image
} -result {{1.0 2.0} {3.0 4.0}}
test crimp-core-1.2 {Basic conversion from Tcl and back, empty image} -body {
set image [crimp read tcl grey8 {}]
crimp write 2string tcl $image
} -cleanup {
unset image
} -result {}
test crimp-core-1.3 {Basic conversion from Tcl and back, empty image, single-row} -body {
set image [crimp read tcl grey8 {{}}]
crimp write 2string tcl $image
} -cleanup {
unset image
} -result {}
# -------------------------------------------------------------------------
## Testing the core accessors: Geometry, type and channel information (names)
foreach {accessor result} {
geometry {0 0 2 2}
at {0 0}
dimensions {2 2}
x 0
y 0
width 2
height 2
type crimp::image::grey8
channels luma
} {
test crimp-core-${accessor}-1.0 "Accessors: $accessor, wrong\#args, not enough" -body {
crimp $accessor
} -returnCodes error -result "wrong \# args: should be \"crimp $accessor imageObj\""
test crimp-core-${accessor}-1.1 "Accessors: $accessor, wrong\#args, too many" -body {
crimp $accessor IMAGE toomuch
} -returnCodes error -result "wrong \# args: should be \"crimp $accessor imageObj\""
test crimp-core-${accessor}-1.2 "Accessors: $accessor" -setup {
set image [crimp read tcl grey8 {{1 2} {3 4}}]
} -body {
crimp $accessor $image
} -cleanup {
unset image
} -result $result
}
# -------------------------------------------------------------------------
## Testing the core accessors: Raw pixels (ByteArray)
test crimp-core-pixel-1.0 "Accessors: pixel, wrong\#args, not enough" -body {
crimp pixel
} -returnCodes error -result "wrong \# args: should be \"crimp pixel imageObj\""
test crimp-core-pixel-1.1 "Accessors: pixel, wrong\#args, too many" -body {
crimp pixel IMAGE toomuch
} -returnCodes error -result "wrong \# args: should be \"crimp pixel imageObj\""
test crimp-core-pixel-1.2 "Accessors: pixel" -setup {
set image [crimp read tcl grey8 {{1 2} {3 4}}]
} -body {
list [binary scan [crimp pixel $image] H* image] $image
} -cleanup {
unset image
} -result {1 01020304}
# -------------------------------------------------------------------------
## Core image types, i.e. types the core can create ...
foreach {n cando itype channels} {
0 {} grey8 {luma}
1 NYI grey16 {luma}
2 NYI grey32 {luma}
3 {} float {value}
4 NYI fpcomplex {real imaginary}
5 NYI rgb {red green blue}
6 NYI rgba {red green blue alpha}
7 NYI hsv {hue saturation value}
} {
test crimp-core-type-2.$n {Accessors: type} -setup {
set image [crimp read tcl $itype {{1 2} {3 4}}]
} -body {
crimp type $image
} -cleanup {
unset image
} -result crimp::image::$itype -constraints $cando
test crimp-core-channels-2.$n {Accessors: channel names} -setup {
set image [crimp read tcl $itype {{1 2} {3 4}}]
} -body {
crimp channels $image
} -cleanup {
unset image
} -result $channels -constraints $cando
}
# -------------------------------------------------------------------------
## Testing the core accessors: Low level access to the image meta data.
test crimp-core-meta-1.0 {Accessor, meta_get, wrong\#args, not enough} -body {
crimp::C::meta_get
} -returnCodes error -result {wrong # args: should be "crimp::C::meta_get imageObj"}
test crimp-core-meta-1.1 {Accessor, meta_get, wrong\#args, too many} -body {
crimp::C::meta_get IMAGE toomuch
} -returnCodes error -result {wrong # args: should be "crimp::C::meta_get imageObj"}
test crimp-core-meta-1.2 {Accessor, meta_get, default} -setup {
set image [crimp read tcl grey8 {}]
} -body {
crimp::C::meta_get $image
} -cleanup {
unset image
} -result {}
test crimp-core-meta-2.0 {Accessor, meta_set, wrong\#args, not enough} -body {
crimp::C::meta_set
} -returnCodes error -result {wrong # args: should be "crimp::C::meta_set imageObj metaObj"}
test crimp-core-meta-2.1 {Accessor, meta_set, wrong\#args, not enough} -body {
crimp::C::meta_set IMAGE
} -returnCodes error -result {wrong # args: should be "crimp::C::meta_set imageObj metaObj"}
test crimp-core-meta-2.2 {Accessor, meta_set, wrong\#args, too many} -body {
crimp::C::meta_set IMAGE VALUE toomuch
} -returnCodes error -result {wrong # args: should be "crimp::C::meta_set imageObj metaObj"}
test crimp-core-meta-2.3 {Accessor, meta_set + meta_get} -setup {
set image [crimp read tcl grey8 {}]
} -body {
crimp::C::meta_get [crimp::C::meta_set $image META]
} -cleanup {
unset image
} -result META
# -------------------------------------------------------------------------
## Testing the core accessors: High level access to the image meta data.
## Dictionary methods -- See to snarfing the tests from the Tcl core.
## TODO
# -------------------------------------------------------------------------
## Testing the core accessors: Placement.
test crimp-core-place-1.0 "Accessors: place, wrong\#args, not enough" -body {
crimp place
} -returnCodes error -result "wrong \# args: should be \"crimp place imageObj x y\""
test crimp-core-place-1.1 "Accessors: place, wrong\#args, not enough" -body {
crimp place IMAGE
} -returnCodes error -result "wrong \# args: should be \"crimp place imageObj x y\""
test crimp-core-place-1.2 "Accessors: place, wrong\#args, not enough" -body {
crimp place IMAGE x
} -returnCodes error -result "wrong \# args: should be \"crimp place imageObj x y\""
test crimp-core-place-1.3 "Accessors: place, wrong\#args, too many" -body {
crimp place IMAGE x y toomuch
} -returnCodes error -result "wrong \# args: should be \"crimp place imageObj x y\""
test crimp-core-place-1.4 "Accessors: place" -setup {
set image [crimp read tcl grey8 {{1 2} {3 4}}]
} -body {
crimp at [crimp place $image -2 5]
} -cleanup {
unset image
} -result {-2 5}
# -------------------------------------------------------------------------
##
## TODO :: bbox2, bbox = rect union
## TODO :: write 2file, 2chan (plus types -> tcl: rgb, rgba, hsv, fpcomplex)
## TODO :: writing to tcl: grey16, grey32 - NYI, untestable
##
# -------------------------------------------------------------------------
testsuiteCleanup
# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End: