Changeset 38731 in project for release


Ignore:
Timestamp:
06/05/20 03:51:44 (2 months ago)
Author:
Kon Lovett
Message:

include test gloss

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/number-limits/trunk/tests/test-gloss.incl.scm

    r38437 r38731  
    11
    2 ;;;test "Gloss" API
     2;;; test "Gloss" API
    33
    4 (define-constant TEST-GLOSS-MARKER "--> ")
    5 
    6 (define (test-group-ref group field . o)
    7   (define (assq-ref ls key . o)
    8     (cond
    9       ((assq key ls)    => cdr)
    10       ((pair? o)        (car o))
    11       (else             #f) ) )
    12   (apply assq-ref (cdr group) field o) )
     4;;
    135
    146(define test-indent-width)
     
    179(define test-indentation-char)
    1810(let ()
    19   (import
    20     (chicken syntax)
    21     (only (chicken process-context) get-environment-variable))
     11  (import (chicken syntax))
     12  (import (only (chicken process-context) get-environment-variable))
    2213
    2314  (define get-environment-variable/default
     
    9081      (checked-guard test-indentation-char char))) )
    9182
     83;;
     84
     85;from test?
     86(define (test-group-ref group field . o)
     87  (define (assq-ref ls key . o)
     88    (cond
     89      ((assq key ls)    => cdr)
     90      ((pair? o)        (car o))
     91      (else             #f) ) )
     92  (apply assq-ref (cdr group) field o) )
     93
     94;;
     95
     96(define-constant TEST-GLOSS-MARKER "--> ")
     97
    9298(define (test-group-indent-string group)
    9399  (define (*test-group-level group)
     
    99105  (make-string (test-group-indent-width group) (test-indentation-char)) )
    100106
     107(define (display-gloss-marker)
     108  (display (test-group-indent-string (current-test-group)))
     109  (display TEST-GLOSS-MARKER) )
     110
     111;;
     112
     113(define-syntax glossn
     114  (syntax-rules ()
     115    ((glossn)
     116      (begin))
     117    ((glossn ?obj)
     118      (begin
     119        (display-gloss-marker)
     120        (display ?obj)
     121        (flush-output)) )
     122    ((glossn ?obj ...)
     123      (begin
     124        (display-gloss-marker)
     125        (for-each display (list ?obj ...))
     126        (flush-output)) ) ) )
     127
    101128(define-syntax gloss
    102129  (syntax-rules ()
    103130    ((gloss)
    104       (newline) )
     131      (newline))
    105132    ((gloss ?obj ...)
    106133      (begin
    107         (display (test-group-indent-string (current-test-group)))
    108         (display TEST-GLOSS-MARKER)
    109         (for-each display (list ?obj ...))
     134        (glossn ?obj ...)
    110135        (newline)) ) ) )
    111136
     137;Needs a format:
    112138;(import (only (chicken format) format)) ;builtin
    113139;(import format)                         ;egg
     140
     141(define-syntax glossnf
     142  (syntax-rules ()
     143    ((glossnf ?fmt ?arg0 ...)
     144      (glossn (format #f ?fmt ?arg0 ...)) ) ) )
     145
    114146(define-syntax glossf
    115147  (syntax-rules ()
    116148    ((glossf ?fmt ?arg0 ...)
    117       (gloss (format #f ?fmt ?arg0 ...)) ) ) )
     149      (begin
     150        (glossnf ?fmt ?arg0 ...)
     151        (newline)) ) ) )
Note: See TracChangeset for help on using the changeset viewer.