114 lines
3.6 KiB
Scheme
114 lines
3.6 KiB
Scheme
|
; test resource methods of Context
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
; function to test methods on Resource
|
||
|
|
; for a valid Resource ID
|
||
|
|
(define (test-resource-methods resource)
|
||
|
|
|
||
|
|
; a resource is an int ID in ScriptFu
|
||
|
|
(assert `(integer? ,resource))
|
||
|
|
|
||
|
|
; get-name returns a string
|
||
|
|
(assert `(string? (car (pika-resource-get-name ,resource))))
|
||
|
|
|
||
|
|
; id-is-valid returns truth
|
||
|
|
; (1) FUTURE #t
|
||
|
|
(assert `(car (pika-resource-id-is-valid ,resource)))
|
||
|
|
|
||
|
|
; pika-resource-get-identifiers succeeds
|
||
|
|
; it returns a triplet
|
||
|
|
(assert `(pika-resource-get-identifiers ,resource))
|
||
|
|
|
||
|
|
; pika-resource-get-identifiers returns numeric for is-internal
|
||
|
|
; Some of the fresh pika active resource are internal, some not !!!
|
||
|
|
(assert `(number? (car (pika-resource-get-identifiers ,resource))))
|
||
|
|
|
||
|
|
; name from get-identifiers is same as from pika-resource-get-name
|
||
|
|
; name is second field of triplet i.e. cadr
|
||
|
|
(assert `(string=? (cadr (pika-resource-get-identifiers ,resource))
|
||
|
|
(car (pika-resource-get-name ,resource))))
|
||
|
|
|
||
|
|
; pika-resource-is-editable succeeds
|
||
|
|
; Returns a wrapped boolean
|
||
|
|
(assert `(pika-resource-is-editable ,resource))
|
||
|
|
|
||
|
|
; The fresh pika active resources are all system resources i.e. not editable
|
||
|
|
; returns 0 for #f
|
||
|
|
(assert `(= (car(pika-resource-is-editable ,resource))
|
||
|
|
0))
|
||
|
|
)
|
||
|
|
|
||
|
|
; "Test Parasite") ; name
|
||
|
|
; "Procedure execution of pika-resource-get-parasite failed")
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
; test context-get-resource returns active resource of given className
|
||
|
|
; Setup. Not assert.
|
||
|
|
|
||
|
|
(define testBrush (car (pika-context-get-resource "PikaBrush")))
|
||
|
|
(define testFont (car (pika-context-get-resource "PikaFont")))
|
||
|
|
(define testGradient (car (pika-context-get-resource "PikaGradient")))
|
||
|
|
(define testPalette (car (pika-context-get-resource "PikaPalette")))
|
||
|
|
(define testPattern (car (pika-context-get-resource "PikaPattern")))
|
||
|
|
; FUTURE Dynamics and other Resource subclasses
|
||
|
|
|
||
|
|
|
||
|
|
; test methods on active resource ID's
|
||
|
|
|
||
|
|
(test-resource-methods testBrush)
|
||
|
|
(test-resource-methods testFont)
|
||
|
|
(test-resource-methods testGradient)
|
||
|
|
(test-resource-methods testPalette)
|
||
|
|
(test-resource-methods testPattern)
|
||
|
|
|
||
|
|
|
||
|
|
; test more specific context methods return same result
|
||
|
|
; as the general context-get-resource
|
||
|
|
|
||
|
|
; test equality of numeric IDs
|
||
|
|
(assert `(= (car(pika-context-get-brush))
|
||
|
|
,testBrush))
|
||
|
|
(assert `(= (car(pika-context-get-font))
|
||
|
|
,testFont))
|
||
|
|
(assert `(= (car(pika-context-get-gradient))
|
||
|
|
,testGradient))
|
||
|
|
(assert `(= (car(pika-context-get-palette))
|
||
|
|
,testPalette))
|
||
|
|
(assert `(= (car(pika-context-get-pattern))
|
||
|
|
,testPattern))
|
||
|
|
|
||
|
|
|
||
|
|
; test resource-id-is-foo methods
|
||
|
|
|
||
|
|
; the resource IDs from setup work with the specific id-is-foo methods
|
||
|
|
|
||
|
|
(assert `(= (car(pika-resource-id-is-brush ,testBrush))
|
||
|
|
1))
|
||
|
|
(assert `(= (car(pika-resource-id-is-font ,testFont))
|
||
|
|
1))
|
||
|
|
(assert `(= (car(pika-resource-id-is-gradient ,testGradient))
|
||
|
|
1))
|
||
|
|
(assert `(= (car(pika-resource-id-is-palette ,testPalette))
|
||
|
|
1))
|
||
|
|
(assert `(= (car(pika-resource-id-is-pattern ,testPattern))
|
||
|
|
1))
|
||
|
|
|
||
|
|
|
||
|
|
; test errors
|
||
|
|
|
||
|
|
|
||
|
|
; invalid type name
|
||
|
|
(assert-error `(pika-context-get-resource "InvalidTypeName")
|
||
|
|
"Procedure execution of pika-context-get-resource failed")
|
||
|
|
|
||
|
|
; invalid numeric ID
|
||
|
|
; -1 is out of range
|
||
|
|
(assert-error `(pika-resource-get-name -1)
|
||
|
|
"Procedure execution of pika-resource-get-name failed on invalid input arguments:")
|
||
|
|
; 12345678 is in range but invalid
|
||
|
|
(assert-error `(pika-resource-get-name 12345678)
|
||
|
|
"Procedure execution of pika-resource-get-name failed on invalid input arguments:")
|
||
|
|
|
