Changeset 21918 in project


Ignore:
Timestamp:
12/11/10 23:00:14 (10 years ago)
Author:
Kon Lovett
Message:

Expanded the "common API" w/ uuid-lib. Rmvd uuid=, etc. (were dep in 1.3), Added "single integer value' external form support; could break on some systems with older OSSP library. Added uuid-load! Better error kinds. More comments.

Still needs the uuid-ossp-fix cut-out BS to deal with the system header conflict.

Location:
release/4/uuid-ossp
Files:
12 edited
1 copied

Legend:

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

    r19530 r21918  
    1 (use testeez uuid-ossp)
    2 ;; This test set was adapted for testeez from uuid-ossp-test.scm
     1;;;; uuid-lib-test.scm  -*- Hen -*-
    32
    4 (testeez "uuid-ossp"
     3(use test)
     4(use uuid-ossp)
    55
    6  (test/eqv  "Nil (1)"
    7             (uuid? (make-uuid))
    8             #t)
     6;Assumes the underlying library works so just the Scheme wrapper tested
    97
    10  (test/eqv  "Nil (2)"
    11              (uuid-nil? (make-uuid))
    12              #t)
     8(test-group "Common API"
    139
    14  (test/eqv  "Nil (4)"
    15              (uuid-nil? (uuid-clone (make-uuid)))
    16              #t)
     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)))
    1715
    18  (test/eqv  "Nil (5)"
    19              (uuid-nil? (uuid-load "nil"))
    20              #t)
     16  (test-assert "uuid-null? 1" (not (uuid-null? (make-uuid 'V1))))
     17  (test-assert "uuid-null? 2" (uuid-null? (make-uuid)))
    2118
    22  (test/eqv  "uuid=?"
    23             (uuid=? (make-uuid) (make-uuid))
    24             #t)
     19  (test-assert "uuid-clear!" (uuid-null? (uuid-clear! (make-uuid 'V4))))
    2520
    26  (test/eqv  "uuid<=?"
    27             (uuid<=? (make-uuid) (make-uuid))
    28             #t)
     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))) )
    2925
    30  (test/eqv  "uuid>=?"
    31             (uuid>=? (make-uuid) (make-uuid))
    32             #t)
     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))))
    3329
    34  (test/eqv  "V1"
    35             (not (make-uuid 'V1))
    36             #f)
     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)))
    3732
    38  (test/eqv  "V1-MC"
    39             (not (make-uuid 'V1-MC))
    40             #f)
     33  (test-assert "External form of uuid"
     34    (let ((tuuid (make-uuid 'V1)))
     35      (uuid=? tuuid (string->uuid (uuid->string tuuid)))))
     36)
    4137
    42  (test/eqv  "V3"
    43             (not (make-uuid 'V3 "ns:URL" "foobarbaz"))
    44             #f)
     38(test-group "Specific API"
    4539
    46  (test/eqv  "V4"
    47             (not (make-uuid 'V4))
    48             #f)
     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")))
     43   
     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"))) )
    4949
    50  (test/eqv  "V5"
    51             (not (make-uuid 'V5 "ns:X500" "foobarbaz"))
    52             #f)
     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)) )
    5354
    54  (test/eqv  "Export"
    55             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    56               (not (uuid-export tuuid)))
    57             #f)
     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))) )
    5860
    59  (test/eqv  "Export binary"
    60             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    61               (not (uuid-export-binary tuuid)))
    62             #f)
     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)))) )
    6367
    64  (test/eqv  "Export text"
    65             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    66               (not (uuid-export-text tuuid)))
    67             #f)
     68  (test-assert "uuid-version is number" (number? (uuid-version)))
    6869
    69  (test/eqv  "Import"
    70             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    71               (not (uuid=? tuuid (uuid-import (uuid-export tuuid)))))
    72             #f)
     70)
    7371
    74  (test/eqv  "Import binary"
    75             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    76               (not (uuid=? tuuid (uuid-import-binary (uuid-export-binary tuuid)))))
    77             #f)
    78 
    79  (test/eqv  "uuid-version is number"
    80             (not (number? (uuid-version)))
    81             #f)
    82 
    83  (test/equal "Error(1)"
    84              (condition-case (make-uuid 'V3 "ns:URL" "foobarbaz" 1 2)
    85                              (v () ((condition-property-accessor 'exn 'message) v)))
    86              "invalid or missing namespace and name")
    87 
    88  (test/equal "Error(2)"
    89              (condition-case (make-uuid 'R27)
    90                              (v () ((condition-property-accessor 'exn 'message) v)))
    91              "invalid mode")
    92 
    93  (test/equal "Error(3)"
    94              (condition-case (uuid-load "foobar")
    95                              (v () ((condition-property-accessor 'exn 'message) v)))
    96              "invalid argument") )
    97 
  • release/4/uuid-ossp/tags/1.4.0/uuid-ossp-fix.c

    r16526 r21918  
    11/*
    2 Source to isolate use of uuid_t by OSSP UUID include file.
    3 This type is part of my unistd.h
     2Source to isolate use of uuid_t by OSSP uuid.h file. This type is part
     3of man Unix system headers. The technique used by the OSSP header to
     4avoid conflict will not work with Chicken sources. So rather than
     5include the OSSP header directly into a Chicken Scheme source a
     6"cut-out" is used to isolate the problem.
    47*/
    58
    69#include "uuid.h"
    710
     11/*
     12These are the enum & macro constants from the header that we cannot
     13include. See above.
     14*/
     15
    816unsigned int uuid_LEN_BIN = UUID_LEN_BIN;
    917unsigned int uuid_LEN_STR = UUID_LEN_STR;
     18unsigned int uuid_LEN_SIV = UUID_LEN_SIV;
    1019
    1120unsigned int uuid_RC_OK = UUID_RC_OK;
     
    1726
    1827unsigned int uuid_MAKE_V1 = UUID_MAKE_V1;
    19 unsigned int uuid_MAKE_V1MC = (UUID_MAKE_MC | UUID_MAKE_V1);
     28unsigned int uuid_MAKE_V1MC = (UUID_MAKE_V1 | UUID_MAKE_MC);
    2029unsigned int uuid_MAKE_V3 = UUID_MAKE_V3;
    2130unsigned int uuid_MAKE_V4 = UUID_MAKE_V4;
     
    2534unsigned int uuid_FMT_STR = UUID_FMT_STR;
    2635unsigned int uuid_FMT_TXT = UUID_FMT_TXT;
     36unsigned int uuid_FMT_SIV = UUID_FMT_SIV;
  • release/4/uuid-ossp/tags/1.4.0/uuid-ossp-fix.h

    r16526 r21918  
    1 /*
    2 To isolate use of uuid_t by OSSP UUID include file.
    3 This type is part of my unistd.h
    4 */
     1/* See "uuid-ossp-fix.c" for more information. */
     2
     3/* Isn't case-sensitivity grand ;-) */
    54
    65extern unsigned int uuid_LEN_BIN;
    76extern unsigned int uuid_LEN_STR;
     7extern unsigned int uuid_LEN_SIV;
    88
    99extern unsigned int uuid_RC_OK;
     
    2323extern unsigned int uuid_FMT_STR;
    2424extern unsigned int uuid_FMT_TXT;
     25extern unsigned int uuid_FMT_SIV;
     26
     27/* Actually enum but this will do */
     28typedef unsigned int uuid_rc_t;
     29typedef unsigned int uuid_fmt_t;
    2530
    2631struct uuid_st;
    27 
    28 typedef unsigned int uuid_rc_t;
    29 typedef unsigned int uuid_fmt_t;
    3032
    3133/* UUID object handling */
  • release/4/uuid-ossp/tags/1.4.0/uuid-ossp.meta

    r20315 r21918  
    1010 (files
    1111  "tests"
    12         "setup-header.scm"
    13         "uuid-ossp.scm" "uuid-ossp.setup" "uuid-ossp.html"
    14         "uuid-ossp-fix.c" "uuid-ossp-fix.h"))
     12  "setup-header.scm"   
     13  "uuid-ossp.scm" "uuid-ossp.setup"
     14  "uuid-ossp-fix.c" "uuid-ossp-fix.h"))
  • release/4/uuid-ossp/tags/1.4.0/uuid-ossp.scm

    r19530 r21918  
    55
    66  (;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    ;
    717    uuid-version
    8     make-uuid
    9     uuid?
    10     uuid-nil? uuid-null?
    11     uuid-compare
    12     uuid=? uuid<>? uuid<? uuid>? uuid<=? uuid>=?
     18    uuid-nil?
    1319    uuid-clone
    14     uuid-load
    15     uuid-import
    16     uuid-import-binary
    17     uuid-export
    18     uuid-export-binary
    19     uuid-export-text
    20     ;DEPRECATED
    21     uuid= uuid<> uuid< uuid> uuid<= uuid>=)
     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<>?)
    2225
    2326  (import scheme chicken foreign)
     
    2831    (always-bound
    2932      +uuid-error-codes+
    30       UUID_LEN_BIN UUID_LEN_STR
     33      UUID_LEN_BIN UUID_LEN_STR UUID_LEN_SIV
    3134      UUID_RC_OK UUID_RC_ARG
    3235      UUID_RC_MEM UUID_RC_SYS
    3336      UUID_RC_INT UUID_RC_IMP
    3437      UUID_MAKE_V1 UUID_MAKE_V1MC UUID_MAKE_V3 UUID_MAKE_V4 UUID_MAKE_V5
    35       UUID_FMT_BIN UUID_FMT_STR UUID_FMT_TXT)
     38      UUID_FMT_BIN UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV)
    3639    (bound-to-procedure
    3740      uuid_create uuid_destroy uuid_clone
     
    4245      uuid_error uuid_version))
    4346
    44 
    4547#>
    4648#include "uuid-ossp-fix.h"
     
    4951(define UUID_LEN_BIN (foreign-value "uuid_LEN_BIN" unsigned-int))
    5052(define UUID_LEN_STR (foreign-value "uuid_LEN_STR" unsigned-int))
     53(define UUID_LEN_SIV (foreign-value "uuid_LEN_SIV" unsigned-int))
    5154
    5255(define UUID_RC_OK (foreign-value "uuid_RC_OK" unsigned-int))
     
    6669(define UUID_FMT_STR (foreign-value "uuid_FMT_STR" unsigned-int))
    6770(define UUID_FMT_TXT (foreign-value "uuid_FMT_TXT" unsigned-int))
    68 
    69 ;;
    70 
    71 (define-foreign-type size_t unsigned-long)
     71(define UUID_FMT_SIV (foreign-value "uuid_FMT_SIV" unsigned-int))
     72
     73;;
     74
     75(define-foreign-type size_t "size_t") ;types like this should be collected somewhere
     76
    7277(define-foreign-type uuid_rc_t unsigned-int)
    7378(define-foreign-type uuid_fmt_t unsigned-int)
     
    112117;;
    113118
    114 (define +uuid-error-codes+ (list
    115   `(,UUID_RC_OK . "everything ok")
    116   `(,UUID_RC_ARG . "invalid argument")
    117   `(,UUID_RC_MEM . "out of memory")
    118   `(,UUID_RC_SYS . "system error")
    119   `(,UUID_RC_INT . "internal error")
    120   `(,UUID_RC_IMP . "not implemented") ) )
     119(define +uuid-error-codes+
     120  `((,UUID_RC_OK . "everything ok")
     121    (,UUID_RC_ARG . "invalid argument")
     122    (,UUID_RC_MEM . "out of memory")
     123    (,UUID_RC_SYS . "system error")
     124    (,UUID_RC_INT . "internal error")
     125    (,UUID_RC_IMP . "not implemented")))
    121126
    122127(define (uuid-error-string code)
     
    124129      (let ((msg (assv code +uuid-error-codes+)))
    125130        (if msg (cdr msg)
    126           "unknown result code" ) ) ) )
     131            "unknown result code" ) ) ) )
    127132
    128133(define (signal-uuid-error code loc)
    129134  (abort
    130     (make-composite-condition
    131       (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
    132       (make-property-condition 'uuid 'code code))) )
     135   (make-composite-condition
     136    (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
     137    (make-property-condition 'uuid 'code code))) )
    133138
    134139(define-inline (uuid-status-ok? code)
     
    148153
    149154(define-inline (box-puuid puuid)
    150   (let ((boxed-puuid (tag-pointer puuid 'ossp-uuid)))
    151     (set-finalizer! boxed-puuid free-uuid)
    152     boxed-puuid ) )
     155  (set-finalizer! (tag-pointer puuid 'uuid-ossp) free-uuid) )
    153156
    154157(define (new-uuid loc)
     
    158161
    159162(define-inline (%uuid? obj)
    160   (tagged-pointer? obj 'ossp-uuid) )
     163  (tagged-pointer? obj 'uuid-ossp) )
    161164
    162165(define (%uuid-compare uuid1 uuid2 loc)
     
    169172(define (uuid-import-format fmt str loc)
    170173  (unless (string? str)
    171     (error loc "can only import from a string" str))
     174    (##sys#signal-hook #:type-error loc
     175                       "bad argument type - not a string" str))
    172176  (let ((str-len
    173177          (select fmt
    174178            ((UUID_FMT_BIN) UUID_LEN_BIN)
    175179            ((UUID_FMT_STR) UUID_LEN_STR)
     180            ((UUID_FMT_SIV) UUID_LEN_SIV)
    176181            (else
    177               (error loc "invalid format" fmt)))))
     182              (##sys#signal-hook #:type-error loc
     183                                 "bad argument type - invalid format" fmt)))))
    178184    (unless (= (string-length str) str-len)
    179       (error loc "invalid length of string: wanted:" str str-len))
     185      ;type-error here is dubious
     186      (##sys#signal-hook #:type-error loc
     187                         "bad argument type - invalid string length" str))
    180188    (let ((uuid (new-uuid loc)))
    181189      (error-check (uuid_import (unbox-puuid uuid) fmt str str-len) loc)
     
    183191
    184192(define (uuid-export-format uuid fmt loc)
    185   (let ((str-bias
     193  (let ((len-bias
    186194          (select fmt
    187195            ((UUID_FMT_BIN) 0)
    188             ((UUID_FMT_STR) 1)
    189             ((UUID_FMT_TXT) 1)
     196            ((UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV) 1)
    190197            (else
    191               (error loc "invalid format" fmt)))))
    192     (let-location ((len size_t 0) (dat c-pointer #f))
     198              (##sys#signal-hook #:type-error loc
     199                                 "bad argument type - invalid format" fmt)))))
     200    (let-location ((len size_t 0)
     201                   (dat c-pointer #f) )
    193202      (error-check (uuid_export (unbox-puuid uuid) fmt (location dat) (location len)) loc)
    194203      (when (or (null-pointer? dat) (zero? len))
    195204        (signal-uuid-error UUID_RC_INT loc))
    196       (let ((str-len (fx- (inexact->exact len) str-bias)))
     205      (let ((str-len (fx- (inexact->exact len) len-bias)))
    197206        (let ((str (make-string str-len)))
    198207          (move-memory! dat (make-locative str) str-len)
     
    200209          str ) ) ) ) )
    201210
    202 (define (get-ns-uuid ns loc)
    203   (cond
    204     ((%uuid? ns)
    205       ns )
    206     ((string? ns)
    207       (let ((uuid (new-uuid loc)))
    208         (error-check (uuid_load (unbox-puuid uuid) ns) loc)
    209         uuid ) )
    210     (else
    211       (error loc "invalid namespace" ns) ) ) )
    212 
    213 (define (make-uuid-2 args uuid mode loc)
    214   (unless (= (length args) 3)
    215     (error loc "invalid or missing namespace and name" args))
    216   (let ((ns-uuid (get-ns-uuid (cadr args) loc)) (name (caddr args)))
     211(define (get-ns-uuid uuid ns loc)
     212  (when (not ns) (set! ns "nil"))
     213  (unless (string? ns)
     214    (##sys#signal-hook #:type-error loc
     215                       "bad argument type - not a string" ns))
     216  (let ((uuid (or uuid (new-uuid loc))))
     217    (error-check (uuid_load (unbox-puuid uuid) ns) loc)
     218    uuid ) )
     219
     220(define (make-uuid-2 args uuid var loc)
     221  (unless (= 2 (length args))
     222    (##sys#error-hook (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
     223                      3 (+ 1 (length args)) #f))
     224  (let* ((ns (car args))
     225         (ns-uuid (if (%uuid? ns) ns (get-ns-uuid #f ns loc)))
     226         (name (cadr args)) )
    217227    (unless (string? name)
    218       (error loc "invalid name" name))
    219     (error-check (uuid_make_2 (unbox-puuid uuid) mode (unbox-puuid ns-uuid) name) loc) ) )
     228      (##sys#signal-hook #:type-error loc
     229                          "bad argument type - not a string" name))
     230    (error-check (uuid_make_2 (unbox-puuid uuid) var (unbox-puuid ns-uuid) name) loc) ) )
    220231
    221232;;
     
    260271    (or (zero? cmp) (positive? cmp) ) ) )
    261272
    262 ;DEPRECATED
    263 (define uuid= uuid=?)
    264 (define uuid<> uuid<>?)
    265 (define uuid< uuid<?)
    266 (define uuid> uuid>?)
    267 (define uuid<= uuid<=?)
    268 (define uuid>= uuid>=?)
    269 
    270273;;
    271274
     
    275278    (box-puuid puuid) ) )
    276279
    277 (define (uuid-load ns)
    278   (get-ns-uuid ns 'uuid-load))
     280;compatibility w/ uuid-lib
     281(define uuid-copy uuid-clone)
    279282
    280283(define (make-uuid . args)
    281284  (let ((uuid (new-uuid 'make-uuid)))
    282     (unless (null? args)
    283       (let ((mode (car args)))
    284         (case mode
    285           ((V1)
    286             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1) 'make-uuid))
    287           ((V1-MC)
    288             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1MC) 'make-uuid))
    289           ((V3)
    290             (make-uuid-2 args uuid UUID_MAKE_V3 'make-uuid))
    291           ((V4)
    292             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V4) 'make-uuid))
    293           ((V5)
    294             (make-uuid-2 args uuid UUID_MAKE_V5 'make-uuid))
    295           (else
    296             (error 'make-uuid "invalid mode" mode)))))
     285    (let ((variant (and (not (null? args)) (car args))))
     286      (case variant
     287        ((#f)
     288          ) ;the nil-uuid
     289        ((V1 time)
     290         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1) 'make-uuid))
     291        ((V1-MC)
     292         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1MC) 'make-uuid))
     293        ((V3)
     294         (make-uuid-2 (cdr args) uuid UUID_MAKE_V3 'make-uuid))
     295        ((V4 random)
     296         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V4) 'make-uuid))
     297        ((V5)
     298         (make-uuid-2 (cdr args) uuid UUID_MAKE_V5 'make-uuid))
     299        (else
     300         (##sys#signal-hook #:type-error 'make-uuid
     301                            "bad argument type - invalid variant" variant) ) ) )
    297302    uuid ) )
     303
     304(define (uuid-clear! uuid)
     305  (get-ns-uuid uuid "nil" 'uuid-clear!) )
     306
     307(define (uuid-load! uuid #!optional ns)
     308  (get-ns-uuid uuid ns 'uuid-load!) )
     309
     310(define (uuid-load #!optional ns)
     311  (get-ns-uuid #f ns 'uuid-load) )
    298312
    299313(define (uuid-import str)
     
    303317  (uuid-import-format UUID_FMT_BIN str 'uuid-import-binary) )
    304318
     319(define (uuid-import-siv str)
     320  (uuid-import-format UUID_FMT_SIV str 'uuid-import-binary) )
     321
    305322(define (uuid-export uuid)
    306323  (uuid-export-format uuid UUID_FMT_STR 'uuid-export) )
     
    312329  (uuid-export-format uuid UUID_FMT_TXT 'uuid-export-text) )
    313330
     331(define (uuid-export-siv uuid)
     332  (uuid-export-format uuid UUID_FMT_SIV 'uuid-export-siv) )
     333
     334(define (string->uuid str)
     335  (uuid-import str) )
     336
     337(define (uuid->string uuid)
     338  (uuid-export uuid) )
     339
    314340(define uuid-version uuid_version)
    315341
  • release/4/uuid-ossp/tags/1.4.0/uuid-ossp.setup

    r20315 r21918  
     1;;;; uuid-ossp.setup  -*- Hen -*-
     2
    13(include "setup-helper")
    24
    3 (setup-shared-extension-module 'uuid-ossp (extension-version "1.3.0")
     5(verify-extension-name "uuid-ossp")
     6
     7(setup-shared-extension-module 'uuid-ossp (extension-version "1.4.0")
    48  compile-options: '(
    59    -scrutinize
     
    711    -optimize-level 3 -debug-level 1
    812    -no-procedure-checks -no-bound-checks
    9     "`uuid-config --cflags` uuid-ossp-fix.c `uuid-config --ldflags --libs` -luuid"))
     13    "`uuid-config --cflags` uuid-ossp-fix.c `uuid-config --ldflags --libs`"))
  • release/4/uuid-ossp/trunk/tests/run.scm

    r19530 r21918  
    1 (use testeez uuid-ossp)
    2 ;; This test set was adapted for testeez from uuid-ossp-test.scm
     1;;;; uuid-lib-test.scm  -*- Hen -*-
    32
    4 (testeez "uuid-ossp"
     3(use test)
     4(use uuid-ossp)
    55
    6  (test/eqv  "Nil (1)"
    7             (uuid? (make-uuid))
    8             #t)
     6;Assumes the underlying library works so just the Scheme wrapper tested
    97
    10  (test/eqv  "Nil (2)"
    11              (uuid-nil? (make-uuid))
    12              #t)
     8(test-group "Common API"
    139
    14  (test/eqv  "Nil (4)"
    15              (uuid-nil? (uuid-clone (make-uuid)))
    16              #t)
     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)))
    1715
    18  (test/eqv  "Nil (5)"
    19              (uuid-nil? (uuid-load "nil"))
    20              #t)
     16  (test-assert "uuid-null? 1" (not (uuid-null? (make-uuid 'V1))))
     17  (test-assert "uuid-null? 2" (uuid-null? (make-uuid)))
    2118
    22  (test/eqv  "uuid=?"
    23             (uuid=? (make-uuid) (make-uuid))
    24             #t)
     19  (test-assert "uuid-clear!" (uuid-null? (uuid-clear! (make-uuid 'V4))))
    2520
    26  (test/eqv  "uuid<=?"
    27             (uuid<=? (make-uuid) (make-uuid))
    28             #t)
     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))) )
    2925
    30  (test/eqv  "uuid>=?"
    31             (uuid>=? (make-uuid) (make-uuid))
    32             #t)
     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))))
    3329
    34  (test/eqv  "V1"
    35             (not (make-uuid 'V1))
    36             #f)
     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)))
    3732
    38  (test/eqv  "V1-MC"
    39             (not (make-uuid 'V1-MC))
    40             #f)
     33  (test-assert "External form of uuid"
     34    (let ((tuuid (make-uuid 'V1)))
     35      (uuid=? tuuid (string->uuid (uuid->string tuuid)))))
     36)
    4137
    42  (test/eqv  "V3"
    43             (not (make-uuid 'V3 "ns:URL" "foobarbaz"))
    44             #f)
     38(test-group "Specific API"
    4539
    46  (test/eqv  "V4"
    47             (not (make-uuid 'V4))
    48             #f)
     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")))
     43   
     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"))) )
    4949
    50  (test/eqv  "V5"
    51             (not (make-uuid 'V5 "ns:X500" "foobarbaz"))
    52             #f)
     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)) )
    5354
    54  (test/eqv  "Export"
    55             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    56               (not (uuid-export tuuid)))
    57             #f)
     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))) )
    5860
    59  (test/eqv  "Export binary"
    60             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    61               (not (uuid-export-binary tuuid)))
    62             #f)
     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)))) )
    6367
    64  (test/eqv  "Export text"
    65             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    66               (not (uuid-export-text tuuid)))
    67             #f)
     68  (test-assert "uuid-version is number" (number? (uuid-version)))
    6869
    69  (test/eqv  "Import"
    70             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    71               (not (uuid=? tuuid (uuid-import (uuid-export tuuid)))))
    72             #f)
     70)
    7371
    74  (test/eqv  "Import binary"
    75             (let ((tuuid (make-uuid 'V3 "ns:URL" "foobarbaz")))
    76               (not (uuid=? tuuid (uuid-import-binary (uuid-export-binary tuuid)))))
    77             #f)
    78 
    79  (test/eqv  "uuid-version is number"
    80             (not (number? (uuid-version)))
    81             #f)
    82 
    83  (test/equal "Error(1)"
    84              (condition-case (make-uuid 'V3 "ns:URL" "foobarbaz" 1 2)
    85                              (v () ((condition-property-accessor 'exn 'message) v)))
    86              "invalid or missing namespace and name")
    87 
    88  (test/equal "Error(2)"
    89              (condition-case (make-uuid 'R27)
    90                              (v () ((condition-property-accessor 'exn 'message) v)))
    91              "invalid mode")
    92 
    93  (test/equal "Error(3)"
    94              (condition-case (uuid-load "foobar")
    95                              (v () ((condition-property-accessor 'exn 'message) v)))
    96              "invalid argument") )
    97 
  • release/4/uuid-ossp/trunk/uuid-ossp-fix.c

    r16526 r21918  
    11/*
    2 Source to isolate use of uuid_t by OSSP UUID include file.
    3 This type is part of my unistd.h
     2Source to isolate use of uuid_t by OSSP uuid.h file. This type is part
     3of man Unix system headers. The technique used by the OSSP header to
     4avoid conflict will not work with Chicken sources. So rather than
     5include the OSSP header directly into a Chicken Scheme source a
     6"cut-out" is used to isolate the problem.
    47*/
    58
    69#include "uuid.h"
    710
     11/*
     12These are the enum & macro constants from the header that we cannot
     13include. See above.
     14*/
     15
    816unsigned int uuid_LEN_BIN = UUID_LEN_BIN;
    917unsigned int uuid_LEN_STR = UUID_LEN_STR;
     18unsigned int uuid_LEN_SIV = UUID_LEN_SIV;
    1019
    1120unsigned int uuid_RC_OK = UUID_RC_OK;
     
    1726
    1827unsigned int uuid_MAKE_V1 = UUID_MAKE_V1;
    19 unsigned int uuid_MAKE_V1MC = (UUID_MAKE_MC | UUID_MAKE_V1);
     28unsigned int uuid_MAKE_V1MC = (UUID_MAKE_V1 | UUID_MAKE_MC);
    2029unsigned int uuid_MAKE_V3 = UUID_MAKE_V3;
    2130unsigned int uuid_MAKE_V4 = UUID_MAKE_V4;
     
    2534unsigned int uuid_FMT_STR = UUID_FMT_STR;
    2635unsigned int uuid_FMT_TXT = UUID_FMT_TXT;
     36unsigned int uuid_FMT_SIV = UUID_FMT_SIV;
  • release/4/uuid-ossp/trunk/uuid-ossp-fix.h

    r16526 r21918  
    1 /*
    2 To isolate use of uuid_t by OSSP UUID include file.
    3 This type is part of my unistd.h
    4 */
     1/* See "uuid-ossp-fix.c" for more information. */
     2
     3/* Isn't case-sensitivity grand ;-) */
    54
    65extern unsigned int uuid_LEN_BIN;
    76extern unsigned int uuid_LEN_STR;
     7extern unsigned int uuid_LEN_SIV;
    88
    99extern unsigned int uuid_RC_OK;
     
    2323extern unsigned int uuid_FMT_STR;
    2424extern unsigned int uuid_FMT_TXT;
     25extern unsigned int uuid_FMT_SIV;
     26
     27/* Actually enum but this will do */
     28typedef unsigned int uuid_rc_t;
     29typedef unsigned int uuid_fmt_t;
    2530
    2631struct uuid_st;
    27 
    28 typedef unsigned int uuid_rc_t;
    29 typedef unsigned int uuid_fmt_t;
    3032
    3133/* UUID object handling */
  • release/4/uuid-ossp/trunk/uuid-ossp.meta

    r20315 r21918  
    1010 (files
    1111  "tests"
    12         "setup-header.scm"
    13         "uuid-ossp.scm" "uuid-ossp.setup" "uuid-ossp.html"
    14         "uuid-ossp-fix.c" "uuid-ossp-fix.h"))
     12  "setup-header.scm"   
     13  "uuid-ossp.scm" "uuid-ossp.setup"
     14  "uuid-ossp-fix.c" "uuid-ossp-fix.h"))
  • release/4/uuid-ossp/trunk/uuid-ossp.scm

    r19530 r21918  
    55
    66  (;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    ;
    717    uuid-version
    8     make-uuid
    9     uuid?
    10     uuid-nil? uuid-null?
    11     uuid-compare
    12     uuid=? uuid<>? uuid<? uuid>? uuid<=? uuid>=?
     18    uuid-nil?
    1319    uuid-clone
    14     uuid-load
    15     uuid-import
    16     uuid-import-binary
    17     uuid-export
    18     uuid-export-binary
    19     uuid-export-text
    20     ;DEPRECATED
    21     uuid= uuid<> uuid< uuid> uuid<= uuid>=)
     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<>?)
    2225
    2326  (import scheme chicken foreign)
     
    2831    (always-bound
    2932      +uuid-error-codes+
    30       UUID_LEN_BIN UUID_LEN_STR
     33      UUID_LEN_BIN UUID_LEN_STR UUID_LEN_SIV
    3134      UUID_RC_OK UUID_RC_ARG
    3235      UUID_RC_MEM UUID_RC_SYS
    3336      UUID_RC_INT UUID_RC_IMP
    3437      UUID_MAKE_V1 UUID_MAKE_V1MC UUID_MAKE_V3 UUID_MAKE_V4 UUID_MAKE_V5
    35       UUID_FMT_BIN UUID_FMT_STR UUID_FMT_TXT)
     38      UUID_FMT_BIN UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV)
    3639    (bound-to-procedure
    3740      uuid_create uuid_destroy uuid_clone
     
    4245      uuid_error uuid_version))
    4346
    44 
    4547#>
    4648#include "uuid-ossp-fix.h"
     
    4951(define UUID_LEN_BIN (foreign-value "uuid_LEN_BIN" unsigned-int))
    5052(define UUID_LEN_STR (foreign-value "uuid_LEN_STR" unsigned-int))
     53(define UUID_LEN_SIV (foreign-value "uuid_LEN_SIV" unsigned-int))
    5154
    5255(define UUID_RC_OK (foreign-value "uuid_RC_OK" unsigned-int))
     
    6669(define UUID_FMT_STR (foreign-value "uuid_FMT_STR" unsigned-int))
    6770(define UUID_FMT_TXT (foreign-value "uuid_FMT_TXT" unsigned-int))
    68 
    69 ;;
    70 
    71 (define-foreign-type size_t unsigned-long)
     71(define UUID_FMT_SIV (foreign-value "uuid_FMT_SIV" unsigned-int))
     72
     73;;
     74
     75(define-foreign-type size_t "size_t") ;types like this should be collected somewhere
     76
    7277(define-foreign-type uuid_rc_t unsigned-int)
    7378(define-foreign-type uuid_fmt_t unsigned-int)
     
    112117;;
    113118
    114 (define +uuid-error-codes+ (list
    115   `(,UUID_RC_OK . "everything ok")
    116   `(,UUID_RC_ARG . "invalid argument")
    117   `(,UUID_RC_MEM . "out of memory")
    118   `(,UUID_RC_SYS . "system error")
    119   `(,UUID_RC_INT . "internal error")
    120   `(,UUID_RC_IMP . "not implemented") ) )
     119(define +uuid-error-codes+
     120  `((,UUID_RC_OK . "everything ok")
     121    (,UUID_RC_ARG . "invalid argument")
     122    (,UUID_RC_MEM . "out of memory")
     123    (,UUID_RC_SYS . "system error")
     124    (,UUID_RC_INT . "internal error")
     125    (,UUID_RC_IMP . "not implemented")))
    121126
    122127(define (uuid-error-string code)
     
    124129      (let ((msg (assv code +uuid-error-codes+)))
    125130        (if msg (cdr msg)
    126           "unknown result code" ) ) ) )
     131            "unknown result code" ) ) ) )
    127132
    128133(define (signal-uuid-error code loc)
    129134  (abort
    130     (make-composite-condition
    131       (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
    132       (make-property-condition 'uuid 'code code))) )
     135   (make-composite-condition
     136    (make-property-condition 'exn 'location loc 'message (uuid-error-string code))
     137    (make-property-condition 'uuid 'code code))) )
    133138
    134139(define-inline (uuid-status-ok? code)
     
    148153
    149154(define-inline (box-puuid puuid)
    150   (let ((boxed-puuid (tag-pointer puuid 'ossp-uuid)))
    151     (set-finalizer! boxed-puuid free-uuid)
    152     boxed-puuid ) )
     155  (set-finalizer! (tag-pointer puuid 'uuid-ossp) free-uuid) )
    153156
    154157(define (new-uuid loc)
     
    158161
    159162(define-inline (%uuid? obj)
    160   (tagged-pointer? obj 'ossp-uuid) )
     163  (tagged-pointer? obj 'uuid-ossp) )
    161164
    162165(define (%uuid-compare uuid1 uuid2 loc)
     
    169172(define (uuid-import-format fmt str loc)
    170173  (unless (string? str)
    171     (error loc "can only import from a string" str))
     174    (##sys#signal-hook #:type-error loc
     175                       "bad argument type - not a string" str))
    172176  (let ((str-len
    173177          (select fmt
    174178            ((UUID_FMT_BIN) UUID_LEN_BIN)
    175179            ((UUID_FMT_STR) UUID_LEN_STR)
     180            ((UUID_FMT_SIV) UUID_LEN_SIV)
    176181            (else
    177               (error loc "invalid format" fmt)))))
     182              (##sys#signal-hook #:type-error loc
     183                                 "bad argument type - invalid format" fmt)))))
    178184    (unless (= (string-length str) str-len)
    179       (error loc "invalid length of string: wanted:" str str-len))
     185      ;type-error here is dubious
     186      (##sys#signal-hook #:type-error loc
     187                         "bad argument type - invalid string length" str))
    180188    (let ((uuid (new-uuid loc)))
    181189      (error-check (uuid_import (unbox-puuid uuid) fmt str str-len) loc)
     
    183191
    184192(define (uuid-export-format uuid fmt loc)
    185   (let ((str-bias
     193  (let ((len-bias
    186194          (select fmt
    187195            ((UUID_FMT_BIN) 0)
    188             ((UUID_FMT_STR) 1)
    189             ((UUID_FMT_TXT) 1)
     196            ((UUID_FMT_STR UUID_FMT_TXT UUID_FMT_SIV) 1)
    190197            (else
    191               (error loc "invalid format" fmt)))))
    192     (let-location ((len size_t 0) (dat c-pointer #f))
     198              (##sys#signal-hook #:type-error loc
     199                                 "bad argument type - invalid format" fmt)))))
     200    (let-location ((len size_t 0)
     201                   (dat c-pointer #f) )
    193202      (error-check (uuid_export (unbox-puuid uuid) fmt (location dat) (location len)) loc)
    194203      (when (or (null-pointer? dat) (zero? len))
    195204        (signal-uuid-error UUID_RC_INT loc))
    196       (let ((str-len (fx- (inexact->exact len) str-bias)))
     205      (let ((str-len (fx- (inexact->exact len) len-bias)))
    197206        (let ((str (make-string str-len)))
    198207          (move-memory! dat (make-locative str) str-len)
     
    200209          str ) ) ) ) )
    201210
    202 (define (get-ns-uuid ns loc)
    203   (cond
    204     ((%uuid? ns)
    205       ns )
    206     ((string? ns)
    207       (let ((uuid (new-uuid loc)))
    208         (error-check (uuid_load (unbox-puuid uuid) ns) loc)
    209         uuid ) )
    210     (else
    211       (error loc "invalid namespace" ns) ) ) )
    212 
    213 (define (make-uuid-2 args uuid mode loc)
    214   (unless (= (length args) 3)
    215     (error loc "invalid or missing namespace and name" args))
    216   (let ((ns-uuid (get-ns-uuid (cadr args) loc)) (name (caddr args)))
     211(define (get-ns-uuid uuid ns loc)
     212  (when (not ns) (set! ns "nil"))
     213  (unless (string? ns)
     214    (##sys#signal-hook #:type-error loc
     215                       "bad argument type - not a string" ns))
     216  (let ((uuid (or uuid (new-uuid loc))))
     217    (error-check (uuid_load (unbox-puuid uuid) ns) loc)
     218    uuid ) )
     219
     220(define (make-uuid-2 args uuid var loc)
     221  (unless (= 2 (length args))
     222    (##sys#error-hook (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
     223                      3 (+ 1 (length args)) #f))
     224  (let* ((ns (car args))
     225         (ns-uuid (if (%uuid? ns) ns (get-ns-uuid #f ns loc)))
     226         (name (cadr args)) )
    217227    (unless (string? name)
    218       (error loc "invalid name" name))
    219     (error-check (uuid_make_2 (unbox-puuid uuid) mode (unbox-puuid ns-uuid) name) loc) ) )
     228      (##sys#signal-hook #:type-error loc
     229                          "bad argument type - not a string" name))
     230    (error-check (uuid_make_2 (unbox-puuid uuid) var (unbox-puuid ns-uuid) name) loc) ) )
    220231
    221232;;
     
    260271    (or (zero? cmp) (positive? cmp) ) ) )
    261272
    262 ;DEPRECATED
    263 (define uuid= uuid=?)
    264 (define uuid<> uuid<>?)
    265 (define uuid< uuid<?)
    266 (define uuid> uuid>?)
    267 (define uuid<= uuid<=?)
    268 (define uuid>= uuid>=?)
    269 
    270273;;
    271274
     
    275278    (box-puuid puuid) ) )
    276279
    277 (define (uuid-load ns)
    278   (get-ns-uuid ns 'uuid-load))
     280;compatibility w/ uuid-lib
     281(define uuid-copy uuid-clone)
    279282
    280283(define (make-uuid . args)
    281284  (let ((uuid (new-uuid 'make-uuid)))
    282     (unless (null? args)
    283       (let ((mode (car args)))
    284         (case mode
    285           ((V1)
    286             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1) 'make-uuid))
    287           ((V1-MC)
    288             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1MC) 'make-uuid))
    289           ((V3)
    290             (make-uuid-2 args uuid UUID_MAKE_V3 'make-uuid))
    291           ((V4)
    292             (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V4) 'make-uuid))
    293           ((V5)
    294             (make-uuid-2 args uuid UUID_MAKE_V5 'make-uuid))
    295           (else
    296             (error 'make-uuid "invalid mode" mode)))))
     285    (let ((variant (and (not (null? args)) (car args))))
     286      (case variant
     287        ((#f)
     288          ) ;the nil-uuid
     289        ((V1 time)
     290         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1) 'make-uuid))
     291        ((V1-MC)
     292         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V1MC) 'make-uuid))
     293        ((V3)
     294         (make-uuid-2 (cdr args) uuid UUID_MAKE_V3 'make-uuid))
     295        ((V4 random)
     296         (error-check (uuid_make_0 (unbox-puuid uuid) UUID_MAKE_V4) 'make-uuid))
     297        ((V5)
     298         (make-uuid-2 (cdr args) uuid UUID_MAKE_V5 'make-uuid))
     299        (else
     300         (##sys#signal-hook #:type-error 'make-uuid
     301                            "bad argument type - invalid variant" variant) ) ) )
    297302    uuid ) )
     303
     304(define (uuid-clear! uuid)
     305  (get-ns-uuid uuid "nil" 'uuid-clear!) )
     306
     307(define (uuid-load! uuid #!optional ns)
     308  (get-ns-uuid uuid ns 'uuid-load!) )
     309
     310(define (uuid-load #!optional ns)
     311  (get-ns-uuid #f ns 'uuid-load) )
    298312
    299313(define (uuid-import str)
     
    303317  (uuid-import-format UUID_FMT_BIN str 'uuid-import-binary) )
    304318
     319(define (uuid-import-siv str)
     320  (uuid-import-format UUID_FMT_SIV str 'uuid-import-binary) )
     321
    305322(define (uuid-export uuid)
    306323  (uuid-export-format uuid UUID_FMT_STR 'uuid-export) )
     
    312329  (uuid-export-format uuid UUID_FMT_TXT 'uuid-export-text) )
    313330
     331(define (uuid-export-siv uuid)
     332  (uuid-export-format uuid UUID_FMT_SIV 'uuid-export-siv) )
     333
     334(define (string->uuid str)
     335  (uuid-import str) )
     336
     337(define (uuid->string uuid)
     338  (uuid-export uuid) )
     339
    314340(define uuid-version uuid_version)
    315341
  • release/4/uuid-ossp/trunk/uuid-ossp.setup

    r20315 r21918  
     1;;;; uuid-ossp.setup  -*- Hen -*-
     2
    13(include "setup-helper")
    24
    3 (setup-shared-extension-module 'uuid-ossp (extension-version "1.3.0")
     5(verify-extension-name "uuid-ossp")
     6
     7(setup-shared-extension-module 'uuid-ossp (extension-version "1.4.0")
    48  compile-options: '(
    59    -scrutinize
     
    711    -optimize-level 3 -debug-level 1
    812    -no-procedure-checks -no-bound-checks
    9     "`uuid-config --cflags` uuid-ossp-fix.c `uuid-config --ldflags --libs` -luuid"))
     13    "`uuid-config --cflags` uuid-ossp-fix.c `uuid-config --ldflags --libs`"))
Note: See TracChangeset for help on using the changeset viewer.