Changeset 38691 in project for release


Ignore:
Timestamp:
05/12/20 20:31:39 (9 months ago)
Author:
juergen
Message:

simple-tests 2.2 with ppp

Location:
release/5/simple-tests
Files:
3 edited
4 copied

Legend:

Unmodified
Added
Removed

  • release/5/simple-tests/tags/2.2/simple-tests.egg

    r38640 r38691  
    44 (category testing)
    55 (license "BSD")
    6  (version "2.1")
     6 (version "2.2")
    77 (author "Juergen Lorenz")
    88 (components (extension simple-tests

  • release/5/simple-tests/tags/2.2/simple-tests.scm

    r38640 r38691  
    4848  writeln
    4949  pe
     50  ppp
     51  ppp*
     52  ppp**
    5053  xpr:val
    51   ppp
    5254  xpr:val*
    53   ppp*
     55  ==
    5456  ; old interface
    5557  define-test
    … …  
    5860  *failures*
    5961  ; new interface
    60   ==
    6162  define-checks
    6263  do-checks
    … …  
    7576(define simple-tests
    7677  (let (
    77     (signatures '((simple-tests sym ..)
    78                   (and? xpr ...)
    79                   (writeln xpr ....)
    80                   (pe macro-code)
    81                   (xpr:val xpr ...)
    82                   (ppp xpr ...)
    83                   (xpr:val* {xpr val} ...)
    84                   (ppp* {xpr val} ...)
    85 
    86                   (define-test (name . parameters) form . forms)
    87                   (check form . forms)
    88                   (compound-test (name) test . tests)
    89 
    90                   (==)
    91                   (== x)
    92                   (== type? type-equal?)
    93                   (do-checks (name? verbose? :arg val: ...) :xpr expected: ....)
    94                   (define-checks (name? verbose? :arg val: ...) :xpr expected: ....)
    95                   (check-all name check-xpr ....)))
     78    (signatures '((simple-tests
     79                    procedure:
     80                    (simple-tests sym ..)
     81                    "documentation procedure")
     82                  (and?
     83                    procedure:
     84                    (and? xpr ...)
     85                    "Pascal like and procedure")
     86                  (writeln
     87                    procedure:
     88                    (writeln xpr ....)
     89                    "write analog of print")
     90                  (pe
     91                    procedure:
     92                    (pe macro-code)
     93                    " composes pretty-print and expand")
     94                  (ppp
     95                    macro:
     96                    (ppp xpr ...)
     97                    " print each xpr quoted in a headline"
     98                    "and pretty-print xpr's computed value")
     99                  (ppp*
     100                    macro:
     101                    (ppp* xpr ypr . xpr-yprs)
     102                    "print each xpr quoted in a headline"
     103                    "and pretty-print xpr's computed and"
     104                    "expected value, ypr")
     105                  (ppp**
     106                    macro:
     107                    (ppp** ((var val) ...) xpr ypr . xpr-yprs)
     108                    "wraps ppp* into a let")
     109                  (xpr:val
     110                    macro:
     111                    (xpr:val xpr ...)
     112                    "alias to ppp")
     113                  (xpr:val*
     114                    macro:
     115                    (xpr:val* xpr ypr . xpr-yprs)
     116                    "alias to ppp*")
     117                  (==
     118                    procedure:
     119                    (==)
     120                    (== x)
     121                    (== type? type-equal?)
     122                    "generic type equality as curried procedure:"
     123                    "the first resets the local database,"
     124                    "the second is the curried equality check"
     125                    "and the third adds a new equality procedure"
     126                    "to the local database")
     127
     128                  (define-test
     129                    macro:
     130                    (define-test (name . parameters) form . forms)
     131                    "creates a test function")
     132                  (check
     133                    macro:
     134                    (check form . forms)
     135                    "report results of all forms")
     136                  (compound-test
     137                    macro:
     138                    (compound-test (name) test . tests)
     139                    "checks all tests created with define-test"
     140                    "and reports a summary of results")
     141
     142                  (define-checks
     143                    macro:
     144                    (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     145                    "returns a unary predicate, name?,"
     146                    "comparing xpr with ypr ...."
     147                    "and using var val ... within this checks."
     148                    "verbose? controls the reported results")
     149                  (do-checks
     150                    macro:
     151                    (do-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     152                    "alias to define-checks")
     153                  (check-all
     154                    macro:
     155                    (check-all name check-xpr ....)
     156                    "checks all check-expressions created by do-check"
     157                    "and reports the results")))
    96158    )
    97159    (case-lambda
    98160      (() (map car signatures))
    99       ((sym) (assq sym signatures)))))
     161      ((sym)
     162       (let ((pair (assq sym signatures)))
     163         (if pair
     164           (for-each print (cdr pair))
     165           (print "Choose one of " (map car signatures))))))))
    100166
    101167(define (writeln . args)
    … …  
    157223    ((_)
    158224     (print))
    159     ((_ xpr val)
     225    ((_ xpr ypr)
    160226     (begin (print "Testing " 'xpr " ...")
    161227            (print* "computed: ") (pp xpr)
    162             (print* "expected: ") (pp val)
     228            (print* "expected: ") (pp ypr)
    163229            ))
    164     ((_ xpr val . pairs)
    165      (begin (help-ppp* xpr val)
     230    ((_ xpr ypr . pairs)
     231     (begin (help-ppp* xpr ypr)
    166232            (help-ppp* . pairs)))
    167233    ))
    168234;
    169 ;;;; (ppp* {xpr val} ...)
     235;;;; (ppp* {xpr ypr} ...)
    170236;;; --------------------
    171237;;; print each xpr quoted in a headline and pretty-print xpr's computed
    172 ;;; and expected value.
     238;;; and expected value, ypr.
    173239(define-syntax ppp*
    174240  (syntax-rules ()
    … …  
    179245       (else)))))
    180246
    181 ;;; (xpr:val* {xpr val} ...)
     247;;; (xpr:val* {xpr ypr} ...)
    182248;;; ------------------------
    183249;;; print each xpr quoted in a headline and pretty-print xpr's computed
    184 ;;; and expected value.
     250;;; and expected value, ypr.
    185251;;; Alias to ppp*
    186252(define-syntax xpr:val*
    … …  
    188254    ((_ . pairs)
    189255     (ppp* . pairs))))
     256
     257;;; (ppp** ((var val) ...) xpr ypr . other xpr-ypr-pairs)
     258;;; -----------------------------------------------------
     259;;; ppp* wrapped into a let
     260(define-syntax ppp**
     261  (syntax-rules ()
     262    ((_ ((var val) ...) xpr ypr . other-xpr-ypr-pairs)
     263     (let ((var val) ...)
     264       (ppp* xpr ypr . other-xpr-ypr-pairs)))))
    190265
    191266;;;;;;;; old interface ;;;;;;;;;
    … …  
    359434      )))
    360435
    361 ;;; (do-checks (name? verbose? :arg val: ...) :xpr expect: ....)
    362 ;;; ----------------------------------------------------------------
    363 ;;; returns a unary predicate, name?, comparing xpr with expect ....
    364 ;;; and using arg val ... within this checks
    365 (define-syntax do-checks
     436;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     437;;; --------------------------------------------------------------
     438;;; returns a unary predicate, name?, comparing xpr with ypr ....
     439;;; and using var val ... within this checks,
     440;;; verbose? controls the reported summary.
     441(define-syntax define-checks
    366442  (er-macro-transformer
    367443    (lambda (form rename compare?)
    … …  
    447523 ))))
    448524
    449 ;;; (define-checks (name? verbose? :arg val: ...) :xpr expect: ....)
    450 ;;; ----------------------------------------------------------------
    451 ;;; returns a unary predicate, name?, comparing xpr with expect ....
    452 ;;; and using arg val ... within this checks
    453 ;;; Alias to do-checks
    454 (define-syntax define-checks
    455   (syntax-rules ()
    456     ((_(name? verbose? . arg-val-pairs) xpr expect . xpr-expect-pairs)
    457      (do-checks (name? verbose? . arg-val-pairs)
    458                 xpr expect .  xpr-expect-pairs))))
     525;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs)
     526;;; ---------------------------------------------------------------
     527;;; returns a unary predicate, name?, comparing xpr with ypr ....
     528;;; and using var val ... within this checks,
     529;;; alias to define-checks
     530(define-syntax do-checks
     531  (syntax-rules ()
     532    ((_(name? verbose? . var-val-pairs) xpr ypr . xpr-ypr-pairs)
     533     (define-checks (name? verbose? . var-val-pairs)
     534       xpr ypr .  xpr-ypr-pairs))))
    459535
    460536(define (check-all-proc name . test-name-pairs) ; internal to check-all

  • release/5/simple-tests/tags/2.2/tests/run.scm

    r38640 r38691  
    4040;;; new interface
    4141;;; define-checks is an alias to do-checks
     42
     43(ppp** ((lst '(0 1 2 3)))
     44  lst
     45  '(0 1 2 3)
     46  (car lst)
     47  0
     48  (cadr lst)
     49  1
     50  (cddr lst)
     51  '(2 3)
     52  )
    4253
    4354(do-checks (bar? verbose? n 5)

  • release/5/simple-tests/trunk/simple-tests.egg

    r38640 r38691  
    44 (category testing)
    55 (license "BSD")
    6  (version "2.1")
     6 (version "2.2")
    77 (author "Juergen Lorenz")
    88 (components (extension simple-tests

  • release/5/simple-tests/trunk/simple-tests.scm

    r38640 r38691  
    4848  writeln
    4949  pe
     50  ppp
     51  ppp*
     52  ppp**
    5053  xpr:val
    51   ppp
    5254  xpr:val*
    53   ppp*
     55  ==
    5456  ; old interface
    5557  define-test
    … …  
    5860  *failures*
    5961  ; new interface
    60   ==
    6162  define-checks
    6263  do-checks
    … …  
    7576(define simple-tests
    7677  (let (
    77     (signatures '((simple-tests sym ..)
    78                   (and? xpr ...)
    79                   (writeln xpr ....)
    80                   (pe macro-code)
    81                   (xpr:val xpr ...)
    82                   (ppp xpr ...)
    83                   (xpr:val* {xpr val} ...)
    84                   (ppp* {xpr val} ...)
    85 
    86                   (define-test (name . parameters) form . forms)
    87                   (check form . forms)
    88                   (compound-test (name) test . tests)
    89 
    90                   (==)
    91                   (== x)
    92                   (== type? type-equal?)
    93                   (do-checks (name? verbose? :arg val: ...) :xpr expected: ....)
    94                   (define-checks (name? verbose? :arg val: ...) :xpr expected: ....)
    95                   (check-all name check-xpr ....)))
     78    (signatures '((simple-tests
     79                    procedure:
     80                    (simple-tests sym ..)
     81                    "documentation procedure")
     82                  (and?
     83                    procedure:
     84                    (and? xpr ...)
     85                    "Pascal like and procedure")
     86                  (writeln
     87                    procedure:
     88                    (writeln xpr ....)
     89                    "write analog of print")
     90                  (pe
     91                    procedure:
     92                    (pe macro-code)
     93                    " composes pretty-print and expand")
     94                  (ppp
     95                    macro:
     96                    (ppp xpr ...)
     97                    " print each xpr quoted in a headline"
     98                    "and pretty-print xpr's computed value")
     99                  (ppp*
     100                    macro:
     101                    (ppp* xpr ypr . xpr-yprs)
     102                    "print each xpr quoted in a headline"
     103                    "and pretty-print xpr's computed and"
     104                    "expected value, ypr")
     105                  (ppp**
     106                    macro:
     107                    (ppp** ((var val) ...) xpr ypr . xpr-yprs)
     108                    "wraps ppp* into a let")
     109                  (xpr:val
     110                    macro:
     111                    (xpr:val xpr ...)
     112                    "alias to ppp")
     113                  (xpr:val*
     114                    macro:
     115                    (xpr:val* xpr ypr . xpr-yprs)
     116                    "alias to ppp*")
     117                  (==
     118                    procedure:
     119                    (==)
     120                    (== x)
     121                    (== type? type-equal?)
     122                    "generic type equality as curried procedure:"
     123                    "the first resets the local database,"
     124                    "the second is the curried equality check"
     125                    "and the third adds a new equality procedure"
     126                    "to the local database")
     127
     128                  (define-test
     129                    macro:
     130                    (define-test (name . parameters) form . forms)
     131                    "creates a test function")
     132                  (check
     133                    macro:
     134                    (check form . forms)
     135                    "report results of all forms")
     136                  (compound-test
     137                    macro:
     138                    (compound-test (name) test . tests)
     139                    "checks all tests created with define-test"
     140                    "and reports a summary of results")
     141
     142                  (define-checks
     143                    macro:
     144                    (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     145                    "returns a unary predicate, name?,"
     146                    "comparing xpr with ypr ...."
     147                    "and using var val ... within this checks."
     148                    "verbose? controls the reported results")
     149                  (do-checks
     150                    macro:
     151                    (do-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     152                    "alias to define-checks")
     153                  (check-all
     154                    macro:
     155                    (check-all name check-xpr ....)
     156                    "checks all check-expressions created by do-check"
     157                    "and reports the results")))
    96158    )
    97159    (case-lambda
    98160      (() (map car signatures))
    99       ((sym) (assq sym signatures)))))
     161      ((sym)
     162       (let ((pair (assq sym signatures)))
     163         (if pair
     164           (for-each print (cdr pair))
     165           (print "Choose one of " (map car signatures))))))))
    100166
    101167(define (writeln . args)
    … …  
    157223    ((_)
    158224     (print))
    159     ((_ xpr val)
     225    ((_ xpr ypr)
    160226     (begin (print "Testing " 'xpr " ...")
    161227            (print* "computed: ") (pp xpr)
    162             (print* "expected: ") (pp val)
     228            (print* "expected: ") (pp ypr)
    163229            ))
    164     ((_ xpr val . pairs)
    165      (begin (help-ppp* xpr val)
     230    ((_ xpr ypr . pairs)
     231     (begin (help-ppp* xpr ypr)
    166232            (help-ppp* . pairs)))
    167233    ))
    168234;
    169 ;;;; (ppp* {xpr val} ...)
     235;;;; (ppp* {xpr ypr} ...)
    170236;;; --------------------
    171237;;; print each xpr quoted in a headline and pretty-print xpr's computed
    172 ;;; and expected value.
     238;;; and expected value, ypr.
    173239(define-syntax ppp*
    174240  (syntax-rules ()
    … …  
    179245       (else)))))
    180246
    181 ;;; (xpr:val* {xpr val} ...)
     247;;; (xpr:val* {xpr ypr} ...)
    182248;;; ------------------------
    183249;;; print each xpr quoted in a headline and pretty-print xpr's computed
    184 ;;; and expected value.
     250;;; and expected value, ypr.
    185251;;; Alias to ppp*
    186252(define-syntax xpr:val*
    … …  
    188254    ((_ . pairs)
    189255     (ppp* . pairs))))
     256
     257;;; (ppp** ((var val) ...) xpr ypr . other xpr-ypr-pairs)
     258;;; -----------------------------------------------------
     259;;; ppp* wrapped into a let
     260(define-syntax ppp**
     261  (syntax-rules ()
     262    ((_ ((var val) ...) xpr ypr . other-xpr-ypr-pairs)
     263     (let ((var val) ...)
     264       (ppp* xpr ypr . other-xpr-ypr-pairs)))))
    190265
    191266;;;;;;;; old interface ;;;;;;;;;
    … …  
    359434      )))
    360435
    361 ;;; (do-checks (name? verbose? :arg val: ...) :xpr expect: ....)
    362 ;;; ----------------------------------------------------------------
    363 ;;; returns a unary predicate, name?, comparing xpr with expect ....
    364 ;;; and using arg val ... within this checks
    365 (define-syntax do-checks
     436;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     437;;; --------------------------------------------------------------
     438;;; returns a unary predicate, name?, comparing xpr with ypr ....
     439;;; and using var val ... within this checks,
     440;;; verbose? controls the reported summary.
     441(define-syntax define-checks
    366442  (er-macro-transformer
    367443    (lambda (form rename compare?)
    … …  
    447523 ))))
    448524
    449 ;;; (define-checks (name? verbose? :arg val: ...) :xpr expect: ....)
    450 ;;; ----------------------------------------------------------------
    451 ;;; returns a unary predicate, name?, comparing xpr with expect ....
    452 ;;; and using arg val ... within this checks
    453 ;;; Alias to do-checks
    454 (define-syntax define-checks
    455   (syntax-rules ()
    456     ((_(name? verbose? . arg-val-pairs) xpr expect . xpr-expect-pairs)
    457      (do-checks (name? verbose? . arg-val-pairs)
    458                 xpr expect .  xpr-expect-pairs))))
     525;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs)
     526;;; ---------------------------------------------------------------
     527;;; returns a unary predicate, name?, comparing xpr with ypr ....
     528;;; and using var val ... within this checks,
     529;;; alias to define-checks
     530(define-syntax do-checks
     531  (syntax-rules ()
     532    ((_(name? verbose? . var-val-pairs) xpr ypr . xpr-ypr-pairs)
     533     (define-checks (name? verbose? . var-val-pairs)
     534       xpr ypr .  xpr-ypr-pairs))))
    459535
    460536(define (check-all-proc name . test-name-pairs) ; internal to check-all

  • release/5/simple-tests/trunk/tests/run.scm

    r38640 r38691  
    4040;;; new interface
    4141;;; define-checks is an alias to do-checks
     42
     43(ppp** ((lst '(0 1 2 3)))
     44  lst
     45  '(0 1 2 3)
     46  (car lst)
     47  0
     48  (cadr lst)
     49  1
     50  (cddr lst)
     51  '(2 3)
     52  )
    4253
    4354(do-checks (bar? verbose? n 5)
Note: See TracChangeset for help on using the changeset viewer.