Changeset 35418 in project


Ignore:
Timestamp:
04/22/18 01:03:03 (5 weeks ago)
Author:
kon
Message:

csi+csc test runner, .h per upstream, add types, use fx, reflow, add test

Location:
release/4/uuid-ossp/trunk
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed
  • release/4/uuid-ossp/trunk/tests/run.scm

    r28281 r35418  
    1 ;;;; uuid-lib-test.scm  -*- Hen -*-
    21
    3 (use test)
    4 (use uuid-ossp)
     2(define EGG-NAME "uuid-ossp")
    53
    6 ;Assumes the underlying library works so just the Scheme wrapper tested
     4;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    75
    8 (test-group "Common API"
     6(use files)
    97
    10   (test-assert "uuid? <null>" (uuid? (make-uuid)))
    11   (test-assert "uuid? V1" (uuid? (make-uuid 'V1)))
    12   (test-assert "uuid? V4" (uuid? (make-uuid 'V4)))
    13   (test-assert "uuid? time" (uuid? (make-uuid 'time)))
    14   (test-assert "uuid? random" (uuid? (make-uuid 'random)))
     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")
    1510
    16   (test-assert "uuid-null? 1" (not (uuid-null? (make-uuid 'V1))))
    17   (test-assert "uuid-null? 2" (uuid-null? (make-uuid)))
     11(define *args* (argv))
    1812
    19   (test-assert "uuid-clear!" (uuid-null? (uuid-clear! (make-uuid 'V4))))
     13(define (test-name #!optional (eggnam EGG-NAME))
     14  (string-append eggnam "-test") )
    2015
    21   (let* ((tuuid (make-uuid 'V4))
    22          (cuuid (uuid-copy tuuid)) )
    23     (test-assert "uuid-copy =" (uuid=? tuuid cuuid))
    24     (test-assert "uuid-copy !eq" (not (eq? tuuid cuuid))) )
     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") ) ) )
    2524
    26   (test-assert "A uuid is = & <= & >= to itself"
    27     (let ((tuuid (make-uuid 'random)))
    28       (and (uuid=? tuuid tuuid) (uuid<=? tuuid tuuid) (uuid>=? tuuid tuuid))))
     25;;;
    2926
    30   (test-assert "A !null uuid is \"unique\"" (not (uuid=? (make-uuid 'V1) (make-uuid 'V1))))
    31   (test-assert "A null uuid is not \"unique\"" (uuid=? (make-uuid) (make-uuid)))
     27(set! EGG-NAME (egg-name))
    3228
    33   (test-assert "External form of uuid"
    34     (let ((tuuid (make-uuid 'V1)))
    35       (uuid=? tuuid (string->uuid (uuid->string tuuid)))))
    36 )
     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)) ) )
    3737
    38 (test-group "Specific API"
     38(define (run-tests eggnams #!optional (cscopts *csc-options*))
     39  (for-each (cut run-test <> cscopts) eggnams) )
    3940
    40   (test-assert "uuid? V1-MC" (uuid? (make-uuid 'V1-MC)))
    41   (test-assert "uuid? V3 \"ns:URL\"" (uuid? (make-uuid 'V3 "ns:URL" "foobarbaz")))
    42   (test-assert "uuid? V5 \"ns:X500\"" (uuid? (make-uuid 'V5 "ns:X500" "foobarbaz")))
     41;;;
    4342
    44   (test-assert "uuid-load" (uuid-nil? (uuid-load)))
    45   (let ((ns-url (uuid-load "ns:URL")))
    46     (test-assert "uuid-load \"ns:URL\" 1" (uuid? ns-url))
    47     (test-assert "uuid-load \"ns:URL\" 2" (not (uuid-nil? ns-url)))
    48     (test-assert "uuid? V3 url-uuid" (uuid? (make-uuid 'V3 ns-url "foobarbaz"))) )
    49 
    50   (let* ((t1 (make-uuid))
    51          (t2 (uuid-load! t1 "ns:OID")) )
    52     (test-assert "uuid-load! overwrites 1" (not (uuid-nil? t1)))
    53     (test-assert "uuid-load! returns uuid" (eq? t1 t2)) )
    54 
    55   (let ((t1 (make-uuid 'V3 "ns:URL" "foobarbaz")))
    56     (test-assert "Export" (string? (uuid-export t1)))
    57     (test-assert "Export binary" (string? (uuid-export-binary t1)))
    58     (test-assert "Export siv" (string? (uuid-export-siv t1)))
    59     (test-assert "Export text" (string? (uuid-export-text t1))) )
    60 
    61     (let ((t1 (make-uuid 'V3 "ns:URL" "foobarbaz")))
    62       (test-assert "Import" (uuid=? t1 (uuid-import (uuid-export t1))))
    63       (test-assert "Import binary"
    64                    (uuid=? t1 (uuid-import-binary (uuid-export-binary t1))))
    65       (test-assert "Import siv"
    66                    (uuid=? t1 (uuid-import-siv (uuid-export-siv t1)))) )
    67 
    68   (test-assert "uuid-version is number" (number? (uuid-version)))
    69 
    70 )
    71 
    72 (test-exit)
    73 
     43(run-test)
  • release/4/uuid-ossp/trunk/uuid-ossp-fix.h

    r21918 r35418  
    2929typedef unsigned int uuid_fmt_t;
    3030
     31/* UUID abstract data type */
    3132struct uuid_st;
    3233
    3334/* UUID object handling */
    34 extern uuid_rc_t uuid_create   (      struct uuid_st **_uuid);
    35 extern uuid_rc_t uuid_destroy  (      struct uuid_st  *_uuid);
    36 extern uuid_rc_t uuid_clone    (const struct uuid_st  *_uuid, struct uuid_st **_clone);
     35extern uuid_rc_t     uuid_create   (      struct uuid_st **_uuid);
     36extern uuid_rc_t     uuid_destroy  (      struct uuid_st  *_uuid);
     37extern uuid_rc_t     uuid_clone    (const struct uuid_st  *_uuid, struct uuid_st **_clone);
    3738
    3839/* UUID generation */
    39 extern uuid_rc_t uuid_load     (      struct uuid_st  *_uuid, const char *_name);
    40 extern uuid_rc_t uuid_make     (      struct uuid_st  *_uuid, unsigned int _mode, ...);
     40extern uuid_rc_t     uuid_load     (      struct uuid_st  *_uuid, const char *_name);
     41extern uuid_rc_t     uuid_make     (      struct uuid_st  *_uuid, unsigned int _mode, ...);
    4142
    4243/* UUID comparison */
    43 extern uuid_rc_t uuid_isnil    (const struct uuid_st  *_uuid,                       int *_result);
    44 extern uuid_rc_t uuid_compare  (const struct uuid_st  *_uuid, const struct uuid_st *_uuid2, int *_result);
     44extern uuid_rc_t     uuid_isnil    (const struct uuid_st  *_uuid,                       int *_result);
     45extern uuid_rc_t     uuid_compare  (const struct uuid_st  *_uuid, const struct uuid_st *_uuid2, int *_result);
    4546
    4647/* UUID import/export */
    47 extern uuid_rc_t uuid_import   (      struct uuid_st  *_uuid, uuid_fmt_t _fmt, const void  *_data_ptr, size_t  _data_len);
    48 extern uuid_rc_t uuid_export   (const struct uuid_st  *_uuid, uuid_fmt_t _fmt,       void **_data_ptr, size_t *_data_len);
     48extern uuid_rc_t     uuid_import   (      struct uuid_st  *_uuid, uuid_fmt_t _fmt, const void  *_data_ptr, size_t  _data_len);
     49extern uuid_rc_t     uuid_export   (const struct uuid_st  *_uuid, uuid_fmt_t _fmt,       void  *_data_ptr, size_t *_data_len);
    4950
    5051/* library utilities */
  • release/4/uuid-ossp/trunk/uuid-ossp.meta

    r28283 r35418  
    1 ;;;; uuid-ossp.meta -*- Hen -*-
     1;;;; uuid-ossp.meta
    22
    33((category net)
     
    88 (depends (setup-helper "1.5.3"))
    99 (test-depends test)
    10  (files "uuid-ossp-fix.c" "uuid-ossp.meta" "uuid-ossp-fix.h" "uuid-ossp.scm" "uuid-ossp.setup" "tests/run.scm"))
     10 (files
     11  "uuid-ossp.meta" "uuid-ossp.setup"
     12  "uuid-ossp-fix.c" "uuid-ossp-fix.h"
     13  "uuid-ossp.scm"
     14  "tests/run.scm" "tests/uuid-ossp-test.scm"))
  • release/4/uuid-ossp/trunk/uuid-ossp.scm

    r28281 r35418  
    44(module uuid-ossp
    55
    6   (;export
    7     ;
    8     uuid?
    9     uuid-null?
    10     uuid-compare
    11     uuid=? uuid<? uuid>? uuid<=? uuid>=?
    12     uuid-copy
    13     uuid-clear!
    14     make-uuid
    15     string->uuid uuid->string
    16     ;
    17     uuid-version
    18     uuid-nil?
    19     uuid-clone
    20     uuid-load! uuid-load
    21     uuid-import uuid-import-binary uuid-import-siv
    22     uuid-export uuid-export-binary uuid-export-text uuid-export-siv
    23     ;Deprecated
    24     uuid<>?)
    25 
    26   (import scheme chicken foreign )
    27 
    28   (use lolevel)
    29 
    30   (declare
    31     (always-bound
    32       +uuid-error-codes+
    33       UUID_LEN_BIN UUID_LEN_STR UUID_LEN_SIV
    34       UUID_RC_OK UUID_RC_ARG
    35       UUID_RC_MEM UUID_RC_SYS
    36       UUID_RC_INT UUID_RC_IMP
    37       UUID_MAKE_V1 UUID_MAKE_V1MC UUID_MAKE_V3 UUID_MAKE_V4 UUID_MAKE_V5
    38       UUID_FMT_BIN UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV)
    39     (bound-to-procedure
    40       uuid_create uuid_destroy uuid_clone
    41       uuid_load
    42       uuid_make_0 uuid_make_2
    43       uuid_isnil uuid_compare
    44       uuid_import uuid_export
    45       uuid_error uuid_version))
     6(;export
     7  ;
     8  uuid?
     9  uuid-null?
     10  uuid-compare
     11  uuid=? uuid<? uuid>? uuid<=? uuid>=?
     12  uuid-copy
     13  uuid-clear!
     14  make-uuid
     15  string->uuid uuid->string
     16  ;
     17  uuid-version
     18  uuid-nil?
     19  uuid-clone
     20  uuid-load! uuid-load
     21  uuid-import uuid-import-binary uuid-import-siv
     22  uuid-export uuid-export-binary uuid-export-text uuid-export-siv
     23  ;Deprecated
     24  uuid<>?)
     25
     26(import scheme chicken foreign )
     27(use lolevel)
     28
     29;;
     30
     31(define (fxzero? x)
     32  (fx= 0 x) )
     33
     34(define (fxnegative? x)
     35  (fx< x 0) )
     36
     37(define (fxpositive? x)
     38  (fx> x 0) )
     39
     40;;
    4641
    4742#>
     
    119114(define (null-pointer? ptr)
    120115  (##sys#check-special ptr 'null-pointer?)
    121   (eq? 0 (##sys#pointer->address ptr) ) )
     116  (zero? (##sys#pointer->address ptr)) )
    122117
    123118;;
     
    132127
    133128(define (uuid-error-string code)
    134   (or (uuid_error code)
    135       (let ((msg (assv code +uuid-error-codes+)))
    136         (if msg (cdr msg)
    137             "unknown result code" ) ) ) )
     129  (or
     130    (uuid_error code)
     131    (let ((msg (assv code +uuid-error-codes+)))
     132      (if msg
     133        (cdr msg)
     134        "unknown result code" ) ) ) )
    138135
    139136(define (signal-uuid-error code loc)
    140137  (abort
    141    (make-composite-condition
    142     (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
    143     (make-property-condition 'uuid 'code code))) )
     138    (make-composite-condition
     139      (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
     140      (make-property-condition 'uuid 'code code))) )
    144141
    145142(define-inline (uuid-status-ok? code)
    146   (= UUID_RC_OK code) )
     143  (fx= UUID_RC_OK code) )
    147144
    148145(define-inline (error-check code loc)
     
    162159
    163160(define (new-uuid loc)
    164   (let-location ((puuid (c-pointer uuid_t)))
     161  (let-location (
     162    (puuid (c-pointer uuid_t)) )
    165163    (error-check (uuid_create (location puuid)) loc)
    166164    (box-puuid puuid) ) )
     
    178176(define (uuid-import-format fmt str loc)
    179177  (unless (string? str)
    180     (##sys#signal-hook #:type-error loc
    181                        "bad argument type - not a string" str))
    182   (let ((str-len
    183           (select fmt
    184             ((UUID_FMT_BIN) UUID_LEN_BIN)
    185             ((UUID_FMT_STR) UUID_LEN_STR)
    186             ((UUID_FMT_SIV) UUID_LEN_SIV)
    187             (else
    188               (##sys#signal-hook #:type-error loc
    189                                  "bad argument type - invalid format" fmt)))))
     178    (##sys#signal-hook
     179      #:type-error loc
     180      "bad argument type - not a string" str))
     181  (let (
     182    (str-len
     183      (select fmt
     184        ((UUID_FMT_BIN) UUID_LEN_BIN)
     185        ((UUID_FMT_STR) UUID_LEN_STR)
     186        ((UUID_FMT_SIV) UUID_LEN_SIV)
     187        (else
     188          (##sys#signal-hook
     189            #:type-error loc
     190            "bad argument type - invalid format" fmt)))) )
    190191    (unless (= (string-length str) str-len)
    191192      ;type-error here is dubious
    192       (##sys#signal-hook #:type-error loc
    193                          "bad argument type - invalid string length" str))
     193      (##sys#signal-hook
     194        #:type-error loc
     195        "bad argument type - invalid string length" str))
    194196    (let ((uuid (new-uuid loc)))
    195197      (error-check (uuid_import (unbox-puuid uuid) fmt str str-len) loc)
     
    197199
    198200(define (uuid-export-format uuid fmt loc)
    199   (let ((len-bias
    200           (select fmt
    201             ((UUID_FMT_BIN) 0)
    202             ((UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV) 1)
    203             (else
    204               (##sys#signal-hook #:type-error loc
    205                                  "bad argument type - invalid format" fmt)))))
    206     (let-location ((len size_t 0)
    207                    (dat c-pointer #f) )
     201  (let (
     202    (len-bias
     203      (select fmt
     204        ((UUID_FMT_BIN) 0)
     205        ((UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV) 1)
     206        (else
     207          (##sys#signal-hook
     208            #:type-error loc
     209            "bad argument type - invalid format" fmt)))))
     210    (let-location (
     211      (len size_t 0)
     212      (dat c-pointer #f) )
    208213      (error-check (uuid_export (unbox-puuid uuid) fmt (location dat) (location len)) loc)
    209       (when (or (null-pointer? dat) (zero? len))
     214      (when (or (null-pointer? dat) (fxzero? len))
    210215        (signal-uuid-error UUID_RC_INT loc))
    211       (let ((str-len (fx- (inexact->exact len) len-bias)))
    212         (let ((str (make-string str-len)))
    213           (move-memory! dat (make-locative str) str-len)
    214           (free dat)
    215           str ) ) ) ) )
     216      (let* (
     217        (str-len (fx- (inexact->exact len) len-bias))
     218        (str (make-string str-len)) )
     219        (move-memory! dat (make-locative str) str-len)
     220        (free dat)
     221        str ) ) ) )
    216222
    217223(define (get-ns-uuid uuid ns loc)
    218   (when (not ns) (set! ns "nil"))
    219   (unless (string? ns)
    220     (##sys#signal-hook #:type-error loc
    221                        "bad argument type - not a string" ns))
    222   (let ((uuid (or uuid (new-uuid loc))))
    223     (error-check (uuid_load (unbox-puuid uuid) ns) loc)
    224     uuid ) )
    225 
    226 (define (make-uuid-2 args uuid var loc)
     224  (let (
     225    (ns (or ns "nil")) )
     226    (unless (string? ns)
     227      (##sys#signal-hook
     228        #:type-error loc
     229        "bad argument type - not a string" ns) )
     230    (let ((uuid (or uuid (new-uuid loc))))
     231      (error-check (uuid_load (unbox-puuid uuid) ns) loc)
     232      uuid ) ) )
     233
     234(define (make-uuid-0! loc uuid var)
     235  (error-check (uuid_make_0 (unbox-puuid uuid) var) loc) )
     236
     237(define (make-uuid-2! loc uuid var args)
    227238  (unless (= 2 (length args))
    228     (##sys#error-hook (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
    229                       3 (+ 1 (length args)) #f))
    230   (let* ((ns (car args))
    231          (ns-uuid (if (%uuid? ns) ns (get-ns-uuid #f ns loc)))
    232          (name (cadr args)) )
     239    (##sys#error-hook
     240      (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
     241      3 (+ 1 (length args)) #f))
     242  (let* (
     243    (ns (car args))
     244    (ns-uuid (if (%uuid? ns) ns (get-ns-uuid #f ns loc)))
     245    (name (cadr args)) )
    233246    (unless (string? name)
    234       (##sys#signal-hook #:type-error loc
    235                           "bad argument type - not a string" name))
     247      (##sys#signal-hook
     248        #:type-error loc
     249        "bad argument type - not a string" name))
    236250    (error-check (uuid_make_2 (unbox-puuid uuid) var (unbox-puuid ns-uuid) name) loc) ) )
    237251
    238252;;
    239253
     254(define-type boxed-uuid pointer)
     255;(define-type boxed-uuid *)
     256
     257(: uuid? (* -> boolean : boxed-uuid))
     258;
    240259(define (uuid? obj)
    241260  (%uuid? obj) )
    242261
     262(: uuid-nil? (* --> boolean))
     263;
    243264(define (uuid-nil? uuid)
    244   (and (%uuid? uuid)
    245        (let-location ((result int))
    246          (error-check (uuid_isnil (unbox-puuid uuid) (location result)) 'uuid-nil?)
    247          (not (zero? result)) ) ) )
    248 
     265  (and
     266    (uuid? uuid)
     267    (let-location (
     268      (result int) )
     269      (error-check (uuid_isnil (unbox-puuid uuid) (location result)) 'uuid-nil?)
     270      (not (zero? result)) ) ) )
     271
     272(: uuid-null? (* --> boolean))
     273;
    249274;compatibility w/ uuid-lib
    250275(define uuid-null? uuid-nil?)
    251276
     277(: uuid-compare (boxed-uuid boxed-uuid -> fixnum))
     278;
    252279(define (uuid-compare uuid1 uuid2)
    253   (let ((cmp (%uuid-compare uuid1 uuid2 'uuid-compare)))
     280  (let (
     281    (cmp (%uuid-compare uuid1 uuid2 'uuid-compare)) )
    254282    (cond
    255       ((negative? cmp) -1)
    256       ((zero? cmp)     0)
    257       (else            1) ) ) )
    258 
     283      ((fxnegative? cmp)  -1)
     284      ((fxzero? cmp)      0)
     285      (else               1) ) ) )
     286
     287(: uuid=? (boxed-uuid boxed-uuid --> boolean))
     288;
    259289(define (uuid=? uuid1 uuid2)
    260   (zero? (%uuid-compare uuid1 uuid2 'uuid=?)) )
    261 
     290  (fxzero? (%uuid-compare uuid1 uuid2 'uuid=?)) )
     291
     292(: uuid<>? (boxed-uuid boxed-uuid --> boolean))
     293;
    262294(define (uuid<>? uuid1 uuid2)
    263   (not (zero? (%uuid-compare uuid1 uuid2 'uuid<>?))) )
    264 
     295  (not (fxzero? (%uuid-compare uuid1 uuid2 'uuid<>?))) )
     296
     297(: uuid<? (boxed-uuid boxed-uuid --> boolean))
     298;
    265299(define (uuid<? uuid1 uuid2)
    266300  (negative? (%uuid-compare uuid1 uuid2 'uuid<?)) )
    267301
     302(: uuid>? (boxed-uuid boxed-uuid --> boolean))
     303;
    268304(define (uuid>? uuid1 uuid2)
    269305  (positive? (%uuid-compare uuid1 uuid2 'uuid>?)) )
    270306
     307(: uuid<=? (boxed-uuid boxed-uuid --> boolean))
     308;
    271309(define (uuid<=? uuid1 uuid2)
    272310  (let ((cmp (%uuid-compare uuid1 uuid2 'uuid<=?)))
    273     (or (zero? cmp) (negative? cmp)) ) )
    274 
     311    (or (fxzero? cmp) (fxnegative? cmp)) ) )
     312
     313(: uuid>=? (boxed-uuid boxed-uuid --> boolean))
     314;
    275315(define (uuid>=? uuid1 uuid2)
    276316  (let ((cmp (%uuid-compare uuid1 uuid2 'uuid>=?)))
    277     (or (zero? cmp) (positive? cmp) ) ) )
    278 
    279 ;;
    280 
     317    (or (fxzero? cmp) (fxpositive? cmp) ) ) )
     318
     319;;
     320
     321(: uuid-clone (boxed-uuid --> boxed-uuid))
     322;
    281323(define (uuid-clone uuid)
    282   (let-location ((puuid (c-pointer uuid_t)))
     324  (let-location (
     325    (puuid (c-pointer uuid_t)) )
    283326    (error-check (uuid_clone (unbox-puuid uuid) (location puuid)) 'uuid-clone)
    284327    (box-puuid puuid) ) )
    285328
     329(: uuid-copy (boxed-uuid --> boxed-uuid))
     330;
    286331;compatibility w/ uuid-lib
    287332(define uuid-copy uuid-clone)
    288333
     334(: make-uuid (#!optional symbol -> boxed-uuid))
     335;
    289336(define (make-uuid . args)
    290   (let ((uuid (new-uuid 'make-uuid)))
    291     (let ((variant (and (not (null? args)) (car args))))
    292       (case variant
    293         ((#f)
    294           ) ;the nil-uuid
    295         ((V1 time)
    296          (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1) 'make-uuid))
    297         ((V1-MC)
    298          (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1MC) 'make-uuid))
    299         ((V3)
    300          (make-uuid-2 (cdr args) uuid UUID_MAKE_V3 'make-uuid))
    301         ((V4 random)
    302          (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V4) 'make-uuid))
    303         ((V5)
    304          (make-uuid-2 (cdr args) uuid UUID_MAKE_V5 'make-uuid))
    305         (else
    306          (##sys#signal-hook #:type-error 'make-uuid
    307                             "bad argument type - invalid variant" variant) ) ) )
     337  (let (
     338    (variant (optional args #f))
     339    (uuid (new-uuid 'make-uuid)) )
     340    (case variant
     341      ((#f)
     342        ) ;the nil-uuid
     343      ((V1 time)
     344        (make-uuid-0! 'make-uuid uuid UUID_MAKE_V1))
     345      ((V1-MC)
     346        (make-uuid-0! 'make-uuid uuid UUID_MAKE_V1MC))
     347      ((V3)
     348        (make-uuid-2! 'make-uuid uuid UUID_MAKE_V3 (cdr args)))
     349      ((V4 random)
     350        (make-uuid-0! 'make-uuid uuid UUID_MAKE_V4))
     351      ((V5)
     352        (make-uuid-2! 'make-uuid uuid UUID_MAKE_V5 (cdr args)))
     353      (else
     354        (##sys#signal-hook
     355          #:type-error 'make-uuid
     356          "bad argument type - invalid variant" variant) ) )
    308357    uuid ) )
    309358
     359(: uuid-clear! (boxed-uuid -> boxed-uuid))
     360;
    310361(define (uuid-clear! uuid)
    311362  (get-ns-uuid uuid "nil" 'uuid-clear!) )
    312363
     364(: uuid-load! (boxed-uuid #!optional string -> boxed-uuid))
     365;
    313366(define (uuid-load! uuid #!optional ns)
    314367  (get-ns-uuid uuid ns 'uuid-load!) )
    315368
     369(: uuid-load (#!optional string --> boxed-uuid))
     370;
    316371(define (uuid-load #!optional ns)
    317372  (get-ns-uuid #f ns 'uuid-load) )
    318373
     374(: uuid-import (string --> boxed-uuid))
     375;
    319376(define (uuid-import str)
    320377  (uuid-import-format UUID_FMT_STR str 'uuid-import) )
    321378
     379(: uuid-import-binary (string --> boxed-uuid))
     380;
    322381(define (uuid-import-binary str)
    323382  (uuid-import-format UUID_FMT_BIN str 'uuid-import-binary) )
    324383
     384(: uuid-import-siv (string --> boxed-uuid))
     385;
    325386(define (uuid-import-siv str)
    326387  (uuid-import-format UUID_FMT_SIV str 'uuid-import-binary) )
    327388
     389(: uuid-export (boxed-uuid --> string))
     390;
    328391(define (uuid-export uuid)
    329392  (uuid-export-format uuid UUID_FMT_STR 'uuid-export) )
    330393
     394(: uuid-export-binary (boxed-uuid --> string))
     395;
    331396(define (uuid-export-binary uuid)
    332397  (uuid-export-format uuid UUID_FMT_BIN 'uuid-export-binary) )
    333398
     399(: uuid-export-text (boxed-uuid --> string))
     400;
    334401(define (uuid-export-text uuid)
    335402  (uuid-export-format uuid UUID_FMT_TXT 'uuid-export-text) )
    336403
     404(: uuid-export-siv (boxed-uuid --> string))
     405;
    337406(define (uuid-export-siv uuid)
    338407  (uuid-export-format uuid UUID_FMT_SIV 'uuid-export-siv) )
    339408
     409(: string->uuid (string --> boxed-uuid))
     410;
    340411(define (string->uuid str)
    341412  (uuid-import str) )
    342413
     414(: uuid->string (boxed-uuid --> string))
     415;
    343416(define (uuid->string uuid)
    344417  (uuid-export uuid) )
    345418
     419(: uuid-version (--> number))
     420;
    346421(define uuid-version uuid_version)
    347422
  • release/4/uuid-ossp/trunk/uuid-ossp.setup

    r28283 r35418  
    1 ;;;; uuid-ossp.setup  -*- Hen -*-
     1;;;; uuid-ossp.setup
    22
    33(use setup-helper-mod)
     
    55(verify-extension-name "uuid-ossp")
    66
    7 (setup-shared-extension-module 'uuid-ossp (extension-version "1.4.2")
     7(setup-shared-extension-module 'uuid-ossp (extension-version "1.5.0")
    88  #:types? #t
    99  #:inline? #t
Note: See TracChangeset for help on using the changeset viewer.