guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-209-g5e33d


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-209-g5e33d0a
Date: Fri, 06 Jul 2012 12:13:34 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=5e33d0aa37ec4de6414dad032ab1ca4fbc5ff583

The branch, stable-2.0 has been updated
       via  5e33d0aa37ec4de6414dad032ab1ca4fbc5ff583 (commit)
       via  3fabb2d2be8379ba61d0b4ab742c0a1e63638b69 (commit)
       via  81e7210f1427d5209357cbcb241e22ce278dd73e (commit)
       via  274e2eecf18a726280802230ab50774fa11e1107 (commit)
       via  d540a1d648d9f7532e3e870b48184fa2b7949f9a (commit)
       via  fc835b1b14a38f61150557ab531de51f98239739 (commit)
       via  5558cdaa302aba6ba493612fbea1fdac09db7d96 (commit)
       via  fc30e14ffe550cfb088cf9f8b388b276663f6297 (commit)
       via  baeb727bcfcf8aa0c2061c2d8ebb788eaa6d4c90 (commit)
       via  eca586b489e5c2d07e86114d4b76da81289cec75 (commit)
       via  3b6e61982466d2a4b5cc7de6c83c4a553ffab72c (commit)
      from  13e3d3d95dcb6c9cb4b3d69129d6b5fd9ad2e65a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 5e33d0aa37ec4de6414dad032ab1ca4fbc5ff583
Author: Dagobert Michelsen <address@hidden>
Date:   Mon Feb 6 09:45:41 2012 +0100

    Add alignment for Sun Studio 12

commit 3fabb2d2be8379ba61d0b4ab742c0a1e63638b69
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 13:13:19 2012 +0200

    more uri-related ipv6 fixes
    
    * module/web/uri.scm (ipv6-regexp): IPv6 numeric addresses do not have
      brackets.  It's only in URIs that they have them.
      (ipv6-host-pat, authority-regexp, parse-authority): Refactor ipv6
      detection to fix a bug with |, and to extract IPv6 hosts from their
      brackets.  This way we can pass the uri-host directly to inet-pton.
      (uri->string): If the host contains a `:', assume it is ipv6 and add
      brackets.
    
    * test-suite/tests/web-uri.test ("build-uri"): Adapt tests to assume
      that the address returned by uri-host and passed to build-uri #:host
      does not have brackets.

commit 81e7210f1427d5209357cbcb241e22ce278dd73e
Author: Daniel Hartwig <address@hidden>
Date:   Sat Dec 31 00:16:42 2011 +0800

    enhance IPv6 support
    
    * module/web/uri.scm (valid-host?): Support dotted-quad notation
      in IPv6 addresses.
      (parse-authority): Support IPv6 literals.
    * test-suite/tests/web-uri.test: Add and fix tests.

commit 274e2eecf18a726280802230ab50774fa11e1107
Author: Daniel Hartwig <address@hidden>
Date:   Fri Dec 30 17:49:37 2011 +0800

    support URIs with domain names starting with numbers
    
    * module/web/uri.scm (valid-host?): Fix regexp to support
    domain names starting with numbers.
    * test-suite/tests/web-uri.scm: Add tests for above and
    IP literals.

commit d540a1d648d9f7532e3e870b48184fa2b7949f9a
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 12:23:39 2012 +0200

    fix typo in web.texi
    
    * doc/ref/web.texi (HTTP Headers): Fix typo in example.  Fixes
      http://bugs.gnu.org/10890.

commit fc835b1b14a38f61150557ab531de51f98239739
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 12:19:12 2012 +0200

    better procedure-arguments for interpreted procs with opt, rest, kwargs
    
    * module/ice-9/session.scm (procedure-arguments): Arrange to interpret
      numbers in the "req" and "opt" positions of an 'arglist as N arguments
      with unknown name.
    
    * module/ice-9/eval.scm (primitive-eval): Set 'arglist on "complex"
      procedures.  Fixes http://bugs.gnu.org/10922.
    
    * test-suite/tests/session.test ("procedure-arguments"): Add a test.

commit 5558cdaa302aba6ba493612fbea1fdac09db7d96
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 11:01:51 2012 +0200

    add check for fchmod
    
    * configure.ac: Add a check for fchmod.
    
    * libguile/filesys.c (scm_chmod): Guard the fchmod case with
      HAVE_FCHMOD.

commit fc30e14ffe550cfb088cf9f8b388b276663f6297
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 10:56:02 2012 +0200

    remove mkdir alias in filesys.c for mingw
    
    * libguile/filesys.c (mkdir): Remove alias, as gnulib handles this for
      us.

commit baeb727bcfcf8aa0c2061c2d8ebb788eaa6d4c90
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 10:50:31 2012 +0200

    fix warnings in mingw in expand.c
    
    * libguile/expand.c (VOID_, CONST_): Add trailing underscores to avoid
      name conflicts on MinGW.

commit eca586b489e5c2d07e86114d4b76da81289cec75
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 10:43:29 2012 +0200

    fix warning about vsnprintf on mingw
    
    * libguile/deprecation.c: Remove a vsnprintf alias for mingw, now that
      gnulib handles it correctly.

commit 3b6e61982466d2a4b5cc7de6c83c4a553ffab72c
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 10:43:02 2012 +0200

    be sure to include time.h for struct timespec
    
    * libguile/gen-scmconfig.c: The GNU libc manual says that struct
      timespec is defined in time.h.  So, just include both sys/time.h and
      time.h, if they are available.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac                  |    2 +-
 doc/ref/web.texi              |    2 +-
 libguile/__scm.h              |    3 +-
 libguile/deprecation.c        |    6 ----
 libguile/expand.c             |   27 +++++++++++--------
 libguile/filesys.c            |    6 ++--
 libguile/gen-scmconfig.c      |   19 ++++++-------
 module/ice-9/eval.scm         |    9 ++++++-
 module/ice-9/session.scm      |    8 ++++-
 module/web/uri.scm            |   20 +++++++++-----
 test-suite/tests/session.test |   25 +++++++++++++++++-
 test-suite/tests/web-uri.test |   57 ++++++++++++++++++++++++++++++++++++++++-
 12 files changed, 138 insertions(+), 46 deletions(-)

diff --git a/configure.ac b/configure.ac
index 3c117d3..5f98798 100644
--- a/configure.ac
+++ b/configure.ac
@@ -756,7 +756,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   utimensat: posix.1-2008
 #   sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround 
ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat 
mkdir mknod nice pipe _pipe poll readdir_r readdir64_r readlink rename rmdir 
select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 
strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid 
strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent 
kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy 
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale 
utimensat sched_getaffinity sched_setaffinity])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround 
ftime ftruncate fchown fchmod getcwd geteuid getsid gettimeofday gmtime_r ioctl 
lstat mkdir mknod nice pipe _pipe poll readdir_r readdir64_r readlink rename 
rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt 
stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname 
waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent 
getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index 
bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l 
newlocale utimensat sched_getaffinity sched_setaffinity])
 
 # Reasons for testing:
 #   netdb.h - not in mingw
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index c374833..a3d92ad 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -665,7 +665,7 @@ A list of allowed methods on a given resource, as symbols.
 A list of content codings, as symbols.
 @example
 (parse-header 'content-encoding "gzip")
address@hidden (GET HEAD)
address@hidden (gzip)
 @end example
 @end deftypevr
 
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 68ababd..1c20bd7 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -126,7 +126,8 @@
 
 /* The SCM_ALIGNED macro, when defined, can be used to instruct the compiler
  * to honor the given alignment constraint.  */
-#if defined __GNUC__
+/* Sun Studio supports alignment since Sun Studio 12 */
+#if defined __GNUC__ || (defined( __SUNPRO_C ) && (__SUNPRO_C - 0 >= 0x590))
 # define SCM_ALIGNED(x)  __attribute__ ((aligned (x)))
 #elif defined __INTEL_COMPILER
 # define SCM_ALIGNED(x)  __declspec (align (x))
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index 0822707..aa50eaf 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -34,12 +34,6 @@
 
 #include "libguile/private-options.h"
 
-
-/* Windows defines. */
-#ifdef __MINGW32__
-#define vsnprintf _vsnprintf
-#endif
-
 
 
 struct issued_warning {
diff --git a/libguile/expand.c b/libguile/expand.c
index bdecd80..cae5520 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
+/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2012
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -49,9 +49,12 @@ static const char* exp_names[SCM_NUM_EXPANDED_TYPES];
 static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
 
 
-#define VOID(src) \
+/* The trailing underscores on these first to are to avoid spurious
+   conflicts with macros defined on MinGW.  */
+
+#define VOID_(src) \
   SCM_MAKE_EXPANDED_VOID(src)
-#define CONST(src, exp) \
+#define CONST_(src, exp) \
   SCM_MAKE_EXPANDED_CONST(src, exp)
 #define PRIMITIVE_REF_TYPE(src, name) \
   SCM_MAKE_EXPANDED_PRIMITIVE_REF_TYPE(src, name)
@@ -375,7 +378,7 @@ expand (SCM exp, SCM env)
         return TOPLEVEL_REF (SCM_BOOL_F, exp);
     }
   else
-    return CONST (SCM_BOOL_F, exp);
+    return CONST_ (SCM_BOOL_F, exp);
 }
 
 static SCM
@@ -431,7 +434,7 @@ expand_and (SCM expr, SCM env)
   const SCM cdr_expr = CDR (expr);
 
   if (scm_is_null (cdr_expr))
-    return CONST (SCM_BOOL_F, SCM_BOOL_T);
+    return CONST_ (SCM_BOOL_F, SCM_BOOL_T);
 
   ASSERT_SYNTAX (scm_is_pair (cdr_expr), s_bad_expression, expr);
 
@@ -441,7 +444,7 @@ expand_and (SCM expr, SCM env)
     return CONDITIONAL (scm_source_properties (expr),
                         expand (CAR (cdr_expr), env),
                         expand_and (cdr_expr, env),
-                        CONST (SCM_BOOL_F, SCM_BOOL_F));
+                        CONST_ (SCM_BOOL_F, SCM_BOOL_F));
 }
 
 static SCM
@@ -469,7 +472,7 @@ expand_cond_clauses (SCM clause, SCM rest, int elp, int 
alp, SCM env)
     }
 
   if (scm_is_null (rest))
-    rest = VOID (SCM_BOOL_F);
+    rest = VOID_ (SCM_BOOL_F);
   else
     rest = expand_cond_clauses (CAR (rest), CDR (rest), elp, alp, env);
 
@@ -586,7 +589,7 @@ expand_eval_when (SCM expr, SCM env)
       || scm_is_true (scm_memq (sym_load, CADR (expr))))
     return expand_sequence (CDDR (expr), env);
   else
-    return VOID (scm_source_properties (expr));
+    return VOID_ (scm_source_properties (expr));
 }
 
 static SCM
@@ -600,7 +603,7 @@ expand_if (SCM expr, SCM env SCM_UNUSED)
                       expand (CADDR (expr), env),
                       ((length == 3)
                        ? expand (CADDDR (expr), env)
-                       : VOID (SCM_BOOL_F)));
+                       : VOID_ (SCM_BOOL_F)));
 }
 
 /* A helper function for expand_lambda to support checking for duplicate
@@ -789,7 +792,7 @@ expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
       vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
       env = scm_acons (x, CAR (vars), env);
       if (scm_is_symbol (x))
-        inits = scm_cons (CONST (SCM_BOOL_F, SCM_BOOL_F), inits);
+        inits = scm_cons (CONST_ (SCM_BOOL_F, SCM_BOOL_F), inits);
       else
         {
           ASSERT_SYNTAX (scm_ilength (x) == 2 && scm_is_symbol (CAR (x)),
@@ -1109,7 +1112,7 @@ expand_or (SCM expr, SCM env SCM_UNUSED)
   ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
 
   if (scm_is_null (CDR (expr)))
-    return CONST (SCM_BOOL_F, SCM_BOOL_F);
+    return CONST_ (SCM_BOOL_F, SCM_BOOL_F);
   else
     {
       SCM tmp = scm_gensym (SCM_UNDEFINED);
@@ -1133,7 +1136,7 @@ expand_quote (SCM expr, SCM env SCM_UNUSED)
   ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
   ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
   quotee = CAR (cdr_expr);
-  return CONST (scm_source_properties (expr), quotee);
+  return CONST_ (scm_source_properties (expr), quotee);
 }
 
 static SCM
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 514c1ae..9c39307 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -103,9 +103,7 @@
 
 /* Some more definitions for the native Windows port. */
 #ifdef __MINGW32__
-# define mkdir(path, mode) mkdir (path)
 # define fsync(fd) _commit (fd)
-# define fchmod(fd, mode) (-1)
 #endif /* __MINGW32__ */
 
 
@@ -1336,12 +1334,13 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
 #define FUNC_NAME s_scm_chmod
 {
   int rv;
-  int fdes;
 
   object = SCM_COERCE_OUTPORT (object);
 
+#if HAVE_FCHMOD
   if (scm_is_integer (object) || SCM_OPFPORTP (object))
     {
+      int fdes;
       if (scm_is_integer (object))
        fdes = scm_to_int (object);
       else
@@ -1349,6 +1348,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
       SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
     }
   else
+#endif
     {
       STRING_SYSCALL (object, c_object,
                      rv = chmod (c_object, scm_to_int (mode)));
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 176f25c..77ab94f 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -149,18 +149,17 @@ main (int argc, char *argv[])
   pf ("/* limits.h not available */\n");
 #endif
 
-# ifdef TIME_WITH_SYS_TIME
+#if HAVE_SYS_TIME_H
   pf ("#include <sys/time.h>\n");
+#else
+  pf ("/* sys/time.h not available */\n");
+#endif
+
+#if HAVE_TIME_H
   pf ("#include <time.h>\n");
-# else
-#  ifdef HAVE_SYS_TIME_H
-  pf ("#include <sys/time.h>\n");
-#  else
-#   ifdef HAVE_TIME_H
-  pf ("#include <time.h>\n");
-#   endif
-#  endif
-# endif
+#else
+  pf ("/* time.h not available */\n");
+#endif
 
   pf("\n");
 #ifdef STDC_HEADERS
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 74b8532..81b9538 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -238,7 +238,14 @@
       (define (set-procedure-arity! proc)
         (let lp ((alt alt) (nreq nreq) (nopt nopt) (rest? rest?))
           (if (not alt)
-              (set-procedure-minimum-arity! proc nreq nopt rest?)
+              (begin
+                (set-procedure-property! proc 'arglist
+                                         (list nreq
+                                               nopt
+                                               (if kw (cdr kw) '())
+                                               (and kw (car kw))
+                                               (and rest? '_)))
+                (set-procedure-minimum-arity! proc nreq nopt rest?))
               (let* ((nreq* (cadr alt))
                      (rest?* (if (null? (cddr alt)) #f (caddr alt)))
                      (tail (and (pair? (cddr alt)) (pair? (cdddr alt)) (cdddr 
alt)))
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index 0eeed86..ce1bcac 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -511,8 +511,12 @@ The alist keys that are currently defined are `required', 
`optional',
    ((procedure-property proc 'arglist)
     => (match-lambda
         ((req opt keyword aok? rest)
-         `((required . ,req)
-           (optional . ,opt)
+         `((required . ,(if (number? req)
+                            (make-list req '_)
+                            req))
+           (optional . ,(if (number? opt)
+                            (make-list opt '_)
+                            opt))
            (keyword . ,keyword)
            (allow-other-keys? . ,aok?)
            (rest . ,rest)))))
diff --git a/module/web/uri.scm b/module/web/uri.scm
index a2a930a..109118b 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -91,7 +91,7 @@ consistency checks to make sure that the constructed URI is 
valid."
 (define ipv4-regexp
   (make-regexp "^([0-9.]+)$"))
 (define ipv6-regexp
-  (make-regexp "^\\[([0-9a-fA-F:]+)\\]+$"))
+  (make-regexp "^([0-9a-fA-F:.]+)$"))
 (define domain-label-regexp
   (make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$"))
 (define top-label-regexp
@@ -116,12 +116,14 @@ consistency checks to make sure that the constructed URI 
is valid."
   "[a-zA-Z0-9_.!~*'();:&=+$,-]+")
 (define host-pat
   "[a-zA-Z0-9.-]+")
+(define ipv6-host-pat
+  "[0-9a-fA-F:.]+")
 (define port-pat
   "[0-9]*")
 (define authority-regexp
   (make-regexp
-   (format #f "^//((~a)@)?(~a)(:(~a))?$"
-           userinfo-pat host-pat port-pat)))
+   (format #f "^//((~a)@)?((~a)|(\\[(~a)\\]))(:(~a))?$"
+           userinfo-pat host-pat ipv6-host-pat port-pat)))
 
 (define (parse-authority authority fail)
   (if (equal? authority "//")
@@ -129,10 +131,12 @@ consistency checks to make sure that the constructed URI 
is valid."
       ;; file:/etc/hosts.
       (values #f #f #f)
       (let ((m (regexp-exec authority-regexp authority)))
-        (if (and m (valid-host? (match:substring m 3)))
+        (if (and m (valid-host? (or (match:substring m 4)
+                                    (match:substring m 6))))
             (values (match:substring m 2)
-                    (match:substring m 3)
-                    (let ((port (match:substring m 5)))
+                    (or (match:substring m 4)
+                        (match:substring m 6))
+                    (let ((port (match:substring m 8)))
                       (and port (not (string-null? port))
                            (string->number port))))
             (fail)))))
@@ -216,7 +220,9 @@ printed."
          (string-append "//"
                         (if userinfo (string-append userinfo "@")
                             "")
-                        host
+                        (if (string-index host #\:)
+                            (string-append "[" host "]")
+                            host)
                         (if (default-port? (uri-scheme uri) port)
                             ""
                             (string-append ":" (number->string port))))
diff --git a/test-suite/tests/session.test b/test-suite/tests/session.test
index 242ecf9..ec992f1 100644
--- a/test-suite/tests/session.test
+++ b/test-suite/tests/session.test
@@ -20,6 +20,7 @@
 
 (define-module (test-suite session)
   #:use-module (test-suite lib)
+  #:use-module (ice-9 match)
   #:use-module (system base compile)
   #:use-module (ice-9 session))
 
@@ -94,7 +95,29 @@
     (let* ((proc (compile '(lambda (a b) #f) #:to 'value))
            (args (procedure-arguments proc)))
       (set-procedure-property! proc 'arglist (map cdr args))
-      (equal? args (procedure-arguments proc)))))
+      (equal? args (procedure-arguments proc))))
+
+  (pass-if "interpreted procedures (simple)"
+    (match (procedure-arguments
+            (eval '(lambda (x y) #f) (current-module)))
+      (((required _ _)
+        (optional)
+        (keyword)
+        (allow-other-keys? . #f)
+        (rest . #f))
+       #t)
+      (_ #f)))
+
+  (pass-if "interpreted procedures (complex)"
+    (match (procedure-arguments
+            (eval '(lambda* (a b #:optional c #:key d) #f) (current-module)))
+      (((required _ _)
+        (optional _)
+        (keyword (#:d . 3))
+        (allow-other-keys? . #f)
+        (rest . #f))
+       #t)
+      (_ #f))))
 
 ;;; Local Variables:
 ;;; eval: (put 'pass-if-valid-arguments 'scheme-indent-function 1)
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 940fb31..7431025 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -90,6 +90,22 @@
     (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f)
            #:scheme 'http #:host "bad.host.1" #:path ""))
 
+  (pass-if "http://1.good.host";
+    (uri=? (build-uri 'http #:host "1.good.host")
+           #:scheme 'http #:host "1.good.host" #:path ""))
+
+  (pass-if "http://192.0.2.1";
+    (uri=? (build-uri 'http #:host "192.0.2.1")
+           #:scheme 'http #:host "192.0.2.1" #:path ""))
+
+  (pass-if "http://[2001:db8::1]";
+    (uri=? (build-uri 'http #:host "2001:db8::1")
+           #:scheme 'http #:host "2001:db8::1" #:path ""))
+
+  (pass-if "http://[::ffff:192.0.2.1]";
+    (uri=? (build-uri 'http #:host "::ffff:192.0.2.1")
+           #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
+
   (pass-if-uri-exception "http://foo:not-a-port";
                          "Expected.*port"
                          (build-uri 'http #:host "foo" #:port "not-a-port"))
@@ -135,6 +151,29 @@
   (pass-if "http://bad.host.1";
     (not (string->uri "http://bad.host.1";)))
 
+  (pass-if "http://1.good.host";
+    (uri=? (string->uri "http://1.good.host";)
+           #:scheme 'http #:host "1.good.host" #:path ""))
+
+  (pass-if "http://192.0.2.1";
+    (uri=? (string->uri "http://192.0.2.1";)
+           #:scheme 'http #:host "192.0.2.1" #:path ""))
+
+  (pass-if "http://[2001:db8::1]";
+    (uri=? (string->uri "http://[2001:db8::1]";)
+           #:scheme 'http #:host "2001:db8::1" #:path ""))
+
+  (pass-if "http://[2001:db8::1]:80";
+    (uri=? (string->uri "http://[2001:db8::1]:80";)
+           #:scheme 'http
+           #:host "2001:db8::1"
+           #:port 80
+           #:path ""))
+
+  (pass-if "http://[::ffff:192.0.2.1]";
+    (uri=? (string->uri "http://[::ffff:192.0.2.1]";)
+           #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
+
   (pass-if "http://foo:";
     (uri=? (string->uri "http://foo:";)
            #:scheme 'http #:host "foo" #:path ""))
@@ -188,6 +227,18 @@
     (equal? "ftp://address@hidden:22/baz";
             (uri->string (string->uri "ftp://address@hidden:22/baz";))))
   
+  (pass-if "http://192.0.2.1";
+    (equal? "http://192.0.2.1";
+            (uri->string (string->uri "http://192.0.2.1";))))
+
+  (pass-if "http://[2001:db8::1]";
+    (equal? "http://[2001:db8::1]";
+            (uri->string (string->uri "http://[2001:db8::1]";))))
+
+  (pass-if "http://[::ffff:192.0.2.1]";
+    (equal? "http://[::ffff:192.0.2.1]";
+            (uri->string (string->uri "http://[::ffff:192.0.2.1]";))))
+
   (pass-if "http://foo:";
     (equal? "http://foo";
             (uri->string (string->uri "http://foo:";))))
@@ -197,7 +248,11 @@
             (uri->string (string->uri "http://foo:/";)))))
 
 (with-test-prefix "decode"
-  (pass-if (equal? "foo bar" (uri-decode "foo%20bar"))))
+  (pass-if "foo%20bar"
+    (equal? "foo bar" (uri-decode "foo%20bar")))
+
+  (pass-if "foo+bar"
+    (equal? "foo bar" (uri-decode "foo+bar"))))
 
 (with-test-prefix "encode"
   (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]