Changeset 38693 in project


Ignore:
Timestamp:
05/16/20 17:47:44 (3 weeks ago)
Author:
juergen
Message:

simple-tests 2.3 with checks

Location:
release/5/simple-tests
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/simple-tests/tags/2.3/simple-tests.egg

    r38691 r38693  
    44 (category testing)
    55 (license "BSD")
    6  (version "2.2")
     6 (version "2.3")
    77 (author "Juergen Lorenz")
    88 (components (extension simple-tests
  • release/5/simple-tests/tags/2.3/simple-tests.scm

    r38691 r38693  
    6060  *failures*
    6161  ; new interface
     62  check
    6263  define-checks
    6364  do-checks
     
    130131                    (define-test (name . parameters) form . forms)
    131132                    "creates a test function")
    132                   (check
    133                     macro:
    134                     (check form . forms)
    135                     "report results of all forms")
    136133                  (compound-test
    137134                    macro:
     
    140137                    "and reports a summary of results")
    141138
     139                  (check
     140                    macro:
     141                    (check ((var val) ...) xpr ypr . xpr-yprs)
     142                    "compares xpr and ypr .... with == in the"
     143                    "environment defined by (var val) ...")
    142144                  (define-checks
    143145                    macro:
     
    297299         #f)))))
    298300
    299 ;;; (check . forms)
    300 ;;; --------------------
     301;;; (check-em . forms) ;; internal
     302;;; ------------------
    301303;;; report result of all forms
    302 (define-syntax check
     304(define-syntax check-em
    303305  (syntax-rules ()
    304306    ((_ form ...)
     
    325327           (cons (show-args (name . parameters)) *locations*))
    326328         )
    327          ((check form . forms) *locations*))))))
     329         ((check-em form . forms) *locations*))))))
    328330
    329331;;; (compound-test (name) test . tests)
     
    434436      )))
    435437
    436 ;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     438;;; (check* ((var val) ...) xpr ypr . xpr-yprs) ;; internal
    437439;;; --------------------------------------------------------------
    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
    442   (er-macro-transformer
    443     (lambda (form rename compare?)
    444       (let ((name (caadr form))
    445             (verbose? (cadadr form))
    446             (args* (cddadr form))
    447             (pairs* (cddr form))
    448             (%x (rename 'x))
    449             (%tests (rename 'tests))
    450             (%writeln (rename 'writeln))
    451             (%set! (rename 'set!))
    452             (%print (rename 'print))
    453             (%print* (rename 'print*))
    454             (%begin (rename 'begin))
    455             (%let (rename 'let))
    456             (%equal? (rename 'equal?)) ;;;
    457             (%== (rename '==))
    458             (%cons (rename 'cons))
    459             (%and (rename 'and))
    460             (%reverse (rename 'reverse))
    461             (%if (rename 'if))
    462             (%null? (rename 'null?))
    463             (%fails (rename 'fails))
    464             (%map (rename 'map))
    465             (%cdr (rename 'cdr))
    466             (%car (rename 'car))
    467             (%apply (rename 'apply))
    468             (%append (rename 'append))
    469             (%define (rename 'define))
    470             (%make-string (rename 'make-string))
    471             (%string-length (rename 'string-length))
    472             (%symbol->string (rename 'symbol->string))
    473             (%when (rename 'when))
    474             (%case-lambda (rename 'case-lambda))
     440;(define-syntax check*
     441;  (er-macro-transformer
     442;    (lambda (form rename compare?)
     443;      (let ((var-vals (cadr form))
     444;            (xpr-yprs (cddr form))
     445;            (%verbose? (rename 'verbose?))
     446;            (%lambda (rename 'lambda))
     447;            (%x (rename 'x))
     448;            (%tests (rename 'tests))
     449;            (%writeln (rename 'writeln))
     450;            (%set! (rename 'set!))
     451;            (%print (rename 'print))
     452;            (%print* (rename 'print*))
     453;            (%begin (rename 'begin))
     454;            (%let (rename 'let))
     455;            (%== (rename '==))
     456;            (%cons (rename 'cons))
     457;            (%reverse (rename 'reverse))
     458;            (%if (rename 'if))
     459;            (%null? (rename 'null?))
     460;            (%fails (rename 'fails))
     461;            (%map (rename 'map))
     462;            (%cdr (rename 'cdr))
     463;            (%when (rename 'when))
     464;            (select-failures
     465;              (lambda (pairs)
     466;                (let loop ((pairs pairs))
     467;                  (cond
     468;                    ((null? pairs) '())
     469;                    ((caar pairs) (loop (cdr pairs)))
     470;                    (else
     471;                     (cons (car pairs) (loop (cdr pairs))))))))
     472;            )
     473;`(,%lambda (,%verbose?)
     474;   (,%let ,var-vals
     475;          (,%let ((,%tests '()))
     476;            ,@(map (lambda (p)
     477;                     `(,%begin
     478;                        (,%let ((,%x ,(car p)))
     479;                           ; protect against functions changing state
     480;                          (,%when ,%verbose?
     481;                            (,%print "testing " ',(car p) " ...")
     482;                            (,%print* "computed: ") (,%writeln ,%x)
     483;                            (,%print* "expected: ") (,%writeln ,(cadr p))
     484;                            )
     485;                          (,%set! ,%tests
     486;                                  (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
     487;                                          ,%tests)))
     488;                          ))
     489;                   (chop xpr-yprs 2))
     490;            (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
     491;              (,%when ,%verbose?
     492;                (,%print "List of failed test expressions: "
     493;                         (,%map ,%cdr ,%fails))
     494;                         )
     495;              (,%if (,%null? ,%fails) #t #f)))))
     496; ))))
     497(define-syntax check*
     498  (ir-macro-transformer
     499    (lambda (form inject compare?)
     500      (let ((var-vals (cadr form))
     501            (xpr-yprs (cddr form))
    475502            (select-failures
    476503              (lambda (pairs)
     
    482509                     (cons (car pairs) (loop (cdr pairs))))))))
    483510            )
    484 ;`(,%define (,name ,verbose?)
    485 `(,%define ,name
    486    (,%case-lambda
    487      (()
    488       (,name #t))
    489      ((,verbose?)
    490       (,%let ,(chop args* 2)
    491         (,%when ,verbose?
    492           (,%print "\nIn " ',name ":")
    493           (,%print* "---"
    494                     (,%make-string (,%string-length
    495                                      (,%symbol->string ',name)) #\-)
     511`(lambda (verbose?)
     512   (let ,var-vals
     513          (let ((tests '()))
     514            ,@(map (lambda (p)
     515                     `(begin
     516                        (let ((x ,(car p)))
     517                           ; protect against functions changing state
     518                          (when verbose?
     519                            (print "testing " ',(car p) " ...")
     520                            (print* "computed: ") (writeln x)
     521                            (print* "expected: ") (writeln ,(cadr p))
     522                            )
     523                          (set! tests
     524                                  (cons (cons ((== x) ,(cadr p)) ',(car p))
     525                                          tests)))
     526                          ))
     527                   (chop xpr-yprs 2))
     528            (let ((fails (,select-failures (reverse tests))))
     529              (when verbose?
     530                (print "List of failed test expressions: "
     531                         (map cdr fails))
     532                         )
     533              (if (null? fails) #t #f)))))
     534 ))))
     535;;; (check ((var val) ...) xpr ypr . xpr-yprs)
     536;;; ------------------------------------------
     537;;; compare xpr and ypr .... in sequence with ==
     538;;; in the environment defined by var val ...
     539(define-syntax check
     540  (syntax-rules ()
     541    ((_ ((var val) ...) xpr ypr . xpr-yprs)
     542     ((check* ((var val) ...) xpr ypr . xpr-yprs) #t))))
     543
     544;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     545;;; --------------------------------------------------------------
     546;;; returns a unary predicate, name?, comparing xpr with ypr ....
     547;;; and using var val ... within this checks,
     548;;; verbose? controls the reported summary.
     549(define-syntax define-checks
     550  (ir-macro-transformer
     551    (lambda (form inject compare?)
     552      (let ((header (cadr form))
     553            (xpr-yprs (cddr form)))
     554        (let ((name (car header))
     555              (verbose? (cadr header))
     556              (var-vals (cddr header)))
     557    `(define ,name
     558       (case-lambda
     559         (()
     560          (,name #t))
     561         ((,verbose?)
     562          (when ,verbose?
     563            (print "\nIn " ',name ":")
     564            (print* "---"
     565                    (make-string (string-length
     566                                   (symbol->string ',name)) #\-)
    496567                    "-\n")
    497           )
    498         (,%let ((,%tests '()))
    499           ,@(map (lambda (p)
    500                    `(,%begin
    501                       (,%let ((,%x ,(car p)))
    502                          ; protect against functions changing state
    503                         (,%when ,verbose?
    504                           (,%print "testing " ',(car p) " ...")
    505                           ;(,%print* "computed: ") (,%writeln ,(car p))
    506                           (,%print* "computed: ") (,%writeln ,%x)
    507                           (,%print* "expected: ") (,%writeln ,(cadr p))
    508                           )
    509                         (,%set! ,%tests
    510                                 ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
    511                                 ;(,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
    512                                 (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
    513                                         ,%tests)))
    514                         ))
    515                  (chop pairs* 2))
    516           (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
    517             (,%when ,verbose?
    518               (,%print "List of failed test expressions: "
    519                        (,%map ,%cdr ,%fails))
    520                        ;(,%apply ,%append (,%map ,%cdr ,%fails)))
    521                        )
    522             (,%if (,%null? ,%fails) #t #f)))))))
    523  ))))
     568            )
     569            ((check* ,(chop var-vals 2)
     570               ,@xpr-yprs) ,verbose?)))))))))
    524571
    525572;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs)
     
    570617 ) ; simple-tests
    571618
     619;(import simple-tests)
     620;
     621;(pe '(check ((lst '(0 1 2)))
     622;        (car lst)
     623;        0
     624;        (cdr lst)
     625;        '(1 2)))
     626;
     627;(check ((lst '(0 1 2)))
     628;        (car lst)
     629;        0
     630;        (cdr lst)
     631;        '(0 1 2))
     632;
     633;(pe '(define-checks (foo verbose? lst '(0 1 2))
     634;        (car lst)
     635;        0
     636;        (cdr lst)
     637;        '(1 2)))
     638;(define-checks (foo verbose? lst '(0 1 2))
     639;        (car lst)
     640;        0
     641;        (cdr lst)
     642;        '(1 2 3))
     643;(foo #t)
     644;(ppp (foo #f))
  • release/5/simple-tests/tags/2.3/tests/run.scm

    r38691 r38693  
    4141;;; define-checks is an alias to do-checks
    4242
    43 (ppp** ((lst '(0 1 2 3)))
     43(check ((lst '(0 1 2 3)))
    4444  lst
    4545  '(0 1 2 3)
  • release/5/simple-tests/trunk/simple-tests.egg

    r38691 r38693  
    44 (category testing)
    55 (license "BSD")
    6  (version "2.2")
     6 (version "2.3")
    77 (author "Juergen Lorenz")
    88 (components (extension simple-tests
  • release/5/simple-tests/trunk/simple-tests.scm

    r38691 r38693  
    6060  *failures*
    6161  ; new interface
     62  check
    6263  define-checks
    6364  do-checks
     
    130131                    (define-test (name . parameters) form . forms)
    131132                    "creates a test function")
    132                   (check
    133                     macro:
    134                     (check form . forms)
    135                     "report results of all forms")
    136133                  (compound-test
    137134                    macro:
     
    140137                    "and reports a summary of results")
    141138
     139                  (check
     140                    macro:
     141                    (check ((var val) ...) xpr ypr . xpr-yprs)
     142                    "compares xpr and ypr .... with == in the"
     143                    "environment defined by (var val) ...")
    142144                  (define-checks
    143145                    macro:
     
    297299         #f)))))
    298300
    299 ;;; (check . forms)
    300 ;;; --------------------
     301;;; (check-em . forms) ;; internal
     302;;; ------------------
    301303;;; report result of all forms
    302 (define-syntax check
     304(define-syntax check-em
    303305  (syntax-rules ()
    304306    ((_ form ...)
     
    325327           (cons (show-args (name . parameters)) *locations*))
    326328         )
    327          ((check form . forms) *locations*))))))
     329         ((check-em form . forms) *locations*))))))
    328330
    329331;;; (compound-test (name) test . tests)
     
    434436      )))
    435437
    436 ;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     438;;; (check* ((var val) ...) xpr ypr . xpr-yprs) ;; internal
    437439;;; --------------------------------------------------------------
    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
    442   (er-macro-transformer
    443     (lambda (form rename compare?)
    444       (let ((name (caadr form))
    445             (verbose? (cadadr form))
    446             (args* (cddadr form))
    447             (pairs* (cddr form))
    448             (%x (rename 'x))
    449             (%tests (rename 'tests))
    450             (%writeln (rename 'writeln))
    451             (%set! (rename 'set!))
    452             (%print (rename 'print))
    453             (%print* (rename 'print*))
    454             (%begin (rename 'begin))
    455             (%let (rename 'let))
    456             (%equal? (rename 'equal?)) ;;;
    457             (%== (rename '==))
    458             (%cons (rename 'cons))
    459             (%and (rename 'and))
    460             (%reverse (rename 'reverse))
    461             (%if (rename 'if))
    462             (%null? (rename 'null?))
    463             (%fails (rename 'fails))
    464             (%map (rename 'map))
    465             (%cdr (rename 'cdr))
    466             (%car (rename 'car))
    467             (%apply (rename 'apply))
    468             (%append (rename 'append))
    469             (%define (rename 'define))
    470             (%make-string (rename 'make-string))
    471             (%string-length (rename 'string-length))
    472             (%symbol->string (rename 'symbol->string))
    473             (%when (rename 'when))
    474             (%case-lambda (rename 'case-lambda))
     440;(define-syntax check*
     441;  (er-macro-transformer
     442;    (lambda (form rename compare?)
     443;      (let ((var-vals (cadr form))
     444;            (xpr-yprs (cddr form))
     445;            (%verbose? (rename 'verbose?))
     446;            (%lambda (rename 'lambda))
     447;            (%x (rename 'x))
     448;            (%tests (rename 'tests))
     449;            (%writeln (rename 'writeln))
     450;            (%set! (rename 'set!))
     451;            (%print (rename 'print))
     452;            (%print* (rename 'print*))
     453;            (%begin (rename 'begin))
     454;            (%let (rename 'let))
     455;            (%== (rename '==))
     456;            (%cons (rename 'cons))
     457;            (%reverse (rename 'reverse))
     458;            (%if (rename 'if))
     459;            (%null? (rename 'null?))
     460;            (%fails (rename 'fails))
     461;            (%map (rename 'map))
     462;            (%cdr (rename 'cdr))
     463;            (%when (rename 'when))
     464;            (select-failures
     465;              (lambda (pairs)
     466;                (let loop ((pairs pairs))
     467;                  (cond
     468;                    ((null? pairs) '())
     469;                    ((caar pairs) (loop (cdr pairs)))
     470;                    (else
     471;                     (cons (car pairs) (loop (cdr pairs))))))))
     472;            )
     473;`(,%lambda (,%verbose?)
     474;   (,%let ,var-vals
     475;          (,%let ((,%tests '()))
     476;            ,@(map (lambda (p)
     477;                     `(,%begin
     478;                        (,%let ((,%x ,(car p)))
     479;                           ; protect against functions changing state
     480;                          (,%when ,%verbose?
     481;                            (,%print "testing " ',(car p) " ...")
     482;                            (,%print* "computed: ") (,%writeln ,%x)
     483;                            (,%print* "expected: ") (,%writeln ,(cadr p))
     484;                            )
     485;                          (,%set! ,%tests
     486;                                  (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
     487;                                          ,%tests)))
     488;                          ))
     489;                   (chop xpr-yprs 2))
     490;            (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
     491;              (,%when ,%verbose?
     492;                (,%print "List of failed test expressions: "
     493;                         (,%map ,%cdr ,%fails))
     494;                         )
     495;              (,%if (,%null? ,%fails) #t #f)))))
     496; ))))
     497(define-syntax check*
     498  (ir-macro-transformer
     499    (lambda (form inject compare?)
     500      (let ((var-vals (cadr form))
     501            (xpr-yprs (cddr form))
    475502            (select-failures
    476503              (lambda (pairs)
     
    482509                     (cons (car pairs) (loop (cdr pairs))))))))
    483510            )
    484 ;`(,%define (,name ,verbose?)
    485 `(,%define ,name
    486    (,%case-lambda
    487      (()
    488       (,name #t))
    489      ((,verbose?)
    490       (,%let ,(chop args* 2)
    491         (,%when ,verbose?
    492           (,%print "\nIn " ',name ":")
    493           (,%print* "---"
    494                     (,%make-string (,%string-length
    495                                      (,%symbol->string ',name)) #\-)
     511`(lambda (verbose?)
     512   (let ,var-vals
     513          (let ((tests '()))
     514            ,@(map (lambda (p)
     515                     `(begin
     516                        (let ((x ,(car p)))
     517                           ; protect against functions changing state
     518                          (when verbose?
     519                            (print "testing " ',(car p) " ...")
     520                            (print* "computed: ") (writeln x)
     521                            (print* "expected: ") (writeln ,(cadr p))
     522                            )
     523                          (set! tests
     524                                  (cons (cons ((== x) ,(cadr p)) ',(car p))
     525                                          tests)))
     526                          ))
     527                   (chop xpr-yprs 2))
     528            (let ((fails (,select-failures (reverse tests))))
     529              (when verbose?
     530                (print "List of failed test expressions: "
     531                         (map cdr fails))
     532                         )
     533              (if (null? fails) #t #f)))))
     534 ))))
     535;;; (check ((var val) ...) xpr ypr . xpr-yprs)
     536;;; ------------------------------------------
     537;;; compare xpr and ypr .... in sequence with ==
     538;;; in the environment defined by var val ...
     539(define-syntax check
     540  (syntax-rules ()
     541    ((_ ((var val) ...) xpr ypr . xpr-yprs)
     542     ((check* ((var val) ...) xpr ypr . xpr-yprs) #t))))
     543
     544;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs)
     545;;; --------------------------------------------------------------
     546;;; returns a unary predicate, name?, comparing xpr with ypr ....
     547;;; and using var val ... within this checks,
     548;;; verbose? controls the reported summary.
     549(define-syntax define-checks
     550  (ir-macro-transformer
     551    (lambda (form inject compare?)
     552      (let ((header (cadr form))
     553            (xpr-yprs (cddr form)))
     554        (let ((name (car header))
     555              (verbose? (cadr header))
     556              (var-vals (cddr header)))
     557    `(define ,name
     558       (case-lambda
     559         (()
     560          (,name #t))
     561         ((,verbose?)
     562          (when ,verbose?
     563            (print "\nIn " ',name ":")
     564            (print* "---"
     565                    (make-string (string-length
     566                                   (symbol->string ',name)) #\-)
    496567                    "-\n")
    497           )
    498         (,%let ((,%tests '()))
    499           ,@(map (lambda (p)
    500                    `(,%begin
    501                       (,%let ((,%x ,(car p)))
    502                          ; protect against functions changing state
    503                         (,%when ,verbose?
    504                           (,%print "testing " ',(car p) " ...")
    505                           ;(,%print* "computed: ") (,%writeln ,(car p))
    506                           (,%print* "computed: ") (,%writeln ,%x)
    507                           (,%print* "expected: ") (,%writeln ,(cadr p))
    508                           )
    509                         (,%set! ,%tests
    510                                 ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
    511                                 ;(,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
    512                                 (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
    513                                         ,%tests)))
    514                         ))
    515                  (chop pairs* 2))
    516           (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
    517             (,%when ,verbose?
    518               (,%print "List of failed test expressions: "
    519                        (,%map ,%cdr ,%fails))
    520                        ;(,%apply ,%append (,%map ,%cdr ,%fails)))
    521                        )
    522             (,%if (,%null? ,%fails) #t #f)))))))
    523  ))))
     568            )
     569            ((check* ,(chop var-vals 2)
     570               ,@xpr-yprs) ,verbose?)))))))))
    524571
    525572;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs)
     
    570617 ) ; simple-tests
    571618
     619;(import simple-tests)
     620;
     621;(pe '(check ((lst '(0 1 2)))
     622;        (car lst)
     623;        0
     624;        (cdr lst)
     625;        '(1 2)))
     626;
     627;(check ((lst '(0 1 2)))
     628;        (car lst)
     629;        0
     630;        (cdr lst)
     631;        '(0 1 2))
     632;
     633;(pe '(define-checks (foo verbose? lst '(0 1 2))
     634;        (car lst)
     635;        0
     636;        (cdr lst)
     637;        '(1 2)))
     638;(define-checks (foo verbose? lst '(0 1 2))
     639;        (car lst)
     640;        0
     641;        (cdr lst)
     642;        '(1 2 3))
     643;(foo #t)
     644;(ppp (foo #f))
  • release/5/simple-tests/trunk/tests/run.scm

    r38691 r38693  
    4141;;; define-checks is an alias to do-checks
    4242
    43 (ppp** ((lst '(0 1 2 3)))
     43(check ((lst '(0 1 2 3)))
    4444  lst
    4545  '(0 1 2 3)
Note: See TracChangeset for help on using the changeset viewer.