Changeset 36802 in project


Ignore:
Timestamp:
11/11/18 03:06:01 (4 weeks ago)
Author:
kon
Message:

better srfi-111 support

Location:
release/5/box/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/box/trunk/box.egg

    r36480 r36802  
    33
    44((synopsis "Boxing")
    5  (version "3.0.1")
     5 (version "3.1.0")
    66 (category data)
    77 (license "BSD")
  • release/5/box/trunk/box.scm

    r36480 r36802  
    2828  make-box-variable-closure
    2929  make-box-location-closure
    30   ;
    31   box set-box! unbox
     30  ;SRFI 111
     31  box immutable-box set-box! unbox
    3232  ;
    3333  *box-structure? *box-structure-ref *box-structure-set!
     
    387387      (error-box 'box-location box))))
    388388
    389 ;;; MZ Scheme Style
     389;;; SRFI-111 Style
    390390
    391391(define-syntax box
     
    393393    ((_ ?arg0 ...)
    394394      (make-box ?arg0 ...))))
     395
     396(define-syntax immutable-box
     397  (syntax-rules ()
     398    ((_ ?arg0 ...)
     399      (make-box ?arg0 ... #t))))
    395400
    396401(define-syntax unbox
  • release/5/box/trunk/tests/box-test.scm

    r36480 r36802  
    99
    1010(import box)
    11 
    12 ;;
    13 
    14 (import (only (chicken platform) features))
    15 
    16 (test-group "Box Support"
    17   (test-assert "SRFI 111"
    18     (let loop ((rem (features)))
    19       (cond
    20         ((null? rem)
    21           #f )
    22         ((eq? #:srfi-111 (car rem))
    23           #t )
    24         (else
    25           (loop (cdr rem)) ) ) ) )
    26 )
    2711
    2812;;
     
    7559;;;
    7660
     61(test-begin "SRFI-111")
     62
     63(import (only (chicken platform) features))
     64
     65(test-group "Feature"
     66  (test-assert "SRFI 111"
     67    (let loop ((rem (features)))
     68      (cond
     69        ((null? rem)
     70          #f )
     71        ((eq? #:srfi-111 (car rem))
     72          #t )
     73        (else
     74          (loop (cdr rem)) ) ) ) )
     75)
     76
     77(test-group "Box"
     78        (let ((tbox #f))
     79    (test-assert (box (void)))
     80    (set! tbox (box (void)))
     81    (test-assert (box? tbox))
     82    (box-set! tbox #t)
     83    (test-assert (unbox tbox))
     84    (test-assert (not (box? 3))) )
     85)
     86
     87(test-group "Immutable-Box"
     88        (let ((tbox #f))
     89    (test-assert (immutable-box #f))
     90    (set! tbox (immutable-box #f))
     91    (test-assert (box? tbox))
     92    (test-assert (not (unbox tbox)))
     93    (test-error (box-set! tbox #t)) )
     94)
     95
     96(test-end "SRFI-111")
     97
     98;;;
     99
    77100(test-end "Box")
    78101
Note: See TracChangeset for help on using the changeset viewer.