Changeset 11779 in project for release/4/uri-generic/trunk


Ignore:
Timestamp:
08/27/08 20:19:18 (13 years ago)
Author:
sjamaan
Message:

Port uri-generic to chicken 4, using the test egg instead of testbase

Location:
release/4/uri-generic
Files:
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/tests/run.scm

    r11562 r11779  
    1 
    21(require-extension srfi-1)
    32(require-extension uri-generic)
    4 (require-extension testbase)
    5 (require-extension testbase-output-compact)
    6 
    7 (define-expect-unary pair?)
     3(require-extension test)
    84
    95;; test cases from Python URI implementation
     
    10197    ))
    10298
    103 (define-test uri-test "uri test"
     99(test-group "uri test"
     100  (for-each (lambda (p)
     101              (let ((ubase (uri-reference (first p)))
     102                    (uabs  (uri-reference (second p)))
     103                    (uex   (uri-reference (third p))))
     104                (let* ((from (uri-relative-from uabs ubase))
     105                       (to    (uri-relative-to from ubase)))
     106                  (test (apply sprintf "~S * ~S -> ~S" p) uex from)
     107                  (test (apply sprintf "~S * ~S -> ~S" p) uabs to)
     108                  )))
     109            path-cases))
    104110
    105    (test/collect 'path-test
    106      (for-each (lambda (p)
    107                  (let ((ubase (uri-reference (first p)))
    108                        (uabs  (uri-reference (second p)))
    109                        (uex   (uri-reference (third p))))
    110                    (let* ((from (uri-relative-from uabs ubase))
    111                           (to    (uri-relative-to from ubase)))
    112                      (collect-test (test/equal from uex))
    113                      (collect-test (test/equal to uabs))
    114                    )))
    115                path-cases))
     111(test-group "rfc test"
     112  (for-each (lambda (p)
     113              (let ((ubase (uri-reference (first p)))
     114                    (uabs  (uri-reference (second p)))
     115                    (uex   (uri-reference (third p))))
     116                (let* ((to    (uri-relative-to uabs ubase)))
     117                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
     118                  )))
     119            rfc-cases))
    116120
    117    (test/collect 'rfc-test
    118      (for-each (lambda (p)
    119                  (let ((ubase (uri-reference (first p)))
    120                        (uabs  (uri-reference (second p)))
    121                        (uex   (uri-reference (third p))))
    122                    (let* ((to    (uri-relative-to uabs ubase)))
    123                      (collect-test (test/equal to uex))
    124                    )))
    125                rfc-cases))
    126 
    127    (test/collect 'extra-test
    128      (for-each (lambda (p)
    129                  (let ((ubase (uri-reference (first p)))
    130                        (uabs  (uri-reference (second p)))
    131                        (uex   (uri-reference (third p))))
    132                    (let* ((to    (uri-relative-to uabs ubase)))
    133                      (collect-test (test/equal to uex))
    134                    )))
    135                extra-cases))
    136    )
    137 
    138 
    139 (test::styler-set! uri-test test::output-style-compact)
    140 (run-test "uri test")
     121(test-group "extra-test"
     122  (for-each (lambda (p)
     123              (let ((ubase (uri-reference (first p)))
     124                    (uabs  (uri-reference (second p)))
     125                    (uex   (uri-reference (third p))))
     126                (let* ((to    (uri-relative-to uabs ubase)))
     127                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
     128                  )))
     129            extra-cases))
  • release/4/uri-generic/trunk/uri-generic.scm

    r11744 r11779  
    1 
    21;;
    32;; Definitions and parsing routines for Uniform Resource Identifiers (RFC 3986).
     
    3938;;
    4039
    41 (require-extension syntax-case)
    42 (require-extension matchable)
    43 (require-extension defstruct)
    44 (require-extension srfi-1)
    45 (require-extension srfi-4)
    46 
    47 (define-extension uri-generic)
    48 
    49 (declare
    50  (not usual-integrations)
    51  (fixnum)
    52  (inline)
    53  (lambda-lift)
    54  (export uri-reference
    55          uri? uri-auth uri-authority uri-scheme uri-path uri-query
    56          uri-fragment uri-host uri-port uri-username uri-password
    57          absolute-uri uri->string uri->list uri-char-list-escape
    58          uri-char-list->string uri-string->char-list
    59          uri-relative-to uri-relative-from
    60          uri-normalize-case uri-normalize-path-segments))
    61 
    62 (cond-expand
     40(module uri-generic
     41 (uri-reference
     42  uri? uri-auth uri-authority uri-scheme uri-path uri-query
     43  uri-fragment uri-host uri-port uri-username uri-password
     44  absolute-uri uri->string uri->list uri-char-list-escape
     45  uri-char-list->string uri-string->char-list
     46  uri-relative-to uri-relative-from
     47  uri-normalize-case uri-normalize-path-segments)
     48
     49(import chicken scheme extras data-structures)
     50 
     51(require-extension matchable defstruct srfi-1 srfi-4 srfi-13 srfi-14)
     52
     53;; What to do with these?
     54#;(cond-expand
    6355   (utf8-strings (use utf8-srfi-13 utf8-srfi-14))
    6456   (else (use srfi-13 srfi-14)))
     
    972964    (URI-path-set! u1 path)
    973965    u1))
     966)
  • release/4/uri-generic/trunk/uri-generic.setup

    r11744 r11779  
    11;; -*- Hen -*-
    22
    3 (define has-exports? (string>=? (chicken-version) "2.310"))
    4 
    5 (define (dynld-name fn)         
    6   (make-pathname #f fn ##sys#load-dynamic-extension))   
    7 
    8 (compile -O2 -d0 -s
    9          ,@(if has-exports? '(-check-imports -emit-exports uri-generic.exports) '())
    10          uri-generic.scm)
     3(compile -s -O2 uri-generic.scm -j uri-generic)
     4(compile -s -O2 uri-generic.import.scm)
    115
    126(install-extension
     
    1610
    1711  ;; Files to install for your extension:
    18   `(,(dynld-name "uri-generic")
    19     ,@(if has-exports? '("uri-generic.exports") (list)) )
    20  
     12  `("uri-generic.so" "uri-generic.import.so")
    2113
    2214  ;; Assoc list with properties for your extension:
    23   '((version 1.2)
    24     (documentation "uri-generic.html")
    25     ,@(if has-exports? `((exports "uri-generic.exports")) (list)) ))
     15  '((version 1.3)
     16    (documentation "uri-generic.html")))
Note: See TracChangeset for help on using the changeset viewer.