Changeset 35217 in project


Ignore:
Timestamp:
02/25/18 22:19:13 (8 months ago)
Author:
kon
Message:

use moremacros - warning checked parameters , re-flow , use csi+csc test runner

Location:
release/4/srfi-29/trunk
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-29/trunk/srfi-29.meta

    r34213 r35217  
    1111  (setup-helper "1.5.4")
    1212  (miscmacros "2.91")
     13  (moremacros "1.4.2")
    1314  (posix-utils "1.0.0")
    1415  (lookup-table "1.13.1")
  • release/4/srfi-29/trunk/srfi-29.scm

    r34412 r35217  
    2222
    2323(;export
    24   ; SRFI 29
     24  ;SRFI 29
    2525  current-language
    2626  current-country
     
    3030  declare-bundle!
    3131  localized-template
    32   ; Extensions
     32  ;Extensions
    3333  undefined-condition? unbound-variable-condition?
    3434  system-bundle-directory
     
    5252  declared-bundle-templates)
    5353
    54 (import scheme)
    55 
    56 (import chicken)
    57 (import
     54(import scheme chicken)
     55(use
    5856  (only srfi-1
    5957    first second third
     
    7068    make-pathname pathname-directory decompose-pathname)
    7169  (only posix
    72     directory? create-directory delete-directory directory))
    73 (require-library
    74   srfi-1 srfi-13 extras data-structures files posix)
    75 
    76 (import
     70    directory? create-directory delete-directory directory)
    7771  (only lookup-table
    7872    make-dict dict-ref dict-set! dict-delete!
     
    8276  (only miscmacros
    8377    if* define-parameter)
     78  (only moremacros
     79    define-warning-parameter warning-guard)
    8480  (only locale
    8581    current-locale-components locale-component-ref)
     
    8884    make-exn-condition+ make-condition-predicate)
    8985  (only type-errors
    90     error-argument-type )
     86    error-argument-type warning-argument-type)
    9187  (only type-checks
    9288    check-procedure check-symbol check-string check-list
    9389    define-check+error-type) )
    94 (require-library
    95   lookup-table miscmacros locale posix-utils
    96   condition-utils type-errors type-checks)
    97 
    98 ;(require-extension variable-item)
    9990
    10091(declare
     
    143134(define-constant DEFAULT-BUNDLE-DIR "srfi-29-bundles")
    144135
     136;;
     137
     138(define-constant NO-PACKAGE-TAG #(no-package))
     139
     140(define-constant NO-TEMPLATE-TAG #(no-template))
     141
    145142;; System bundles are here:
    146143
     
    148145;is [<language> [<country> [<details>...]]] (package-name).
    149146
    150 (define +default-system-bundles+ (make-pathname (repository-path) DEFAULT-BUNDLE-DIR))
     147(define DEFAULT-SYSTEM-BUNDLES (make-pathname (repository-path) DEFAULT-BUNDLE-DIR))
    151148
    152149;; Where
    153150
    154 (define-parameter system-bundle-directory +default-system-bundles+
    155   (lambda (x)
    156     (if (pathname? x)
    157       x
    158       (error 'system-bundle-directory "invalid directory" x) ) ) )
     151(define-warning-parameter system-bundle-directory DEFAULT-SYSTEM-BUNDLES pathname)
    159152
    160153;;; Errors
     
    180173;;; Locale Operations
    181174
    182 (define (locale-item? x) (or (not x) (symbol? x)))
     175(define (locale-item? x)
     176  (or (not x) (symbol? x)) )
     177
    183178(define-check+error-type locale-item)
    184179
    185 (define (locale-details? obj) (and (list? obj) (every locale-item? obj)))
     180(define locale-language? locale-item?)
     181(define locale-country? locale-item?)
     182
     183(define (locale-details? obj)
     184  (and (list? obj) (every locale-item? obj)) )
     185
    186186(define-check+error-type locale-details)
    187187
     
    210210
    211211(define package-name? symbol?)
     212
    212213(define-check+error-type package-name)
    213214
    214 (define (bundle-specifier-element? obj) (or (not obj) (symbol? obj)))
     215(define (bundle-specifier-element? obj)
     216  (or (not obj) (symbol? obj)) )
    215217
    216218;; bundle-specifier: (list-of symbol)
     
    222224    (package-name? (car obj))
    223225    (every bundle-specifier-element? (cdr obj))) )
     226
    224227(define-check+error-type bundle-specifier)
    225228
     
    252255(define bundle-specifiers)
    253256(let ((localization-bundles (make-dict equal?)))
    254 
     257  ;
    255258  (set! bundle-ref (lambda (bndl-spec)
    256259    (dict-ref localization-bundles bndl-spec) ) )
    257 
     260  ;
    258261  (set! bundle-set! (lambda (bndl-spec bndl-alist)
    259262    (dict-set! localization-bundles
    260263      bndl-spec (alist->dict bndl-alist equal?)) ) )
    261 
     264  ;
    262265  (set! bundle-delete! (lambda (bndl-spec)
    263266    (invalidate-package-bundle-cache bndl-spec)
    264267    (dict-delete! localization-bundles bndl-spec) ) )
    265 
     268  ;
    266269  (set! bundle-specifiers (lambda ()
    267270    (dict-keys localization-bundles))) )
     
    317320;; The initial procedure is the builtin
    318321
    319 (define-parameter current-locale-format-function format
    320   (lambda (x)
    321     (if (procedure? x)
    322       x
    323       (error 'current-locale-format-function "invalid procedure" x) ) ) )
     322(define-warning-parameter current-locale-format-function format procedure)
    324323
    325324;; The default language, country, and locale-details
    326325
    327 (define ((make-locale-guard chk) x)
     326(define ((make-locale-loadtime-guard chk) x)
    328327  (let ((x (chk x)))
    329328    (unless *LOADTIME* (invalidate-package-bundle-cache))
     
    331330
    332331(define-parameter current-language (locale-ref 'language)
    333   (make-locale-guard (lambda (x) (check-locale-item 'current-language x))))
     332  (make-locale-loadtime-guard (warning-guard current-language locale-language)))
     333
    334334(define-parameter current-country (locale-ref 'region)
    335   (make-locale-guard (lambda (x) (check-locale-item 'current-country x))))
    336 (define-parameter current-locale-details (locale-ref 'details)
    337   (make-locale-guard (lambda (x) (check-locale-details 'current-locale-details  x))))
     335  (make-locale-loadtime-guard (warning-guard current-country locale-country)))
     336
     337(define-parameter current-locale-details  (locale-ref 'details)
     338  (make-locale-loadtime-guard (warning-guard current-locale-details locale-details)))
    338339
    339340;; If you change (current-locale), you don't have to set current-*
     
    371372;;
    372373;; Raises an expception for undefined elements.
    373 
    374 (define NO-PACKAGE-TAG '#(no-package))
    375 (define NO-TEMPLATE-TAG '#(no-template))
    376374
    377375(define (*required-localized-template loc pkgnam tplnam)
     
    396394  (localized-template pkgnam tplnam defpkg deftpl) )
    397395
    398 (define ((make-localized-template/default pkgnam)
    399           tplnam #!optional (defpkg tplnam) (deftpl tplnam))
     396(define ((make-localized-template/default pkgnam) tplnam #!optional (defpkg tplnam) (deftpl tplnam))
    400397  (localized-template pkgnam tplnam) )
    401398
     
    407404
    408405(define (localized-format pkgnam tplnam . fmtargs)
    409 
     406  ;
    410407  (define (format-info-string pkgnam tplnam fmtargs)
    411408    (conc
     
    415412        (apply conc (intersperse fmtargs #\space))
    416413      #\]) )
    417 
    418   (let ((fmtstr
    419           (or
    420             (localized-template pkgnam tplnam)
    421             (and (string? tplnam) tplnam))))
     414  ;
     415  (let (
     416    (fmtstr
     417      (or
     418        (localized-template pkgnam tplnam)
     419        (and (string? tplnam) tplnam))) )
    422420    (if fmtstr
    423421      (apply (current-locale-format-function) fmtstr fmtargs)
     
    446444;Assumes valid argument!
    447445(define (make-identifier ident)
    448   (cond
    449     ; qualified name
    450     ((pair? ident)
    451       (##sys#module-rename (alist-element-atomic-value ident) (car ident)) )
    452     ; unqualified name
    453     (else
    454       ident ) ) )
     446  (if (pair? ident)
     447    ;qualified name
     448    (##sys#module-rename (alist-element-atomic-value ident) (car ident))
     449    ;unqualified name
     450    ident ) )
    455451
    456452;Assumes valid argument!
     
    486482
    487483(define (load-localized-compiled-code libspec pkgnam var-tplnams)
    488   (check-package-name 'load-localized-compiled-code pkgnam)
    489484  (*load-localized-compiled-code
    490485    libspec
    491     pkgnam
     486    (check-package-name 'load-localized-compiled-code pkgnam)
    492487    (check-template-variable-names 'load-localized-compiled-code pkgnam var-tplnams)) )
     488
     489;;
    493490
    494491(define (*load-localized-compiled-code libspec pkgnam var-tplnams)
     
    496493  (fixup-references 'load-localized-compiled-code pkgnam var-tplnams) )
    497494
    498 ;;
    499 
    500495;There must be a better way using sys namespace operations.
    501496;(Chicken 4.2.2 had a query for ALL loaded binaries. KRL dloader branch still
     
    506501
    507502(define (*load-code loc libspec)
    508   (let ((unit
    509           (if (not (pair? libspec))
    510             (and (symbol? libspec) libspec)
    511             (and (pair? libspec) (symbol? (first libspec)) (first libspec)) ) )
    512         (path
    513           (and (string? (if (pair? libspec) (second libspec) libspec)) libspec) ) )
    514     ; A pathname is preferred to a unitname
     503  (let (
     504    (unit
     505      (if (not (pair? libspec))
     506        (and (symbol? libspec) libspec)
     507        (and (pair? libspec) (symbol? (first libspec)) (first libspec)) ) )
     508    (path
     509      (and (string? (if (pair? libspec) (second libspec) libspec)) libspec) ) )
     510    ;pathname is preferred to a unitname
    515511    (let ((the-name (or path unit)))
    516512      (unless (member the-name +loaded-library-names+)
    517513        (cond
    518           ; Library Unit w/ path
     514          ;Library Unit w/ path
    519515          ((and unit path)
    520516            (load-library unit path) )
    521           ; Library Unit
     517          ;Library Unit
    522518          (unit
    523519            (load-library unit) )
     
    567563(define (load-bundle! bndl-spec . args)
    568564  (let-optionals args ((alt-dir (system-bundle-directory)))
    569     (let ((path
    570             (need-bundle-absolute-pathname
    571               'load-bundle! bndl-spec alt-dir)))
     565    (let (
     566      (path
     567        (need-bundle-absolute-pathname 'load-bundle! bndl-spec alt-dir)))
    572568      (and
    573569        (file-exists? path)
     
    578574(define (store-bundle! bndl-spec . args)
    579575  (let-optionals args ((alt-dir (system-bundle-directory)))
    580     (let ((path
    581             (need-bundle-absolute-pathname
    582               'store-bundle! bndl-spec alt-dir))
    583           (bndl
    584             (need-bundle 'store-bundle! bndl-spec)) )
     576    (let (
     577      (path
     578        (need-bundle-absolute-pathname 'store-bundle! bndl-spec alt-dir))
     579      (bndl
     580        (need-bundle 'store-bundle! bndl-spec)) )
    585581      (create-pathname-directory path)
    586582      (delete-file* path)
     
    592588(define (remove-bundle! bndl-spec . args)
    593589  (let-optionals args ((alt-dir (system-bundle-directory)))
    594     (let ((path
    595             (need-bundle-absolute-pathname
    596               'remove-bundle! bndl-spec alt-dir)))
     590    (let (
     591      (path
     592        (need-bundle-absolute-pathname 'remove-bundle! bndl-spec alt-dir)) )
    597593      (bundle-delete! bndl-spec)
    598594      (delete-file* path)
     
    603599(define (remove-bundle-directory! bndl-spec . args)
    604600  (let-optionals args ((alt-dir (system-bundle-directory)))
    605     (let ((path (need-bundle-absolute-pathname
    606                   'remove-bundle-directory! bndl-spec alt-dir)))
     601    (let (
     602      (path
     603        (need-bundle-absolute-pathname 'remove-bundle-directory! bndl-spec alt-dir)) )
    607604      (delete-file* path)
    608605      (let ((topdir alt-dir))
    609606        (let loop ((path path))
    610           (let* ((dir (pathname-directory path))
    611                  (fillst (directory dir)))
     607          (let* (
     608            (dir (pathname-directory path))
     609            (fillst (directory dir)) )
    612610            (cond
    613611              ((string=? dir topdir)        #t)
     
    622620  (let-optionals args ((alt-dir (system-bundle-directory)))
    623621    (let loop ((bndl-spec
    624                 (check-bundle-specifier
    625                   'load-best-available-bundle! bndl-spec)))
     622                (check-bundle-specifier 'load-best-available-bundle! bndl-spec)))
    626623      (and
    627624        (not (null? bndl-spec))
     
    647644  (dict->alist
    648645    (need-bundle 'declared-bundle-templates
    649       (check-bundle-specifier 'declared-bundle-templates
    650         bndl-spec))) )
     646      (check-bundle-specifier 'declared-bundle-templates bndl-spec))) )
    651647
    652648;;;
    653649
    654650(register-feature! 'srfi-29)
     651
     652;;ugh
    655653(define *LOADTIME* #f)
    656654
  • release/4/srfi-29/trunk/srfi-29.setup

    r34412 r35217  
    99  (file-chmod (srfi-29-bundles-home) 'a+rx) )
    1010
    11 (setup-shared-extension-module 'srfi-29 (extension-version "2.4.1")
     11(setup-shared-extension-module 'srfi-29 (extension-version "2.5.0")
    1212  #:inline? #t
    1313  #:types? #t
  • release/4/srfi-29/trunk/tests/run.scm

    r34412 r35217  
    1 ;;;; srfi-29-test.scm
    21
    3 ;To use w/ TLS:
    4 ;(cd .../srfi-29/trunk/tests; \
    5 ;sudo csi -n -R posix -e '(setenv "SRFI29_TLS" "1")' -s run.scm)
     2(define EGG-NAME "srfi-29")
    63
    7 (use test)
    8 (use srfi-29)
    9 (use posix)
     4;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    105
    11 (define (allow-sysops?)
    12   (or
    13     (eq? 'windows (software-type))
    14     (= 0 (current-effective-user-id))) )
     6(use files)
    157
    16 (test-group "SRFI 29 Basics"
     8;no -disable-interrupts
     9(define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    1710
    18   (let ((bal1 '((foo1 . 1) ("bar1" . 2) (baz1 . 3)))
    19         (bal2 '((foo2 . 4) ("bar2" . 5) (baz2 . 6)))
    20         (bal3 '((foo3 . 7) ("bar3" . 8) (baz3 . 9))) )
     11(define *args* (argv))
    2112
    22     (test-group "Locale"
     13(define (test-name #!optional (eggnam EGG-NAME))
     14  (string-append eggnam "-test") )
    2315
    24       (test-assert "L1" (current-language))
    25       (test-assert "L2" (current-country))
    26       (test-assert "L3" (current-locale-details))
     16(define (egg-name #!optional (def EGG-NAME))
     17  (cond
     18    ((<= 4 (length *args*))
     19      (cadddr *args*) )
     20    (def
     21      def )
     22    (else
     23      (error 'test "cannot determine egg-name") ) ) )
    2724
    28       (test-assert "L4" (symbol? (current-language)))
    29       (test-assert "L5" (symbol? (current-country)))
    30       (test-assert "L6" (list? (current-locale-details)))
     25;;;
    3126
    32       (test-assert "L7" (current-language 'foo))
    33       (test-assert "L8" (current-country 'bar))
    34       (test-assert "L9" (current-locale-details '(baz)))
     27(set! EGG-NAME (egg-name))
    3528
    36       (test "L10" 'foo (current-language))
    37       (test "L11" 'bar (current-country))
    38       (test "L12" '(baz) (current-locale-details))
     29(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
     30  (let ((tstnam (test-name eggnam)))
     31    (print "*** csi ***")
     32    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
     33    (newline)
     34    (print "*** csc (" cscopts ") ***")
     35    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
     36    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
    3937
    40       (reset-locale-parameters)
    41     )
     38(define (run-tests eggnams #!optional (cscopts *csc-options*))
     39  (for-each (cut run-test <> cscopts) eggnams) )
    4240
    43     (test-group "Bundles"
     41;;;
    4442
    45       (test-assert "" (declare-bundle! '(srfi-29-test) bal1))
    46       (test-assert "" (declare-bundle! '(srfi-29-test foo) bal2))
    47       (test-assert "" (declare-bundle! '(srfi-29-test foo bar) bal3))
    48 
    49       (test "declared-bundle-specifiers (uses internal list order; brittle)"
    50             '((srfi-29-test foo bar) (srfi-29-test foo) (srfi-29-test))
    51             (declared-bundle-specifiers))
    52       (test "declared-bundle-templates" bal1 (declared-bundle-templates '(srfi-29-test)))
    53       (test "declared-bundle-templates foo" bal2 (declared-bundle-templates '(srfi-29-test foo)))
    54       (test "declared-bundle-templates foo bar" bal3 (declared-bundle-templates '(srfi-29-test foo bar)))
    55 
    56       (test "" 1 (localized-template 'srfi-29-test 'foo1))
    57       (test "" 2 (localized-template 'srfi-29-test "bar1"))
    58       (test "" 3 (localized-template 'srfi-29-test 'baz1))
    59 
    60       (test-assert "" (undeclare-bundle! '(srfi-29-test)))
    61       (test-assert "" (undeclare-bundle! '(srfi-29-test foo)))
    62       (test-assert "" (undeclare-bundle! '(srfi-29-test foo bar)))
    63 
    64       (test-assert "" (not (localized-template 'srfi-29-test 'foo1)))
    65       (test-assert "" (not (localized-template 'srfi-29-test "bar1")))
    66       (test-assert "" (not (localized-template 'srfi-29-test 'baz1)))
    67     )
    68 
    69     (test-group "Bundles Alternate Directory"
    70 
    71       (define altdir ".")
    72 
    73       (test-assert "B1" (declare-bundle! '(srfi-29-test) bal1))
    74       (test-assert "B2" (declare-bundle! '(srfi-29-test foo) bal2))
    75       (test-assert "B3" (declare-bundle! '(srfi-29-test foo bar) bal3))
    76 
    77       (test-assert "B7" (store-bundle! '(srfi-29-test) altdir))
    78       (test-assert "B8" (store-bundle! '(srfi-29-test foo) altdir))
    79       (test-assert "B9" (store-bundle! '(srfi-29-test foo bar) altdir))
    80 
    81       (test-assert "B10" (remove-bundle! '(srfi-29-test) altdir))
    82       (test-assert "B11" (remove-bundle! '(srfi-29-test foo) altdir))
    83       (test-assert "B12" (remove-bundle! '(srfi-29-test foo bar) altdir))
    84 
    85       (test-assert "B13" (not (load-bundle! '(srfi-29-test) altdir)))
    86       (test-assert "B14" (not (load-bundle! '(srfi-29-test foo) altdir)))
    87       (test-assert "B15" (not (load-bundle! '(srfi-29-test foo bar) altdir)))
    88 
    89       (test-assert "AltDir RmDir" (remove-bundle-directory! '(srfi-29-test foo bar) altdir))
    90     )
    91 
    92     (when (allow-sysops?)
    93       (test-group "Bundles System Directory"
    94 
    95         (test-assert "B16" (declare-bundle! '(srfi-29-test) bal1))
    96         (test-assert "B17" (declare-bundle! '(srfi-29-test foo) bal2))
    97         (test-assert "B18" (declare-bundle! '(srfi-29-test foo bar) bal3))
    98 
    99         (test-assert "B19" (store-bundle! '(srfi-29-test)))
    100         (test-assert "B20" (store-bundle! '(srfi-29-test foo)))
    101         (test-assert "B21" (store-bundle! '(srfi-29-test foo bar)))
    102 
    103         (test-assert "B22" (undeclare-bundle! '(srfi-29-test)))
    104         (test-assert "B23" (undeclare-bundle! '(srfi-29-test foo)))
    105         (test-assert "B24" (undeclare-bundle! '(srfi-29-test foo bar)))
    106 
    107         (test-assert "B25.1" (not (localized-template 'srfi-29-test 'foo1)))
    108         (test-assert "B26.1" (not (localized-template 'srfi-29-test "bar1")))
    109         (test-assert "B27.1" (not (localized-template 'srfi-29-test 'baz1)))
    110 
    111         (test-assert "B22.1" (load-bundle! '(srfi-29-test)))
    112         (test-assert "B23.1" (load-bundle! '(srfi-29-test foo)))
    113         (test-assert "B24.1" (load-bundle! '(srfi-29-test foo bar)))
    114 
    115         (test "B25" 1 (localized-template 'srfi-29-test 'foo1))
    116         (test "B26" 2 (localized-template 'srfi-29-test "bar1"))
    117         (test "B27" 3 (localized-template 'srfi-29-test 'baz1))
    118 
    119         (test "localized-templates" bal1 (localized-templates 'srfi-29-test))
    120 
    121         (current-language 'foo)
    122 
    123         (test "B28" 4 (localized-template 'srfi-29-test 'foo2))
    124         (test "B29" 5 (localized-template 'srfi-29-test "bar2"))
    125         (test "B30" 6 (localized-template 'srfi-29-test 'baz2))
    126 
    127         (test "localized-templates language foo" bal2 (localized-templates 'srfi-29-test))
    128 
    129         (current-country 'bar)
    130 
    131         (test "B31" 7 (localized-template 'srfi-29-test 'foo3))
    132         (test "B32" 8 (localized-template 'srfi-29-test "bar3"))
    133         (test "B33" 9 (localized-template 'srfi-29-test 'baz3))
    134 
    135         (test "localized-templates language foo, country bar"
    136           bal3 (localized-templates 'srfi-29-test))
    137 
    138         (test-assert "B37.1" (localized-template-set! 'srfi-29-test 'baz3 'foobar))
    139         (test "B37.2" 'foobar (localized-template 'srfi-29-test 'baz3))
    140         (test-assert "B37.3" (not (localized-template-set! 'foobar 'baz3 #t)))
    141         (test-assert "B37.4" (localized-template-set! 'srfi-29-test 'barf 16))
    142         (test "B37.5" 16 (localized-template 'srfi-29-test 'barf))
    143 
    144         (test-assert "B34" (remove-bundle! '(srfi-29-test)))
    145         (test-assert "B35" (remove-bundle! '(srfi-29-test foo)))
    146         (test-assert "B36" (remove-bundle! '(srfi-29-test foo bar)))
    147 
    148         (test-assert "SysDir RmDir" (remove-bundle-directory! '(srfi-29-test foo bar)))
    149 
    150         (reset-locale-parameters)
    151       )
    152     )
    153   )
    154 
    155   #;(test-assert "B22.2" (load-best-available-bundle! (most-specific-bundle-specifier 'srfi-19)))
    156   #;(test "B22.3 English" "August" (localized-template 'srfi-19 'august))
    157   #;(test "B22.4 English" "December" (localized-template 'srfi-19 'december))
    158 )
    159 
    160 (test-group "SRFI 29 Logic"
    161 
    162   ;for compile & load so extension assumed
    163   (define test-logic-filename "test-logic")
    164 
    165   ;compile logic
    166   (system (string-append "csc -s " test-logic-filename))
    167 
    168   ;declare logic pkg
    169   (declare-bundle! '(srfi-29-test)
    170     `((library . ,test-logic-filename)          ;pathname of compiled logic (for load)
    171       (proc* . (srfi-29-test . test-star))      ;module ident
    172       (proc0 . srfi-29-test-0)                  ;0 arg proc
    173       (proc1 . srfi-29-test-1)                  ;1 arg proc
    174       (procN . srfi-29-test-N)))                ;N arg proc
    175   (define !item@ (make-required-localized-template 'srfi-29-test))
    176   (test-assert (procedure? !item@))
    177 
    178   ;load logic
    179   (load-localized-compiled-code
    180     (!item@ 'library)
    181     'srfi-29-test
    182     '(proc0 proc1 procN proc*))
    183 
    184   ;test logic
    185   (test-assert (procedure? (!item@ 'proc0)))
    186   (test-assert (procedure? (!item@ 'proc1)))
    187   (test-assert (procedure? (!item@ 'procN)))
    188   (test-assert (procedure? (!item@ 'proc*)))
    189 
    190   (test 0 ((!item@ 'proc0)))
    191   (test -56 ((!item@ 'proc1) 56))
    192   (test '(1 2 3 4 5 6) ((!item@ 'procN) 1 2 3 4 5 6))
    193   (test '(* hello) ((!item@ 'proc*) 'hello))
    194 )
    195 
    196 (test-exit)
     43(run-test)
Note: See TracChangeset for help on using the changeset viewer.