[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-98-gf82f629
|
From: |
Mark H Weaver |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-98-gf82f629 |
|
Date: |
Thu, 18 Jul 2013 19:38:50 +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=f82f62944a4e605d385f40b5a4a01e19677bc0b3
The branch, master has been updated
via f82f62944a4e605d385f40b5a4a01e19677bc0b3 (commit)
via 824b9ad8b792ab42c5cc614d66462dfaab489075 (commit)
via fe51c7b3e0a1e93be3bb81dd2d4b18936fe2df3a (commit)
via e472f65245b6b5744be8b8acf2ec3d27902bd941 (commit)
via 23cf330c86a56b12525af0fea8ce7da0e0981e45 (commit)
via 06903786211afd9a554b8f009a37111f729607ee (commit)
via 1f4f2a12d093fe4f156ef25ebc4a25d05185e5f9 (commit)
via a1c9ecf0a46fb3b09a268030f790aa487d38a433 (commit)
from 902a4e779da1193ff9097c23b40fbd44ab2df6a3 (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 f82f62944a4e605d385f40b5a4a01e19677bc0b3
Merge: 902a4e7 824b9ad
Author: Mark H Weaver <address@hidden>
Date: Thu Jul 18 15:31:34 2013 -0400
Merge remote-tracking branch 'origin/stable-2.0'
-----------------------------------------------------------------------
Summary of changes:
Makefile.am | 3 +-
doc/ref/web.texi | 14 +++++++
libguile/_scm.h | 50 ++++++++++++------------
libguile/tags.h | 5 +-
module/rnrs/arithmetic/bitwise.scm | 2 +-
module/rnrs/arithmetic/fixnums.scm | 16 ++++++--
module/rnrs/arithmetic/flonums.scm | 2 +-
module/web/client.scm | 14 ++++++-
module/web/http.scm | 25 ++++++++++++-
test-suite/tests/r6rs-arithmetic-bitwise.test | 2 +-
test-suite/tests/r6rs-arithmetic-fixnums.test | 14 ++++++-
test-suite/tests/r6rs-arithmetic-flonums.test | 2 +-
12 files changed, 108 insertions(+), 41 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 8cdcc7e..2ed8370 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -64,7 +64,8 @@ EXTRA_DIST = LICENSE HACKING GUILE-VERSION
\
gnulib-local/lib/localcharset.c.diff \
gnulib-local/m4/clock_time.m4.diff \
gnulib-local/build-aux/git-version-gen.diff \
- libguile/texi-fragments-to-docstrings
+ libguile/texi-fragments-to-docstrings \
+ gdbinit
TESTS = check-guile
TESTS_ENVIRONMENT = @LOCALCHARSET_TESTS_ENVIRONMENT@
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 0d41f9f..c59f958 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -1459,6 +1459,20 @@ fetcher, similar in structure to the web server
(@pxref{Web Server}).
Another option, good but not as performant, would be to use threads,
possibly via par-map or futures.
address@hidden {Scheme Parameter} current-http-proxy
+Either @code{#f} or a non-empty string containing the URL of the HTTP
+proxy server to be used by the procedures in the @code{(web client)}
+module, including @code{open-socket-for-uri}. Its initial value is
+based on the @env{http_proxy} environment variable.
+
address@hidden
+(current-http-proxy) @result{} "http://localhost:8123/";
+(parameterize ((current-http-proxy #f))
+ (http-get "http://example.com/";)) ; temporarily bypass proxy
+(current-http-proxy) @result{} "http://localhost:8123/";
address@hidden example
address@hidden deffn
+
@node Web Server
@subsection Web Server
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 7dd188d..1ec93fb 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -3,7 +3,8 @@
#ifndef SCM__SCM_H
#define SCM__SCM_H
-/* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008, 2009, 2010, 2011 Free
Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 2000, 2001, 2002, 2006, 2008, 2009, 2010,
+ * 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -93,18 +94,17 @@
#ifdef vms
# ifndef __GNUC__
# include <ssdef.h>
-# define SCM_SYSCALL(line) \
- do \
- { \
- errno = 0; \
- line; \
- if (EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3)) \
- { \
- SCM_ASYNC_TICK; \
- continue; \
- } \
- } \
- while(0)
+# define SCM_SYSCALL(line) \
+ do \
+ { \
+ errno = 0; \
+ line; \
+ if (EVMSERR == errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3)) \
+ SCM_ASYNC_TICK; \
+ else \
+ break; \
+ } \
+ while (1)
# endif /* ndef __GNUC__ */
#endif /* def vms */
#endif /* ndef SCM_SYSCALL */
@@ -112,18 +112,18 @@
#ifndef SCM_SYSCALL
# ifdef EINTR
# if (EINTR > 0)
-# define SCM_SYSCALL(line) \
- do \
- { \
- errno = 0; \
- line; \
- if (errno == EINTR) \
- { \
- SCM_ASYNC_TICK; \
- continue; \
- } \
- } \
- while(0)
+# define SCM_SYSCALL(line) \
+ do \
+ { \
+ errno = 0; \
+ line; \
+ if (errno == EINTR) \
+ { \
+ SCM_ASYNC_TICK; \
+ errno = EINTR; \
+ } \
+ } \
+ while (errno == EINTR)
# endif /* (EINTR > 0) */
# endif /* def EINTR */
#endif /* ndef SCM_SYSCALL */
diff --git a/libguile/tags.h b/libguile/tags.h
index fcfc014..234d4c7 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -87,14 +87,15 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
The 0?: constructions makes sure that the code is never executed,
and that there is no performance hit. However, the alternative is
compiled, and does generate a warning when used with the wrong
- pointer type.
+ pointer type. We use a volatile pointer type to avoid warnings
+ from clang.
The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)'
statements, so for them type-checking is disabled. */
#if defined __DECC || defined __HP_cc
# define SCM_UNPACK(x) ((scm_t_bits) (x))
#else
-# define SCM_UNPACK(x) ((scm_t_bits) (0? (*(SCM*)0=(x)): x))
+# define SCM_UNPACK(x) ((scm_t_bits) (0? (*(volatile SCM *)0=(x)): x))
#endif
/*
diff --git a/module/rnrs/arithmetic/bitwise.scm
b/module/rnrs/arithmetic/bitwise.scm
index ac870ff..0acbc8c 100644
--- a/module/rnrs/arithmetic/bitwise.scm
+++ b/module/rnrs/arithmetic/bitwise.scm
@@ -1,6 +1,6 @@
;;; bitwise.scm --- The R6RS bitwise arithmetic operations library
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
diff --git a/module/rnrs/arithmetic/fixnums.scm
b/module/rnrs/arithmetic/fixnums.scm
index e626199..7a5a621 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -1,6 +1,6 @@
;;; fixnums.scm --- The R6RS fixnums arithmetic library
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -95,8 +95,11 @@
(rnrs exceptions (6))
(rnrs lists (6)))
- (define fixnum-width
- (let ((w (inexact->exact (round (/ (log (+ most-positive-fixnum 1)) (log
2))))))
+ (define fixnum-width
+ (let ((w (do ((i 0 (+ 1 i))
+ (n 1 (* 2 n)))
+ ((> n most-positive-fixnum)
+ (+ 1 i)))))
(lambda () w)))
(define (greatest-fixnum) most-positive-fixnum)
@@ -227,7 +230,12 @@
(assert-fixnum fx1 fx2 fx3)
(bitwise-if fx1 fx2 fx3))
- (define (fxbit-count fx) (assert-fixnum fx) (logcount fx))
+ (define (fxbit-count fx)
+ (assert-fixnum fx)
+ (if (negative? fx)
+ (bitwise-not (logcount fx))
+ (logcount fx)))
+
(define (fxlength fx) (assert-fixnum fx) (bitwise-length fx))
(define (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx))
(define (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1))
diff --git a/module/rnrs/arithmetic/flonums.scm
b/module/rnrs/arithmetic/flonums.scm
index fd04a4a..1c4b94c 100644
--- a/module/rnrs/arithmetic/flonums.scm
+++ b/module/rnrs/arithmetic/flonums.scm
@@ -1,6 +1,6 @@
;;; flonums.scm --- The R6RS flonums arithmetic library
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
diff --git a/module/web/client.scm b/module/web/client.scm
index 7d5ea49..24132c6 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -39,8 +39,10 @@
#:use-module (web request)
#:use-module (web response)
#:use-module (web uri)
+ #:use-module (web http)
#:use-module (srfi srfi-1)
- #:export (open-socket-for-uri
+ #:export (current-http-proxy
+ open-socket-for-uri
http-get
http-get*
http-head
@@ -50,6 +52,11 @@
http-trace
http-options))
+(define current-http-proxy
+ (make-parameter (let ((proxy (getenv "http_proxy")))
+ (and (not (equal? proxy ""))
+ proxy))))
+
(define (ensure-uri uri-or-string)
(cond
((string? uri-or-string) (string->uri uri-or-string))
@@ -58,7 +65,8 @@
(define (open-socket-for-uri uri-or-string)
"Return an open input/output port for a connection to URI."
- (define uri (ensure-uri uri-or-string))
+ (define http-proxy (current-http-proxy))
+ (define uri (ensure-uri (or http-proxy uri-or-string)))
(define addresses
(let ((port (uri-port uri)))
(delete-duplicates
@@ -84,6 +92,8 @@
(setvbuf s _IOFBF)
;; Enlarge the receive buffer.
(setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
+ ;; If we're using a proxy, make a note of that.
+ (when http-proxy (set-http-proxy-port?! s #t))
s)
(lambda args
;; Connection failed, so try one of the other addresses.
diff --git a/module/web/http.scm b/module/web/http.scm
index 35169ef..21d2964 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -66,7 +66,10 @@
write-response-line
make-chunked-input-port
- make-chunked-output-port))
+ make-chunked-output-port
+
+ http-proxy-port?
+ set-http-proxy-port?!))
(define (string->header name)
@@ -1117,6 +1120,21 @@ three values: the method, the URI, and the version."
"Write the first line of an HTTP request to PORT."
(display method port)
(display #\space port)
+ (when (http-proxy-port? port)
+ (let ((scheme (uri-scheme uri))
+ (host (uri-host uri))
+ (host-port (uri-port uri)))
+ (when (and scheme host)
+ (display scheme port)
+ (display "://" port)
+ (if (string-index host #\:)
+ (begin (display #\[ port)
+ (display host port)
+ (display #\] port))
+ (display host port))
+ (unless ((@@ (web uri) default-port?) scheme host-port)
+ (display #\: port)
+ (display host-port port)))))
(let ((path (uri-path uri))
(query (uri-query uri)))
(if (not (string-null? path))
@@ -1958,3 +1976,8 @@ KEEP-ALIVE? is true."
(unless keep-alive?
(close-port port)))
(make-soft-port (vector put-char put-string flush #f close) "w"))
+
+(define %http-proxy-port? (make-object-property))
+(define (http-proxy-port? port) (%http-proxy-port? port))
+(define (set-http-proxy-port?! port flag)
+ (set! (%http-proxy-port? port) flag))
diff --git a/test-suite/tests/r6rs-arithmetic-bitwise.test
b/test-suite/tests/r6rs-arithmetic-bitwise.test
index c864f3b..3b35846 100644
--- a/test-suite/tests/r6rs-arithmetic-bitwise.test
+++ b/test-suite/tests/r6rs-arithmetic-bitwise.test
@@ -1,6 +1,6 @@
;;; arithmetic-bitwise.test --- Test suite for R6RS (rnrs arithmetic bitwise)
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/r6rs-arithmetic-fixnums.test
b/test-suite/tests/r6rs-arithmetic-fixnums.test
index d39d544..60c3b87 100644
--- a/test-suite/tests/r6rs-arithmetic-fixnums.test
+++ b/test-suite/tests/r6rs-arithmetic-fixnums.test
@@ -1,6 +1,6 @@
;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise)
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,14 @@
:use-module ((rnrs exceptions) :version (6))
:use-module (test-suite lib))
+(with-test-prefix "fixnum-width"
+ (pass-if-equal "consistent with least-fixnum"
+ (- (expt 2 (- (fixnum-width) 1)))
+ (least-fixnum))
+ (pass-if-equal "consistent with greatest-fixnum"
+ (- (expt 2 (- (fixnum-width) 1)) 1)
+ (greatest-fixnum)))
+
(with-test-prefix "fixnum?"
(pass-if "fixnum? is #t for fixnums" (fixnum? 0))
@@ -157,7 +165,9 @@
(with-test-prefix "fxif" (pass-if "simple" (fx=? (fxif 5 3 4) 1)))
-(with-test-prefix "fxbit-count" (pass-if "simple" (fx=? (fxbit-count 5) 2)))
+(with-test-prefix "fxbit-count"
+ (pass-if "simple" (fx=? (fxbit-count 5) 2))
+ (pass-if "negative" (fx=? (fxbit-count -5) -2)))
(with-test-prefix "fxlength" (pass-if "simple" (fx=? (fxlength 5) 3)))
diff --git a/test-suite/tests/r6rs-arithmetic-flonums.test
b/test-suite/tests/r6rs-arithmetic-flonums.test
index 3df00b2..ea425e3 100644
--- a/test-suite/tests/r6rs-arithmetic-flonums.test
+++ b/test-suite/tests/r6rs-arithmetic-flonums.test
@@ -1,6 +1,6 @@
;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums)
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-98-gf82f629,
Mark H Weaver <=