(module struct mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 1))) (require "../../struct.ss") (define-struct/opt normal (a b c)) (define-struct/opt one-opt (a b [c "default c value"])) (define-struct/opt two-opt (a [b "default b value"] [c "default c value"])) (define-struct/opt three-opt ([a "default a value"] [b "default b value"] [c "default c value"])) (define test-struct (make-test-suite "all struct.ss tests" (make-test-case "normal arity" (assert-true (and (not (procedure-arity-includes? make-normal 0)) (not (procedure-arity-includes? make-normal 1)) (not (procedure-arity-includes? make-normal 2)) (procedure-arity-includes? make-normal 3) (not (procedure-arity-includes? make-normal 4))))) (make-test-case "normal (a)" (assert-equal? (normal-a (make-normal 1 2 3)) 1)) (make-test-case "normal (b)" (assert-equal? (normal-b (make-normal 1 2 3)) 2)) (make-test-case "normal (c)" (assert-equal? (normal-c (make-normal 1 2 3)) 3)) (make-test-case "one opt arity" (assert-true (and (not (procedure-arity-includes? make-one-opt 0)) (not (procedure-arity-includes? make-one-opt 1)) (procedure-arity-includes? make-one-opt 2) (procedure-arity-includes? make-one-opt 3) (not (procedure-arity-includes? make-one-opt 4))))) (make-test-case "one opt, all explicit (a)" (assert-equal? (one-opt-a (make-one-opt 1 2 3)) 1)) (make-test-case "one opt, all explicit (b)" (assert-equal? (one-opt-b (make-one-opt 1 2 3)) 2)) (make-test-case "one opt, all explicit (c)" (assert-equal? (one-opt-c (make-one-opt 1 2 3)) 3)) (make-test-case "one opt, last implicit (a)" (assert-equal? (one-opt-a (make-one-opt 1 2)) 1)) (make-test-case "one opt, last implicit (b)" (assert-equal? (one-opt-b (make-one-opt 1 2)) 2)) (make-test-case "one opt, last implicit (c)" (assert-equal? (one-opt-c (make-one-opt 1 2)) "default c value")) (make-test-case "two opt arity" (assert-true (and (not (procedure-arity-includes? make-two-opt 0)) (procedure-arity-includes? make-two-opt 1) (procedure-arity-includes? make-two-opt 2) (procedure-arity-includes? make-two-opt 3) (not (procedure-arity-includes? make-two-opt 4))))) (make-test-case "two opt, all explicit (a)" (assert-equal? (two-opt-a (make-two-opt 1 2 3)) 1)) (make-test-case "two opt, all explicit (b)" (assert-equal? (two-opt-b (make-two-opt 1 2 3)) 2)) (make-test-case "two opt, all explicit (c)" (assert-equal? (two-opt-c (make-two-opt 1 2 3)) 3)) (make-test-case "two opt, last implicit (a)" (assert-equal? (two-opt-a (make-two-opt 1 2)) 1)) (make-test-case "two opt, last implicit (b)" (assert-equal? (two-opt-b (make-two-opt 1 2)) 2)) (make-test-case "two opt, last implicit (c)" (assert-equal? (two-opt-c (make-two-opt 1 2)) "default c value")) (make-test-case "two opt, both implicit (a)" (assert-equal? (two-opt-a (make-two-opt 1)) 1)) (make-test-case "two opt, both implicit (b)" (assert-equal? (two-opt-b (make-two-opt 1)) "default b value")) (make-test-case "two opt, both implicit (c)" (assert-equal? (two-opt-c (make-two-opt 1)) "default c value")) (make-test-case "three opt arity" (assert-true (and (procedure-arity-includes? make-three-opt 0) (procedure-arity-includes? make-three-opt 1) (procedure-arity-includes? make-three-opt 2) (procedure-arity-includes? make-three-opt 3) (not (procedure-arity-includes? make-three-opt 4))))) (make-test-case "three opt, all explicit (a)" (assert-equal? (three-opt-a (make-three-opt 1 2 3)) 1)) (make-test-case "three opt, all explicit (b)" (assert-equal? (three-opt-b (make-three-opt 1 2 3)) 2)) (make-test-case "three opt, all explicit (c)" (assert-equal? (three-opt-c (make-three-opt 1 2 3)) 3)) (make-test-case "three opt, last implicit (a)" (assert-equal? (three-opt-a (make-three-opt 1 2)) 1)) (make-test-case "three opt, last implicit (b)" (assert-equal? (three-opt-b (make-three-opt 1 2)) 2)) (make-test-case "three opt, last implicit (c)" (assert-equal? (three-opt-c (make-three-opt 1 2)) "default c value")) (make-test-case "three opt, two implicit (a)" (assert-equal? (three-opt-a (make-three-opt 1)) 1)) (make-test-case "three opt, two implicit (b)" (assert-equal? (three-opt-b (make-three-opt 1)) "default b value")) (make-test-case "three opt, two implicit (c)" (assert-equal? (three-opt-c (make-three-opt 1)) "default c value")) (make-test-case "three opt, all implicit (a)" (assert-equal? (three-opt-a (make-three-opt)) "default a value")) (make-test-case "three opt, all implicit (b)" (assert-equal? (three-opt-b (make-three-opt)) "default b value")) (make-test-case "three opt, all implicit (c)" (assert-equal? (three-opt-c (make-three-opt)) "default c value")) )) (provide test-struct))