Changeset 25426 in project


Ignore:
Timestamp:
10/24/11 16:55:22 (9 years ago)
Author:
Alex Shinn
Message:

adding support for less verbose tests w/ TEST_QUIET=1 env var

Location:
release/4/test
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/test/tags/0.9.9.3/test-support.scm

    r25175 r25426  
    158158(define (test-default-applier expect expr info)
    159159  (let* ((group (current-test-group))
    160          (indent (and group (test-group-indent-width group))))
     160         (verbose? (and group (test-group-ref group 'verbosity)))
     161         (indent (and verbose? (test-group-indent-width group))))
    161162    (cond
    162      ((and group
    163            (equal? 0 (test-group-ref group 'count 0))
    164            (zero? (test-group-ref group 'subgroups-count 0))
    165            (test-group-ref group 'verbosity))
    166       (newline)
    167       (print-header-line
    168        (string-append "testing " (or (test-group-name group) ""))
    169        (or indent 0))))
    170     (if (and indent (positive? indent))
    171         (display (make-string indent #\space)))
    172     (test-print-name info indent)
     163     (verbose?
     164      (cond
     165       ((and (equal? 0 (test-group-ref group 'count 0))
     166             (zero? (test-group-ref group 'subgroups-count 0))
     167             (test-group-ref group 'verbosity))
     168        (newline)
     169        (print-header-line
     170         (string-append "testing " (or (test-group-name group) ""))
     171         (or indent 0))))
     172      (if (and indent (positive? indent))
     173          (display (make-string indent #\space)))
     174      (test-print-name info indent)))
    173175    (let ((expect-val
    174176           (condition-case
     
    200202
    201203(define (test-default-handler status expect expr info)
    202   (define indent
     204  ;; update group info
     205  (let* ((group (current-test-group))
     206         (verbose? (and group (test-group-ref group 'verbosity)))
     207         (indent
     208          (cond (group
     209                 => (lambda (group)
     210                      (make-string (+ 4 (or (test-group-indent-width group) 0))
     211                                   #\space)))
     212                (else (make-string 4 #\space)))))
    203213    (cond ((current-test-group)
    204214           => (lambda (group)
    205                 (make-string (+ 4 (or (test-group-indent-width group) 0)) #\space)))
    206           (else (make-string 4 #\space))))
    207   ;; update group info
    208   (cond ((current-test-group)
    209          => (lambda (group)
    210               (if (not (eq? 'SKIP status))
    211                 (test-group-inc! group 'count))
    212               (test-group-inc! group status))))
    213   (cond
    214    ((or (eq? status 'FAIL) (eq? status 'ERROR))
    215     (test-failure-count (+ 1 (test-failure-count)))))
    216   (cond
    217     ((not (eq? status 'SKIP))
    218      ;; display status
    219      (display "[")
    220      (if (not (eq? status 'ERROR)) (display " ")) ; pad
    221      (display ((if (test-ansi?)
    222                  (case status
    223                    ((ERROR) (compose underline red))
    224                    ((FAIL) red)
    225                    ((SKIP) yellow)
    226                    (else green))
    227                  identity)
    228                status))
    229      (display "]")
    230      (newline)
    231      ;; display status explanation
    232      (cond ((not (eq? status 'PASS))
    233             (display indent)))
    234      (cond
     215                (if (not (eq? 'SKIP status))
     216                    (test-group-inc! group 'count))
     217                (test-group-inc! group status))))
     218    (cond
     219     ((or (eq? status 'FAIL) (eq? status 'ERROR))
     220      (test-failure-count (+ 1 (test-failure-count)))))
     221    (cond
     222     ((not verbose?)
     223      (write-char (case status
     224                    ((PASS) #\.) ((FAIL) #\x) ((ERROR) #\!) (else #\space)))
     225      (if (zero? (modulo (test-group-ref group 'count) (current-column-width)))
     226          (newline)))
     227     ((not (eq? status 'SKIP))
     228      ;; display status
     229      (display "[")
     230      (if (not (eq? status 'ERROR)) (display " ")) ; pad
     231      (display ((if (test-ansi?)
     232                    (case status
     233                      ((ERROR) (compose underline red))
     234                      ((FAIL) red)
     235                      ((SKIP) yellow)
     236                      (else green))
     237                    identity)
     238                status))
     239      (display "]")
     240      (newline)
     241      ;; display status explanation
     242      (cond ((not (eq? status 'PASS))
     243             (display indent)))
     244      (cond
    235245       ((eq? status 'ERROR)
    236246        (cond ((assq 'exception info)
     
    247257        (display "expected ") (write (assq-ref info 'expected))
    248258        (display " but got ") (write (assq-ref info 'result)) (newline)))
    249      ;; display line, source and values info
    250      (cond
     259      ;; display line, source and values info
     260      (cond
    251261       ((or (not (current-test-group))
    252262            (test-group-ref (current-test-group) 'verbosity))
     
    254264          ((FAIL ERROR)
    255265           (cond
    256              ((assq-ref info 'line-number)
    257               => (lambda (line)
    258                    (display "    in line ")
    259                    (write line)
    260                    (cond ((assq-ref info 'file-name)
    261                           => (lambda (file) (display " of file ") (write file))))
    262                    (newline))))
     266            ((assq-ref info 'line-number)
     267             => (lambda (line)
     268                  (display "    in line ")
     269                  (write line)
     270                  (cond ((assq-ref info 'file-name)
     271                         => (lambda (file) (display " of file ") (write file))))
     272                  (newline))))
    263273           (cond
    264              ((assq-ref info 'source)
    265               => (lambda (s)
    266                    (if (or (assq-ref info 'name)
    267                            (> (string-length (write-to-string s))
    268                               (current-column-width)))
    269                        (for-each
    270                         (lambda (line) (display "    ") (display line) (newline))
    271                         (string-split
    272                          (with-output-to-string (lambda () (pp s)))
    273                          "\n"))))))
     274            ((assq-ref info 'source)
     275             => (lambda (s)
     276                  (if (or (assq-ref info 'name)
     277                          (> (string-length (write-to-string s))
     278                             (current-column-width)))
     279                      (for-each
     280                       (lambda (line) (display "    ") (display line) (newline))
     281                       (string-split
     282                        (with-output-to-string (lambda () (pp s)))
     283                        "\n"))))))
    274284           (cond
    275              ((assq-ref info 'values)
    276               => (lambda (v)
    277                    (for-each
    278                     (lambda (v)
    279                       (display "    ") (display (car v))
    280                       (display ": ") (write (cdr v)) (newline))
    281                     v)))))
    282           )))))
     285            ((assq-ref info 'values)
     286             => (lambda (v)
     287                  (for-each
     288                   (lambda (v)
     289                     (display "    ") (display (car v))
     290                     (display ": ") (write (cdr v)) (newline))
     291                   v)))))
     292          ))))))
    283293  status)
    284294
     
    307317         (subgroups-pass (or (test-group-ref group 'subgroups-pass) 0))
    308318         (indent (make-string (or (test-group-indent-width group) 0) #\space)))
     319    (if (not (test-group-ref group 'verbosity))
     320        (newline))
    309321    (cond
    310322     ((or (positive? count) (positive? subgroups-count))
  • release/4/test/tags/0.9.9.3/test.setup

    r25175 r25426  
    55 'test
    66 '("test.so" "test.import.so")
    7  '((version 0.9.9.2)))
     7 '((version 0.9.9.3)))
  • release/4/test/trunk/test-support.scm

    r25175 r25426  
    158158(define (test-default-applier expect expr info)
    159159  (let* ((group (current-test-group))
    160          (indent (and group (test-group-indent-width group))))
     160         (verbose? (and group (test-group-ref group 'verbosity)))
     161         (indent (and verbose? (test-group-indent-width group))))
    161162    (cond
    162      ((and group
    163            (equal? 0 (test-group-ref group 'count 0))
    164            (zero? (test-group-ref group 'subgroups-count 0))
    165            (test-group-ref group 'verbosity))
    166       (newline)
    167       (print-header-line
    168        (string-append "testing " (or (test-group-name group) ""))
    169        (or indent 0))))
    170     (if (and indent (positive? indent))
    171         (display (make-string indent #\space)))
    172     (test-print-name info indent)
     163     (verbose?
     164      (cond
     165       ((and (equal? 0 (test-group-ref group 'count 0))
     166             (zero? (test-group-ref group 'subgroups-count 0))
     167             (test-group-ref group 'verbosity))
     168        (newline)
     169        (print-header-line
     170         (string-append "testing " (or (test-group-name group) ""))
     171         (or indent 0))))
     172      (if (and indent (positive? indent))
     173          (display (make-string indent #\space)))
     174      (test-print-name info indent)))
    173175    (let ((expect-val
    174176           (condition-case
     
    200202
    201203(define (test-default-handler status expect expr info)
    202   (define indent
     204  ;; update group info
     205  (let* ((group (current-test-group))
     206         (verbose? (and group (test-group-ref group 'verbosity)))
     207         (indent
     208          (cond (group
     209                 => (lambda (group)
     210                      (make-string (+ 4 (or (test-group-indent-width group) 0))
     211                                   #\space)))
     212                (else (make-string 4 #\space)))))
    203213    (cond ((current-test-group)
    204214           => (lambda (group)
    205                 (make-string (+ 4 (or (test-group-indent-width group) 0)) #\space)))
    206           (else (make-string 4 #\space))))
    207   ;; update group info
    208   (cond ((current-test-group)
    209          => (lambda (group)
    210               (if (not (eq? 'SKIP status))
    211                 (test-group-inc! group 'count))
    212               (test-group-inc! group status))))
    213   (cond
    214    ((or (eq? status 'FAIL) (eq? status 'ERROR))
    215     (test-failure-count (+ 1 (test-failure-count)))))
    216   (cond
    217     ((not (eq? status 'SKIP))
    218      ;; display status
    219      (display "[")
    220      (if (not (eq? status 'ERROR)) (display " ")) ; pad
    221      (display ((if (test-ansi?)
    222                  (case status
    223                    ((ERROR) (compose underline red))
    224                    ((FAIL) red)
    225                    ((SKIP) yellow)
    226                    (else green))
    227                  identity)
    228                status))
    229      (display "]")
    230      (newline)
    231      ;; display status explanation
    232      (cond ((not (eq? status 'PASS))
    233             (display indent)))
    234      (cond
     215                (if (not (eq? 'SKIP status))
     216                    (test-group-inc! group 'count))
     217                (test-group-inc! group status))))
     218    (cond
     219     ((or (eq? status 'FAIL) (eq? status 'ERROR))
     220      (test-failure-count (+ 1 (test-failure-count)))))
     221    (cond
     222     ((not verbose?)
     223      (write-char (case status
     224                    ((PASS) #\.) ((FAIL) #\x) ((ERROR) #\!) (else #\space)))
     225      (if (zero? (modulo (test-group-ref group 'count) (current-column-width)))
     226          (newline)))
     227     ((not (eq? status 'SKIP))
     228      ;; display status
     229      (display "[")
     230      (if (not (eq? status 'ERROR)) (display " ")) ; pad
     231      (display ((if (test-ansi?)
     232                    (case status
     233                      ((ERROR) (compose underline red))
     234                      ((FAIL) red)
     235                      ((SKIP) yellow)
     236                      (else green))
     237                    identity)
     238                status))
     239      (display "]")
     240      (newline)
     241      ;; display status explanation
     242      (cond ((not (eq? status 'PASS))
     243             (display indent)))
     244      (cond
    235245       ((eq? status 'ERROR)
    236246        (cond ((assq 'exception info)
     
    247257        (display "expected ") (write (assq-ref info 'expected))
    248258        (display " but got ") (write (assq-ref info 'result)) (newline)))
    249      ;; display line, source and values info
    250      (cond
     259      ;; display line, source and values info
     260      (cond
    251261       ((or (not (current-test-group))
    252262            (test-group-ref (current-test-group) 'verbosity))
     
    254264          ((FAIL ERROR)
    255265           (cond
    256              ((assq-ref info 'line-number)
    257               => (lambda (line)
    258                    (display "    in line ")
    259                    (write line)
    260                    (cond ((assq-ref info 'file-name)
    261                           => (lambda (file) (display " of file ") (write file))))
    262                    (newline))))
     266            ((assq-ref info 'line-number)
     267             => (lambda (line)
     268                  (display "    in line ")
     269                  (write line)
     270                  (cond ((assq-ref info 'file-name)
     271                         => (lambda (file) (display " of file ") (write file))))
     272                  (newline))))
    263273           (cond
    264              ((assq-ref info 'source)
    265               => (lambda (s)
    266                    (if (or (assq-ref info 'name)
    267                            (> (string-length (write-to-string s))
    268                               (current-column-width)))
    269                        (for-each
    270                         (lambda (line) (display "    ") (display line) (newline))
    271                         (string-split
    272                          (with-output-to-string (lambda () (pp s)))
    273                          "\n"))))))
     274            ((assq-ref info 'source)
     275             => (lambda (s)
     276                  (if (or (assq-ref info 'name)
     277                          (> (string-length (write-to-string s))
     278                             (current-column-width)))
     279                      (for-each
     280                       (lambda (line) (display "    ") (display line) (newline))
     281                       (string-split
     282                        (with-output-to-string (lambda () (pp s)))
     283                        "\n"))))))
    274284           (cond
    275              ((assq-ref info 'values)
    276               => (lambda (v)
    277                    (for-each
    278                     (lambda (v)
    279                       (display "    ") (display (car v))
    280                       (display ": ") (write (cdr v)) (newline))
    281                     v)))))
    282           )))))
     285            ((assq-ref info 'values)
     286             => (lambda (v)
     287                  (for-each
     288                   (lambda (v)
     289                     (display "    ") (display (car v))
     290                     (display ": ") (write (cdr v)) (newline))
     291                   v)))))
     292          ))))))
    283293  status)
    284294
     
    307317         (subgroups-pass (or (test-group-ref group 'subgroups-pass) 0))
    308318         (indent (make-string (or (test-group-indent-width group) 0) #\space)))
     319    (if (not (test-group-ref group 'verbosity))
     320        (newline))
    309321    (cond
    310322     ((or (positive? count) (positive? subgroups-count))
  • release/4/test/trunk/test.setup

    r25175 r25426  
    55 'test
    66 '("test.so" "test.import.so")
    7  '((version 0.9.9.2)))
     7 '((version 0.9.9.3)))
Note: See TracChangeset for help on using the changeset viewer.