[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, ra0, updated. v2.1.0-726-ga5340d7
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, ra0, updated. v2.1.0-726-ga5340d7 |
|
Date: |
Fri, 07 Feb 2014 14:46:11 +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=a5340d7288407c6c6cf5c842ae3925d184bf95eb
The branch, ra0 has been updated
discards 71b5b27c3680570be03666f9358ec3862982ebf2 (commit)
discards a722e6a1745c06a2e02e0d7d76089850c8e0f561 (commit)
discards 951036b17b35997e70320b23df923fb127d60e09 (commit)
discards e2097e86b08f44a33ea3a1632c21b4ab5a10384b (commit)
discards 6b9a35a71f09ed325a9dadf41c85018bc5f5a53b (commit)
discards 7d4a6ae51e2f586d217c6bd31e05103e97e4c643 (commit)
discards ec732d3747125ce46a58e4cbab7e3346459c6043 (commit)
discards 6d92752435d29b51df7250fb65bc0563fb053bb9 (commit)
discards 13d0eee41c38dd0f2516d45b0e0de1d78eff1f7f (commit)
discards 3baf2f2dc78f021eabd00df49e1bd168e72c28da (commit)
discards 017889f044b8eaeda05db5d039d0adc9046ebb79 (commit)
discards 460e644ae1a640e622ddbc7233dcbb002a502a8c (commit)
discards 6564edf3f9667b38b5448e1b3cb237da7029df93 (commit)
discards 66476d60c8f00b7b02930803753d742adb069095 (commit)
discards c9b3a066d1822d85cd5da1396108ff7e104a2b28 (commit)
discards 9fd58191bcb3ea053b47860d303ecfdc86ad3474 (commit)
discards 36d6dec6b15cc235d3bbff1b65dcbef3e1bc4a92 (commit)
discards 19f6292b51df8aa64a37323b97c83a42379d28be (commit)
discards 382cd6bad4817566c76b0e84299644f52dd531d2 (commit)
discards 3f3388d4e5d9af33d41025c4d488bf8ea5ab2853 (commit)
discards d744c52734bdfd0f90800167c6ba053473c778e9 (commit)
discards e609c16687dd4219a1a51d3d2720d8ca9e93f911 (commit)
discards 4f5c36b7f91cde4fa760cad4bc7cc8738d99cb06 (commit)
discards 2c0b2ce8a0f1f98eef70e7ca1a43b010d9904f93 (commit)
discards 2d7d0954c218e9fb4af7ba917e8cd319d6566814 (commit)
discards ffe5b4048b08c89ed41f3d345eff9f31432c4699 (commit)
discards 5446995598ab916df6232401bf21041536a8fad4 (commit)
discards 7914ae9b07b5d6cfce4df5885f44a2e7d008337d (commit)
discards f4348f288cc74d39e80b16df21930c109f40c7aa (commit)
discards 4e2fd1249e774ec5c37f1f41e6949f45c9b063be (commit)
discards b26082652c2af2732db2634b5441b6665919dd0f (commit)
discards a31bd83f24697fef584350edfaa47a7fa3273f19 (commit)
discards e1d71e39e5ea715c8d56a174fe40ce192fd3a3c1 (commit)
discards 19ed36c569b65cc55b1c11a3da128f3378a7f03a (commit)
discards 579272174693b6304e61434f0db0662c4d252631 (commit)
discards 17babc39732a4d5b765b67f31b7b199234a361aa (commit)
discards 9947aaa29603dcf83a992c666a47a9b6200b998e (commit)
via a5340d7288407c6c6cf5c842ae3925d184bf95eb (commit)
via c361f6b17705fdadc4da436d3ec291713c2d7113 (commit)
via 27230bb012bc93f9c5f02e8c0f855c2a6d4f69cc (commit)
via c420dbfc03f8772beae9183d7b1773466e5a4056 (commit)
via 9888660409d2a9cf1b762936b6b503c9d4be8d77 (commit)
via bfc9277082b55ac6cc52544910bc0bff75ee9eb7 (commit)
via b28367a36e3e536557fdc9072bd223835eb71a19 (commit)
via b84542a9c8493ac5abba18a8336acf481a200856 (commit)
via fcf95b5cf299e5d3b86f8d171586bf7f1faa17f8 (commit)
via 24ff9de6901cd07d5dfdb8272ee287b1f3302049 (commit)
via 6517d315f58d75fb1b9b8609ceb5e0745f9878fc (commit)
via a5721d789ab516512dccc03dd4964c85c5f02fb5 (commit)
via 390c9cfe05d921c08642b4358b18c54b5a0e1a7f (commit)
via 1fadf71223da8b68ff60f8f68d08b7d8c4ab5d21 (commit)
via a9967184071de59cd69f468d61bd1637916fe18e (commit)
via 08a7b5f893965fefe402d21b45946e7d4f29fc41 (commit)
via 5569daa0806414015bb07aa0c3ffaf017d8259bf (commit)
via 4ec2c043676ed1b31a1a0ba5eed9d049a7b6c821 (commit)
via 0e5c6f5ae96f19e9941f8068b83918a8f0a26744 (commit)
via cde8b37582288b7e0c2bde14cf0b76b88198f084 (commit)
via e3717f38901acdcd57a664265714878b02cd2789 (commit)
via f7239ac53d7bd4c939cda1ec9420ecc82550579b (commit)
via 2c533af6e0f88ea046597db736561052b3777c59 (commit)
via b3ceb8bc0e6786e65a3ca58ca6af0205b456ad22 (commit)
via d9c9aa16e0768788013bcb35bd84f592066088b0 (commit)
via 4042884c89b122082d7463ae2630f8b5993661bc (commit)
via dca733a69556f072ed9c36697a6b673d20967137 (commit)
via fdf483f3fc265d0b94675d967ade8f2b0ffb0cc7 (commit)
via 53120e777ab87d8a751cc5e820abdb826c16d5e8 (commit)
via d0513caa740073d599bc39f0e9de0f074012585e (commit)
via d0028906e89d6c03e8a51a0a67058b7e6f8c242d (commit)
via 1776cdfa0c2d3da155b7098db4c5b26bbc06ff09 (commit)
via 97d339e9c264aded2d439d96c8af61a93e43a4e4 (commit)
via afe96cbfbf4e446ff57126d27cf0f29e71dbd3d8 (commit)
via 823ebc0d6bd0ad2469fb6138a8d90b2e96946ff5 (commit)
via 95b759adcc195adfe2d947f6ea1a4686518ea5a8 (commit)
via 9db57a19e1204d6c458675bd8347fdfc00ecc3e8 (commit)
via cc620af7ca9bb7c2c841f9612fbdf97b68aaf277 (commit)
via 7affd3141b4f821fba911caa7a94d9cc9c03fafe (commit)
via 01a8d00ca331f64d5f9337409c339998155596d2 (commit)
via 479fc9a5caca8592da5cc84570fbf2335c632d6c (commit)
via b00c9b221401082449fd733a78bb1b4f88e41ebe (commit)
via cd36c69619e406082100efb1e62998fc67bbc2a6 (commit)
via 04f59ec2e7ab73caacbbfa2c5905fe4f240c47c5 (commit)
via 08224c56fa735612fa6b33533c927c9c3eaf8d3d (commit)
via ae7f13be4bda70a6bc4a8478ce043df1a752ee6e (commit)
via dc7a33fa871c42d0474602f3560d3ce350e1f1c3 (commit)
via a1aae2c3a03afc542ab6a7c6672c5a645ac77b09 (commit)
via 0dbc5e571aa3bdb73fd0b9b1631e502167c4325a (commit)
via 7d484bfa15172982862b450db6a2a3620e95239d (commit)
via e4eb0e39b4bbfa321fd30376ebdda32e931b60f7 (commit)
via e140d85d5346f6cc3bd8b9f3954b063e159a2708 (commit)
via c9647bfb7e780d65969d77db75576533e3e4470a (commit)
via 9b5da400dde6e6bc8fd0e318e7ca1feffa5870db (commit)
via 1e3fd6a0c81bb3e9900a93a9d1923cc788de0f99 (commit)
via 13af75bfe00ff66d18dff31fbf76fadbc3f8c4f4 (commit)
via 40a723a92236fe4e58feb89057b4182b1fc76810 (commit)
via 8acd457958892f64c9f676b50b39a2a3061cbac3 (commit)
via 8a114e1b54d1711a6edfad1f8c78f54db7b8e157 (commit)
via 5e74217c7cf07ad474cdce1a01e049492e7ef1b7 (commit)
via c8e839cfeb647aca034b9bcd5a321d419dedca1f (commit)
via 5e69ceb7a667377a61cb0c31d7ac20e245b3fafd (commit)
via 866af5da3d11ac4a9df44ee8c5b1781a0073c288 (commit)
via 48eb9021190766577a79ec26fe0b2f3332254561 (commit)
via 34e89877342f20fdb8a531ad78dab34cfd2b0843 (commit)
via 9060dc29d51faac0d8f4f51047a3d20f27fbbf6d (commit)
via 58147d67806e1f54c447d7eabac35b1a5086c3a6 (commit)
via e6c1c5f6cb16913eadeb8758cd817c5a58d146b8 (commit)
via 4dc4b86e858d391d20d0ea2551614a89fa3bd4d1 (commit)
via ca5e0414e96886177d883a249edd957d2331db65 (commit)
via a7a4ba6a2de7dee9b5c9e2fa5e0c3caf022c0b14 (commit)
via 3e2e49650c7360f7bba03219943334e2eabd3d91 (commit)
via 60617d819d77a1b92ed6c557a0b49b8e9a8e97b9 (commit)
via f6ddf827f8f192af7a8cd255bd8374a0d38bbb74 (commit)
via fc1cb3fad4c9186974edd7f899465e07c6377c8b (commit)
via 45a28515c13348dfd18e53038ad63dd091a5a3c1 (commit)
via a5cbbaa66a2491453db0edff9b0cb592a98f61bf (commit)
via e6c8e6047ed2e772cc4e1fb5ad4d389e5c616feb (commit)
via d0d8c872afcc0e3384389171ceb32dc26df8c8a6 (commit)
via 6f4cc6a31eaf9a55730e85a096846caaf5a940fc (commit)
via 8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c (commit)
via 122f24cc8a3637ed42d7792ad1ff8ec0c49c58df (commit)
This update added new revisions after undoing existing revisions. That is
to say, the old revision is not a strict subset of the new revision. This
situation occurs when you --force push a change and generate a repository
containing something like this:
* -- * -- B -- O -- O -- O (71b5b27c3680570be03666f9358ec3862982ebf2)
\
N -- N -- N (a5340d7288407c6c6cf5c842ae3925d184bf95eb)
When this happens we assume that you've already had alert emails for all
of the O revisions, and so we here report only the revisions in the N
branch from the common base, B.
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 a5340d7288407c6c6cf5c842ae3925d184bf95eb
Author: Daniel Llorens <address@hidden>
Date: Wed May 22 13:36:24 2013 +0200
Arrays are not an array implementation
* libguile/bitvectors.c: match other uses of SCM_ARRAY_IMPLEMENTATION.
* libguile/generalized-arrays.c
(scm_is_array): don't use scm_i_array_implementation_for_obj on arrays.
(scm_is_typed_array): idem. Use impl->get_handle instead of
scm_array_get_handle to avoid calling scm_i_array_implementation_for_obj
twice.
* libguile/arrays.c: remove SCM_ARRAY_IMPLEMENTATION on scm_tc7_array type.
commit c361f6b17705fdadc4da436d3ec291713c2d7113
Author: Daniel Llorens <address@hidden>
Date: Wed May 8 16:06:40 2013 +0200
array-contents returns root for empty arrays with empty root
This fixes a compiler issue where (uniform-array->bytevector #2f64())
failed because of the stricter definition of uniform-vector? on this branch.
Perhaps it would be better if uniform-array->bytevector didn't require
a contiguous argument.
* libguile/arrays.c: (scm_array_contents): return the root regardless of
the value of SCM_I_ARRAY_DIMS (ra)->inc.
* test-suite/tests/arrays.test: check.
commit 27230bb012bc93f9c5f02e8c0f855c2a6d4f69cc
Author: Daniel Llorens <address@hidden>
Date: Thu May 2 11:43:31 2013 +0200
Fix compilation bugs with some kinds of typed arrays
* module/language/glil/compile-assembly.scm: pass (array-contents x)
to uniform-array->bytevector instead of x, when x is a typed array.
* test-suite/tests/arrays.test: test an instance of the above that
failed in Guile 2.0.9.
commit c420dbfc03f8772beae9183d7b1773466e5a4056
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 30 16:11:07 2013 +0200
Preallocate index list in scm_array_index_map_x
* libguile/array-map.c
- (scm_array_index_map_x): preallocate the index list instead of
constructing it on each rank-1 iteration.
- (ramap, rafe): use SCM_I_ARRAY_V just once.
commit 9888660409d2a9cf1b762936b6b503c9d4be8d77
Author: Daniel Llorens <address@hidden>
Date: Mon Apr 29 15:37:52 2013 +0200
Rename scm_t_array_handle.array to .root
Globally rename this field (after shared-array-root), since it's not an
array.
commit bfc9277082b55ac6cc52544910bc0bff75ee9eb7
Author: Daniel Llorens <address@hidden>
Date: Mon Apr 29 14:19:52 2013 +0200
Match types used in arrays.c to struct field types
* libguile/arrays.c
- scm_shared_array_root: check for SCM_I_ARRAYP first.
- scm_i_shap2ra:
* check valid bounds in the '(lbnd ubnd) case. This makes
(make-array 0 '(4 -3)) fail with a 'bad dimension' instead of
with a 'wrong index' error.
* use ssize_t for lbnd/ubnd/inc, not long.
- scm_make_shared_array: use ssize_t for indices, not long.
- scm_transpose_array: use size_t for ndim, not ulong.
- scm_i_print_array: idem.
commit b28367a36e3e536557fdc9072bd223835eb71a19
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 26 17:59:45 2013 +0200
Bounds error in vector_handle_ref/set is implementation error
* libguile/vectors.c: bounds are already checked unless impl is called
directly, so don't check again.
* libguile/strings.c, libguile/bitvectors.c: fix comments.
commit b84542a9c8493ac5abba18a8336acf481a200856
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 26 13:02:38 2013 +0200
Don't use ASET in scm_array_index_map_x
* libguile/array-map.c: (scm_array_index_map_x): replace ASET by direct
use of handle->impl.
commit fcf95b5cf299e5d3b86f8d171586bf7f1faa17f8
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 26 02:05:22 2013 +0200
In scm_ramapc, only check unrolled axes for emptiness
* libguile/array-map.c: (scm_ramapc)
- Don't check emptiness while preparing ra0, but only after kroll is
known,
and only before kroll. len = 0 will be caught by the unrolled loop.
- Use ra0 axis length in unroll check depth for rest args, not ra1's.
- Recover early exit feature when cproc returns 0.
commit 24ff9de6901cd07d5dfdb8272ee287b1f3302049
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 25 18:49:14 2013 +0200
Fix scm_ramapc bugs with 0-inc arrays
* libguile/array-map.c: (scm_ramapc): Cannot flag empty on the product
inc * dim * dim ... Check every dim.
* test-suite/tests/ramap.test: Tests the 0-inc, non empty case for both
array-map! and array-copy!.
commit 6517d315f58d75fb1b9b8609ceb5e0745f9878fc
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 25 15:18:05 2013 +0200
Fix corner cases of scm_ramapc
* libguile/array-map.c
- (scm_ramapc): mismatched axes limit unrollk (kroll). Reorganize
the function to do all checking as we go.
- (scm_ra_matchp): unused; remove.
- (find_unrollk): inlined in scm_ramapc; remove.
- (klen): inlined in scm_ramapc; remove.
- (rafill): n is size_t.
- (racp): n is size_t. Use n and not i0end to bound the loop.
- (ramap): Use n and not i0end to bound the loop. This is needed for the
rank
0 case to work with the new scm_ramapc, as inc may be set to 0 in that
case.
- (rafe): idem.
* test-suite/tests/ramap.test
- check that size mismatch prevents unrolling (matching behavior III) with
both array-copy! and array-map!.
- check that non-contiguous stride in non-ref args prevents unrolling
(rank 2, discontinuous) with both array-copy! and array-map!.
- check rank 0 cases with array-for-each, array-map!.
commit a5721d789ab516512dccc03dd4964c85c5f02fb5
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 24 23:29:48 2013 +0200
Rewrite scm_ramapc()
* libguile/array-map.c
- (cind): replace by cindk, that operates only on the unrolled index set.
- (klen): new function.
- (make1array): take extra inc argument.
- (scm_ramapc): rewrite to unroll as many axes as possible instead of
just all
or one.
- (AREF): lbnd is known to be 0: remove.
- (ASET): v is known to come from SCM_I_ARRAY_V; assume base, inc, lbnd.
- (racp): use ssize_t instead of long for the indices.
- (scm_array_index_map_x): build the index list at the last-but-one axis,
then
set the car of the last element, instead of building the list at the
last axis.
* test-suite/tests/ramap.test
- add array-map! test with offset arguments.
commit 390c9cfe05d921c08642b4358b18c54b5a0e1a7f
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 24 17:13:56 2013 +0200
Check more cases of array-contents
* libguile/arrays.c: (scm_array_contents): fix comment.
* test-suite/tests/arrays.test: add cases that depend on correct
setting of CONTIGUOUS_FLAG.
commit 1fadf71223da8b68ff60f8f68d08b7d8c4ab5d21
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 24 16:34:31 2013 +0200
Check the documented matching behavior of array-map!/copy!
* test-suite/tests/arrays.test: move array-copy! tests to ramap.test.
* test-suite/tests/ramap.test: check the dissimilar matching behavior of
array-copy! and array-map! with arguments of different size.
commit a9967184071de59cd69f468d61bd1637916fe18e
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 24 16:00:06 2013 +0200
Simplify ASET in array-map.c
* libguile/array-map.c: (ASET): this is only ever used with a true vector
type, so remove use of inc/base/lbnd.
commit 08a7b5f893965fefe402d21b45946e7d4f29fc41
Author: Daniel Llorens <address@hidden>
Date: Mon Apr 22 09:02:32 2013 +0200
Inline ASET in array-index-map! for rank 1 arguments
* libguile/array-map.c: (scm_array_index_map_x): branch to special case on
rank 1, instead of !SCM_I_ARRAYP (ra). Inline ASET in this case.
commit 5569daa0806414015bb07aa0c3ffaf017d8259bf
Author: Daniel Llorens <address@hidden>
Date: Sat Apr 20 01:27:42 2013 +0200
Fix compilation errors when reading arrays at the repl
* compile-assembly.scm
- vector-fold2: handle rank 1 arrays, since this is called with
the result of array-contents which need not be a vector.
- dump-constants: fix uses of vector-fold2. Replace vector-length
on result of array-contents by array-length.
* libguile/arrays.c
- scm_array_contents: branch cases not on scm_is_generalized_vector but
on SCM_I_ARRAYP. Thus lbnd!=0, which could happen with
scm_is_generalized_vector, never appears in the output.
* test-suite/tests/arrays.test
- tests for array-contents.
commit 4ec2c043676ed1b31a1a0ba5eed9d049a7b6c821
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 19 16:44:48 2013 +0200
Factor out make1array() in scm_ramapc()
* libguile/array-map.c: (scm_ramapc): factor out vector->array conversion
to aux function make1array.
commit 0e5c6f5ae96f19e9941f8068b83918a8f0a26744
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 19 14:53:34 2013 +0200
Raw pointer loop in array-copy! for vector/vector case
This special case improves
(define a (make-array 1. 1000000 10))
(define b (make-array *unspecified* 1000000 10))
(define c (transpose-array (make-array *unspecified* 10 1000000) 1 0))
,time (array-copy! a b)
,time (array-copy! a c)
from 0.041598s / 0.072561 to 0.012164s / 0.041886s on a i7-3930K.
* libguile/array-map.c: (racp): if both src and dst are on vectors, use
the element pointers to do the copy.
commit cde8b37582288b7e0c2bde14cf0b76b88198f084
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 19 13:43:30 2013 +0200
Have array impl->vref, vset take SCM, not handles
* libguile/array-handle.h
- scm_i_t_array_ref, scm_i_t_array_set take SCM.
- scm_array_handle_ref, scm_array_handle_set: pass h->array.
* libguile/array-map.c
- AREF, ASET, rafill, racp, ramap, rafe: pass storage vector SCM
instead of handle.
* libguile/bitvector.c
- bitvector_handle_ref, bitvector_handle_set_x: take bitvector arg.
* libguile/bytevectors.c
- bv_handle_ref, bv_handle_set_x: take bytevector arg.
- scm_i_print_bytevectors: don't use array handles.
* libguile/deprecated.c
- scm_generalized_vector_to_list: pass h.array.
* libguile/strings.c
- string_handle_ref, string_handle_set: take string arg.
* libguile/uniform.c
- scm_c_uniform_vector_ref, scm_c_uniform_vector_set_x: pass h.array.
* libguile/vectors.c
- vector_handle_ref, vector_handle_set: take vector arg.
commit e3717f38901acdcd57a664265714878b02cd2789
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 19 12:57:13 2013 +0200
Fix array map functions with empty arguments
* libguile/array-map.c
- scm_ra_matchp: look for empty axes and return new case 5 if so. Use
array handles to remove the SCM_I_ARRAYP / not branch.
- scm_ramapc: Heed case 5.
* test-suite/tests/ramap.test
- test empty arguments for array-copy! and array-for-each. Note those
that failed in 2.0.9.
commit f7239ac53d7bd4c939cda1ec9420ecc82550579b
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 19 10:42:40 2013 +0200
Fix empty array bug in array-index-map!
* libguile/array-map.c: (scm_array_index_map_x): bail out if any one of the
axes is empty.
* test-suite/tests/ramap.test: add tests for empty array-case of
array-index-map!. The 'f64 case with not-last emtpy axis is broken in
2.0.9.
commit 2c533af6e0f88ea046597db736561052b3777c59
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 17 17:29:36 2013 +0200
Avoid using array_handle fields in impl->vref/vset
* libguile/bytevectors.c: (bv_handle_set_x, bv_handle_ref): get length
and element type fields from the bytevector, not from the handle.
* libguile/vectors.c: (vector_handle_set, vector_handle_ref): get length
from the vector, not from the handle.
commit b3ceb8bc0e6786e65a3ca58ca6af0205b456ad22
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 17 15:12:15 2013 +0200
Remove undocumented casting behavior in srfi4 vector_elements
* libguile/srfi-4.c: scm_##tag##vector_writable_elements: if the argument's
type doesn't match the tag, throw type error.
commit d9c9aa16e0768788013bcb35bd84f592066088b0
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 17 14:33:40 2013 +0200
Test that typed-array? returns #f with non-array argument
* test-suite/tests/arrays.test: ditto.
commit 4042884c89b122082d7463ae2630f8b5993661bc
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 17 14:01:54 2013 +0200
Avoid array API in make-srfi-4-vector
* libguile/bytevector.h: publish SCM_BYTEVECTOR_TYPE_SIZE,
bytevector_ref_fns
and bytevector_set_fns from libguile/bytevector.c.
* libguile/bytevector.c: bv_handle_ref, bv_handle_set: prefer
SCM_BYTEVECTOR_TYPE_SIZE to scm_array_handle_uniform_element_size.
* libguile/srfi-4.c: scm_make_srfi_4_vector: don't use array handles.
commit dca733a69556f072ed9c36697a6b673d20967137
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 17 10:19:26 2013 +0200
Replace SCM_IMP in array-map.c
* libguile/array-map.c
- scm_ramapc: check scm_array_contents with scm_is_false.
commit fdf483f3fc265d0b94675d967ade8f2b0ffb0cc7
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 16 18:19:57 2013 +0200
Fix comment in scm_array_get_handle
libguile/array-handle.c: (scm_array_get_handle): comment applies to either
branch.
commit 53120e777ab87d8a751cc5e820abdb826c16d5e8
Author: Daniel Llorens <address@hidden>
Date: Mon Apr 15 13:44:10 2013 +0200
Don't bother with array handle in scm_c_array_rank
* libguile/generalized-arrays.c: (scm_c_array_rank): compute rank directly
from
object.
commit d0513caa740073d599bc39f0e9de0f074012585e
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 12 17:50:09 2013 +0200
Use underlying vector implementation directly in array handles
* libguile/array-handle.c
- scm_array_get_handle: if the object is an array, point impl to
the underlying vector instead of array impl, then fix the axes. Avoid
calling scm_i_array_implementation_for_obj twice.
* libguile/arrays.c
- array_handle_ref, array_handle_set, array_get_handle: remove.
* libguile/bitvectors.c, libguile/bytevectors.c, libguile/strings.c,
libguile/vectors.c: fix base = 0 in the array handle.
* libguile/vectors.c: (vector_handle_set, vector_handle_ref): do not
use h->dims.
commit d0028906e89d6c03e8a51a0a67058b7e6f8c242d
Author: Daniel Llorens <address@hidden>
Date: Fri Apr 12 15:04:52 2013 +0200
Match uniform_vector_elements with vector_elements
* libguile/vectors.c
- (scm_vector_writable_elements): allow any non-uniform rank 1 array,
after the doc. Match the implementation with
scm_uniform_vector_elements.
- (scm_vector_elements): after the above.
* libguile/uniform.c
- (scm_uniform_vector_writable_elements): ditto for uniform rank 1 arrays.
* libguile/sort.c
- revert the changes in 7a6fd9, except for the argument type test; allow
what scm_vector_(writable_)elements allows.
commit 1776cdfa0c2d3da155b7098db4c5b26bbc06ff09
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 11 19:38:19 2013 +0200
Online documentation for vector-ref, vector-set!
* libguile/vectors.c: (scm_vector_ref, scm_vector_set!): embed the
comments as documentation.
commit 97d339e9c264aded2d439d96c8af61a93e43a4e4
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 11 19:32:23 2013 +0200
vector-length rejects non vector? arg
* libguile/vectors.c
- scm_c_vector_length: error if SCM_I_IS_VECTOR (v) fails.
- scm_vector_length: Documentation for vector-length.
commit afe96cbfbf4e446ff57126d27cf0f29e71dbd3d8
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 11 18:28:19 2013 +0200
vector-ref, vector-set! reject non vector? args
* libguile/vectors.c: (scm_c_vector_ref, scm_c_vector_set_x):
throw type error if v is not vector?.
commit 823ebc0d6bd0ad2469fb6138a8d90b2e96946ff5
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 11 18:11:35 2013 +0200
Identify scm_is_vector with scm_is_simple_vector
This patch fixes the bug (vector-ref address@hidden(1 2 3) 1) => 2.
* libguile/vectors.c: (scm_is_vector): just as scm_is_simple_vector.
* libguile/filesys.c, libguile/random.c, libguile/stime.c, libguile/trees.c,
libguile/validate.h: use scm_is_vector instead of scm_is_simple_vector.
* libguile/sort.c
- scm_restricted_vector_sort_x: use scm_array_handle_writable_elements
instead of scm_vector_writable_elements, to work with non-vector
rank-1 array objects.
- scm_sort_x: check for scm_is_array instead of scm_is_vector. Rank
check is in restricted_vector_sort_x.
- scm_sort: ditto.
- scm_stable_sort_x: like scm_restricted_vector_sort_x.
- scm_stable_sort: like scm_sort.
* test-suite/tests/arrays.test: fix header.
* test-suite/tests/random.test: new coverage test covering
random:normal-vector!
* test-suite/Makefile.am: include random.test in make check.
commit 95b759adcc195adfe2d947f6ea1a4686518ea5a8
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 11 13:10:08 2013 +0200
For uniform vectors SCM_I_ARRAYP can't be true
This fixes an inconsistency where uniform-vector? of a shared array could
be true but -ref operations failed to account correctly for lbnd.
* libguile/uniform.c
- scm_is_uniform_vector: SCM_I_ARRAYP disqualifies obj as uniform vector.
- scm_c_uniform_vector_length: lbnd is known 0, so don't use it.
- scm_c_uniform_vector_ref: lbnd/base/inc are known to be 0/0/1.
- scm_c_uniform_vector_set_x!: idem.
- scm_uniform_vector_writable_elements: check uvec's type.
* test-suite/tests/arrays.test
- group the exception types at the top.
- check that uniform-vector functions do not accept general arrays.
-----------------------------------------------------------------------
Summary of changes:
GNUmakefile | 2 +-
THANKS | 1 +
build-aux/announce-gen | 2 +-
build-aux/config.rpath | 2 +-
build-aux/gendocs.sh | 15 +-
build-aux/git-version-gen | 2 +-
build-aux/gitlog-to-changelog | 2 +-
build-aux/gnu-web-doc-update | 2 +-
build-aux/gnupload | 25 +-
build-aux/snippet/arg-nonnull.h | 2 +-
build-aux/snippet/c++defs.h | 2 +-
build-aux/snippet/unused-parameter.h | 2 +-
build-aux/snippet/warn-on-use.h | 2 +-
build-aux/useless-if-before-free | 2 +-
build-aux/vc-list-files | 2 +-
doc/gendocs_template | 2 +-
doc/ref/api-binding.texi | 27 +-
doc/ref/api-evaluation.texi | 2 +-
doc/ref/api-io.texi | 4 +
doc/ref/api-macros.texi | 35 +-
doc/ref/api-memory.texi | 13 +-
doc/ref/guile-invoke.texi | 8 -
doc/ref/posix.texi | 3 +
doc/ref/r6rs.texi | 8 +-
doc/ref/srfi-modules.texi | 445 ++++++++++
lib/Makefile.am | 44 +-
lib/accept.c | 2 +-
lib/alignof.h | 4 +-
lib/alloca.in.h | 2 +-
lib/arpa_inet.in.h | 2 +-
lib/asnprintf.c | 2 +-
lib/basename-lgpl.c | 2 +-
lib/binary-io.h | 5 +-
lib/bind.c | 2 +-
lib/btowc.c | 2 +-
lib/byteswap.in.h | 2 +-
lib/c-ctype.c | 2 +-
lib/c-ctype.h | 5 +-
lib/c-strcase.h | 2 +-
lib/c-strcasecmp.c | 2 +-
lib/c-strcaseeq.h | 2 +-
lib/c-strncasecmp.c | 2 +-
lib/canonicalize-lgpl.c | 2 +-
lib/ceil.c | 2 +-
lib/close.c | 2 +-
lib/config.charset | 2 +-
lib/connect.c | 2 +-
lib/copysign.c | 2 +-
lib/dirent.in.h | 2 +-
lib/dirfd.c | 2 +-
lib/dirname-lgpl.c | 2 +-
lib/dirname.h | 2 +-
lib/dosname.h | 2 +-
lib/dup2.c | 6 +-
lib/duplocale.c | 2 +-
lib/errno.in.h | 2 +-
lib/fcntl.in.h | 2 +-
lib/fd-hook.c | 2 +-
lib/fd-hook.h | 2 +-
lib/float+.h | 2 +-
lib/float.c | 2 +-
lib/float.in.h | 2 +-
lib/flock.c | 2 +-
lib/floor.c | 2 +-
lib/frexp.c | 2 +-
lib/fstat.c | 2 +-
lib/full-read.c | 2 +-
lib/full-read.h | 2 +-
lib/full-write.c | 2 +-
lib/full-write.h | 2 +-
lib/gai_strerror.c | 2 +-
lib/getaddrinfo.c | 2 +-
lib/getlogin.c | 2 +-
lib/getpeername.c | 2 +-
lib/getsockname.c | 2 +-
lib/getsockopt.c | 2 +-
lib/gettext.h | 2 +-
lib/gettimeofday.c | 154 ++++
lib/glthread/lock.c | 1057 +++++++++++++++++++++++
lib/glthread/lock.h | 927 ++++++++++++++++++++
lib/glthread/threadlib.c | 73 ++
lib/iconv.c | 2 +-
lib/iconv.in.h | 2 +-
lib/iconv_close.c | 2 +-
lib/iconv_open.c | 2 +-
lib/iconveh.h | 2 +-
lib/inet_ntop.c | 2 +-
lib/inet_pton.c | 2 +-
lib/isfinite.c | 2 +-
lib/isinf.c | 2 +-
lib/isnan.c | 20 +-
lib/isnand-nolibm.h | 2 +-
lib/isnand.c | 2 +-
lib/isnanf-nolibm.h | 2 +-
lib/isnanf.c | 2 +-
lib/isnanl-nolibm.h | 2 +-
lib/isnanl.c | 2 +-
lib/itold.c | 2 +-
lib/langinfo.in.h | 2 +-
lib/listen.c | 2 +-
lib/localcharset.c | 9 +-
lib/localcharset.h | 2 +-
lib/locale.in.h | 2 +-
lib/localeconv.c | 2 +-
lib/log.c | 2 +-
lib/log1p.c | 2 +-
lib/lstat.c | 2 +-
lib/malloc.c | 2 +-
lib/malloca.c | 31 +-
lib/malloca.h | 4 +-
lib/math.in.h | 5 +-
lib/mbrtowc.c | 2 +-
lib/mbsinit.c | 2 +-
lib/mbtowc-impl.h | 2 +-
lib/mbtowc.c | 2 +-
lib/memchr.c | 2 +-
lib/msvc-inval.c | 8 +-
lib/msvc-inval.h | 2 +-
lib/msvc-nothrow.c | 2 +-
lib/msvc-nothrow.h | 2 +-
lib/netdb.in.h | 2 +-
lib/netinet_in.in.h | 2 +-
lib/nl_langinfo.c | 2 +-
lib/nproc.c | 2 +-
lib/nproc.h | 2 +-
lib/open.c | 2 +-
lib/pathmax.h | 2 +-
lib/pipe.c | 2 +-
lib/pipe2.c | 10 +-
lib/poll.c | 2 +-
lib/poll.in.h | 2 +-
lib/printf-args.c | 2 +-
lib/printf-args.h | 2 +-
lib/printf-parse.c | 2 +-
lib/printf-parse.h | 2 +-
lib/putenv.c | 128 ++--
lib/raise.c | 2 +-
lib/read.c | 2 +-
lib/readlink.c | 2 +-
lib/recv.c | 2 +-
lib/recvfrom.c | 2 +-
lib/ref-add.sin | 2 +-
lib/ref-del.sin | 2 +-
lib/regcomp.c | 97 +--
lib/regex.c | 3 +-
lib/regex.h | 2 +-
lib/regex_internal.c | 8 +-
lib/regex_internal.h | 74 ++-
lib/regexec.c | 16 +-
lib/rename.c | 2 +-
lib/rmdir.c | 2 +-
lib/round.c | 2 +-
lib/safe-read.c | 2 +-
lib/safe-read.h | 2 +-
lib/safe-write.c | 2 +-
lib/safe-write.h | 2 +-
lib/same-inode.h | 2 +-
lib/select.c | 2 +-
lib/send.c | 2 +-
lib/sendto.c | 2 +-
lib/setenv.c | 2 +-
lib/setsockopt.c | 2 +-
lib/shutdown.c | 2 +-
lib/signal.in.h | 16 +-
lib/signbitd.c | 2 +-
lib/signbitf.c | 2 +-
lib/signbitl.c | 2 +-
lib/size_max.h | 2 +-
lib/snprintf.c | 2 +-
lib/socket.c | 2 +-
lib/sockets.c | 2 +-
lib/sockets.h | 2 +-
lib/stat-time.h | 5 +-
lib/stat.c | 2 +-
lib/stdalign.in.h | 42 +-
lib/stdbool.in.h | 2 +-
lib/stddef.in.h | 2 +-
lib/stdint.in.h | 2 +-
lib/stdio.in.h | 25 +-
lib/stdlib.in.h | 2 +-
lib/streq.h | 2 +-
lib/strftime.c | 2 +-
lib/strftime.h | 2 +-
lib/striconveh.c | 2 +-
lib/striconveh.h | 2 +-
lib/string.in.h | 2 +-
lib/stripslash.c | 2 +-
lib/sys_file.in.h | 2 +-
lib/sys_select.in.h | 18 +-
lib/sys_socket.in.h | 5 +-
lib/sys_stat.in.h | 2 +-
lib/sys_time.in.h | 12 +-
lib/sys_times.in.h | 2 +-
lib/sys_types.in.h | 2 +-
lib/sys_uio.in.h | 2 +-
lib/time.in.h | 46 +-
lib/time_r.c | 2 +-
lib/times.c | 2 +-
lib/trunc.c | 2 +-
lib/unistd.in.h | 22 +-
lib/unistr.in.h | 2 +-
lib/unistr/u8-mbtouc-aux.c | 2 +-
lib/unistr/u8-mbtouc-unsafe-aux.c | 2 +-
lib/unistr/u8-mbtouc-unsafe.c | 2 +-
lib/unistr/u8-mbtouc.c | 2 +-
lib/unistr/u8-mbtoucr.c | 2 +-
lib/unistr/u8-prev.c | 2 +-
lib/unistr/u8-uctomb-aux.c | 2 +-
lib/unistr/u8-uctomb.c | 2 +-
lib/unitypes.in.h | 2 +-
lib/vasnprintf.c | 5 +-
lib/vasnprintf.h | 2 +-
lib/verify.h | 136 ++--
lib/vsnprintf.c | 2 +-
lib/w32sock.h | 2 +-
lib/wchar.in.h | 2 +-
lib/wcrtomb.c | 2 +-
lib/wctype.in.h | 12 +-
lib/write.c | 2 +-
lib/xsize.h | 5 +-
libguile/arrays.c | 1 +
libguile/backtrace.c | 20 +-
libguile/debug.c | 20 +-
libguile/eval.c | 33 +-
libguile/fports.c | 35 +-
libguile/frames.c | 20 +-
libguile/generalized-vectors.c | 13 +-
libguile/goops.c | 22 +-
libguile/ports.c | 43 +-
libguile/ports.h | 11 +-
libguile/r6rs-ports.c | 93 ++-
libguile/scmsigs.c | 2 +-
libguile/strings.c | 17 +-
libguile/strports.c | 25 +-
libguile/throw.c | 48 +-
libguile/vectors.c | 9 +-
libguile/weak-vector.c | 75 ++-
libguile/weak-vector.h | 15 +-
m4/00gnulib.m4 | 22 +-
m4/absolute-header.m4 | 2 +-
m4/alloca.m4 | 2 +-
m4/arpa_inet_h.m4 | 2 +-
m4/autobuild.m4 | 2 +-
m4/btowc.m4 | 2 +-
m4/byteswap.m4 | 2 +-
m4/canonicalize.m4 | 2 +-
m4/ceil.m4 | 2 +-
m4/check-math-lib.m4 | 2 +-
m4/clock_time.m4 | 2 +-
m4/close.m4 | 2 +-
m4/codeset.m4 | 2 +-
m4/configmake.m4 | 13 +-
m4/copysign.m4 | 2 +-
m4/dirent_h.m4 | 2 +-
m4/dirfd.m4 | 2 +-
m4/dirname.m4 | 2 +-
m4/double-slash-root.m4 | 2 +-
m4/dup2.m4 | 9 +-
m4/duplocale.m4 | 2 +-
m4/eealloc.m4 | 2 +-
m4/environ.m4 | 2 +-
m4/errno_h.m4 | 2 +-
m4/exponentd.m4 | 2 +-
m4/exponentf.m4 | 2 +-
m4/exponentl.m4 | 2 +-
m4/extensions.m4 | 4 +-
m4/extern-inline.m4 | 54 +-
m4/fcntl-o.m4 | 2 +-
m4/fcntl_h.m4 | 2 +-
m4/float_h.m4 | 2 +-
m4/flock.m4 | 2 +-
m4/floor.m4 | 2 +-
m4/fpieee.m4 | 2 +-
m4/frexp.m4 | 12 +-
m4/fstat.m4 | 2 +-
m4/func.m4 | 2 +-
m4/getaddrinfo.m4 | 2 +-
m4/getlogin.m4 | 2 +-
m4/gettimeofday.m4 | 138 +++
m4/glibc21.m4 | 2 +-
m4/gnulib-cache.m4 | 2 +-
m4/gnulib-common.m4 | 8 +-
m4/gnulib-comp.m4 | 23 +-
m4/gnulib-tool.m4 | 2 +-
m4/hostent.m4 | 2 +-
m4/iconv.m4 | 2 +-
m4/iconv_h.m4 | 2 +-
m4/iconv_open-utf.m4 | 2 +-
m4/iconv_open.m4 | 2 +-
m4/include_next.m4 | 55 +--
m4/inet_ntop.m4 | 2 +-
m4/inet_pton.m4 | 2 +-
m4/inline.m4 | 2 +-
m4/intmax_t.m4 | 2 +-
m4/inttypes_h.m4 | 2 +-
m4/isfinite.m4 | 2 +-
m4/isinf.m4 | 2 +-
m4/isnan.m4 | 2 +-
m4/isnand.m4 | 2 +-
m4/isnanf.m4 | 2 +-
m4/isnanl.m4 | 2 +-
m4/langinfo_h.m4 | 2 +-
m4/largefile.m4 | 2 +-
m4/ld-version-script.m4 | 2 +-
m4/ldexp.m4 | 2 +-
m4/lib-ld.m4 | 2 +-
m4/lib-link.m4 | 2 +-
m4/lib-prefix.m4 | 2 +-
m4/libunistring-base.m4 | 2 +-
m4/libunistring.m4 | 2 +-
m4/localcharset.m4 | 2 +-
m4/locale-fr.m4 | 2 +-
m4/locale-ja.m4 | 2 +-
m4/locale-zh.m4 | 2 +-
m4/locale_h.m4 | 2 +-
m4/localeconv.m4 | 2 +-
m4/lock.m4 | 42 +
m4/log.m4 | 2 +-
m4/log1p.m4 | 2 +-
m4/longlong.m4 | 2 +-
m4/lstat.m4 | 2 +-
m4/malloc.m4 | 2 +-
m4/malloca.m4 | 2 +-
m4/math_h.m4 | 2 +-
m4/mathfunc.m4 | 2 +-
m4/mbrtowc.m4 | 2 +-
m4/mbsinit.m4 | 2 +-
m4/mbstate_t.m4 | 2 +-
m4/mbtowc.m4 | 2 +-
m4/memchr.m4 | 2 +-
m4/mmap-anon.m4 | 2 +-
m4/mode_t.m4 | 2 +-
m4/msvc-inval.m4 | 2 +-
m4/msvc-nothrow.m4 | 2 +-
m4/multiarch.m4 | 2 +-
m4/netdb_h.m4 | 2 +-
m4/netinet_in_h.m4 | 2 +-
m4/nl_langinfo.m4 | 2 +-
m4/nocrash.m4 | 2 +-
m4/nproc.m4 | 2 +-
m4/off_t.m4 | 2 +-
m4/open.m4 | 2 +-
m4/pathmax.m4 | 2 +-
m4/pipe.m4 | 2 +-
m4/pipe2.m4 | 2 +-
m4/poll.m4 | 2 +-
m4/poll_h.m4 | 2 +-
m4/printf.m4 | 2 +-
m4/putenv.m4 | 6 +-
m4/raise.m4 | 2 +-
m4/read.m4 | 2 +-
m4/readlink.m4 | 2 +-
m4/regex.m4 | 58 +-
m4/rename.m4 | 2 +-
m4/rmdir.m4 | 2 +-
m4/round.m4 | 2 +-
m4/safe-read.m4 | 2 +-
m4/safe-write.m4 | 2 +-
m4/select.m4 | 2 +-
m4/servent.m4 | 2 +-
m4/setenv.m4 | 2 +-
m4/signal_h.m4 | 2 +-
m4/signbit.m4 | 2 +-
m4/size_max.m4 | 2 +-
m4/snprintf.m4 | 2 +-
m4/socketlib.m4 | 2 +-
m4/sockets.m4 | 2 +-
m4/socklen.m4 | 2 +-
m4/sockpfaf.m4 | 2 +-
m4/ssize_t.m4 | 2 +-
m4/stat-time.m4 | 2 +-
m4/stat.m4 | 2 +-
m4/stdalign.m4 | 10 +-
m4/stdbool.m4 | 2 +-
m4/stddef_h.m4 | 2 +-
m4/stdint.m4 | 2 +-
m4/stdint_h.m4 | 2 +-
m4/stdio_h.m4 | 2 +-
m4/stdlib_h.m4 | 2 +-
m4/strftime.m4 | 2 +-
m4/string_h.m4 | 2 +-
m4/sys_file_h.m4 | 2 +-
m4/sys_select_h.m4 | 2 +-
m4/sys_socket_h.m4 | 2 +-
m4/sys_stat_h.m4 | 2 +-
m4/sys_time_h.m4 | 2 +-
m4/sys_times_h.m4 | 2 +-
m4/sys_types_h.m4 | 6 +-
m4/sys_uio_h.m4 | 2 +-
m4/threadlib.m4 | 371 ++++++++
m4/time_h.m4 | 13 +-
m4/time_r.m4 | 2 +-
m4/times.m4 | 2 +-
m4/tm_gmtoff.m4 | 2 +-
m4/trunc.m4 | 2 +-
m4/unistd_h.m4 | 5 +-
m4/vasnprintf.m4 | 2 +-
m4/visibility.m4 | 2 +-
m4/vsnprintf.m4 | 2 +-
m4/warn-on-use.m4 | 2 +-
m4/warnings.m4 | 32 +-
m4/wchar_h.m4 | 2 +-
m4/wchar_t.m4 | 2 +-
m4/wcrtomb.m4 | 2 +-
m4/wctype_h.m4 | 2 +-
m4/wint_t.m4 | 2 +-
m4/write.m4 | 2 +-
m4/xsize.m4 | 2 +-
maint.mk | 17 +-
module/Makefile.am | 11 +-
module/ice-9/boot-9.scm | 74 ++-
module/ice-9/i18n.scm | 2 +-
module/ice-9/poll.scm | 2 +-
module/ice-9/popen.scm | 2 +-
module/ice-9/r6rs-libraries.scm | 2 +-
module/ice-9/weak-vector.scm | 9 +-
module/language/tree-il/primitives.scm | 34 +-
module/oop/goops.scm | 8 +-
module/oop/goops/compile.scm | 2 +-
module/oop/goops/dispatch.scm | 2 +-
module/srfi/{srfi-2.scm => srfi-111.scm} | 34 +-
module/srfi/srfi-43.scm | 1077 +++++++++++++++++++++++
module/srfi/srfi-64.scm | 55 ++
module/srfi/srfi-64/testing.scm | 1040 ++++++++++++++++++++++
module/srfi/srfi-88.scm | 2 +-
module/system/foreign.scm | 2 +-
module/system/repl/server.scm | 39 +-
module/texinfo/serialize.scm | 2 +-
module/web/http.scm | 8 +-
test-suite/Makefile.am | 6 +-
test-suite/tests/guardians.test | 12 +-
test-suite/tests/ports.test | 14 +-
test-suite/tests/r6rs-ports.test | 143 +++
test-suite/tests/srfi-111.test | 65 ++
test-suite/tests/srfi-43.test | 1375 ++++++++++++++++++++++++++++++
test-suite/tests/srfi-64-test.scm | 934 ++++++++++++++++++++
test-suite/tests/srfi-64.test | 45 +
test-suite/tests/syntax.test | 174 ++++
test-suite/tests/weaks.test | 41 +-
test-suite/tests/web-http.test | 19 +-
440 files changed, 9876 insertions(+), 1030 deletions(-)
create mode 100644 lib/gettimeofday.c
create mode 100644 lib/glthread/lock.c
create mode 100644 lib/glthread/lock.h
create mode 100644 lib/glthread/threadlib.c
create mode 100644 m4/gettimeofday.m4
create mode 100644 m4/lock.m4
create mode 100644 m4/threadlib.m4
copy module/srfi/{srfi-2.scm => srfi-111.scm} (56%)
create mode 100644 module/srfi/srfi-43.scm
create mode 100644 module/srfi/srfi-64.scm
create mode 100644 module/srfi/srfi-64/testing.scm
create mode 100644 test-suite/tests/srfi-111.test
create mode 100644 test-suite/tests/srfi-43.test
create mode 100644 test-suite/tests/srfi-64-test.scm
create mode 100644 test-suite/tests/srfi-64.test
diff --git a/GNUmakefile b/GNUmakefile
index 8759034..4ab6429 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -5,7 +5,7 @@
# It is necessary if you want to build targets usually of interest
# only to the maintainer.
-# Copyright (C) 2001, 2003, 2006-2013 Free Software Foundation, Inc.
+# Copyright (C) 2001, 2003, 2006-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/THANKS b/THANKS
index f16376b..ddb11c1 100644
--- a/THANKS
+++ b/THANKS
@@ -192,6 +192,7 @@ For fixes or providing information which led to a fix:
Andy Wingo
Keith Wright
William Xu
+ Atom X Zane
;; Local Variables:
diff --git a/build-aux/announce-gen b/build-aux/announce-gen
index 3a64ec6..db9ed50 100755
--- a/build-aux/announce-gen
+++ b/build-aux/announce-gen
@@ -9,7 +9,7 @@ my $VERSION = '2012-06-08 06:53'; # UTC
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/build-aux/config.rpath b/build-aux/config.rpath
index c38b914..ab6fd99 100755
--- a/build-aux/config.rpath
+++ b/build-aux/config.rpath
@@ -2,7 +2,7 @@
# Output a system dependent set of variables, describing how to set the
# run time search path of shared libraries in an executable.
#
-# Copyright 1996-2013 Free Software Foundation, Inc.
+# Copyright 1996-2014 Free Software Foundation, Inc.
# Taken from GNU libtool, 2001
# Originally by Gordon Matzigkeit <address@hidden>, 1996
#
diff --git a/build-aux/gendocs.sh b/build-aux/gendocs.sh
index e4bfc9f..f9ec9df 100755
--- a/build-aux/gendocs.sh
+++ b/build-aux/gendocs.sh
@@ -2,7 +2,7 @@
# gendocs.sh -- generate a GNU manual in many formats. This script is
# mentioned in maintain.texi. See the help message below for usage details.
-scriptversion=2013-02-03.15
+scriptversion=2013-10-10.09
# Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
# Free Software Foundation, Inc.
@@ -272,6 +272,7 @@ mkdir -p "$outdir/"
cmd="$SETLANG $MAKEINFO -o $PACKAGE.info $commonarg $infoarg \"$srcfile\""
echo "Generating info... ($cmd)"
+rm -f $PACKAGE.info* # get rid of any strays
eval "$cmd"
tar czf "$outdir/$PACKAGE.info.tar.gz" $PACKAGE.info*
ls -l "$outdir/$PACKAGE.info.tar.gz"
@@ -307,6 +308,7 @@ if $generate_ascii; then
ls -l "$outdir/$PACKAGE.txt" "$outdir/$PACKAGE.txt.gz"
fi
+# Split HTML at level $1. Used for texi2html.
html_split()
{
opt="--split=$1 --node-files $commonarg $htmlarg"
@@ -339,7 +341,16 @@ if test -z "$use_texi2html"; then
mv $PACKAGE.html "$outdir/"
ls -l "$outdir/$PACKAGE.html" "$outdir/$PACKAGE.html.gz"
- opt="--html -o $PACKAGE.html --split=$split $commonarg $htmlarg"
+ # Before Texinfo 5.0, makeinfo did not accept a --split=HOW option,
+ # it just always split by node. So if we're splitting by node anyway,
+ # leave it out.
+ if test "x$split" = xnode; then
+ split_arg=
+ else
+ split_arg=--split=$split
+ fi
+ #
+ opt="--html -o $PACKAGE.html $split_arg $commonarg $htmlarg"
cmd="$SETLANG $MAKEINFO $opt \"$srcfile\""
printf "\nGenerating html by $split... ($cmd)\n"
eval "$cmd"
diff --git a/build-aux/git-version-gen b/build-aux/git-version-gen
index 223a61e..1e5d556 100755
--- a/build-aux/git-version-gen
+++ b/build-aux/git-version-gen
@@ -2,7 +2,7 @@
# Print a version string.
scriptversion=2012-12-31.23; # UTC
-# Copyright (C) 2007-2013 Free Software Foundation, Inc.
+# Copyright (C) 2007-2014 Free Software Foundation, Inc.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index e02d34c..78afff4 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -9,7 +9,7 @@ my $VERSION = '2012-07-29 06:11'; # UTC
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2008-2013 Free Software Foundation, Inc.
+# Copyright (C) 2008-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/build-aux/gnu-web-doc-update b/build-aux/gnu-web-doc-update
index 268ecc0..7af2f18 100755
--- a/build-aux/gnu-web-doc-update
+++ b/build-aux/gnu-web-doc-update
@@ -4,7 +4,7 @@
VERSION=2012-12-16.14; # UTC
-# Copyright (C) 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2009-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/build-aux/gnupload b/build-aux/gnupload
index 782dd6f..2da97d8 100755
--- a/build-aux/gnupload
+++ b/build-aux/gnupload
@@ -1,9 +1,9 @@
#!/bin/sh
# Sign files and upload them.
-scriptversion=2012-12-11.16; # UTC
+scriptversion=2013-03-19.17; # UTC
-# Copyright (C) 2004-2013 Free Software Foundation, Inc.
+# Copyright (C) 2004-2014 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -39,9 +39,8 @@ nl='
usage="Usage: $0 [OPTION]... [CMD] FILE... [[CMD] FILE...]
-Sign all FILES, and process them at selected destinations according to CMD.
-<http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html>
-explains further.
+Sign all FILES, and process them at the destinations specified with --to.
+If CMD is not given, it defaults to uploading. See examples below.
Commands:
--delete delete FILES from destination
@@ -50,8 +49,7 @@ Commands:
-- treat the remaining arguments as files to upload
Options:
- --help print this help text and exit
- --to DEST specify one destination for FILES
+ --to DEST specify a destination DEST for FILES
(multiple --to options are allowed)
--user NAME sign with key NAME
--replace allow replacements of existing files
@@ -59,10 +57,10 @@ Options:
--dry-run do nothing, show what would have been done
(including the constructed directive file)
--version output version information and exit
+ --help print this help text and exit
If --symlink-regex is given without EXPR, then the link target name
is created by replacing the version information with '-latest', e.g.:
-
foo-1.3.4.tar.gz -> foo-latest.tar.gz
Recognized destinations are:
@@ -80,6 +78,9 @@ in the current working directory, its contents are prepended
to the
actual command line options. Use this to keep your defaults. Comments
(#) and empty lines in $conffile are allowed.
+<http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html>
+gives some further background.
+
Examples:
1. Upload foobar-1.0.tar.gz to ftp.gnu.org:
gnupload --to ftp.gnu.org:foobar foobar-1.0.tar.gz
@@ -104,7 +105,7 @@ Examples:
--delete oopsbar-0.9.91.tar.gz \\
-- foobar-0.9.91.tar.gz
-gnupload uses the ncftpput program to do the transfers; if you don't
+gnupload executes a program ncftpput to do the transfers; if you don't
happen to have an ncftp package installed, the ncftpput-ftp script in
the build-aux/ directory of the gnulib package
(http://savannah.gnu.org/projects/gnulib) may serve as a replacement.
@@ -132,6 +133,12 @@ while test -n "$1"; do
if test -z "$2"; then
echo "$0: Missing argument for --to" 1>&2
exit 1
+ elif echo "$2" | grep 'ftp-upload\.gnu\.org' >/dev/null; then
+ echo "$0: Use ftp.gnu.org:PKGNAME or alpha.gnu.org:PKGNAME" >&2
+ echo "$0: for the destination, not ftp-upload.gnu.org (which" >&2
+ echo "$0: is used for direct ftp uploads, not with gnupload)." >&2
+ echo "$0: See --help and its examples if need be." >&2
+ exit 1
else
to="$to $2"
shift
diff --git a/build-aux/snippet/arg-nonnull.h b/build-aux/snippet/arg-nonnull.h
index 8ea2a47..9ee8b15 100644
--- a/build-aux/snippet/arg-nonnull.h
+++ b/build-aux/snippet/arg-nonnull.h
@@ -1,5 +1,5 @@
/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/snippet/c++defs.h b/build-aux/snippet/c++defs.h
index b35b933..67b1233 100644
--- a/build-aux/snippet/c++defs.h
+++ b/build-aux/snippet/c++defs.h
@@ -1,5 +1,5 @@
/* C++ compatible function declaration macros.
- Copyright (C) 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/snippet/unused-parameter.h
b/build-aux/snippet/unused-parameter.h
index 1347c27..41d9510 100644
--- a/build-aux/snippet/unused-parameter.h
+++ b/build-aux/snippet/unused-parameter.h
@@ -1,5 +1,5 @@
/* A C macro for declaring that specific function parameters are not used.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/snippet/warn-on-use.h b/build-aux/snippet/warn-on-use.h
index 1736a1b..1c4d7bd 100644
--- a/build-aux/snippet/warn-on-use.h
+++ b/build-aux/snippet/warn-on-use.h
@@ -1,5 +1,5 @@
/* A C macro for emitting warnings if a function is used.
- Copyright (C) 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/useless-if-before-free b/build-aux/useless-if-before-free
index 663347a..4c76c75 100755
--- a/build-aux/useless-if-before-free
+++ b/build-aux/useless-if-before-free
@@ -10,7 +10,7 @@ my $VERSION = '2012-01-06 07:23'; # UTC
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2008-2013 Free Software Foundation, Inc.
+# Copyright (C) 2008-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/build-aux/vc-list-files b/build-aux/vc-list-files
index 7ec335f..b2bca54 100755
--- a/build-aux/vc-list-files
+++ b/build-aux/vc-list-files
@@ -4,7 +4,7 @@
# Print a version string.
scriptversion=2011-05-16.22; # UTC
-# Copyright (C) 2006-2013 Free Software Foundation, Inc.
+# Copyright (C) 2006-2014 Free Software Foundation, Inc.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/doc/gendocs_template b/doc/gendocs_template
index 63fbe53..4836df7 100644
--- a/doc/gendocs_template
+++ b/doc/gendocs_template
@@ -75,7 +75,7 @@ the FSF.<br />
Please send broken links and other corrections or suggestions to
<a href="mailto:%%EMAIL%%";><%%EMAIL%%></a>.</p>
-<p>Copyright © 2013 Free Software Foundation, Inc.</p>
+<p>Copyright © 2014 Free Software Foundation, Inc.</p>
<p>Verbatim copying and distribution of this entire article are
permitted worldwide, without royalty, in any medium, provided this
diff --git a/doc/ref/api-binding.texi b/doc/ref/api-binding.texi
index e3a9918..5857e78 100644
--- a/doc/ref/api-binding.texi
+++ b/doc/ref/api-binding.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010, 2011
address@hidden Free Software Foundation, Inc.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010, 2011,
address@hidden 2014 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node Binding Constructs
@@ -17,6 +17,7 @@ and expressions. This is important for modularity and data
abstraction.
* Local Bindings:: Local variable bindings.
* Internal Definitions:: Internal definitions.
* Binding Reflection:: Querying variable bindings.
+* Binding Multiple Values:: Binding multiple return values.
@end menu
@@ -321,6 +322,28 @@ the current module when @var{module} is not specified;
otherwise return
@end deffn
address@hidden Binding Multiple Values
address@hidden Binding multiple return values
+
address@hidden {Syntax} define-values formals expression
+The @var{expression} is evaluated, and the @var{formals} are bound to
+the return values in the same way that the formals in a @code{lambda}
+expression are matched to the arguments in a procedure call.
address@hidden deffn
+
address@hidden
+(define-values (q r) (floor/ 10 3))
+(list q r) @result{} (3 1)
+
+(define-values (x . y) (values 1 2 3))
+x @result{} 1
+y @result{} (2 3)
+
+(define-values x (values 1 2 3))
+x @result{} (1 2 3)
address@hidden example
+
+
@c Local Variables:
@c TeX-master: "guile.texi"
@c End:
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index aa3729c..dde1643 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -238,7 +238,7 @@ comments as specified by R6RS and
@url{http://srfi.schemers.org/srfi-30/srfi-30.html, SRFI-30}:
@lisp
-(+ #| this is a #| nested |# block comment |# 2)
+(+ 1 #| this is a #| nested |# block comment |# 2)
@result{} 3
@end lisp
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 5ca3506..8b44224 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1792,6 +1792,10 @@ indicating the position of the next byte is to read.
Finally, if @var{close} is not @code{#f}, it must be a thunk. It is
invoked when the custom binary input port is closed.
+The returned port is fully buffered by default, but its buffering mode
+can be changed using @code{setvbuf} (@pxref{Ports and File Descriptors,
address@hidden).
+
Using a custom binary input port, the @code{open-bytevector-input-port}
procedure could be implemented as follows:
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 39c0f24..9964e6b 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -1194,17 +1194,42 @@ The fix is to use @code{eval-when}.
@example
;; correct: using eval-when
(use-modules (srfi srfi-19))
-(eval-when (compile load eval)
+(eval-when (expand load eval)
(define (date) (date->string (current-date))))
(define-syntax %date (identifier-syntax (date)))
(define *compilation-date* %date)
@end example
@deffn {Syntax} eval-when conditions exp...
-Evaluate @var{exp...} under the given @var{conditions}. Valid conditions
include
address@hidden, @code{load}, and @code{compile}. If you need to use
address@hidden, use it with all three conditions, as in the above example.
-Other uses of @code{eval-when} may void your warranty or poison your cat.
+Evaluate @var{exp...} under the given @var{conditions}. Valid
+conditions include:
+
address@hidden @code
address@hidden expand
+Evaluate during macro expansion, whether compiling or not.
+
address@hidden load
+Evaluate during the evaluation phase of compiled code, e.g. when loading
+a compiled module or running compiled code at the REPL.
+
address@hidden eval
+Evaluate during the evaluation phase of non-compiled code.
+
address@hidden compile
+Evaluate during macro expansion, but only when compiling.
address@hidden table
+
+In other words, when using the primitive evaluator, @code{eval-when}
+expressions with @code{expand} are run during macro expansion, and those
+with @code{eval} are run during the evaluation phase.
+
+When using the compiler, @code{eval-when} expressions with either
address@hidden or @code{compile} are run during macro expansion, and
+those with @code{load} are run during the evaluation phase.
+
+When in doubt, use the three conditions @code{(expand load eval)}, as in
+the example above. Other uses of @code{eval-when} may void your
+warranty or poison your cat.
@end deffn
@node Macro Expansion
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index 6512650..130ff84 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010, 2012, 2013
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010, 2012, 2013, 2014
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -350,6 +350,17 @@ Return @code{#t} if @var{obj} is a weak vector. Note that
all
weak hashes are also weak vectors.
@end deffn
address@hidden {Scheme Procedure} weak-vector-ref wvect k
address@hidden {C Function} scm_weak_vector_ref (wvect, k)
+Return the @var{k}th element of the weak vector @var{wvect}, or
address@hidden if that element has been collected.
address@hidden deffn
+
address@hidden {Scheme Procedure} weak-vector-set! wvect k elt
address@hidden {C Function} scm_weak_vector_set_x (wvect, k, elt)
+Set the @var{k}th element of the weak vector @var{wvect} to @var{elt}.
address@hidden deffn
+
@node Guardians
@subsection Guardians
diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi
index 2929286..d233ce6 100644
--- a/doc/ref/guile-invoke.texi
+++ b/doc/ref/guile-invoke.texi
@@ -410,14 +410,6 @@ Guile uses the environment variable @env{HOME}, the name
of your home
directory, to locate various files, such as @file{.guile} or
@file{.guile_history}.
address@hidden LTDL_LIBRARY_PATH
address@hidden LTDL_LIBRARY_PATH
-Guile now adds its install prefix to the @env{LTDL_LIBRARY_PATH}.
-
-Users may now install Guile in non-standard directories and run
-`/path/to/bin/guile', without having also to set @env{LTDL_LIBRARY_PATH}
-to include `/path/to/lib'.
-
@end table
@c Local Variables:
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 40c20e7..9091d9f 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -470,6 +470,9 @@ line buffered
block buffered, using a newly allocated buffer of @var{size} bytes.
If @var{size} is omitted, a default size will be used.
@end defvar
+
+Only certain types of ports are supported, most importantly
+file ports.
@end deffn
@deffn {Scheme Procedure} fcntl port/fd cmd [value]
diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index 9c5984b..e5ffb78 100644
--- a/doc/ref/r6rs.texi
+++ b/doc/ref/r6rs.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 2010, 2011, 2012, 2013
address@hidden Free Software Foundation, Inc.
address@hidden Copyright (C) 2010, 2011, 2012, 2013,
address@hidden 2014 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node R6RS Support
@@ -100,6 +100,10 @@ ongoing to fix this.
Guile does not prevent use of textual I/O procedures on binary ports.
More generally, it does not make a sharp distinction between binary and
textual ports (@pxref{R6RS Port Manipulation, binary-port?}).
+
address@hidden
+Guile's implementation of @code{equal?} may fail to terminate when
+applied to arguments containing cycles.
@end itemize
@node R6RS Standard Libraries
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 84cc164..746ee62 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -47,18 +47,21 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-39:: Parameter objects
* SRFI-41:: Streams.
* SRFI-42:: Eager comprehensions
+* SRFI-43:: Vector Library.
* SRFI-45:: Primitives for expressing iterative lazy
algorithms
* SRFI-46:: Basic syntax-rules Extensions.
* SRFI-55:: Requiring Features.
* SRFI-60:: Integers as bits.
* SRFI-61:: A more general `cond' clause
* SRFI-62:: S-expression comments.
+* SRFI-64:: A Scheme API for test suites.
* SRFI-67:: Compare procedures
* SRFI-69:: Basic hash tables.
* SRFI-87:: => in case clauses.
* SRFI-88:: Keyword objects.
* SRFI-98:: Accessing environment variables.
* SRFI-105:: Curly-infix expressions.
+* SRFI-111:: Boxes.
@end menu
@@ -4503,6 +4506,417 @@ the input @var{stream}s is finite, or is infinite if
all the input
See @uref{http://srfi.schemers.org/srfi-42/srfi-42.html, the
specification of SRFI-42}.
address@hidden SRFI-43
address@hidden SRFI-43 - Vector Library
address@hidden SRFI-43
+
+This subsection is based on the
address@hidden://srfi.schemers.org/srfi-43/srfi-43.html, specification of
+SRFI-43} by Taylor Campbell.
+
address@hidden The copyright notice and license text of the SRFI-43
specification is
address@hidden reproduced below:
+
address@hidden Copyright (C) Taylor Campbell (2003). All Rights Reserved.
+
address@hidden Permission is hereby granted, free of charge, to any person
obtaining a
address@hidden copy of this software and associated documentation files (the
address@hidden "Software"), to deal in the Software without restriction,
including
address@hidden without limitation the rights to use, copy, modify, merge,
publish,
address@hidden distribute, sublicense, and/or sell copies of the Software, and
to
address@hidden permit persons to whom the Software is furnished to do so,
subject to
address@hidden the following conditions:
+
address@hidden The above copyright notice and this permission notice shall be
included
address@hidden in all copies or substantial portions of the Software.
+
address@hidden THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS
address@hidden OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
address@hidden MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
address@hidden NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE
address@hidden LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION
address@hidden OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION
address@hidden WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
address@hidden
+SRFI-43 implements a comprehensive library of vector operations. It can
+be made available with:
+
address@hidden
+(use-modules (srfi srfi-43))
address@hidden example
+
address@hidden
+* SRFI-43 Constructors::
+* SRFI-43 Predicates::
+* SRFI-43 Selectors::
+* SRFI-43 Iteration::
+* SRFI-43 Searching::
+* SRFI-43 Mutators::
+* SRFI-43 Conversion::
address@hidden menu
+
address@hidden SRFI-43 Constructors
address@hidden SRFI-43 Constructors
+
address@hidden {Scheme Procedure} make-vector size [fill]
+Create and return a vector of size @var{size}, optionally filling it
+with @var{fill}. The default value of @var{fill} is unspecified.
+
address@hidden
+(make-vector 5 3) @result{} #(3 3 3 3 3)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector x @dots{}
+Create and return a vector whose elements are @var{x} @enddots{}.
+
address@hidden
+(vector 0 1 2 3 4) @result{} #(0 1 2 3 4)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-unfold f length initial-seed @dots{}
+The fundamental vector constructor. Create a vector whose length is
address@hidden and iterates across each index k from 0 up to
address@hidden - 1, applying @var{f} at each iteration to the current index
+and current seeds, in that order, to receive n + 1 values: first, the
+element to put in the kth slot of the new vector and n new seeds for
+the next iteration. It is an error for the number of seeds to vary
+between iterations.
+
address@hidden
+(vector-unfold (lambda (i x) (values x (- x 1)))
+ 10 0)
address@hidden #(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)
+
+(vector-unfold values 10)
address@hidden #(0 1 2 3 4 5 6 7 8 9)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-unfold-right f length initial-seed
@dots{}
+Like @code{vector-unfold}, but it uses @var{f} to generate elements from
+right-to-left, rather than left-to-right.
+
address@hidden
+(vector-unfold-right (lambda (i x) (values x (+ x 1)))
+ 10 0)
address@hidden #(9 8 7 6 5 4 3 2 1 0)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-copy vec [start [end [fill]]]
+Allocate a new vector whose length is @var{end} - @var{start} and fills
+it with elements from @var{vec}, taking elements from @var{vec} starting
+at index @var{start} and stopping at index @var{end}. @var{start}
+defaults to 0 and @var{end} defaults to the value of
address@hidden(vector-length vec)}. If @var{end} extends beyond the length of
address@hidden, the slots in the new vector that obviously cannot be filled
+by elements from @var{vec} are filled with @var{fill}, whose default
+value is unspecified.
+
address@hidden
+(vector-copy '#(a b c d e f g h i))
address@hidden #(a b c d e f g h i)
+
+(vector-copy '#(a b c d e f g h i) 6)
address@hidden #(g h i)
+
+(vector-copy '#(a b c d e f g h i) 3 6)
address@hidden #(d e f)
+
+(vector-copy '#(a b c d e f g h i) 6 12 'x)
address@hidden #(g h i x x x)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-reverse-copy vec [start [end]]
+Like @code{vector-copy}, but it copies the elements in the reverse order
+from @var{vec}.
+
address@hidden
+(vector-reverse-copy '#(5 4 3 2 1 0) 1 5)
address@hidden #(1 2 3 4)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-append vec @dots{}
+Return a newly allocated vector that contains all elements in order from
+the subsequent locations in @var{vec} @enddots{}.
+
address@hidden
+(vector-append '#(a) '#(b c d))
address@hidden #(a b c d)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-concatenate list-of-vectors
+Append each vector in @var{list-of-vectors}. Equivalent to
address@hidden(apply vector-append list-of-vectors)}.
+
address@hidden
+(vector-concatenate '(#(a b) #(c d)))
address@hidden #(a b c d)
address@hidden example
address@hidden deffn
+
address@hidden SRFI-43 Predicates
address@hidden SRFI-43 Predicates
+
address@hidden {Scheme Procedure} vector? obj
+Return true if @var{obj} is a vector, else return false.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-empty? vec
+Return true if @var{vec} is empty, i.e. its length is 0, else return
+false.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector= elt=? vec @dots{}
+Return true if the vectors @var{vec} @dots{} have equal lengths and
+equal elements according to @var{elt=?}. @var{elt=?} is always applied
+to two arguments. Element comparison must be consistent with @code{eq?}
+in the following sense: if @code{(eq? a b)} returns true, then
address@hidden(elt=? a b)} must also return true. The order in which
+comparisons are performed is unspecified.
address@hidden deffn
+
address@hidden SRFI-43 Selectors
address@hidden SRFI-43 Selectors
+
address@hidden {Scheme Procedure} vector-ref vec i
+Return the value that the location in @var{vec} at @var{i} is mapped to
+in the store. Indexing is based on zero.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-length vec
+Return the length of @var{vec}.
address@hidden deffn
+
address@hidden SRFI-43 Iteration
address@hidden SRFI-43 Iteration
+
address@hidden {Scheme Procedure} vector-fold kons knil vec1 vec2 @dots{}
+The fundamental vector iterator. @var{kons} is iterated over each index
+in all of the vectors, stopping at the end of the shortest; @var{kons}
+is applied as
address@hidden
+(kons i state (vector-ref vec1 i) (vector-ref vec2 i) ...)
address@hidden smalllisp
+where @var{state} is the current state value, and @var{i} is the current
+index. The current state value begins with @var{knil}, and becomes
+whatever @var{kons} returned at the respective iteration. The iteration
+is strictly left-to-right.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-fold-right kons knil vec1 vec2 @dots{}
+Similar to @code{vector-fold}, but it iterates right-to-left instead of
+left-to-right.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-map f vec1 vec2 @dots{}
+Return a new vector of the shortest size of the vector arguments. Each
+element at index i of the new vector is mapped from the old vectors by
address@hidden
+(f i (vector-ref vec1 i) (vector-ref vec2 i) ...)
address@hidden smalllisp
+The dynamic order of application of @var{f} is unspecified.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-map! f vec1 vec2 @dots{}
+Similar to @code{vector-map}, but rather than mapping the new elements
+into a new vector, the new mapped elements are destructively inserted
+into @var{vec1}. The dynamic order of application of @var{f} is
+unspecified.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-for-each f vec1 vec2 @dots{}
+Call @code{(f i (vector-ref vec1 i) (vector-ref vec2 i) ...)} for each
+index i less than the length of the shortest vector passed. The
+iteration is strictly left-to-right.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-count pred? vec1 vec2 @dots{}
+Count the number of parallel elements in the vectors that satisfy
address@hidden, which is applied, for each index i less than the length of
+the smallest vector, to i and each parallel element in the vectors at
+that index, in order.
+
address@hidden
+(vector-count (lambda (i elt) (even? elt))
+ '#(3 1 4 1 5 9 2 5 6))
address@hidden 3
+(vector-count (lambda (i x y) (< x y))
+ '#(1 3 6 9) '#(2 4 6 8 10 12))
address@hidden 2
address@hidden example
address@hidden deffn
+
address@hidden SRFI-43 Searching
address@hidden SRFI-43 Searching
+
address@hidden {Scheme Procedure} vector-index pred? vec1 vec2 @dots{}
+Find and return the index of the first elements in @var{vec1} @var{vec2}
address@hidden that satisfy @var{pred?}. If no matching element is found by
+the end of the shortest vector, return @code{#f}.
+
address@hidden
+(vector-index even? '#(3 1 4 1 5 9))
address@hidden 2
+(vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
address@hidden 1
+(vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
address@hidden #f
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-index-right pred? vec1 vec2 @dots{}
+Like @code{vector-index}, but it searches right-to-left, rather than
+left-to-right. Note that the SRFI 43 specification requires that all
+the vectors must have the same length, but both the SRFI 43 reference
+implementation and Guile's implementation allow vectors with unequal
+lengths, and start searching from the last index of the shortest vector.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-skip pred? vec1 vec2 @dots{}
+Find and return the index of the first elements in @var{vec1} @var{vec2}
address@hidden that do not satisfy @var{pred?}. If no matching element is
+found by the end of the shortest vector, return @code{#f}. Equivalent
+to @code{vector-index} but with the predicate inverted.
+
address@hidden
+(vector-skip number? '#(1 2 a b 3 4 c d)) @result{} 2
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-skip-right pred? vec1 vec2 @dots{}
+Like @code{vector-skip}, but it searches for a non-matching element
+right-to-left, rather than left-to-right. Note that the SRFI 43
+specification requires that all the vectors must have the same length,
+but both the SRFI 43 reference implementation and Guile's implementation
+allow vectors with unequal lengths, and start searching from the last
+index of the shortest vector.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-binary-search vec value cmp [start
[end]]
+Find and return an index of @var{vec} between @var{start} and @var{end}
+whose value is @var{value} using a binary search. If no matching
+element is found, return @code{#f}. The default @var{start} is 0 and
+the default @var{end} is the length of @var{vec}.
+
address@hidden must be a procedure of two arguments such that @code{(cmp a
+b)} returns a negative integer if @math{a < b}, a positive integer if
address@hidden > b}, or zero if @math{a = b}. The elements of @var{vec} must
+be sorted in non-decreasing order according to @var{cmp}.
+
+Note that SRFI 43 does not document the @var{start} and @var{end}
+arguments, but both its reference implementation and Guile's
+implementation support them.
+
address@hidden
+(define (char-cmp c1 c2)
+ (cond ((char<? c1 c2) -1)
+ ((char>? c1 c2) 1)
+ (else 0)))
+
+(vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
+ #\g
+ char-cmp)
address@hidden 6
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-any pred? vec1 vec2 @dots{}
+Find the first parallel set of elements from @var{vec1} @var{vec2}
address@hidden for which @var{pred?} returns a true value. If such a parallel
+set of elements exists, @code{vector-any} returns the value that
address@hidden returned for that set of elements. The iteration is
+strictly left-to-right.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-every pred? vec1 vec2 @dots{}
+If, for every index i between 0 and the length of the shortest vector
+argument, the set of elements @code{(vector-ref vec1 i)}
address@hidden(vector-ref vec2 i)} @dots{} satisfies @var{pred?},
address@hidden returns the value that @var{pred?} returned for the
+last set of elements, at the last index of the shortest vector.
+Otherwise it returns @code{#f}. The iteration is strictly
+left-to-right.
address@hidden deffn
+
address@hidden SRFI-43 Mutators
address@hidden SRFI-43 Mutators
+
address@hidden {Scheme Procedure} vector-set! vec i value
+Assign the contents of the location at @var{i} in @var{vec} to
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-swap! vec i j
+Swap the values of the locations in @var{vec} at @var{i} and @var{j}.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-fill! vec fill [start [end]]
+Assign the value of every location in @var{vec} between @var{start} and
address@hidden to @var{fill}. @var{start} defaults to 0 and @var{end}
+defaults to the length of @var{vec}.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-reverse! vec [start [end]]
+Destructively reverse the contents of @var{vec} between @var{start} and
address@hidden @var{start} defaults to 0 and @var{end} defaults to the
+length of @var{vec}.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-copy! target tstart source [sstart
[send]]
+Copy a block of elements from @var{source} to @var{target}, both of
+which must be vectors, starting in @var{target} at @var{tstart} and
+starting in @var{source} at @var{sstart}, ending when (@var{send} -
address@hidden) elements have been copied. It is an error for
address@hidden to have a length less than (@var{tstart} + @var{send} -
address@hidden). @var{sstart} defaults to 0 and @var{send} defaults to
+the length of @var{source}.
address@hidden deffn
+
address@hidden {Scheme Procedure} vector-reverse-copy! target tstart source
[sstart [send]]
+Like @code{vector-copy!}, but this copies the elements in the reverse
+order. It is an error if @var{target} and @var{source} are identical
+vectors and the @var{target} and @var{source} ranges overlap; however,
+if @var{tstart} = @var{sstart}, @code{vector-reverse-copy!} behaves as
address@hidden(vector-reverse! target tstart send)} would.
address@hidden deffn
+
address@hidden SRFI-43 Conversion
address@hidden SRFI-43 Conversion
+
address@hidden {Scheme Procedure} vector->list vec [start [end]]
+Return a newly allocated list containing the elements in @var{vec}
+between @var{start} and @var{end}. @var{start} defaults to 0 and
address@hidden defaults to the length of @var{vec}.
address@hidden deffn
+
address@hidden {Scheme Procedure} reverse-vector->list vec [start [end]]
+Like @code{vector->list}, but the resulting list contains the specified
+range of elements of @var{vec} in reverse order.
address@hidden deffn
+
address@hidden {Scheme Procedure} list->vector proper-list [start [end]]
+Return a newly allocated vector of the elements from @var{proper-list}
+with indices between @var{start} and @var{end}. @var{start} defaults to
+0 and @var{end} defaults to the length of @var{proper-list}. Note that
+SRFI 43 does not document the @var{start} and @var{end} arguments, but
+both its reference implementation and Guile's implementation support
+them.
address@hidden deffn
+
address@hidden {Scheme Procedure} reverse-list->vector proper-list [start [end]]
+Like @code{list->vector}, but the resulting vector contains the specified
+range of elements of @var{proper-list} in reverse order. Note that SRFI
+43 does not document the @var{start} and @var{end} arguments, but both
+its reference implementation and Guile's implementation support them.
address@hidden deffn
+
@node SRFI-45
@subsection SRFI-45 - Primitives for Expressing Iterative Lazy Algorithms
@cindex SRFI-45
@@ -4851,6 +5265,13 @@ needed to get SRFI-61 itself. Extended @code{cond} is
documented in
Starting from version 2.0, Guile's @code{read} supports SRFI-62/R7RS
S-expression comments by default.
address@hidden SRFI-64
address@hidden SRFI-64 - A Scheme API for test suites.
address@hidden SRFI-64
+
+See @uref{http://srfi.schemers.org/srfi-64/srfi-64.html, the
+specification of SRFI-64}.
+
@node SRFI-67
@subsection SRFI-67 - Compare procedures
@cindex SRFI-67
@@ -5174,6 +5595,30 @@ directive @code{#!curly-infix-and-bracket-lists}. For
example:
For more information on reader options, @xref{Scheme Read}.
address@hidden SRFI-111
address@hidden SRFI-111 Boxes.
address@hidden SRFI-111
+
address@hidden://srfi.schemers.org/srfi-111/srfi-111.html, SRFI-111}
+provides boxes: objects with a single mutable cell.
+
address@hidden {Scheme Procedure} box value
+Return a newly allocated box whose contents is initialized to
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} box? obj
+Return true if @var{obj} is a box, otherwise return false.
address@hidden deffn
+
address@hidden {Scheme Procedure} unbox box
+Return the current contents of @var{box}.
address@hidden deffn
+
address@hidden {Scheme Procedure} set-box! box value
+Set the contents of @var{box} to @var{value}.
address@hidden deffn
+
@c srfi-modules.texi ends here
@c Local Variables:
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 2ba04b7..5648369 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -1,6 +1,6 @@
## DO NOT EDIT! GENERATED AUTOMATICALLY!
## Process this file with automake to produce Makefile.in.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -23,7 +23,7 @@
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local
--lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close
connect copysign dirfd duplocale environ extensions flock floor fpieee frexp
fstat full-read full-write func gendocs getaddrinfo getlogin getpeername
getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update
gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp
lib-symbol-versions lib-symbol-visibility libunistring listen localcharset
locale log1p maintainer-makefile malloc-gnu malloca nl_langinfo nproc open
pipe-posix pipe2 poll putenv recv recvfrom regex rename select send sendto
setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string
sys_stat time times trunc verify vsnprintf warnings wchar
-AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
+AUTOMAKE_OPTIONS = 1.9.6 gnits subdir-objects
SUBDIRS =
noinst_HEADERS =
@@ -69,11 +69,21 @@ libgnu_la_LDFLAGS += $(LOG1P_LIBM)
libgnu_la_LDFLAGS += $(LOG_LIBM)
libgnu_la_LDFLAGS += $(LTLIBICONV)
libgnu_la_LDFLAGS += $(LTLIBINTL)
+libgnu_la_LDFLAGS += $(LTLIBTHREAD)
libgnu_la_LDFLAGS += $(LTLIBUNISTRING)
libgnu_la_LDFLAGS += $(ROUND_LIBM)
libgnu_la_LDFLAGS += $(SERVENT_LIB)
libgnu_la_LDFLAGS += $(TRUNC_LIBM)
+## begin gnulib module absolute-header
+
+# Use this preprocessor expression to decide whether #include_next works.
+# Do not rely on a 'configure'-time test for this, since the expression
+# might appear in an installed header, which is used by some other compiler.
+HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER)
+
+## end gnulib module absolute-header
+
## begin gnulib module accept
@@ -263,7 +273,7 @@ EXTRA_libgnu_la_SOURCES += close.c
## begin gnulib module configmake
# Listed in the same order as the GNU makefile conventions, and
-# provided by autoconf 2.59c+.
+# provided by autoconf 2.59c+ or 2.70.
# The Automake-defined pkg* macros are appended, in the order
# listed in the Automake 1.10a+ documentation.
configmake.h: Makefile
@@ -279,6 +289,7 @@ configmake.h: Makefile
echo '#define SYSCONFDIR "$(sysconfdir)"'; \
echo '#define SHAREDSTATEDIR "$(sharedstatedir)"'; \
echo '#define LOCALSTATEDIR "$(localstatedir)"'; \
+ echo '#define RUNSTATEDIR "$(runstatedir)"'; \
echo '#define INCLUDEDIR "$(includedir)"'; \
echo '#define OLDINCLUDEDIR "$(oldincludedir)"'; \
echo '#define DOCDIR "$(docdir)"'; \
@@ -630,6 +641,15 @@ libgnu_la_SOURCES += gettext.h
## end gnulib module gettext-h
+## begin gnulib module gettimeofday
+
+
+EXTRA_DIST += gettimeofday.c
+
+EXTRA_libgnu_la_SOURCES += gettimeofday.c
+
+## end gnulib module gettimeofday
+
## begin gnulib module git-version-gen
@@ -1012,6 +1032,12 @@ EXTRA_libgnu_la_SOURCES += localeconv.c
## end gnulib module localeconv
+## begin gnulib module lock
+
+libgnu_la_SOURCES += glthread/lock.h glthread/lock.c
+
+## end gnulib module lock
+
## begin gnulib module log
@@ -2711,6 +2737,14 @@ EXTRA_DIST += sys_uio.in.h
## end gnulib module sys_uio
+## begin gnulib module threadlib
+
+libgnu_la_SOURCES += glthread/threadlib.c
+
+EXTRA_DIST += $(top_srcdir)/build-aux/config.rpath
+
+## end gnulib module threadlib
+
## begin gnulib module time
BUILT_SOURCES += time.h
@@ -2725,6 +2759,7 @@ time.h: time.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \
+ -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \
-e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \
-e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \
-e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \
@@ -2734,6 +2769,8 @@ time.h: time.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
-e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \
+ -e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \
+ -e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \
-e 's|@''REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \
-e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \
-e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \
@@ -2898,6 +2935,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
-e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \
+ -e 's|@''REPLACE_GETDTABLESIZE''@|$(REPLACE_GETDTABLESIZE)|g' \
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
diff --git a/lib/accept.c b/lib/accept.c
index 0c8e52e..b216c6b 100644
--- a/lib/accept.c
+++ b/lib/accept.c
@@ -1,6 +1,6 @@
/* accept.c --- wrappers for Windows accept function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/alignof.h b/lib/alignof.h
index 2bf3820..280f3e3 100644
--- a/lib/alignof.h
+++ b/lib/alignof.h
@@ -1,5 +1,5 @@
/* Determine alignment of types.
- Copyright (C) 2003-2004, 2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2004, 2006, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -41,7 +41,7 @@
- when -malign-double is specified: alignof_slot(double) = 8.
Note: The result cannot be used as a value for an 'enum' constant,
due to bugs in HP-UX 10.20 cc and AIX 3.2.5 xlc. */
-#if defined __GNUC__
+#if defined __GNUC__ || defined __IBM__ALIGNOF__
# define alignof_type __alignof__
#else
# define alignof_type alignof_slot
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index 19aea41..e3aa62d 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -1,6 +1,6 @@
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2013 Free Software Foundation,
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2014 Free Software Foundation,
Inc.
This program is free software; you can redistribute it and/or modify it
diff --git a/lib/arpa_inet.in.h b/lib/arpa_inet.in.h
index 5344a92..3f5df47 100644
--- a/lib/arpa_inet.in.h
+++ b/lib/arpa_inet.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <arpa/inet.h>.
- Copyright (C) 2005-2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/asnprintf.c b/lib/asnprintf.c
index 8c399b2..7806f68 100644
--- a/lib/asnprintf.c
+++ b/lib/asnprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 1999, 2002, 2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2002, 2006, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/basename-lgpl.c b/lib/basename-lgpl.c
index 5e89d26..fe00793 100644
--- a/lib/basename-lgpl.c
+++ b/lib/basename-lgpl.c
@@ -1,6 +1,6 @@
/* basename.c -- return the last element in a file name
- Copyright (C) 1990, 1998-2001, 2003-2006, 2009-2013 Free Software
+ Copyright (C) 1990, 1998-2001, 2003-2006, 2009-2014 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/binary-io.h b/lib/binary-io.h
index b2095a2..c276faa 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -1,5 +1,5 @@
/* Binary mode I/O.
- Copyright (C) 2001, 2003, 2005, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2003, 2005, 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -25,6 +25,9 @@
so we include it here first. */
#include <stdio.h>
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef BINARY_IO_INLINE
# define BINARY_IO_INLINE _GL_INLINE
diff --git a/lib/bind.c b/lib/bind.c
index e26f88e..36750c9 100644
--- a/lib/bind.c
+++ b/lib/bind.c
@@ -1,6 +1,6 @@
/* bind.c --- wrappers for Windows bind function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/btowc.c b/lib/btowc.c
index aca5742..aad27f5 100644
--- a/lib/btowc.c
+++ b/lib/btowc.c
@@ -1,5 +1,5 @@
/* Convert unibyte character to wide character.
- Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
index 6c7ab6d..130c79d 100644
--- a/lib/byteswap.in.h
+++ b/lib/byteswap.in.h
@@ -1,5 +1,5 @@
/* byteswap.h - Byte swapping
- Copyright (C) 2005, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-2014 Free Software Foundation, Inc.
Written by Oskar Liljeblad <address@hidden>, 2005.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/c-ctype.c b/lib/c-ctype.c
index ccd8d94..7fe3f7e 100644
--- a/lib/c-ctype.c
+++ b/lib/c-ctype.c
@@ -1,6 +1,6 @@
/* Character handling in C locale.
- Copyright 2000-2003, 2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright 2000-2003, 2006, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index 64bae06..a258019 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -5,7 +5,7 @@
<ctype.h> functions' behaviour depends on the current locale set via
setlocale.
- Copyright (C) 2000-2003, 2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2003, 2006, 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -136,7 +136,8 @@ extern int c_tolower (int c) _GL_ATTRIBUTE_CONST;
extern int c_toupper (int c) _GL_ATTRIBUTE_CONST;
-#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ &&
!defined NO_C_CTYPE_MACROS
+#if (defined __GNUC__ && !defined __STRICT_ANSI__ && defined __OPTIMIZE__ \
+ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS)
/* ASCII optimizations. */
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
index e484aa8..ee3bd3f 100644
--- a/lib/c-strcase.h
+++ b/lib/c-strcase.h
@@ -1,5 +1,5 @@
/* Case-insensitive string comparison functions in C locale.
- Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2013 Free Software
+ Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
index 765b25a..5059cc6 100644
--- a/lib/c-strcasecmp.c
+++ b/lib/c-strcasecmp.c
@@ -1,5 +1,5 @@
/* c-strcasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/c-strcaseeq.h b/lib/c-strcaseeq.h
index 53ce1e1..44d3751 100644
--- a/lib/c-strcaseeq.h
+++ b/lib/c-strcaseeq.h
@@ -1,5 +1,5 @@
/* Optimized case-insensitive string comparison in C locale.
- Copyright (C) 2001-2002, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
index ad5f4f6..6145981 100644
--- a/lib/c-strncasecmp.c
+++ b/lib/c-strncasecmp.c
@@ -1,5 +1,5 @@
/* c-strncasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index 5451791..a999c9c 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -1,5 +1,5 @@
/* Return the canonical absolute name of a given file.
- Copyright (C) 1996-2013 Free Software Foundation, Inc.
+ Copyright (C) 1996-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/ceil.c b/lib/ceil.c
index 3a264ae..7e81035 100644
--- a/lib/ceil.c
+++ b/lib/ceil.c
@@ -1,5 +1,5 @@
/* Round towards positive infinity.
- Copyright (C) 2007, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/close.c b/lib/close.c
index 02ff0b1..9d2e027 100644
--- a/lib/close.c
+++ b/lib/close.c
@@ -1,5 +1,5 @@
/* close replacement.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/config.charset b/lib/config.charset
index f15f5bb..8fe2507 100644
--- a/lib/config.charset
+++ b/lib/config.charset
@@ -1,7 +1,7 @@
#! /bin/sh
# Output a system dependent table of character encoding aliases.
#
-# Copyright (C) 2000-2004, 2006-2013 Free Software Foundation, Inc.
+# Copyright (C) 2000-2004, 2006-2014 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/connect.c b/lib/connect.c
index 03746f8..295fe95 100644
--- a/lib/connect.c
+++ b/lib/connect.c
@@ -1,6 +1,6 @@
/* connect.c --- wrappers for Windows connect function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/copysign.c b/lib/copysign.c
index 61efeb8..616ea35 100644
--- a/lib/copysign.c
+++ b/lib/copysign.c
@@ -1,5 +1,5 @@
/* Copy sign into another 'double' number.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index aff6af3..3418bd9 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -1,5 +1,5 @@
/* A GNU-like <dirent.h>.
- Copyright (C) 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/dirfd.c b/lib/dirfd.c
index c535b17..86f8e0a 100644
--- a/lib/dirfd.c
+++ b/lib/dirfd.c
@@ -1,6 +1,6 @@
/* dirfd.c -- return the file descriptor associated with an open DIR*
- Copyright (C) 2001, 2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2006, 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/dirname-lgpl.c b/lib/dirname-lgpl.c
index 90597ac..121d387 100644
--- a/lib/dirname-lgpl.c
+++ b/lib/dirname-lgpl.c
@@ -1,6 +1,6 @@
/* dirname.c -- return all but the last element in a file name
- Copyright (C) 1990, 1998, 2000-2001, 2003-2006, 2009-2013 Free Software
+ Copyright (C) 1990, 1998, 2000-2001, 2003-2006, 2009-2014 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/dirname.h b/lib/dirname.h
index 4b5acd9..e31cb61 100644
--- a/lib/dirname.h
+++ b/lib/dirname.h
@@ -1,6 +1,6 @@
/* Take file names apart into directory and base names.
- Copyright (C) 1998, 2001, 2003-2006, 2009-2013 Free Software Foundation,
+ Copyright (C) 1998, 2001, 2003-2006, 2009-2014 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/dosname.h b/lib/dosname.h
index 82d62e5..b81163d 100644
--- a/lib/dosname.h
+++ b/lib/dosname.h
@@ -1,6 +1,6 @@
/* File names on MS-DOS/Windows systems.
- Copyright (C) 2000-2001, 2004-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2004-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/dup2.c b/lib/dup2.c
index 89b40c4..9709b7a 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -1,6 +1,6 @@
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2004-2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -96,7 +96,11 @@ rpl_dup2 (int fd, int desired_fd)
/* On Linux kernels 2.6.26-2.6.29, dup2 (fd, fd) returns -EBADF.
On Cygwin 1.5.x, dup2 (1, 1) returns 0.
On Cygwin 1.7.17, dup2 (1, -1) dumps core.
+ On Cygwin 1.7.25, dup2 (1, 256) can dump core.
On Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */
+# if HAVE_SETDTABLESIZE
+ setdtablesize (desired_fd + 1);
+# endif
if (desired_fd < 0)
fd = desired_fd;
if (fd == desired_fd)
diff --git a/lib/duplocale.c b/lib/duplocale.c
index 5a291b9..86d5ce5 100644
--- a/lib/duplocale.c
+++ b/lib/duplocale.c
@@ -1,5 +1,5 @@
/* Duplicate a locale object.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/errno.in.h b/lib/errno.in.h
index f2295cd..8dbb5f9 100644
--- a/lib/errno.in.h
+++ b/lib/errno.in.h
@@ -1,6 +1,6 @@
/* A POSIX-like <errno.h>.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
index f71ce2f..1cd1970 100644
--- a/lib/fcntl.in.h
+++ b/lib/fcntl.in.h
@@ -1,6 +1,6 @@
/* Like <fcntl.h>, but with non-working flags defined to 0.
- Copyright (C) 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/fd-hook.c b/lib/fd-hook.c
index cafd91c..fd07578 100644
--- a/lib/fd-hook.c
+++ b/lib/fd-hook.c
@@ -1,5 +1,5 @@
/* Hook for making making file descriptor functions close(), ioctl()
extensible.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2009.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/fd-hook.h b/lib/fd-hook.h
index 397dbb0..5ff0f73 100644
--- a/lib/fd-hook.h
+++ b/lib/fd-hook.h
@@ -1,5 +1,5 @@
/* Hook for making making file descriptor functions close(), ioctl()
extensible.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
diff --git a/lib/float+.h b/lib/float+.h
index 1bd368c..085c379 100644
--- a/lib/float+.h
+++ b/lib/float+.h
@@ -1,5 +1,5 @@
/* Supplemental information about the floating-point formats.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2007.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/float.c b/lib/float.c
index 37b0b49..3faa5ee 100644
--- a/lib/float.c
+++ b/lib/float.c
@@ -1,5 +1,5 @@
/* Auxiliary definitions for <float.h>.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/float.in.h b/lib/float.in.h
index 40875a2..e814eab 100644
--- a/lib/float.in.h
+++ b/lib/float.in.h
@@ -1,6 +1,6 @@
/* A correct <float.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/flock.c b/lib/flock.c
index f15fe12..928e151 100644
--- a/lib/flock.c
+++ b/lib/flock.c
@@ -6,7 +6,7 @@
Written by Richard W.M. Jones <rjones.at.redhat.com>
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 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/lib/floor.c b/lib/floor.c
index 3dca6f5..a00f937 100644
--- a/lib/floor.c
+++ b/lib/floor.c
@@ -1,5 +1,5 @@
/* Round towards negative infinity.
- Copyright (C) 2007, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/frexp.c b/lib/frexp.c
index eb2b379..6eff945 100644
--- a/lib/frexp.c
+++ b/lib/frexp.c
@@ -1,5 +1,5 @@
/* Split a double into fraction and mantissa.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/fstat.c b/lib/fstat.c
index 121f4bf..17ccc8e 100644
--- a/lib/fstat.c
+++ b/lib/fstat.c
@@ -1,5 +1,5 @@
/* fstat() replacement.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/full-read.c b/lib/full-read.c
index f884bb6..4d67afb 100644
--- a/lib/full-read.c
+++ b/lib/full-read.c
@@ -1,5 +1,5 @@
/* An interface to read that retries after partial reads and interrupts.
- Copyright (C) 2002-2003, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/full-read.h b/lib/full-read.h
index 81f6edf..954b94d 100644
--- a/lib/full-read.h
+++ b/lib/full-read.h
@@ -1,6 +1,6 @@
/* An interface to read() that reads all it is asked to read.
- Copyright (C) 2002, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/full-write.c b/lib/full-write.c
index 8f30798..6a77b7b 100644
--- a/lib/full-write.c
+++ b/lib/full-write.c
@@ -1,6 +1,6 @@
/* An interface to read and write that retries (if necessary) until complete.
- Copyright (C) 1993-1994, 1997-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 1997-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/full-write.h b/lib/full-write.h
index cb05bff..2fab6fa 100644
--- a/lib/full-write.h
+++ b/lib/full-write.h
@@ -1,6 +1,6 @@
/* An interface to write() that writes all it is asked to write.
- Copyright (C) 2002-2003, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/gai_strerror.c b/lib/gai_strerror.c
index 0205a78..d0c589d 100644
--- a/lib/gai_strerror.c
+++ b/lib/gai_strerror.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1997, 2001-2002, 2004-2006, 2008-2013 Free Software
+/* Copyright (C) 1997, 2001-2002, 2004-2006, 2008-2014 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Philip Blundell <address@hidden>, 1997.
diff --git a/lib/getaddrinfo.c b/lib/getaddrinfo.c
index 9b0297c..6581dd5 100644
--- a/lib/getaddrinfo.c
+++ b/lib/getaddrinfo.c
@@ -1,5 +1,5 @@
/* Get address information (partial implementation).
- Copyright (C) 1997, 2001-2002, 2004-2013 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2002, 2004-2014 Free Software Foundation, Inc.
Contributed by Simon Josefsson <address@hidden>.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/getlogin.c b/lib/getlogin.c
index ebe7c33..f8cfe5d 100644
--- a/lib/getlogin.c
+++ b/lib/getlogin.c
@@ -1,6 +1,6 @@
/* Provide a working getlogin for systems which lack it.
- Copyright (C) 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/getpeername.c b/lib/getpeername.c
index 307c9e2..e5b3eae 100644
--- a/lib/getpeername.c
+++ b/lib/getpeername.c
@@ -1,6 +1,6 @@
/* getpeername.c --- wrappers for Windows getpeername function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/getsockname.c b/lib/getsockname.c
index daac0c0..d26bae5 100644
--- a/lib/getsockname.c
+++ b/lib/getsockname.c
@@ -1,6 +1,6 @@
/* getsockname.c --- wrappers for Windows getsockname function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/getsockopt.c b/lib/getsockopt.c
index c80487f..0b2fb2b 100644
--- a/lib/getsockopt.c
+++ b/lib/getsockopt.c
@@ -1,6 +1,6 @@
/* getsockopt.c --- wrappers for Windows getsockopt function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/gettext.h b/lib/gettext.h
index 2cc0e05..330d8da 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -1,5 +1,5 @@
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2013 Free Software
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
new file mode 100644
index 0000000..c4e40fb
--- /dev/null
+++ b/lib/gettimeofday.c
@@ -0,0 +1,154 @@
+/* Provide gettimeofday for systems that don't have it or for which it's
broken.
+
+ Copyright (C) 2001-2003, 2005-2007, 2009-2014 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+/* Specification. */
+#include <sys/time.h>
+
+#include <time.h>
+
+#if HAVE_SYS_TIMEB_H
+# include <sys/timeb.h>
+#endif
+
+#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME
+
+/* Work around the bug in some systems whereby gettimeofday clobbers
+ the static buffer that localtime uses for its return value. The
+ gettimeofday function from Mac OS X 10.0.4 (i.e., Darwin 1.3.7) has
+ this problem. The tzset replacement is necessary for at least
+ Solaris 2.5, 2.5.1, and 2.6. */
+
+static struct tm tm_zero_buffer;
+static struct tm *localtime_buffer_addr = &tm_zero_buffer;
+
+# undef localtime
+extern struct tm *localtime (time_t const *);
+
+# undef gmtime
+extern struct tm *gmtime (time_t const *);
+
+/* This is a wrapper for localtime. It is used only on systems for which
+ gettimeofday clobbers the static buffer used for localtime's result.
+
+ On the first call, record the address of the static buffer that
+ localtime uses for its result. */
+
+struct tm *
+rpl_localtime (time_t const *timep)
+{
+ struct tm *tm = localtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+/* Same as above, since gmtime and localtime use the same buffer. */
+struct tm *
+rpl_gmtime (time_t const *timep)
+{
+ struct tm *tm = gmtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+#endif /* GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME */
+
+#if TZSET_CLOBBERS_LOCALTIME
+
+# undef tzset
+extern void tzset (void);
+
+/* This is a wrapper for tzset, for systems on which tzset may clobber
+ the static buffer used for localtime's result. */
+void
+rpl_tzset (void)
+{
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to tzset. */
+ struct tm save = *localtime_buffer_addr;
+ tzset ();
+ *localtime_buffer_addr = save;
+}
+#endif
+
+/* This is a wrapper for gettimeofday. It is used only on systems
+ that lack this function, or whose implementation of this function
+ causes problems. */
+
+int
+gettimeofday (struct timeval *restrict tv, void *restrict tz)
+{
+#undef gettimeofday
+#if HAVE_GETTIMEOFDAY
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to gettimeofday. */
+ struct tm save = *localtime_buffer_addr;
+# endif
+
+# if defined timeval /* 'struct timeval' overridden by gnulib? */
+# undef timeval
+ struct timeval otv;
+ int result = gettimeofday (&otv, (struct timezone *) tz);
+ if (result == 0)
+ {
+ tv->tv_sec = otv.tv_sec;
+ tv->tv_usec = otv.tv_usec;
+ }
+# else
+ int result = gettimeofday (tv, (struct timezone *) tz);
+# endif
+
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ *localtime_buffer_addr = save;
+# endif
+
+ return result;
+
+#else
+
+# if HAVE__FTIME
+
+ struct _timeb timebuf;
+ _ftime (&timebuf);
+ tv->tv_sec = timebuf.time;
+ tv->tv_usec = timebuf.millitm * 1000;
+
+# else
+
+# if !defined OK_TO_USE_1S_CLOCK
+# error "Only 1-second nominal clock resolution found. Is that intended?" \
+ "If so, compile with the -DOK_TO_USE_1S_CLOCK option."
+# endif
+ tv->tv_sec = time (NULL);
+ tv->tv_usec = 0;
+
+# endif
+
+ return 0;
+
+#endif
+}
diff --git a/lib/glthread/lock.c b/lib/glthread/lock.c
new file mode 100644
index 0000000..0454cc2
--- /dev/null
+++ b/lib/glthread/lock.c
@@ -0,0 +1,1057 @@
+/* Locking in multithreaded situations.
+ Copyright (C) 2005-2014 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Bruno Haible <address@hidden>, 2005.
+ Based on GCC's gthr-posix.h, gthr-posix95.h, gthr-solaris.h,
+ gthr-win32.h. */
+
+#include <config.h>
+
+#include "glthread/lock.h"
+
+/* ========================================================================= */
+
+#if USE_POSIX_THREADS
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+# if HAVE_PTHREAD_RWLOCK
+
+# if !defined PTHREAD_RWLOCK_INITIALIZER
+
+int
+glthread_rwlock_init_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_rwlock_init (&lock->rwlock, NULL);
+ if (err != 0)
+ return err;
+ lock->initialized = 1;
+ return 0;
+}
+
+int
+glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock)
+{
+ if (!lock->initialized)
+ {
+ int err;
+
+ err = pthread_mutex_lock (&lock->guard);
+ if (err != 0)
+ return err;
+ if (!lock->initialized)
+ {
+ err = glthread_rwlock_init_multithreaded (lock);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->guard);
+ return err;
+ }
+ }
+ err = pthread_mutex_unlock (&lock->guard);
+ if (err != 0)
+ return err;
+ }
+ return pthread_rwlock_rdlock (&lock->rwlock);
+}
+
+int
+glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock)
+{
+ if (!lock->initialized)
+ {
+ int err;
+
+ err = pthread_mutex_lock (&lock->guard);
+ if (err != 0)
+ return err;
+ if (!lock->initialized)
+ {
+ err = glthread_rwlock_init_multithreaded (lock);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->guard);
+ return err;
+ }
+ }
+ err = pthread_mutex_unlock (&lock->guard);
+ if (err != 0)
+ return err;
+ }
+ return pthread_rwlock_wrlock (&lock->rwlock);
+}
+
+int
+glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock)
+{
+ if (!lock->initialized)
+ return EINVAL;
+ return pthread_rwlock_unlock (&lock->rwlock);
+}
+
+int
+glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ if (!lock->initialized)
+ return EINVAL;
+ err = pthread_rwlock_destroy (&lock->rwlock);
+ if (err != 0)
+ return err;
+ lock->initialized = 0;
+ return 0;
+}
+
+# endif
+
+# else
+
+int
+glthread_rwlock_init_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_init (&lock->lock, NULL);
+ if (err != 0)
+ return err;
+ err = pthread_cond_init (&lock->waiting_readers, NULL);
+ if (err != 0)
+ return err;
+ err = pthread_cond_init (&lock->waiting_writers, NULL);
+ if (err != 0)
+ return err;
+ lock->waiting_writers_count = 0;
+ lock->runcount = 0;
+ return 0;
+}
+
+int
+glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_lock (&lock->lock);
+ if (err != 0)
+ return err;
+ /* Test whether only readers are currently running, and whether the runcount
+ field will not overflow. */
+ /* POSIX says: "It is implementation-defined whether the calling thread
+ acquires the lock when a writer does not hold the lock and there are
+ writers blocked on the lock." Let's say, no: give the writers a higher
+ priority. */
+ while (!(lock->runcount + 1 > 0 && lock->waiting_writers_count == 0))
+ {
+ /* This thread has to wait for a while. Enqueue it among the
+ waiting_readers. */
+ err = pthread_cond_wait (&lock->waiting_readers, &lock->lock);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->lock);
+ return err;
+ }
+ }
+ lock->runcount++;
+ return pthread_mutex_unlock (&lock->lock);
+}
+
+int
+glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_lock (&lock->lock);
+ if (err != 0)
+ return err;
+ /* Test whether no readers or writers are currently running. */
+ while (!(lock->runcount == 0))
+ {
+ /* This thread has to wait for a while. Enqueue it among the
+ waiting_writers. */
+ lock->waiting_writers_count++;
+ err = pthread_cond_wait (&lock->waiting_writers, &lock->lock);
+ if (err != 0)
+ {
+ lock->waiting_writers_count--;
+ pthread_mutex_unlock (&lock->lock);
+ return err;
+ }
+ lock->waiting_writers_count--;
+ }
+ lock->runcount--; /* runcount becomes -1 */
+ return pthread_mutex_unlock (&lock->lock);
+}
+
+int
+glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_lock (&lock->lock);
+ if (err != 0)
+ return err;
+ if (lock->runcount < 0)
+ {
+ /* Drop a writer lock. */
+ if (!(lock->runcount == -1))
+ {
+ pthread_mutex_unlock (&lock->lock);
+ return EINVAL;
+ }
+ lock->runcount = 0;
+ }
+ else
+ {
+ /* Drop a reader lock. */
+ if (!(lock->runcount > 0))
+ {
+ pthread_mutex_unlock (&lock->lock);
+ return EINVAL;
+ }
+ lock->runcount--;
+ }
+ if (lock->runcount == 0)
+ {
+ /* POSIX recommends that "write locks shall take precedence over read
+ locks", to avoid "writer starvation". */
+ if (lock->waiting_writers_count > 0)
+ {
+ /* Wake up one of the waiting writers. */
+ err = pthread_cond_signal (&lock->waiting_writers);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->lock);
+ return err;
+ }
+ }
+ else
+ {
+ /* Wake up all waiting readers. */
+ err = pthread_cond_broadcast (&lock->waiting_readers);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->lock);
+ return err;
+ }
+ }
+ }
+ return pthread_mutex_unlock (&lock->lock);
+}
+
+int
+glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_destroy (&lock->lock);
+ if (err != 0)
+ return err;
+ err = pthread_cond_destroy (&lock->waiting_readers);
+ if (err != 0)
+ return err;
+ err = pthread_cond_destroy (&lock->waiting_writers);
+ if (err != 0)
+ return err;
+ return 0;
+}
+
+# endif
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+# if HAVE_PTHREAD_MUTEX_RECURSIVE
+
+# if defined PTHREAD_RECURSIVE_MUTEX_INITIALIZER || defined
PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP
+
+int
+glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock)
+{
+ pthread_mutexattr_t attributes;
+ int err;
+
+ err = pthread_mutexattr_init (&attributes);
+ if (err != 0)
+ return err;
+ err = pthread_mutexattr_settype (&attributes, PTHREAD_MUTEX_RECURSIVE);
+ if (err != 0)
+ {
+ pthread_mutexattr_destroy (&attributes);
+ return err;
+ }
+ err = pthread_mutex_init (lock, &attributes);
+ if (err != 0)
+ {
+ pthread_mutexattr_destroy (&attributes);
+ return err;
+ }
+ err = pthread_mutexattr_destroy (&attributes);
+ if (err != 0)
+ return err;
+ return 0;
+}
+
+# else
+
+int
+glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock)
+{
+ pthread_mutexattr_t attributes;
+ int err;
+
+ err = pthread_mutexattr_init (&attributes);
+ if (err != 0)
+ return err;
+ err = pthread_mutexattr_settype (&attributes, PTHREAD_MUTEX_RECURSIVE);
+ if (err != 0)
+ {
+ pthread_mutexattr_destroy (&attributes);
+ return err;
+ }
+ err = pthread_mutex_init (&lock->recmutex, &attributes);
+ if (err != 0)
+ {
+ pthread_mutexattr_destroy (&attributes);
+ return err;
+ }
+ err = pthread_mutexattr_destroy (&attributes);
+ if (err != 0)
+ return err;
+ lock->initialized = 1;
+ return 0;
+}
+
+int
+glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (!lock->initialized)
+ {
+ int err;
+
+ err = pthread_mutex_lock (&lock->guard);
+ if (err != 0)
+ return err;
+ if (!lock->initialized)
+ {
+ err = glthread_recursive_lock_init_multithreaded (lock);
+ if (err != 0)
+ {
+ pthread_mutex_unlock (&lock->guard);
+ return err;
+ }
+ }
+ err = pthread_mutex_unlock (&lock->guard);
+ if (err != 0)
+ return err;
+ }
+ return pthread_mutex_lock (&lock->recmutex);
+}
+
+int
+glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (!lock->initialized)
+ return EINVAL;
+ return pthread_mutex_unlock (&lock->recmutex);
+}
+
+int
+glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock)
+{
+ int err;
+
+ if (!lock->initialized)
+ return EINVAL;
+ err = pthread_mutex_destroy (&lock->recmutex);
+ if (err != 0)
+ return err;
+ lock->initialized = 0;
+ return 0;
+}
+
+# endif
+
+# else
+
+int
+glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock)
+{
+ int err;
+
+ err = pthread_mutex_init (&lock->mutex, NULL);
+ if (err != 0)
+ return err;
+ lock->owner = (pthread_t) 0;
+ lock->depth = 0;
+ return 0;
+}
+
+int
+glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock)
+{
+ pthread_t self = pthread_self ();
+ if (lock->owner != self)
+ {
+ int err;
+
+ err = pthread_mutex_lock (&lock->mutex);
+ if (err != 0)
+ return err;
+ lock->owner = self;
+ }
+ if (++(lock->depth) == 0) /* wraparound? */
+ {
+ lock->depth--;
+ return EAGAIN;
+ }
+ return 0;
+}
+
+int
+glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != pthread_self ())
+ return EPERM;
+ if (lock->depth == 0)
+ return EINVAL;
+ if (--(lock->depth) == 0)
+ {
+ lock->owner = (pthread_t) 0;
+ return pthread_mutex_unlock (&lock->mutex);
+ }
+ else
+ return 0;
+}
+
+int
+glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != (pthread_t) 0)
+ return EBUSY;
+ return pthread_mutex_destroy (&lock->mutex);
+}
+
+# endif
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+static const pthread_once_t fresh_once = PTHREAD_ONCE_INIT;
+
+int
+glthread_once_singlethreaded (pthread_once_t *once_control)
+{
+ /* We don't know whether pthread_once_t is an integer type, a floating-point
+ type, a pointer type, or a structure type. */
+ char *firstbyte = (char *)once_control;
+ if (*firstbyte == *(const char *)&fresh_once)
+ {
+ /* First time use of once_control. Invert the first byte. */
+ *firstbyte = ~ *(const char *)&fresh_once;
+ return 1;
+ }
+ else
+ return 0;
+}
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_PTH_THREADS
+
+/* Use the GNU Pth threads library. */
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+static void
+glthread_once_call (void *arg)
+{
+ void (**gl_once_temp_addr) (void) = (void (**) (void)) arg;
+ void (*initfunction) (void) = *gl_once_temp_addr;
+ initfunction ();
+}
+
+int
+glthread_once_multithreaded (pth_once_t *once_control, void (*initfunction)
(void))
+{
+ void (*temp) (void) = initfunction;
+ return (!pth_once (once_control, glthread_once_call, &temp) ? errno : 0);
+}
+
+int
+glthread_once_singlethreaded (pth_once_t *once_control)
+{
+ /* We know that pth_once_t is an integer type. */
+ if (*once_control == PTH_ONCE_INIT)
+ {
+ /* First time use of once_control. Invert the marker. */
+ *once_control = ~ PTH_ONCE_INIT;
+ return 1;
+ }
+ else
+ return 0;
+}
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_SOLARIS_THREADS
+
+/* Use the old Solaris threads library. */
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+int
+glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock)
+{
+ int err;
+
+ err = mutex_init (&lock->mutex, USYNC_THREAD, NULL);
+ if (err != 0)
+ return err;
+ lock->owner = (thread_t) 0;
+ lock->depth = 0;
+ return 0;
+}
+
+int
+glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock)
+{
+ thread_t self = thr_self ();
+ if (lock->owner != self)
+ {
+ int err;
+
+ err = mutex_lock (&lock->mutex);
+ if (err != 0)
+ return err;
+ lock->owner = self;
+ }
+ if (++(lock->depth) == 0) /* wraparound? */
+ {
+ lock->depth--;
+ return EAGAIN;
+ }
+ return 0;
+}
+
+int
+glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != thr_self ())
+ return EPERM;
+ if (lock->depth == 0)
+ return EINVAL;
+ if (--(lock->depth) == 0)
+ {
+ lock->owner = (thread_t) 0;
+ return mutex_unlock (&lock->mutex);
+ }
+ else
+ return 0;
+}
+
+int
+glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != (thread_t) 0)
+ return EBUSY;
+ return mutex_destroy (&lock->mutex);
+}
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+int
+glthread_once_multithreaded (gl_once_t *once_control, void (*initfunction)
(void))
+{
+ if (!once_control->inited)
+ {
+ int err;
+
+ /* Use the mutex to guarantee that if another thread is already calling
+ the initfunction, this thread waits until it's finished. */
+ err = mutex_lock (&once_control->mutex);
+ if (err != 0)
+ return err;
+ if (!once_control->inited)
+ {
+ once_control->inited = 1;
+ initfunction ();
+ }
+ return mutex_unlock (&once_control->mutex);
+ }
+ else
+ return 0;
+}
+
+int
+glthread_once_singlethreaded (gl_once_t *once_control)
+{
+ /* We know that gl_once_t contains an integer type. */
+ if (!once_control->inited)
+ {
+ /* First time use of once_control. Invert the marker. */
+ once_control->inited = ~ 0;
+ return 1;
+ }
+ else
+ return 0;
+}
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_WINDOWS_THREADS
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+void
+glthread_lock_init_func (gl_lock_t *lock)
+{
+ InitializeCriticalSection (&lock->lock);
+ lock->guard.done = 1;
+}
+
+int
+glthread_lock_lock_func (gl_lock_t *lock)
+{
+ if (!lock->guard.done)
+ {
+ if (InterlockedIncrement (&lock->guard.started) == 0)
+ /* This thread is the first one to need this lock. Initialize it. */
+ glthread_lock_init (lock);
+ else
+ /* Yield the CPU while waiting for another thread to finish
+ initializing this lock. */
+ while (!lock->guard.done)
+ Sleep (0);
+ }
+ EnterCriticalSection (&lock->lock);
+ return 0;
+}
+
+int
+glthread_lock_unlock_func (gl_lock_t *lock)
+{
+ if (!lock->guard.done)
+ return EINVAL;
+ LeaveCriticalSection (&lock->lock);
+ return 0;
+}
+
+int
+glthread_lock_destroy_func (gl_lock_t *lock)
+{
+ if (!lock->guard.done)
+ return EINVAL;
+ DeleteCriticalSection (&lock->lock);
+ lock->guard.done = 0;
+ return 0;
+}
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+/* In this file, the waitqueues are implemented as circular arrays. */
+#define gl_waitqueue_t gl_carray_waitqueue_t
+
+static void
+gl_waitqueue_init (gl_waitqueue_t *wq)
+{
+ wq->array = NULL;
+ wq->count = 0;
+ wq->alloc = 0;
+ wq->offset = 0;
+}
+
+/* Enqueues the current thread, represented by an event, in a wait queue.
+ Returns INVALID_HANDLE_VALUE if an allocation failure occurs. */
+static HANDLE
+gl_waitqueue_add (gl_waitqueue_t *wq)
+{
+ HANDLE event;
+ unsigned int index;
+
+ if (wq->count == wq->alloc)
+ {
+ unsigned int new_alloc = 2 * wq->alloc + 1;
+ HANDLE *new_array =
+ (HANDLE *) realloc (wq->array, new_alloc * sizeof (HANDLE));
+ if (new_array == NULL)
+ /* No more memory. */
+ return INVALID_HANDLE_VALUE;
+ /* Now is a good opportunity to rotate the array so that its contents
+ starts at offset 0. */
+ if (wq->offset > 0)
+ {
+ unsigned int old_count = wq->count;
+ unsigned int old_alloc = wq->alloc;
+ unsigned int old_offset = wq->offset;
+ unsigned int i;
+ if (old_offset + old_count > old_alloc)
+ {
+ unsigned int limit = old_offset + old_count - old_alloc;
+ for (i = 0; i < limit; i++)
+ new_array[old_alloc + i] = new_array[i];
+ }
+ for (i = 0; i < old_count; i++)
+ new_array[i] = new_array[old_offset + i];
+ wq->offset = 0;
+ }
+ wq->array = new_array;
+ wq->alloc = new_alloc;
+ }
+ /* Whether the created event is a manual-reset one or an auto-reset one,
+ does not matter, since we will wait on it only once. */
+ event = CreateEvent (NULL, TRUE, FALSE, NULL);
+ if (event == INVALID_HANDLE_VALUE)
+ /* No way to allocate an event. */
+ return INVALID_HANDLE_VALUE;
+ index = wq->offset + wq->count;
+ if (index >= wq->alloc)
+ index -= wq->alloc;
+ wq->array[index] = event;
+ wq->count++;
+ return event;
+}
+
+/* Notifies the first thread from a wait queue and dequeues it. */
+static void
+gl_waitqueue_notify_first (gl_waitqueue_t *wq)
+{
+ SetEvent (wq->array[wq->offset + 0]);
+ wq->offset++;
+ wq->count--;
+ if (wq->count == 0 || wq->offset == wq->alloc)
+ wq->offset = 0;
+}
+
+/* Notifies all threads from a wait queue and dequeues them all. */
+static void
+gl_waitqueue_notify_all (gl_waitqueue_t *wq)
+{
+ unsigned int i;
+
+ for (i = 0; i < wq->count; i++)
+ {
+ unsigned int index = wq->offset + i;
+ if (index >= wq->alloc)
+ index -= wq->alloc;
+ SetEvent (wq->array[index]);
+ }
+ wq->count = 0;
+ wq->offset = 0;
+}
+
+void
+glthread_rwlock_init_func (gl_rwlock_t *lock)
+{
+ InitializeCriticalSection (&lock->lock);
+ gl_waitqueue_init (&lock->waiting_readers);
+ gl_waitqueue_init (&lock->waiting_writers);
+ lock->runcount = 0;
+ lock->guard.done = 1;
+}
+
+int
+glthread_rwlock_rdlock_func (gl_rwlock_t *lock)
+{
+ if (!lock->guard.done)
+ {
+ if (InterlockedIncrement (&lock->guard.started) == 0)
+ /* This thread is the first one to need this lock. Initialize it. */
+ glthread_rwlock_init (lock);
+ else
+ /* Yield the CPU while waiting for another thread to finish
+ initializing this lock. */
+ while (!lock->guard.done)
+ Sleep (0);
+ }
+ EnterCriticalSection (&lock->lock);
+ /* Test whether only readers are currently running, and whether the runcount
+ field will not overflow. */
+ if (!(lock->runcount + 1 > 0))
+ {
+ /* This thread has to wait for a while. Enqueue it among the
+ waiting_readers. */
+ HANDLE event = gl_waitqueue_add (&lock->waiting_readers);
+ if (event != INVALID_HANDLE_VALUE)
+ {
+ DWORD result;
+ LeaveCriticalSection (&lock->lock);
+ /* Wait until another thread signals this event. */
+ result = WaitForSingleObject (event, INFINITE);
+ if (result == WAIT_FAILED || result == WAIT_TIMEOUT)
+ abort ();
+ CloseHandle (event);
+ /* The thread which signalled the event already did the bookkeeping:
+ removed us from the waiting_readers, incremented lock->runcount.
*/
+ if (!(lock->runcount > 0))
+ abort ();
+ return 0;
+ }
+ else
+ {
+ /* Allocation failure. Weird. */
+ do
+ {
+ LeaveCriticalSection (&lock->lock);
+ Sleep (1);
+ EnterCriticalSection (&lock->lock);
+ }
+ while (!(lock->runcount + 1 > 0));
+ }
+ }
+ lock->runcount++;
+ LeaveCriticalSection (&lock->lock);
+ return 0;
+}
+
+int
+glthread_rwlock_wrlock_func (gl_rwlock_t *lock)
+{
+ if (!lock->guard.done)
+ {
+ if (InterlockedIncrement (&lock->guard.started) == 0)
+ /* This thread is the first one to need this lock. Initialize it. */
+ glthread_rwlock_init (lock);
+ else
+ /* Yield the CPU while waiting for another thread to finish
+ initializing this lock. */
+ while (!lock->guard.done)
+ Sleep (0);
+ }
+ EnterCriticalSection (&lock->lock);
+ /* Test whether no readers or writers are currently running. */
+ if (!(lock->runcount == 0))
+ {
+ /* This thread has to wait for a while. Enqueue it among the
+ waiting_writers. */
+ HANDLE event = gl_waitqueue_add (&lock->waiting_writers);
+ if (event != INVALID_HANDLE_VALUE)
+ {
+ DWORD result;
+ LeaveCriticalSection (&lock->lock);
+ /* Wait until another thread signals this event. */
+ result = WaitForSingleObject (event, INFINITE);
+ if (result == WAIT_FAILED || result == WAIT_TIMEOUT)
+ abort ();
+ CloseHandle (event);
+ /* The thread which signalled the event already did the bookkeeping:
+ removed us from the waiting_writers, set lock->runcount = -1. */
+ if (!(lock->runcount == -1))
+ abort ();
+ return 0;
+ }
+ else
+ {
+ /* Allocation failure. Weird. */
+ do
+ {
+ LeaveCriticalSection (&lock->lock);
+ Sleep (1);
+ EnterCriticalSection (&lock->lock);
+ }
+ while (!(lock->runcount == 0));
+ }
+ }
+ lock->runcount--; /* runcount becomes -1 */
+ LeaveCriticalSection (&lock->lock);
+ return 0;
+}
+
+int
+glthread_rwlock_unlock_func (gl_rwlock_t *lock)
+{
+ if (!lock->guard.done)
+ return EINVAL;
+ EnterCriticalSection (&lock->lock);
+ if (lock->runcount < 0)
+ {
+ /* Drop a writer lock. */
+ if (!(lock->runcount == -1))
+ abort ();
+ lock->runcount = 0;
+ }
+ else
+ {
+ /* Drop a reader lock. */
+ if (!(lock->runcount > 0))
+ {
+ LeaveCriticalSection (&lock->lock);
+ return EPERM;
+ }
+ lock->runcount--;
+ }
+ if (lock->runcount == 0)
+ {
+ /* POSIX recommends that "write locks shall take precedence over read
+ locks", to avoid "writer starvation". */
+ if (lock->waiting_writers.count > 0)
+ {
+ /* Wake up one of the waiting writers. */
+ lock->runcount--;
+ gl_waitqueue_notify_first (&lock->waiting_writers);
+ }
+ else
+ {
+ /* Wake up all waiting readers. */
+ lock->runcount += lock->waiting_readers.count;
+ gl_waitqueue_notify_all (&lock->waiting_readers);
+ }
+ }
+ LeaveCriticalSection (&lock->lock);
+ return 0;
+}
+
+int
+glthread_rwlock_destroy_func (gl_rwlock_t *lock)
+{
+ if (!lock->guard.done)
+ return EINVAL;
+ if (lock->runcount != 0)
+ return EBUSY;
+ DeleteCriticalSection (&lock->lock);
+ if (lock->waiting_readers.array != NULL)
+ free (lock->waiting_readers.array);
+ if (lock->waiting_writers.array != NULL)
+ free (lock->waiting_writers.array);
+ lock->guard.done = 0;
+ return 0;
+}
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+void
+glthread_recursive_lock_init_func (gl_recursive_lock_t *lock)
+{
+ lock->owner = 0;
+ lock->depth = 0;
+ InitializeCriticalSection (&lock->lock);
+ lock->guard.done = 1;
+}
+
+int
+glthread_recursive_lock_lock_func (gl_recursive_lock_t *lock)
+{
+ if (!lock->guard.done)
+ {
+ if (InterlockedIncrement (&lock->guard.started) == 0)
+ /* This thread is the first one to need this lock. Initialize it. */
+ glthread_recursive_lock_init (lock);
+ else
+ /* Yield the CPU while waiting for another thread to finish
+ initializing this lock. */
+ while (!lock->guard.done)
+ Sleep (0);
+ }
+ {
+ DWORD self = GetCurrentThreadId ();
+ if (lock->owner != self)
+ {
+ EnterCriticalSection (&lock->lock);
+ lock->owner = self;
+ }
+ if (++(lock->depth) == 0) /* wraparound? */
+ {
+ lock->depth--;
+ return EAGAIN;
+ }
+ }
+ return 0;
+}
+
+int
+glthread_recursive_lock_unlock_func (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != GetCurrentThreadId ())
+ return EPERM;
+ if (lock->depth == 0)
+ return EINVAL;
+ if (--(lock->depth) == 0)
+ {
+ lock->owner = 0;
+ LeaveCriticalSection (&lock->lock);
+ }
+ return 0;
+}
+
+int
+glthread_recursive_lock_destroy_func (gl_recursive_lock_t *lock)
+{
+ if (lock->owner != 0)
+ return EBUSY;
+ DeleteCriticalSection (&lock->lock);
+ lock->guard.done = 0;
+ return 0;
+}
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+void
+glthread_once_func (gl_once_t *once_control, void (*initfunction) (void))
+{
+ if (once_control->inited <= 0)
+ {
+ if (InterlockedIncrement (&once_control->started) == 0)
+ {
+ /* This thread is the first one to come to this once_control. */
+ InitializeCriticalSection (&once_control->lock);
+ EnterCriticalSection (&once_control->lock);
+ once_control->inited = 0;
+ initfunction ();
+ once_control->inited = 1;
+ LeaveCriticalSection (&once_control->lock);
+ }
+ else
+ {
+ /* Undo last operation. */
+ InterlockedDecrement (&once_control->started);
+ /* Some other thread has already started the initialization.
+ Yield the CPU while waiting for the other thread to finish
+ initializing and taking the lock. */
+ while (once_control->inited < 0)
+ Sleep (0);
+ if (once_control->inited <= 0)
+ {
+ /* Take the lock. This blocks until the other thread has
+ finished calling the initfunction. */
+ EnterCriticalSection (&once_control->lock);
+ LeaveCriticalSection (&once_control->lock);
+ if (!(once_control->inited > 0))
+ abort ();
+ }
+ }
+ }
+}
+
+#endif
+
+/* ========================================================================= */
diff --git a/lib/glthread/lock.h b/lib/glthread/lock.h
new file mode 100644
index 0000000..894b1fb
--- /dev/null
+++ b/lib/glthread/lock.h
@@ -0,0 +1,927 @@
+/* Locking in multithreaded situations.
+ Copyright (C) 2005-2014 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Bruno Haible <address@hidden>, 2005.
+ Based on GCC's gthr-posix.h, gthr-posix95.h, gthr-solaris.h,
+ gthr-win32.h. */
+
+/* This file contains locking primitives for use with a given thread library.
+ It does not contain primitives for creating threads or for other
+ synchronization primitives.
+
+ Normal (non-recursive) locks:
+ Type: gl_lock_t
+ Declaration: gl_lock_define(extern, name)
+ Initializer: gl_lock_define_initialized(, name)
+ Initialization: gl_lock_init (name);
+ Taking the lock: gl_lock_lock (name);
+ Releasing the lock: gl_lock_unlock (name);
+ De-initialization: gl_lock_destroy (name);
+ Equivalent functions with control of error handling:
+ Initialization: err = glthread_lock_init (&name);
+ Taking the lock: err = glthread_lock_lock (&name);
+ Releasing the lock: err = glthread_lock_unlock (&name);
+ De-initialization: err = glthread_lock_destroy (&name);
+
+ Read-Write (non-recursive) locks:
+ Type: gl_rwlock_t
+ Declaration: gl_rwlock_define(extern, name)
+ Initializer: gl_rwlock_define_initialized(, name)
+ Initialization: gl_rwlock_init (name);
+ Taking the lock: gl_rwlock_rdlock (name);
+ gl_rwlock_wrlock (name);
+ Releasing the lock: gl_rwlock_unlock (name);
+ De-initialization: gl_rwlock_destroy (name);
+ Equivalent functions with control of error handling:
+ Initialization: err = glthread_rwlock_init (&name);
+ Taking the lock: err = glthread_rwlock_rdlock (&name);
+ err = glthread_rwlock_wrlock (&name);
+ Releasing the lock: err = glthread_rwlock_unlock (&name);
+ De-initialization: err = glthread_rwlock_destroy (&name);
+
+ Recursive locks:
+ Type: gl_recursive_lock_t
+ Declaration: gl_recursive_lock_define(extern, name)
+ Initializer: gl_recursive_lock_define_initialized(, name)
+ Initialization: gl_recursive_lock_init (name);
+ Taking the lock: gl_recursive_lock_lock (name);
+ Releasing the lock: gl_recursive_lock_unlock (name);
+ De-initialization: gl_recursive_lock_destroy (name);
+ Equivalent functions with control of error handling:
+ Initialization: err = glthread_recursive_lock_init (&name);
+ Taking the lock: err = glthread_recursive_lock_lock (&name);
+ Releasing the lock: err = glthread_recursive_lock_unlock (&name);
+ De-initialization: err = glthread_recursive_lock_destroy (&name);
+
+ Once-only execution:
+ Type: gl_once_t
+ Initializer: gl_once_define(extern, name)
+ Execution: gl_once (name, initfunction);
+ Equivalent functions with control of error handling:
+ Execution: err = glthread_once (&name, initfunction);
+*/
+
+
+#ifndef _LOCK_H
+#define _LOCK_H
+
+#include <errno.h>
+#include <stdlib.h>
+
+/* ========================================================================= */
+
+#if USE_POSIX_THREADS
+
+/* Use the POSIX threads library. */
+
+# include <pthread.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if PTHREAD_IN_USE_DETECTION_HARD
+
+/* The pthread_in_use() detection needs to be done at runtime. */
+# define pthread_in_use() \
+ glthread_in_use ()
+extern int glthread_in_use (void);
+
+# endif
+
+# if USE_POSIX_THREADS_WEAK
+
+/* Use weak references to the POSIX threads library. */
+
+/* Weak references avoid dragging in external libraries if the other parts
+ of the program don't use them. Here we use them, because we don't want
+ every program that uses libintl to depend on libpthread. This assumes
+ that libpthread would not be loaded after libintl; i.e. if libintl is
+ loaded first, by an executable that does not depend on libpthread, and
+ then a module is dynamically loaded that depends on libpthread, libintl
+ will not be multithread-safe. */
+
+/* The way to test at runtime whether libpthread is present is to test
+ whether a function pointer's value, such as &pthread_mutex_init, is
+ non-NULL. However, some versions of GCC have a bug through which, in
+ PIC mode, &foo != NULL always evaluates to true if there is a direct
+ call to foo(...) in the same function. To avoid this, we test the
+ address of a function in libpthread that we don't use. */
+
+# pragma weak pthread_mutex_init
+# pragma weak pthread_mutex_lock
+# pragma weak pthread_mutex_unlock
+# pragma weak pthread_mutex_destroy
+# pragma weak pthread_rwlock_init
+# pragma weak pthread_rwlock_rdlock
+# pragma weak pthread_rwlock_wrlock
+# pragma weak pthread_rwlock_unlock
+# pragma weak pthread_rwlock_destroy
+# pragma weak pthread_once
+# pragma weak pthread_cond_init
+# pragma weak pthread_cond_wait
+# pragma weak pthread_cond_signal
+# pragma weak pthread_cond_broadcast
+# pragma weak pthread_cond_destroy
+# pragma weak pthread_mutexattr_init
+# pragma weak pthread_mutexattr_settype
+# pragma weak pthread_mutexattr_destroy
+# ifndef pthread_self
+# pragma weak pthread_self
+# endif
+
+# if !PTHREAD_IN_USE_DETECTION_HARD
+# pragma weak pthread_cancel
+# define pthread_in_use() (pthread_cancel != NULL)
+# endif
+
+# else
+
+# if !PTHREAD_IN_USE_DETECTION_HARD
+# define pthread_in_use() 1
+# endif
+
+# endif
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+typedef pthread_mutex_t gl_lock_t;
+# define gl_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_mutex_t NAME;
+# define gl_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_mutex_t NAME = gl_lock_initializer;
+# define gl_lock_initializer \
+ PTHREAD_MUTEX_INITIALIZER
+# define glthread_lock_init(LOCK) \
+ (pthread_in_use () ? pthread_mutex_init (LOCK, NULL) : 0)
+# define glthread_lock_lock(LOCK) \
+ (pthread_in_use () ? pthread_mutex_lock (LOCK) : 0)
+# define glthread_lock_unlock(LOCK) \
+ (pthread_in_use () ? pthread_mutex_unlock (LOCK) : 0)
+# define glthread_lock_destroy(LOCK) \
+ (pthread_in_use () ? pthread_mutex_destroy (LOCK) : 0)
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+# if HAVE_PTHREAD_RWLOCK
+
+# ifdef PTHREAD_RWLOCK_INITIALIZER
+
+typedef pthread_rwlock_t gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ PTHREAD_RWLOCK_INITIALIZER
+# define glthread_rwlock_init(LOCK) \
+ (pthread_in_use () ? pthread_rwlock_init (LOCK, NULL) : 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ (pthread_in_use () ? pthread_rwlock_rdlock (LOCK) : 0)
+# define glthread_rwlock_wrlock(LOCK) \
+ (pthread_in_use () ? pthread_rwlock_wrlock (LOCK) : 0)
+# define glthread_rwlock_unlock(LOCK) \
+ (pthread_in_use () ? pthread_rwlock_unlock (LOCK) : 0)
+# define glthread_rwlock_destroy(LOCK) \
+ (pthread_in_use () ? pthread_rwlock_destroy (LOCK) : 0)
+
+# else
+
+typedef struct
+ {
+ int initialized;
+ pthread_mutex_t guard; /* protects the initialization */
+ pthread_rwlock_t rwlock; /* read-write lock */
+ }
+ gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ { 0, PTHREAD_MUTEX_INITIALIZER }
+# define glthread_rwlock_init(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_init_multithreaded (LOCK) : 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_rdlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_wrlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_wrlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_unlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_unlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_destroy(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_destroy_multithreaded (LOCK) : 0)
+extern int glthread_rwlock_init_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock);
+
+# endif
+
+# else
+
+typedef struct
+ {
+ pthread_mutex_t lock; /* protects the remaining fields */
+ pthread_cond_t waiting_readers; /* waiting readers */
+ pthread_cond_t waiting_writers; /* waiting writers */
+ unsigned int waiting_writers_count; /* number of waiting writers */
+ int runcount; /* number of readers running, or -1 when a writer runs
*/
+ }
+ gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ { PTHREAD_MUTEX_INITIALIZER, PTHREAD_COND_INITIALIZER,
PTHREAD_COND_INITIALIZER, 0, 0 }
+# define glthread_rwlock_init(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_init_multithreaded (LOCK) : 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_rdlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_wrlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_wrlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_unlock(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_unlock_multithreaded (LOCK) : 0)
+# define glthread_rwlock_destroy(LOCK) \
+ (pthread_in_use () ? glthread_rwlock_destroy_multithreaded (LOCK) : 0)
+extern int glthread_rwlock_init_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock);
+extern int glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock);
+
+# endif
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+# if HAVE_PTHREAD_MUTEX_RECURSIVE
+
+# if defined PTHREAD_RECURSIVE_MUTEX_INITIALIZER || defined
PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP
+
+typedef pthread_mutex_t gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_mutex_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_mutex_t NAME = gl_recursive_lock_initializer;
+# ifdef PTHREAD_RECURSIVE_MUTEX_INITIALIZER
+# define gl_recursive_lock_initializer \
+ PTHREAD_RECURSIVE_MUTEX_INITIALIZER
+# else
+# define gl_recursive_lock_initializer \
+ PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP
+# endif
+# define glthread_recursive_lock_init(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_lock(LOCK) \
+ (pthread_in_use () ? pthread_mutex_lock (LOCK) : 0)
+# define glthread_recursive_lock_unlock(LOCK) \
+ (pthread_in_use () ? pthread_mutex_unlock (LOCK) : 0)
+# define glthread_recursive_lock_destroy(LOCK) \
+ (pthread_in_use () ? pthread_mutex_destroy (LOCK) : 0)
+extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t
*lock);
+
+# else
+
+typedef struct
+ {
+ pthread_mutex_t recmutex; /* recursive mutex */
+ pthread_mutex_t guard; /* protects the initialization */
+ int initialized;
+ }
+ gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
+# define gl_recursive_lock_initializer \
+ { PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, 0 }
+# define glthread_recursive_lock_init(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_lock(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_unlock(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK)
: 0)
+# define glthread_recursive_lock_destroy(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_destroy_multithreaded
(LOCK) : 0)
+extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t
*lock);
+
+# endif
+
+# else
+
+/* Old versions of POSIX threads on Solaris did not have recursive locks.
+ We have to implement them ourselves. */
+
+typedef struct
+ {
+ pthread_mutex_t mutex;
+ pthread_t owner;
+ unsigned long depth;
+ }
+ gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
+# define gl_recursive_lock_initializer \
+ { PTHREAD_MUTEX_INITIALIZER, (pthread_t) 0, 0 }
+# define glthread_recursive_lock_init(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_lock(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_unlock(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK)
: 0)
+# define glthread_recursive_lock_destroy(LOCK) \
+ (pthread_in_use () ? glthread_recursive_lock_destroy_multithreaded (LOCK)
: 0)
+extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t
*lock);
+
+# endif
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+typedef pthread_once_t gl_once_t;
+# define gl_once_define(STORAGECLASS, NAME) \
+ STORAGECLASS pthread_once_t NAME = PTHREAD_ONCE_INIT;
+# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
+ (pthread_in_use ()
\
+ ? pthread_once (ONCE_CONTROL, INITFUNCTION)
\
+ : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) :
0))
+extern int glthread_once_singlethreaded (pthread_once_t *once_control);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_PTH_THREADS
+
+/* Use the GNU Pth threads library. */
+
+# include <pth.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if USE_PTH_THREADS_WEAK
+
+/* Use weak references to the GNU Pth threads library. */
+
+# pragma weak pth_mutex_init
+# pragma weak pth_mutex_acquire
+# pragma weak pth_mutex_release
+# pragma weak pth_rwlock_init
+# pragma weak pth_rwlock_acquire
+# pragma weak pth_rwlock_release
+# pragma weak pth_once
+
+# pragma weak pth_cancel
+# define pth_in_use() (pth_cancel != NULL)
+
+# else
+
+# define pth_in_use() 1
+
+# endif
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+typedef pth_mutex_t gl_lock_t;
+# define gl_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pth_mutex_t NAME;
+# define gl_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pth_mutex_t NAME = gl_lock_initializer;
+# define gl_lock_initializer \
+ PTH_MUTEX_INIT
+# define glthread_lock_init(LOCK) \
+ (pth_in_use () && !pth_mutex_init (LOCK) ? errno : 0)
+# define glthread_lock_lock(LOCK) \
+ (pth_in_use () && !pth_mutex_acquire (LOCK, 0, NULL) ? errno : 0)
+# define glthread_lock_unlock(LOCK) \
+ (pth_in_use () && !pth_mutex_release (LOCK) ? errno : 0)
+# define glthread_lock_destroy(LOCK) \
+ ((void)(LOCK), 0)
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+typedef pth_rwlock_t gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pth_rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pth_rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ PTH_RWLOCK_INIT
+# define glthread_rwlock_init(LOCK) \
+ (pth_in_use () && !pth_rwlock_init (LOCK) ? errno : 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ (pth_in_use () && !pth_rwlock_acquire (LOCK, PTH_RWLOCK_RD, 0, NULL) ?
errno : 0)
+# define glthread_rwlock_wrlock(LOCK) \
+ (pth_in_use () && !pth_rwlock_acquire (LOCK, PTH_RWLOCK_RW, 0, NULL) ?
errno : 0)
+# define glthread_rwlock_unlock(LOCK) \
+ (pth_in_use () && !pth_rwlock_release (LOCK) ? errno : 0)
+# define glthread_rwlock_destroy(LOCK) \
+ ((void)(LOCK), 0)
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+/* In Pth, mutexes are recursive by default. */
+typedef pth_mutex_t gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS pth_mutex_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS pth_mutex_t NAME = gl_recursive_lock_initializer;
+# define gl_recursive_lock_initializer \
+ PTH_MUTEX_INIT
+# define glthread_recursive_lock_init(LOCK) \
+ (pth_in_use () && !pth_mutex_init (LOCK) ? errno : 0)
+# define glthread_recursive_lock_lock(LOCK) \
+ (pth_in_use () && !pth_mutex_acquire (LOCK, 0, NULL) ? errno : 0)
+# define glthread_recursive_lock_unlock(LOCK) \
+ (pth_in_use () && !pth_mutex_release (LOCK) ? errno : 0)
+# define glthread_recursive_lock_destroy(LOCK) \
+ ((void)(LOCK), 0)
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+typedef pth_once_t gl_once_t;
+# define gl_once_define(STORAGECLASS, NAME) \
+ STORAGECLASS pth_once_t NAME = PTH_ONCE_INIT;
+# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
+ (pth_in_use ()
\
+ ? glthread_once_multithreaded (ONCE_CONTROL, INITFUNCTION)
\
+ : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) :
0))
+extern int glthread_once_multithreaded (pth_once_t *once_control, void
(*initfunction) (void));
+extern int glthread_once_singlethreaded (pth_once_t *once_control);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_SOLARIS_THREADS
+
+/* Use the old Solaris threads library. */
+
+# include <thread.h>
+# include <synch.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if USE_SOLARIS_THREADS_WEAK
+
+/* Use weak references to the old Solaris threads library. */
+
+# pragma weak mutex_init
+# pragma weak mutex_lock
+# pragma weak mutex_unlock
+# pragma weak mutex_destroy
+# pragma weak rwlock_init
+# pragma weak rw_rdlock
+# pragma weak rw_wrlock
+# pragma weak rw_unlock
+# pragma weak rwlock_destroy
+# pragma weak thr_self
+
+# pragma weak thr_suspend
+# define thread_in_use() (thr_suspend != NULL)
+
+# else
+
+# define thread_in_use() 1
+
+# endif
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+typedef mutex_t gl_lock_t;
+# define gl_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS mutex_t NAME;
+# define gl_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS mutex_t NAME = gl_lock_initializer;
+# define gl_lock_initializer \
+ DEFAULTMUTEX
+# define glthread_lock_init(LOCK) \
+ (thread_in_use () ? mutex_init (LOCK, USYNC_THREAD, NULL) : 0)
+# define glthread_lock_lock(LOCK) \
+ (thread_in_use () ? mutex_lock (LOCK) : 0)
+# define glthread_lock_unlock(LOCK) \
+ (thread_in_use () ? mutex_unlock (LOCK) : 0)
+# define glthread_lock_destroy(LOCK) \
+ (thread_in_use () ? mutex_destroy (LOCK) : 0)
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+typedef rwlock_t gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ DEFAULTRWLOCK
+# define glthread_rwlock_init(LOCK) \
+ (thread_in_use () ? rwlock_init (LOCK, USYNC_THREAD, NULL) : 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ (thread_in_use () ? rw_rdlock (LOCK) : 0)
+# define glthread_rwlock_wrlock(LOCK) \
+ (thread_in_use () ? rw_wrlock (LOCK) : 0)
+# define glthread_rwlock_unlock(LOCK) \
+ (thread_in_use () ? rw_unlock (LOCK) : 0)
+# define glthread_rwlock_destroy(LOCK) \
+ (thread_in_use () ? rwlock_destroy (LOCK) : 0)
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+/* Old Solaris threads did not have recursive locks.
+ We have to implement them ourselves. */
+
+typedef struct
+ {
+ mutex_t mutex;
+ thread_t owner;
+ unsigned long depth;
+ }
+ gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
+# define gl_recursive_lock_initializer \
+ { DEFAULTMUTEX, (thread_t) 0, 0 }
+# define glthread_recursive_lock_init(LOCK) \
+ (thread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) : 0)
+# define glthread_recursive_lock_lock(LOCK) \
+ (thread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) : 0)
+# define glthread_recursive_lock_unlock(LOCK) \
+ (thread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK) :
0)
+# define glthread_recursive_lock_destroy(LOCK) \
+ (thread_in_use () ? glthread_recursive_lock_destroy_multithreaded (LOCK) :
0)
+extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t
*lock);
+extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t
*lock);
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+typedef struct
+ {
+ volatile int inited;
+ mutex_t mutex;
+ }
+ gl_once_t;
+# define gl_once_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_once_t NAME = { 0, DEFAULTMUTEX };
+# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
+ (thread_in_use ()
\
+ ? glthread_once_multithreaded (ONCE_CONTROL, INITFUNCTION)
\
+ : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) :
0))
+extern int glthread_once_multithreaded (gl_once_t *once_control, void
(*initfunction) (void));
+extern int glthread_once_singlethreaded (gl_once_t *once_control);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
+
+/* ========================================================================= */
+
+#if USE_WINDOWS_THREADS
+
+# define WIN32_LEAN_AND_MEAN /* avoid including junk */
+# include <windows.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+/* We can use CRITICAL_SECTION directly, rather than the native Windows Event,
+ Mutex, Semaphore types, because
+ - we need only to synchronize inside a single process (address space),
+ not inter-process locking,
+ - we don't need to support trylock operations. (TryEnterCriticalSection
+ does not work on Windows 95/98/ME. Packages that need trylock usually
+ define their own mutex type.) */
+
+/* There is no way to statically initialize a CRITICAL_SECTION. It needs
+ to be done lazily, once only. For this we need spinlocks. */
+
+typedef struct { volatile int done; volatile long started; } gl_spinlock_t;
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+typedef struct
+ {
+ gl_spinlock_t guard; /* protects the initialization */
+ CRITICAL_SECTION lock;
+ }
+ gl_lock_t;
+# define gl_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_lock_t NAME;
+# define gl_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_lock_t NAME = gl_lock_initializer;
+# define gl_lock_initializer \
+ { { 0, -1 } }
+# define glthread_lock_init(LOCK) \
+ (glthread_lock_init_func (LOCK), 0)
+# define glthread_lock_lock(LOCK) \
+ glthread_lock_lock_func (LOCK)
+# define glthread_lock_unlock(LOCK) \
+ glthread_lock_unlock_func (LOCK)
+# define glthread_lock_destroy(LOCK) \
+ glthread_lock_destroy_func (LOCK)
+extern void glthread_lock_init_func (gl_lock_t *lock);
+extern int glthread_lock_lock_func (gl_lock_t *lock);
+extern int glthread_lock_unlock_func (gl_lock_t *lock);
+extern int glthread_lock_destroy_func (gl_lock_t *lock);
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+/* It is impossible to implement read-write locks using plain locks, without
+ introducing an extra thread dedicated to managing read-write locks.
+ Therefore here we need to use the low-level Event type. */
+
+typedef struct
+ {
+ HANDLE *array; /* array of waiting threads, each represented by an
event */
+ unsigned int count; /* number of waiting threads */
+ unsigned int alloc; /* length of allocated array */
+ unsigned int offset; /* index of first waiting thread in array */
+ }
+ gl_carray_waitqueue_t;
+typedef struct
+ {
+ gl_spinlock_t guard; /* protects the initialization */
+ CRITICAL_SECTION lock; /* protects the remaining fields */
+ gl_carray_waitqueue_t waiting_readers; /* waiting readers */
+ gl_carray_waitqueue_t waiting_writers; /* waiting writers */
+ int runcount; /* number of readers running, or -1 when a writer runs
*/
+ }
+ gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME;
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
+# define gl_rwlock_initializer \
+ { { 0, -1 } }
+# define glthread_rwlock_init(LOCK) \
+ (glthread_rwlock_init_func (LOCK), 0)
+# define glthread_rwlock_rdlock(LOCK) \
+ glthread_rwlock_rdlock_func (LOCK)
+# define glthread_rwlock_wrlock(LOCK) \
+ glthread_rwlock_wrlock_func (LOCK)
+# define glthread_rwlock_unlock(LOCK) \
+ glthread_rwlock_unlock_func (LOCK)
+# define glthread_rwlock_destroy(LOCK) \
+ glthread_rwlock_destroy_func (LOCK)
+extern void glthread_rwlock_init_func (gl_rwlock_t *lock);
+extern int glthread_rwlock_rdlock_func (gl_rwlock_t *lock);
+extern int glthread_rwlock_wrlock_func (gl_rwlock_t *lock);
+extern int glthread_rwlock_unlock_func (gl_rwlock_t *lock);
+extern int glthread_rwlock_destroy_func (gl_rwlock_t *lock);
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+/* The native Windows documentation says that CRITICAL_SECTION already
+ implements a recursive lock. But we need not rely on it: It's easy to
+ implement a recursive lock without this assumption. */
+
+typedef struct
+ {
+ gl_spinlock_t guard; /* protects the initialization */
+ DWORD owner;
+ unsigned long depth;
+ CRITICAL_SECTION lock;
+ }
+ gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME;
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
+ STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
+# define gl_recursive_lock_initializer \
+ { { 0, -1 }, 0, 0 }
+# define glthread_recursive_lock_init(LOCK) \
+ (glthread_recursive_lock_init_func (LOCK), 0)
+# define glthread_recursive_lock_lock(LOCK) \
+ glthread_recursive_lock_lock_func (LOCK)
+# define glthread_recursive_lock_unlock(LOCK) \
+ glthread_recursive_lock_unlock_func (LOCK)
+# define glthread_recursive_lock_destroy(LOCK) \
+ glthread_recursive_lock_destroy_func (LOCK)
+extern void glthread_recursive_lock_init_func (gl_recursive_lock_t *lock);
+extern int glthread_recursive_lock_lock_func (gl_recursive_lock_t *lock);
+extern int glthread_recursive_lock_unlock_func (gl_recursive_lock_t *lock);
+extern int glthread_recursive_lock_destroy_func (gl_recursive_lock_t *lock);
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+typedef struct
+ {
+ volatile int inited;
+ volatile long started;
+ CRITICAL_SECTION lock;
+ }
+ gl_once_t;
+# define gl_once_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_once_t NAME = { -1, -1 };
+# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
+ (glthread_once_func (ONCE_CONTROL, INITFUNCTION), 0)
+extern void glthread_once_func (gl_once_t *once_control, void (*initfunction)
(void));
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
+
+/* ========================================================================= */
+
+#if !(USE_POSIX_THREADS || USE_PTH_THREADS || USE_SOLARIS_THREADS ||
USE_WINDOWS_THREADS)
+
+/* Provide dummy implementation if threads are not supported. */
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+typedef int gl_lock_t;
+# define gl_lock_define(STORAGECLASS, NAME)
+# define gl_lock_define_initialized(STORAGECLASS, NAME)
+# define glthread_lock_init(NAME) 0
+# define glthread_lock_lock(NAME) 0
+# define glthread_lock_unlock(NAME) 0
+# define glthread_lock_destroy(NAME) 0
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+typedef int gl_rwlock_t;
+# define gl_rwlock_define(STORAGECLASS, NAME)
+# define gl_rwlock_define_initialized(STORAGECLASS, NAME)
+# define glthread_rwlock_init(NAME) 0
+# define glthread_rwlock_rdlock(NAME) 0
+# define glthread_rwlock_wrlock(NAME) 0
+# define glthread_rwlock_unlock(NAME) 0
+# define glthread_rwlock_destroy(NAME) 0
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+typedef int gl_recursive_lock_t;
+# define gl_recursive_lock_define(STORAGECLASS, NAME)
+# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME)
+# define glthread_recursive_lock_init(NAME) 0
+# define glthread_recursive_lock_lock(NAME) 0
+# define glthread_recursive_lock_unlock(NAME) 0
+# define glthread_recursive_lock_destroy(NAME) 0
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+typedef int gl_once_t;
+# define gl_once_define(STORAGECLASS, NAME) \
+ STORAGECLASS gl_once_t NAME = 0;
+# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
+ (*(ONCE_CONTROL) == 0 ? (*(ONCE_CONTROL) = ~ 0, INITFUNCTION (), 0) : 0)
+
+#endif
+
+/* ========================================================================= */
+
+/* Macros with built-in error handling. */
+
+/* -------------------------- gl_lock_t datatype -------------------------- */
+
+#define gl_lock_init(NAME) \
+ do \
+ { \
+ if (glthread_lock_init (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_lock_lock(NAME) \
+ do \
+ { \
+ if (glthread_lock_lock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_lock_unlock(NAME) \
+ do \
+ { \
+ if (glthread_lock_unlock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_lock_destroy(NAME) \
+ do \
+ { \
+ if (glthread_lock_destroy (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+
+/* ------------------------- gl_rwlock_t datatype ------------------------- */
+
+#define gl_rwlock_init(NAME) \
+ do \
+ { \
+ if (glthread_rwlock_init (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_rwlock_rdlock(NAME) \
+ do \
+ { \
+ if (glthread_rwlock_rdlock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_rwlock_wrlock(NAME) \
+ do \
+ { \
+ if (glthread_rwlock_wrlock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_rwlock_unlock(NAME) \
+ do \
+ { \
+ if (glthread_rwlock_unlock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_rwlock_destroy(NAME) \
+ do \
+ { \
+ if (glthread_rwlock_destroy (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+
+/* --------------------- gl_recursive_lock_t datatype --------------------- */
+
+#define gl_recursive_lock_init(NAME) \
+ do \
+ { \
+ if (glthread_recursive_lock_init (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_recursive_lock_lock(NAME) \
+ do \
+ { \
+ if (glthread_recursive_lock_lock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_recursive_lock_unlock(NAME) \
+ do \
+ { \
+ if (glthread_recursive_lock_unlock (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+#define gl_recursive_lock_destroy(NAME) \
+ do \
+ { \
+ if (glthread_recursive_lock_destroy (&NAME)) \
+ abort (); \
+ } \
+ while (0)
+
+/* -------------------------- gl_once_t datatype -------------------------- */
+
+#define gl_once(NAME, INITFUNCTION) \
+ do \
+ { \
+ if (glthread_once (&NAME, INITFUNCTION)) \
+ abort (); \
+ } \
+ while (0)
+
+/* ========================================================================= */
+
+#endif /* _LOCK_H */
diff --git a/lib/glthread/threadlib.c b/lib/glthread/threadlib.c
new file mode 100644
index 0000000..37a5762
--- /dev/null
+++ b/lib/glthread/threadlib.c
@@ -0,0 +1,73 @@
+/* Multithreading primitives.
+ Copyright (C) 2005-2014 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Bruno Haible <address@hidden>, 2005. */
+
+#include <config.h>
+
+/* ========================================================================= */
+
+#if USE_POSIX_THREADS
+
+/* Use the POSIX threads library. */
+
+# include <pthread.h>
+# include <stdlib.h>
+
+# if PTHREAD_IN_USE_DETECTION_HARD
+
+/* The function to be executed by a dummy thread. */
+static void *
+dummy_thread_func (void *arg)
+{
+ return arg;
+}
+
+int
+glthread_in_use (void)
+{
+ static int tested;
+ static int result; /* 1: linked with -lpthread, 0: only with libc */
+
+ if (!tested)
+ {
+ pthread_t thread;
+
+ if (pthread_create (&thread, NULL, dummy_thread_func, NULL) != 0)
+ /* Thread creation failed. */
+ result = 0;
+ else
+ {
+ /* Thread creation works. */
+ void *retval;
+ if (pthread_join (thread, &retval) != 0)
+ abort ();
+ result = 1;
+ }
+ tested = 1;
+ }
+ return result;
+}
+
+# endif
+
+#endif
+
+/* ========================================================================= */
+
+/* This declaration is solely to ensure that after preprocessing
+ this file is never empty. */
+typedef int dummy;
diff --git a/lib/iconv.c b/lib/iconv.c
index 933730b..a6dfed3 100644
--- a/lib/iconv.c
+++ b/lib/iconv.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 1999-2001, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2001, 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/iconv.in.h b/lib/iconv.in.h
index 2e7efbe..ed95ed7 100644
--- a/lib/iconv.in.h
+++ b/lib/iconv.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <iconv.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/iconv_close.c b/lib/iconv_close.c
index 3492f28..6e28673 100644
--- a/lib/iconv_close.c
+++ b/lib/iconv_close.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/iconv_open.c b/lib/iconv_open.c
index eaf7c7d..fc19d44 100644
--- a/lib/iconv_open.c
+++ b/lib/iconv_open.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/iconveh.h b/lib/iconveh.h
index 8d792ac..43b23eb 100644
--- a/lib/iconveh.h
+++ b/lib/iconveh.h
@@ -1,5 +1,5 @@
/* Character set conversion handler type.
- Copyright (C) 2001-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/inet_ntop.c b/lib/inet_ntop.c
index 96202e2..4629519 100644
--- a/lib/inet_ntop.c
+++ b/lib/inet_ntop.c
@@ -1,6 +1,6 @@
/* inet_ntop.c -- convert IPv4 and IPv6 addresses from binary to text form
- Copyright (C) 2005-2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/inet_pton.c b/lib/inet_pton.c
index 08f1b20..52ae317 100644
--- a/lib/inet_pton.c
+++ b/lib/inet_pton.c
@@ -1,6 +1,6 @@
/* inet_pton.c -- convert IPv4 and IPv6 addresses from text to binary form
- Copyright (C) 2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isfinite.c b/lib/isfinite.c
index d9eddf5..18c1d21 100644
--- a/lib/isfinite.c
+++ b/lib/isfinite.c
@@ -1,5 +1,5 @@
/* Test for finite value (zero, subnormal, or normal, and not infinite or NaN).
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isinf.c b/lib/isinf.c
index 24c32d3..217de79 100644
--- a/lib/isinf.c
+++ b/lib/isinf.c
@@ -1,5 +1,5 @@
/* Test for positive or negative infinity.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnan.c b/lib/isnan.c
index 18fa5a2..1557733 100644
--- a/lib/isnan.c
+++ b/lib/isnan.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -79,10 +79,21 @@ extern int rpl_isnanf (float x);
((sizeof (DOUBLE) + sizeof (unsigned int) - 1) / sizeof (unsigned int))
typedef union { DOUBLE value; unsigned int word[NWORDS]; } memory_double;
+/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
+ representations, have infinities and NaNs, and do not trap on
+ exceptions. Define IEEE_FLOATING_POINT if this host is one of the
+ typical ones. The C11 macro __STDC_IEC_559__ is close to what is
+ wanted here, but is not quite right because this file does not require
+ all the features of C11 Annex F (and does not require C11 at all,
+ for that matter). */
+
+#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
+ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
+
int
FUNC (DOUBLE x)
{
-#ifdef KNOWN_EXPBIT0_LOCATION
+#if defined KNOWN_EXPBIT0_LOCATION && IEEE_FLOATING_POINT
# if defined USE_LONG_DOUBLE && ((defined __ia64 && LDBL_MANT_DIG == 64) ||
(defined __x86_64__ || defined __amd64__) || (defined __i386 || defined
__i386__ || defined _I386 || defined _M_IX86 || defined _X86_)) &&
!HAVE_SAME_LONG_DOUBLE_AS_DOUBLE
/* Special CPU dependent code is needed to treat bit patterns outside the
IEEE 754 specification (such as Pseudo-NaNs, Pseudo-Infinities,
@@ -153,8 +164,9 @@ FUNC (DOUBLE x)
}
# endif
#else
- /* The configuration did not find sufficient information. Give up about
- the signaling NaNs, handle only the quiet NaNs. */
+ /* The configuration did not find sufficient information, or does
+ not use IEEE floating point. Give up about the signaling NaNs;
+ handle only the quiet NaNs. */
if (x == x)
{
# if defined USE_LONG_DOUBLE && ((defined __ia64 && LDBL_MANT_DIG == 64) ||
(defined __x86_64__ || defined __amd64__) || (defined __i386 || defined
__i386__ || defined _I386 || defined _M_IX86 || defined _X86_)) &&
!HAVE_SAME_LONG_DOUBLE_AS_DOUBLE
diff --git a/lib/isnand-nolibm.h b/lib/isnand-nolibm.h
index 3510202..b0498ef 100644
--- a/lib/isnand-nolibm.h
+++ b/lib/isnand-nolibm.h
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnand.c b/lib/isnand.c
index 9bd092b..11efbf8 100644
--- a/lib/isnand.c
+++ b/lib/isnand.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnanf-nolibm.h b/lib/isnanf-nolibm.h
index 56f4fde..9e2aa2f 100644
--- a/lib/isnanf-nolibm.h
+++ b/lib/isnanf-nolibm.h
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnanf.c b/lib/isnanf.c
index 503575f..c7a66ca 100644
--- a/lib/isnanf.c
+++ b/lib/isnanf.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnanl-nolibm.h b/lib/isnanl-nolibm.h
index c5d0323..9cf090c 100644
--- a/lib/isnanl-nolibm.h
+++ b/lib/isnanl-nolibm.h
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/isnanl.c b/lib/isnanl.c
index 967eaff..dbf9d5d 100644
--- a/lib/isnanl.c
+++ b/lib/isnanl.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/itold.c b/lib/itold.c
index ff43bd0..136742e 100644
--- a/lib/itold.c
+++ b/lib/itold.c
@@ -1,5 +1,5 @@
/* Replacement for 'int' to 'long double' conversion routine.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/langinfo.in.h b/lib/langinfo.in.h
index d60a980..f4a281a 100644
--- a/lib/langinfo.in.h
+++ b/lib/langinfo.in.h
@@ -1,5 +1,5 @@
/* Substitute for and wrapper around <langinfo.h>.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/listen.c b/lib/listen.c
index ea6eddc..912f1b7 100644
--- a/lib/listen.c
+++ b/lib/listen.c
@@ -1,6 +1,6 @@
/* listen.c --- wrappers for Windows listen function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/localcharset.c b/lib/localcharset.c
index e967ee5..7f09567 100644
--- a/lib/localcharset.c
+++ b/lib/localcharset.c
@@ -1,6 +1,6 @@
/* Determine a canonical name for the current locale's character encoding.
- Copyright (C) 2000-2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2006, 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -65,6 +65,11 @@
# include <os2.h>
#endif
+/* For MB_CUR_MAX_L */
+#if defined DARWIN7
+# include <xlocale.h>
+#endif
+
#if ENABLE_RELOCATABLE
# include "relocatable.h"
#else
@@ -545,7 +550,7 @@ locale_charset (void)
#ifdef DARWIN7
/* Mac OS X sets MB_CUR_MAX to 1 when LC_ALL=C, and "UTF-8"
(the default codeset) does not work when MB_CUR_MAX is 1. */
- if (strcmp (codeset, "UTF-8") == 0 && MB_CUR_MAX <= 1)
+ if (strcmp (codeset, "UTF-8") == 0 && MB_CUR_MAX_L (uselocale (NULL)) <= 1)
codeset = "ASCII";
#endif
diff --git a/lib/localcharset.h b/lib/localcharset.h
index 4580edf..4b104c3 100644
--- a/lib/localcharset.h
+++ b/lib/localcharset.h
@@ -1,5 +1,5 @@
/* Determine a canonical name for the current locale's character encoding.
- Copyright (C) 2000-2003, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2003, 2009-2014 Free Software Foundation, Inc.
This file is part of the GNU CHARSET Library.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/locale.in.h b/lib/locale.in.h
index ca67816..a10b129 100644
--- a/lib/locale.in.h
+++ b/lib/locale.in.h
@@ -1,5 +1,5 @@
/* A POSIX <locale.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/localeconv.c b/lib/localeconv.c
index 41396a0..ed2767b 100644
--- a/lib/localeconv.c
+++ b/lib/localeconv.c
@@ -1,5 +1,5 @@
/* Query locale dependent information for formatting numbers.
- Copyright (C) 2012-2013 Free Software Foundation, Inc.
+ Copyright (C) 2012-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/log.c b/lib/log.c
index 892721a..ef8d332 100644
--- a/lib/log.c
+++ b/lib/log.c
@@ -1,5 +1,5 @@
/* Logarithm.
- Copyright (C) 2012-2013 Free Software Foundation, Inc.
+ Copyright (C) 2012-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/log1p.c b/lib/log1p.c
index 8c0788a..d1132d3 100644
--- a/lib/log1p.c
+++ b/lib/log1p.c
@@ -1,5 +1,5 @@
/* Natural logarithm of 1 plus argument.
- Copyright (C) 2012-2013 Free Software Foundation, Inc.
+ Copyright (C) 2012-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/lstat.c b/lib/lstat.c
index b0873d3..cff1188 100644
--- a/lib/lstat.c
+++ b/lib/lstat.c
@@ -1,6 +1,6 @@
/* Work around a bug of lstat on some systems
- Copyright (C) 1997-2006, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 1997-2006, 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/malloc.c b/lib/malloc.c
index 8124cad..c6e292a 100644
--- a/lib/malloc.c
+++ b/lib/malloc.c
@@ -1,6 +1,6 @@
/* malloc() function that is glibc compatible.
- Copyright (C) 1997-1998, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1997-1998, 2006-2007, 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/malloca.c b/lib/malloca.c
index 04ddc23..3e95f23 100644
--- a/lib/malloca.c
+++ b/lib/malloca.c
@@ -1,5 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2003.
This program is free software; you can redistribute it and/or modify
@@ -49,12 +49,18 @@
#define MAGIC_SIZE sizeof (int)
/* This is how the header info would look like without any alignment
considerations. */
-struct preliminary_header { void *next; char room[MAGIC_SIZE]; };
+struct preliminary_header { void *next; int magic; };
/* But the header's size must be a multiple of sa_alignment_max. */
#define HEADER_SIZE \
(((sizeof (struct preliminary_header) + sa_alignment_max - 1) /
sa_alignment_max) * sa_alignment_max)
-struct header { void *next; char room[HEADER_SIZE - sizeof (struct
preliminary_header) + MAGIC_SIZE]; };
-verify (HEADER_SIZE == sizeof (struct header));
+union header {
+ void *next;
+ struct {
+ char room[HEADER_SIZE - MAGIC_SIZE];
+ int word;
+ } magic;
+};
+verify (HEADER_SIZE == sizeof (union header));
/* We make the hash table quite big, so that during lookups the probability
of empty hash buckets is quite high. There is no need to make the hash
table resizable, because when the hash table gets filled so much that the
@@ -74,20 +80,21 @@ mmalloca (size_t n)
if (nplus >= n)
{
- char *p = (char *) malloc (nplus);
+ void *p = malloc (nplus);
if (p != NULL)
{
size_t slot;
+ union header *h = p;
- p += HEADER_SIZE;
+ p = h + 1;
/* Put a magic number into the indicator word. */
- ((int *) p)[-1] = MAGIC_NUMBER;
+ h->magic.word = MAGIC_NUMBER;
/* Enter p into the hash table. */
slot = (uintptr_t) p % HASH_TABLE_SIZE;
- ((struct header *) (p - HEADER_SIZE))->next = mmalloca_results[slot];
+ h->next = mmalloca_results[slot];
mmalloca_results[slot] = p;
return p;
@@ -123,15 +130,17 @@ freea (void *p)
void **chain = &mmalloca_results[slot];
for (; *chain != NULL;)
{
+ union header *h = p;
if (*chain == p)
{
/* Found it. Remove it from the hash table and free it. */
- char *p_begin = (char *) p - HEADER_SIZE;
- *chain = ((struct header *) p_begin)->next;
+ union header *p_begin = h - 1;
+ *chain = p_begin->next;
free (p_begin);
return;
}
- chain = &((struct header *) ((char *) *chain -
HEADER_SIZE))->next;
+ h = *chain;
+ chain = &h[-1].next;
}
}
/* At this point, we know it was not a mmalloca() result. */
diff --git a/lib/malloca.h b/lib/malloca.h
index 7747679..5810afa 100644
--- a/lib/malloca.h
+++ b/lib/malloca.h
@@ -1,5 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2003.
This program is free software; you can redistribute it and/or modify
@@ -92,7 +92,7 @@ extern void * nmalloca (size_t n, size_t s);
/* ------------------- Auxiliary, non-public definitions ------------------- */
/* Determine the alignment of a type at compile time. */
-#if defined __GNUC__
+#if defined __GNUC__ || defined __IBM__ALIGNOF__
# define sa_alignof __alignof__
#elif defined __cplusplus
template <class type> struct sa_alignof_helper { char __slot1; type __slot2;
};
diff --git a/lib/math.in.h b/lib/math.in.h
index 46d0cf1..4f2aa86 100644
--- a/lib/math.in.h
+++ b/lib/math.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <math.h>.
- Copyright (C) 2002-2003, 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -28,6 +28,9 @@
#ifndef address@hidden@_MATH_H
#define address@hidden@_MATH_H
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_MATH_INLINE
# define _GL_MATH_INLINE _GL_INLINE
diff --git a/lib/mbrtowc.c b/lib/mbrtowc.c
index 75d10bc..dff1296 100644
--- a/lib/mbrtowc.c
+++ b/lib/mbrtowc.c
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 1999-2002, 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2005-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/mbsinit.c b/lib/mbsinit.c
index 98ae1e6..71bae34 100644
--- a/lib/mbsinit.c
+++ b/lib/mbsinit.c
@@ -1,5 +1,5 @@
/* Test for initial conversion state.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/mbtowc-impl.h b/lib/mbtowc-impl.h
index 35b3528..df11ad2 100644
--- a/lib/mbtowc-impl.h
+++ b/lib/mbtowc-impl.h
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/mbtowc.c b/lib/mbtowc.c
index 7777f0a..bd9d3aa 100644
--- a/lib/mbtowc.c
+++ b/lib/mbtowc.c
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/memchr.c b/lib/memchr.c
index 6b28405..c1caad3 100644
--- a/lib/memchr.c
+++ b/lib/memchr.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2004, 2006, 2008-2013
+/* Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2004, 2006, 2008-2014
Free Software Foundation, Inc.
Based on strlen implementation by Torbjorn Granlund (address@hidden),
diff --git a/lib/msvc-inval.c b/lib/msvc-inval.c
index 5e59da7..84190d0 100644
--- a/lib/msvc-inval.c
+++ b/lib/msvc-inval.c
@@ -1,5 +1,5 @@
/* Invalid parameter handler for MSVC runtime libraries.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -28,7 +28,7 @@
# if MSVC_INVALID_PARAMETER_HANDLING == DEFAULT_HANDLING
-static void cdecl
+static void __cdecl
gl_msvc_invalid_parameter_handler (const wchar_t *expression,
const wchar_t *function,
const wchar_t *file,
@@ -45,7 +45,7 @@ gl_msvc_invalid_parameter_handler (const wchar_t *expression,
# if defined _MSC_VER
-static void cdecl
+static void __cdecl
gl_msvc_invalid_parameter_handler (const wchar_t *expression,
const wchar_t *function,
const wchar_t *file,
@@ -94,7 +94,7 @@ gl_msvc_inval_current (void)
}
}
-static void cdecl
+static void __cdecl
gl_msvc_invalid_parameter_handler (const wchar_t *expression,
const wchar_t *function,
const wchar_t *file,
diff --git a/lib/msvc-inval.h b/lib/msvc-inval.h
index 3ff7494..c6df57e 100644
--- a/lib/msvc-inval.h
+++ b/lib/msvc-inval.h
@@ -1,5 +1,5 @@
/* Invalid parameter handler for MSVC runtime libraries.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/msvc-nothrow.c b/lib/msvc-nothrow.c
index c17a9a2..9b1eb59 100644
--- a/lib/msvc-nothrow.c
+++ b/lib/msvc-nothrow.c
@@ -1,6 +1,6 @@
/* Wrappers that don't throw invalid parameter notifications
with MSVC runtime libraries.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/msvc-nothrow.h b/lib/msvc-nothrow.h
index 80d4785..1917325 100644
--- a/lib/msvc-nothrow.h
+++ b/lib/msvc-nothrow.h
@@ -1,6 +1,6 @@
/* Wrappers that don't throw invalid parameter notifications
with MSVC runtime libraries.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/netdb.in.h b/lib/netdb.in.h
index dff665c..3613fb5 100644
--- a/lib/netdb.in.h
+++ b/lib/netdb.in.h
@@ -1,5 +1,5 @@
/* Provide a netdb.h header file for systems lacking it (read: MinGW).
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
Written by Simon Josefsson.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/netinet_in.in.h b/lib/netinet_in.in.h
index 97ec58d..8ab66a1 100644
--- a/lib/netinet_in.in.h
+++ b/lib/netinet_in.in.h
@@ -1,5 +1,5 @@
/* Substitute for <netinet/in.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/nl_langinfo.c b/lib/nl_langinfo.c
index 2210b7f..83d2c77 100644
--- a/lib/nl_langinfo.c
+++ b/lib/nl_langinfo.c
@@ -1,6 +1,6 @@
/* nl_langinfo() replacement: query locale dependent information.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/nproc.c b/lib/nproc.c
index 86aefe5..293c651 100644
--- a/lib/nproc.c
+++ b/lib/nproc.c
@@ -1,6 +1,6 @@
/* Detect the number of processors.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/nproc.h b/lib/nproc.h
index 57689aa..dbc3157 100644
--- a/lib/nproc.h
+++ b/lib/nproc.h
@@ -1,6 +1,6 @@
/* Detect the number of processors.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/open.c b/lib/open.c
index b4d9c87..f6fd06e 100644
--- a/lib/open.c
+++ b/lib/open.c
@@ -1,5 +1,5 @@
/* Open a descriptor to a file.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/pathmax.h b/lib/pathmax.h
index 105edae..15ed6c2 100644
--- a/lib/pathmax.h
+++ b/lib/pathmax.h
@@ -1,5 +1,5 @@
/* Define PATH_MAX somehow. Requires sys/types.h.
- Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2013 Free Software
+ Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/pipe.c b/lib/pipe.c
index fc11967..03aed5e 100644
--- a/lib/pipe.c
+++ b/lib/pipe.c
@@ -1,5 +1,5 @@
/* Create a pipe.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 09952eb..4e4e894 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -1,5 +1,5 @@
/* Create a pipe, with specific opening flags.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -138,13 +138,13 @@ pipe2 (int fd[2], int flags)
# if O_BINARY
if (flags & O_BINARY)
{
- setmode (fd[1], O_BINARY);
- setmode (fd[0], O_BINARY);
+ set_binary_mode (fd[1], O_BINARY);
+ set_binary_mode (fd[0], O_BINARY);
}
else if (flags & O_TEXT)
{
- setmode (fd[1], O_TEXT);
- setmode (fd[0], O_TEXT);
+ set_binary_mode (fd[1], O_TEXT);
+ set_binary_mode (fd[0], O_TEXT);
}
# endif
diff --git a/lib/poll.c b/lib/poll.c
index 2767f5a..7b1e582 100644
--- a/lib/poll.c
+++ b/lib/poll.c
@@ -1,7 +1,7 @@
/* Emulation for poll(2)
Contributed by Paolo Bonzini.
- Copyright 2001-2003, 2006-2013 Free Software Foundation, Inc.
+ Copyright 2001-2003, 2006-2014 Free Software Foundation, Inc.
This file is part of gnulib.
diff --git a/lib/poll.in.h b/lib/poll.in.h
index 3c0b48f..bde9806 100644
--- a/lib/poll.in.h
+++ b/lib/poll.in.h
@@ -1,7 +1,7 @@
/* Header for poll(2) emulation
Contributed by Paolo Bonzini.
- Copyright 2001-2003, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright 2001-2003, 2007, 2009-2014 Free Software Foundation, Inc.
This file is part of gnulib.
diff --git a/lib/printf-args.c b/lib/printf-args.c
index 73fa7a4..9673e6d 100644
--- a/lib/printf-args.c
+++ b/lib/printf-args.c
@@ -1,5 +1,5 @@
/* Decomposed printf argument list.
- Copyright (C) 1999, 2002-2003, 2005-2007, 2009-2013 Free Software
+ Copyright (C) 1999, 2002-2003, 2005-2007, 2009-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/printf-args.h b/lib/printf-args.h
index af7e72d..831c147 100644
--- a/lib/printf-args.h
+++ b/lib/printf-args.h
@@ -1,5 +1,5 @@
/* Decomposed printf argument list.
- Copyright (C) 1999, 2002-2003, 2006-2007, 2011-2013 Free Software
+ Copyright (C) 1999, 2002-2003, 2006-2007, 2011-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/printf-parse.c b/lib/printf-parse.c
index 9a266df..e6a09a8 100644
--- a/lib/printf-parse.c
+++ b/lib/printf-parse.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 1999-2000, 2002-2003, 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2000, 2002-2003, 2006-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/printf-parse.h b/lib/printf-parse.h
index 0d535fa..44d6f55 100644
--- a/lib/printf-parse.h
+++ b/lib/printf-parse.h
@@ -1,5 +1,5 @@
/* Parse printf format string.
- Copyright (C) 1999, 2002-2003, 2005, 2007, 2010-2013 Free Software
+ Copyright (C) 1999, 2002-2003, 2005, 2007, 2010-2014 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/putenv.c b/lib/putenv.c
index 2abc6ac..de8caa7 100644
--- a/lib/putenv.c
+++ b/lib/putenv.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2013 Free Software
+/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2014 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
@@ -34,6 +34,11 @@
#include <string.h>
#include <unistd.h>
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
#if _LIBC
# if HAVE_GNU_LD
# define environ __environ
@@ -57,7 +62,9 @@ static int
_unsetenv (const char *name)
{
size_t len;
+#if !HAVE_DECL__PUTENV
char **ep;
+#endif
if (name == NULL || *name == '\0' || strchr (name, '=') != NULL)
{
@@ -67,6 +74,21 @@ _unsetenv (const char *name)
len = strlen (name);
+#if HAVE_DECL__PUTENV
+ {
+ int putenv_result, putenv_errno;
+ char *name_ = malloc (len + 2);
+ memcpy (name_, name, len);
+ name_[len] = '=';
+ name_[len + 1] = 0;
+ putenv_result = _putenv (name_);
+ putenv_errno = errno;
+ free (name_);
+ __set_errno (putenv_errno);
+ return putenv_result;
+ }
+#else
+
LOCK;
ep = environ;
@@ -87,6 +109,7 @@ _unsetenv (const char *name)
UNLOCK;
return 0;
+#endif
}
@@ -95,9 +118,8 @@ _unsetenv (const char *name)
int
putenv (char *string)
{
- const char *const name_end = strchr (string, '=');
- register size_t size;
- register char **ep;
+ const char *name_end = strchr (string, '=');
+ char **ep;
if (name_end == NULL)
{
@@ -105,62 +127,68 @@ putenv (char *string)
return _unsetenv (string);
}
- size = 0;
- for (ep = environ; *ep != NULL; ++ep)
- if (!strncmp (*ep, string, name_end - string) &&
- (*ep)[name_end - string] == '=')
- break;
- else
- ++size;
-
- if (*ep == NULL)
+#if HAVE_DECL__PUTENV
+ /* Rely on _putenv to allocate the new environment. If other
+ parts of the application use _putenv, the !HAVE_DECL__PUTENV code
+ would fight over who owns the environ vector, causing a crash. */
+ if (name_end[1])
+ return _putenv (string);
+ else
{
-#if HAVE__PUTENV
- /* Rely on _putenv to allocate the new environment. If other
- parts of the application use _putenv, the !HAVE__PUTENV code
- would fight over who owns the environ vector, causing a crash. */
- if (name_end[1])
- return _putenv (string);
- else
+ /* _putenv ("NAME=") unsets NAME, so invoke _putenv ("NAME= ")
+ to allocate the environ vector and then replace the new
+ entry with "NAME=". */
+ int putenv_result, putenv_errno;
+ char *name_x = malloc (name_end - string + sizeof "= ");
+ if (!name_x)
+ return -1;
+ memcpy (name_x, string, name_end - string + 1);
+ name_x[name_end - string + 1] = ' ';
+ name_x[name_end - string + 2] = 0;
+ putenv_result = _putenv (name_x);
+ putenv_errno = errno;
+ for (ep = environ; *ep; ep++)
+ if (strcmp (*ep, name_x) == 0)
+ {
+ *ep = string;
+ break;
+ }
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ if (putenv_result == 0)
{
- /* _putenv ("NAME=") unsets NAME, so invoke _putenv ("NAME=x")
- to allocate the environ vector and then replace the new
- entry with "NAME=". */
- int putenv_result, putenv_errno;
- char *name_x = malloc (name_end - string + sizeof "=x");
- if (!name_x)
- return -1;
- memcpy (name_x, string, name_end - string + 1);
- name_x[name_end - string + 1] = 'x';
- name_x[name_end - string + 2] = 0;
- putenv_result = _putenv (name_x);
- putenv_errno = errno;
- for (ep = environ; *ep; ep++)
- if (*ep == name_x)
- {
- *ep = string;
- break;
- }
- free (name_x);
- __set_errno (putenv_errno);
- return putenv_result;
+ /* _putenv propagated "NAME= " into the subprocess environment;
+ fix that by calling SetEnvironmentVariable directly. */
+ name_x[name_end - string] = 0;
+ putenv_result = SetEnvironmentVariable (name_x, "") ? 0 : -1;
+ putenv_errno = ENOMEM; /* ENOMEM is the only way to fail. */
}
+# endif
+ free (name_x);
+ __set_errno (putenv_errno);
+ return putenv_result;
+ }
#else
+ for (ep = environ; *ep; ep++)
+ if (strncmp (*ep, string, name_end - string) == 0
+ && (*ep)[name_end - string] == '=')
+ break;
+
+ if (*ep)
+ *ep = string;
+ else
+ {
static char **last_environ = NULL;
- char **new_environ = (char **) malloc ((size + 2) * sizeof (char *));
- if (new_environ == NULL)
+ size_t size = ep - environ;
+ char **new_environ = malloc ((size + 2) * sizeof *new_environ);
+ if (! new_environ)
return -1;
- (void) memcpy ((void *) new_environ, (void *) environ,
- size * sizeof (char *));
- new_environ[size] = (char *) string;
- new_environ[size + 1] = NULL;
+ new_environ[0] = string;
+ memcpy (new_environ + 1, environ, (size + 1) * sizeof *new_environ);
free (last_environ);
last_environ = new_environ;
environ = new_environ;
-#endif
}
- else
- *ep = string;
return 0;
+#endif
}
diff --git a/lib/raise.c b/lib/raise.c
index 3720dfa..2f04eea 100644
--- a/lib/raise.c
+++ b/lib/raise.c
@@ -1,6 +1,6 @@
/* Provide a non-threads replacement for the POSIX raise function.
- Copyright (C) 2002-2003, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/read.c b/lib/read.c
index 155e6d1..4efe8ce 100644
--- a/lib/read.c
+++ b/lib/read.c
@@ -1,5 +1,5 @@
/* POSIX compatible read() function.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/readlink.c b/lib/readlink.c
index ce8a0e8..ef502f5 100644
--- a/lib/readlink.c
+++ b/lib/readlink.c
@@ -1,5 +1,5 @@
/* Stub for readlink().
- Copyright (C) 2003-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/recv.c b/lib/recv.c
index aaa7d00..fc7e124 100644
--- a/lib/recv.c
+++ b/lib/recv.c
@@ -1,6 +1,6 @@
/* recv.c --- wrappers for Windows recv function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/recvfrom.c b/lib/recvfrom.c
index 3155071..0d4fba0 100644
--- a/lib/recvfrom.c
+++ b/lib/recvfrom.c
@@ -1,6 +1,6 @@
/* recvfrom.c --- wrappers for Windows recvfrom function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/ref-add.sin b/lib/ref-add.sin
index 7cbdec5..9adfb0d 100644
--- a/lib/ref-add.sin
+++ b/lib/ref-add.sin
@@ -1,6 +1,6 @@
# Add this package to a list of references stored in a text file.
#
-# Copyright (C) 2000, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2000, 2009-2014 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/ref-del.sin b/lib/ref-del.sin
index cf7b492..45449cb 100644
--- a/lib/ref-del.sin
+++ b/lib/ref-del.sin
@@ -1,6 +1,6 @@
# Remove this package from a list of references stored in a text file.
#
-# Copyright (C) 2000, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2000, 2009-2014 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/regcomp.c b/lib/regcomp.c
index b236f36..56faf11 100644
--- a/lib/regcomp.c
+++ b/lib/regcomp.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
@@ -292,7 +292,7 @@ weak_alias (__re_compile_fastmap, re_compile_fastmap)
#endif
static inline void
-__attribute ((always_inline))
+__attribute__ ((always_inline))
re_set_fastmap (char *fastmap, bool icase, int ch)
{
fastmap[ch] = 1;
@@ -586,7 +586,7 @@ weak_alias (__regerror, regerror)
static const bitset_t utf8_sb_map =
{
/* Set the first 128 bits. */
-# ifdef __GNUC__
+# if defined __GNUC__ && !defined __STRICT_ANSI__
[0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX
# else
# if 4 * BITSET_WORD_BITS < ASCII_CHARS
@@ -663,7 +663,10 @@ regfree (preg)
{
re_dfa_t *dfa = preg->buffer;
if (BE (dfa != NULL, 1))
- free_dfa_content (dfa);
+ {
+ lock_fini (dfa->lock);
+ free_dfa_content (dfa);
+ }
preg->buffer = NULL;
preg->allocated = 0;
@@ -784,6 +787,8 @@ re_compile_internal (regex_t *preg, const char * pattern,
size_t length,
preg->used = sizeof (re_dfa_t);
err = init_dfa (dfa, length);
+ if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0))
+ err = REG_ESPACE;
if (BE (err != REG_NOERROR, 0))
{
free_dfa_content (dfa);
@@ -797,8 +802,6 @@ re_compile_internal (regex_t *preg, const char * pattern,
size_t length,
strncpy (dfa->re_str, pattern, length + 1);
#endif
- __libc_lock_init (dfa->lock);
-
err = re_string_construct (®exp, pattern, length, preg->translate,
(syntax & RE_ICASE) != 0, dfa);
if (BE (err != REG_NOERROR, 0))
@@ -806,6 +809,7 @@ re_compile_internal (regex_t *preg, const char * pattern,
size_t length,
re_compile_internal_free_return:
free_workarea_compile (preg);
re_string_destruct (®exp);
+ lock_fini (dfa->lock);
free_dfa_content (dfa);
preg->buffer = NULL;
preg->allocated = 0;
@@ -838,6 +842,7 @@ re_compile_internal (regex_t *preg, const char * pattern,
size_t length,
if (BE (err != REG_NOERROR, 0))
{
+ lock_fini (dfa->lock);
free_dfa_content (dfa);
preg->buffer = NULL;
preg->allocated = 0;
@@ -2835,40 +2840,29 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
/* Local function for parse_bracket_exp used in _LIBC environment.
Seek the collating symbol entry corresponding to NAME.
- Return the index of the symbol in the SYMB_TABLE. */
+ Return the index of the symbol in the SYMB_TABLE,
+ or -1 if not found. */
auto inline int32_t
- __attribute ((always_inline))
- seek_collating_symbol_entry (name, name_len)
- const unsigned char *name;
- size_t name_len;
+ __attribute__ ((always_inline))
+ seek_collating_symbol_entry (const unsigned char *name, size_t name_len)
{
- int32_t hash = elem_hash ((const char *) name, name_len);
- int32_t elem = hash % table_size;
- if (symb_table[2 * elem] != 0)
- {
- int32_t second = hash % (table_size - 2) + 1;
+ int32_t elem;
- do
- {
- /* First compare the hashing value. */
- if (symb_table[2 * elem] == hash
- /* Compare the length of the name. */
- && name_len == extra[symb_table[2 * elem + 1]]
- /* Compare the name. */
- && memcmp (name, &extra[symb_table[2 * elem + 1] + 1],
- name_len) == 0)
- {
- /* Yep, this is the entry. */
- break;
- }
-
- /* Next entry. */
- elem += second;
- }
- while (symb_table[2 * elem] != 0);
- }
- return elem;
+ for (elem = 0; elem < table_size; elem++)
+ if (symb_table[2 * elem] != 0)
+ {
+ int32_t idx = symb_table[2 * elem + 1];
+ /* Skip the name of collating element name. */
+ idx += 1 + extra[idx];
+ if (/* Compare the length of the name. */
+ name_len == extra[idx]
+ /* Compare the name. */
+ && memcmp (name, &extra[idx + 1], name_len) == 0)
+ /* Yep, this is the entry. */
+ return elem;
+ }
+ return -1;
}
/* Local function for parse_bracket_exp used in _LIBC environment.
@@ -2876,9 +2870,8 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
Return the value if succeeded, UINT_MAX otherwise. */
auto inline unsigned int
- __attribute ((always_inline))
- lookup_collation_sequence_value (br_elem)
- bracket_elem_t *br_elem;
+ __attribute__ ((always_inline))
+ lookup_collation_sequence_value (bracket_elem_t *br_elem)
{
if (br_elem->type == SB_CHAR)
{
@@ -2906,7 +2899,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
int32_t elem, idx;
elem = seek_collating_symbol_entry (br_elem->opr.name,
sym_name_len);
- if (symb_table[2 * elem] != 0)
+ if (elem != -1)
{
/* We found the entry. */
idx = symb_table[2 * elem + 1];
@@ -2924,7 +2917,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
/* Return the collation sequence value. */
return *(unsigned int *) (extra + idx);
}
- else if (symb_table[2 * elem] == 0 && sym_name_len == 1)
+ else if (sym_name_len == 1)
{
/* No valid character. Match it as a single byte
character. */
@@ -2945,12 +2938,9 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
update it. */
auto inline reg_errcode_t
- __attribute ((always_inline))
- build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem)
- re_charset_t *mbcset;
- Idx *range_alloc;
- bitset_t sbcset;
- bracket_elem_t *start_elem, *end_elem;
+ __attribute__ ((always_inline))
+ build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc,
+ bracket_elem_t *start_elem, bracket_elem_t *end_elem)
{
unsigned int ch;
uint32_t start_collseq;
@@ -3029,26 +3019,23 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
pointer argument since we may update it. */
auto inline reg_errcode_t
- __attribute ((always_inline))
- build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name)
- re_charset_t *mbcset;
- Idx *coll_sym_alloc;
- bitset_t sbcset;
- const unsigned char *name;
+ __attribute__ ((always_inline))
+ build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset,
+ Idx *coll_sym_alloc, const unsigned char *name)
{
int32_t elem, idx;
size_t name_len = strlen ((const char *) name);
if (nrules != 0)
{
elem = seek_collating_symbol_entry (name, name_len);
- if (symb_table[2 * elem] != 0)
+ if (elem != -1)
{
/* We found the entry. */
idx = symb_table[2 * elem + 1];
/* Skip the name of collating element name. */
idx += 1 + extra[idx];
}
- else if (symb_table[2 * elem] == 0 && name_len == 1)
+ else if (name_len == 1)
{
/* No valid character, treat it as a normal
character. */
diff --git a/lib/regex.c b/lib/regex.c
index ca40e6e..e44f55f 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
@@ -24,6 +24,7 @@
# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
# endif
# if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wold-style-definition"
# pragma GCC diagnostic ignored "-Wtype-limits"
# endif
#endif
diff --git a/lib/regex.h b/lib/regex.h
index 74645ca..54327c6 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -1,6 +1,6 @@
/* Definitions for data structures and routines for the regular
expression library.
- Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 Free Software
+ Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2014 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
diff --git a/lib/regex_internal.c b/lib/regex_internal.c
index e11ad3d..0343ee6 100644
--- a/lib/regex_internal.c
+++ b/lib/regex_internal.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
@@ -834,7 +834,7 @@ re_string_reconstruct (re_string_t *pstr, Idx idx, int
eflags)
}
static unsigned char
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure))
re_string_peek_byte_case (const re_string_t *pstr, Idx idx)
{
int ch;
@@ -1354,7 +1354,7 @@ re_node_set_insert_last (re_node_set *set, Idx elem)
Return true if SET1 and SET2 are equivalent. */
static bool
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure))
re_node_set_compare (const re_node_set *set1, const re_node_set *set2)
{
Idx i;
@@ -1369,7 +1369,7 @@ re_node_set_compare (const re_node_set *set1, const
re_node_set *set2)
/* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise. */
static Idx
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure))
re_node_set_contains (const re_node_set *set, Idx elem)
{
__re_size_t idx, right, mid;
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index fa93382..a0eae33 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
@@ -32,12 +32,50 @@
#include <wctype.h>
#include <stdbool.h>
#include <stdint.h>
-#if defined _LIBC
+
+#ifdef _LIBC
# include <bits/libc-lock.h>
+# define lock_define(name) __libc_lock_define (, name)
+# define lock_init(lock) (__libc_lock_init (lock), 0)
+# define lock_fini(lock) 0
+# define lock_lock(lock) __libc_lock_lock (lock)
+# define lock_unlock(lock) __libc_lock_unlock (lock)
+#elif defined GNULIB_LOCK
+# include "glthread/lock.h"
+ /* Use gl_lock_define if empty macro arguments are known to work.
+ Otherwise, fall back on less-portable substitutes. */
+# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \
+ || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__))
+# define lock_define(name) gl_lock_define (, name)
+# elif USE_POSIX_THREADS
+# define lock_define(name) pthread_mutex_t name;
+# elif USE_PTH_THREADS
+# define lock_define(name) pth_mutex_t name;
+# elif USE_SOLARIS_THREADS
+# define lock_define(name) mutex_t name;
+# elif USE_WINDOWS_THREADS
+# define lock_define(name) gl_lock_t name;
+# else
+# define lock_define(name)
+# endif
+# define lock_init(lock) glthread_lock_init (&(lock))
+# define lock_fini(lock) glthread_lock_destroy (&(lock))
+# define lock_lock(lock) glthread_lock_lock (&(lock))
+# define lock_unlock(lock) glthread_lock_unlock (&(lock))
+#elif defined GNULIB_PTHREAD
+# include <pthread.h>
+# define lock_define(name) pthread_mutex_t name;
+# define lock_init(lock) pthread_mutex_init (&(lock), 0)
+# define lock_fini(lock) pthread_mutex_destroy (&(lock))
+# define lock_lock(lock) pthread_mutex_lock (&(lock))
+# define lock_unlock(lock) pthread_mutex_unlock (&(lock))
#else
-# define __libc_lock_init(NAME) do { } while (0)
-# define __libc_lock_lock(NAME) do { } while (0)
-# define __libc_lock_unlock(NAME) do { } while (0)
+# define lock_define(name)
+# define lock_init(lock) 0
+# define lock_fini(lock) ((void) 0)
+ /* The 'dfa' avoids an "unused variable 'dfa'" warning from GCC. */
+# define lock_lock(lock) ((void) dfa)
+# define lock_unlock(lock) ((void) 0)
#endif
/* In case that the system doesn't have isblank(). */
@@ -72,7 +110,7 @@
# define gettext_noop(String) String
#endif
-#if (defined MB_CUR_MAX && HAVE_WCTYPE_H && HAVE_ISWCTYPE && HAVE_WCSCOLL) ||
_LIBC
+#if (defined MB_CUR_MAX && HAVE_WCTYPE_H && HAVE_ISWCTYPE) || _LIBC
# define RE_ENABLE_I18N
#endif
@@ -107,10 +145,8 @@
# define attribute_hidden
#endif /* not _LIBC */
-#if __GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1)
-# define __attribute(arg) __attribute__ (arg)
-#else
-# define __attribute(arg)
+#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1)
+# define __attribute__(arg)
#endif
typedef __re_idx_t Idx;
@@ -426,7 +462,7 @@ static void build_upper_buffer (re_string_t *pstr)
internal_function;
static void re_string_translate_buffer (re_string_t *pstr) internal_function;
static unsigned int re_string_context_at (const re_string_t *input, Idx idx,
int eflags)
- internal_function __attribute ((pure));
+ internal_function __attribute__ ((pure));
#endif
#define re_string_peek_byte(pstr, offset) \
((pstr)->mbs[(pstr)->cur_idx + offset])
@@ -700,9 +736,7 @@ struct re_dfa_t
#ifdef DEBUG
char* re_str;
#endif
-#ifdef _LIBC
- __libc_lock_define (, lock)
-#endif
+ lock_define (lock)
};
#define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
@@ -774,7 +808,7 @@ bitset_copy (bitset_t dest, const bitset_t src)
memcpy (dest, src, sizeof (bitset_t));
}
-static void
+static void __attribute__ ((unused))
bitset_not (bitset_t set)
{
int bitset_i;
@@ -786,7 +820,7 @@ bitset_not (bitset_t set)
& ~set[BITSET_WORDS - 1]);
}
-static void
+static void __attribute__ ((unused))
bitset_merge (bitset_t dest, const bitset_t src)
{
int bitset_i;
@@ -794,7 +828,7 @@ bitset_merge (bitset_t dest, const bitset_t src)
dest[bitset_i] |= src[bitset_i];
}
-static void
+static void __attribute__ ((unused))
bitset_mask (bitset_t dest, const bitset_t src)
{
int bitset_i;
@@ -805,7 +839,7 @@ bitset_mask (bitset_t dest, const bitset_t src)
#ifdef RE_ENABLE_I18N
/* Functions for re_string. */
static int
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure, unused))
re_string_char_size_at (const re_string_t *pstr, Idx idx)
{
int byte_idx;
@@ -818,7 +852,7 @@ re_string_char_size_at (const re_string_t *pstr, Idx idx)
}
static wint_t
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure, unused))
re_string_wchar_at (const re_string_t *pstr, Idx idx)
{
if (pstr->mb_cur_max == 1)
@@ -828,7 +862,7 @@ re_string_wchar_at (const re_string_t *pstr, Idx idx)
# ifndef NOT_IN_libc
static int
-internal_function __attribute ((pure))
+internal_function __attribute__ ((pure, unused))
re_string_elem_size_at (const re_string_t *pstr, Idx idx)
{
# ifdef _LIBC
diff --git a/lib/regexec.c b/lib/regexec.c
index 1bd1640..05a8e80 100644
--- a/lib/regexec.c
+++ b/lib/regexec.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
@@ -228,9 +228,7 @@ regexec (preg, string, nmatch, pmatch, eflags)
{
reg_errcode_t err;
Idx start, length;
-#ifdef _LIBC
re_dfa_t *dfa = preg->buffer;
-#endif
if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND))
return REG_BADPAT;
@@ -246,14 +244,14 @@ regexec (preg, string, nmatch, pmatch, eflags)
length = strlen (string);
}
- __libc_lock_lock (dfa->lock);
+ lock_lock (dfa->lock);
if (preg->no_sub)
err = re_search_internal (preg, string, length, start, length,
length, 0, NULL, eflags);
else
err = re_search_internal (preg, string, length, start, length,
length, nmatch, pmatch, eflags);
- __libc_lock_unlock (dfa->lock);
+ lock_unlock (dfa->lock);
return err != REG_NOERROR;
}
@@ -421,9 +419,7 @@ re_search_stub (struct re_pattern_buffer *bufp,
Idx nregs;
regoff_t rval;
int eflags = 0;
-#ifdef _LIBC
re_dfa_t *dfa = bufp->buffer;
-#endif
Idx last_start = start + range;
/* Check for out-of-range. */
@@ -434,7 +430,7 @@ re_search_stub (struct re_pattern_buffer *bufp,
else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0))
last_start = 0;
- __libc_lock_lock (dfa->lock);
+ lock_lock (dfa->lock);
eflags |= (bufp->not_bol) ? REG_NOTBOL : 0;
eflags |= (bufp->not_eol) ? REG_NOTEOL : 0;
@@ -498,7 +494,7 @@ re_search_stub (struct re_pattern_buffer *bufp,
}
re_free (pmatch);
out:
- __libc_lock_unlock (dfa->lock);
+ lock_unlock (dfa->lock);
return rval;
}
@@ -1064,7 +1060,7 @@ prune_impossible_nodes (re_match_context_t *mctx)
since initial states may have constraints like "\<", "^", etc.. */
static inline re_dfastate_t *
-__attribute ((always_inline)) internal_function
+__attribute__ ((always_inline)) internal_function
acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx,
Idx idx)
{
diff --git a/lib/rename.c b/lib/rename.c
index eceadec..1cd4e6d 100644
--- a/lib/rename.c
+++ b/lib/rename.c
@@ -1,6 +1,6 @@
/* Work around rename bugs in some systems.
- Copyright (C) 2001-2003, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2003, 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/rmdir.c b/lib/rmdir.c
index f18acbe..964dd20 100644
--- a/lib/rmdir.c
+++ b/lib/rmdir.c
@@ -1,6 +1,6 @@
/* Work around rmdir bugs.
- Copyright (C) 1988, 1990, 1999, 2003-2006, 2009-2013 Free Software
+ Copyright (C) 1988, 1990, 1999, 2003-2006, 2009-2014 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/round.c b/lib/round.c
index 4d4e69b..d1c2aac 100644
--- a/lib/round.c
+++ b/lib/round.c
@@ -1,5 +1,5 @@
/* Round toward nearest, breaking ties away from zero.
- Copyright (C) 2007, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/safe-read.c b/lib/safe-read.c
index 39490ab..6c9639f 100644
--- a/lib/safe-read.c
+++ b/lib/safe-read.c
@@ -1,6 +1,6 @@
/* An interface to read and write that retries after interrupts.
- Copyright (C) 1993-1994, 1998, 2002-2006, 2009-2013 Free Software
+ Copyright (C) 1993-1994, 1998, 2002-2006, 2009-2014 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/safe-read.h b/lib/safe-read.h
index 91a86c6..6cd5f68 100644
--- a/lib/safe-read.h
+++ b/lib/safe-read.h
@@ -1,5 +1,5 @@
/* An interface to read() that retries after interrupts.
- Copyright (C) 2002, 2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/safe-write.c b/lib/safe-write.c
index 71f2f3d..3e7ffd6 100644
--- a/lib/safe-write.c
+++ b/lib/safe-write.c
@@ -1,5 +1,5 @@
/* An interface to write that retries after interrupts.
- Copyright (C) 2002, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/safe-write.h b/lib/safe-write.h
index 779f5d5..45a6146 100644
--- a/lib/safe-write.h
+++ b/lib/safe-write.h
@@ -1,5 +1,5 @@
/* An interface to write() that retries after interrupts.
- Copyright (C) 2002, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/same-inode.h b/lib/same-inode.h
index 94fe3e2..f85a3cc 100644
--- a/lib/same-inode.h
+++ b/lib/same-inode.h
@@ -1,6 +1,6 @@
/* Determine whether two stat buffers refer to the same file.
- Copyright (C) 2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/select.c b/lib/select.c
index 13ca150..a31f902 100644
--- a/lib/select.c
+++ b/lib/select.c
@@ -1,7 +1,7 @@
/* Emulation for select(2)
Contributed by Paolo Bonzini.
- Copyright 2008-2013 Free Software Foundation, Inc.
+ Copyright 2008-2014 Free Software Foundation, Inc.
This file is part of gnulib.
diff --git a/lib/send.c b/lib/send.c
index 3e76ce1..9e70c91 100644
--- a/lib/send.c
+++ b/lib/send.c
@@ -1,6 +1,6 @@
/* send.c --- wrappers for Windows send function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sendto.c b/lib/sendto.c
index 2154582..69b8ebc 100644
--- a/lib/sendto.c
+++ b/lib/sendto.c
@@ -1,6 +1,6 @@
/* sendto.c --- wrappers for Windows sendto function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/setenv.c b/lib/setenv.c
index 8076c54..50e6860 100644
--- a/lib/setenv.c
+++ b/lib/setenv.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1992, 1995-2003, 2005-2013 Free Software Foundation, Inc.
+/* Copyright (C) 1992, 1995-2003, 2005-2014 Free Software Foundation, Inc.
This file is part of the GNU C Library.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/setsockopt.c b/lib/setsockopt.c
index 7a50835..2b905da 100644
--- a/lib/setsockopt.c
+++ b/lib/setsockopt.c
@@ -1,6 +1,6 @@
/* setsockopt.c --- wrappers for Windows setsockopt function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/shutdown.c b/lib/shutdown.c
index 2f5fc54..54b7728 100644
--- a/lib/shutdown.c
+++ b/lib/shutdown.c
@@ -1,6 +1,6 @@
/* shutdown.c --- wrappers for Windows shutdown function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/signal.in.h b/lib/signal.in.h
index 6f96f0d..057fa9e 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <signal.h>.
- Copyright (C) 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -195,6 +195,20 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1];
# endif
+/* When also using extern inline, suppress the use of static inline in
+ standard headers of problematic Apple configurations, as Libc at
+ least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
+ <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ Perhaps Apple will fix this some day. */
+#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
+ && (defined __i386__ || defined __x86_64__))
+# undef sigaddset
+# undef sigdelset
+# undef sigemptyset
+# undef sigfillset
+# undef sigismember
+#endif
+
/* Test whether a given signal is contained in a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
/* This function is defined as a macro on Mac OS X. */
diff --git a/lib/signbitd.c b/lib/signbitd.c
index 1c813da..1efb6e6 100644
--- a/lib/signbitd.c
+++ b/lib/signbitd.c
@@ -1,5 +1,5 @@
/* signbit() macro: Determine the sign bit of a floating-point number.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/signbitf.c b/lib/signbitf.c
index 817484b..3240e4e 100644
--- a/lib/signbitf.c
+++ b/lib/signbitf.c
@@ -1,5 +1,5 @@
/* signbit() macro: Determine the sign bit of a floating-point number.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/signbitl.c b/lib/signbitl.c
index 159cfce..3f84725 100644
--- a/lib/signbitl.c
+++ b/lib/signbitl.c
@@ -1,5 +1,5 @@
/* signbit() macro: Determine the sign bit of a floating-point number.
- Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/size_max.h b/lib/size_max.h
index 20fb1b7..680ca0f 100644
--- a/lib/size_max.h
+++ b/lib/size_max.h
@@ -1,5 +1,5 @@
/* size_max.h -- declare SIZE_MAX through system headers
- Copyright (C) 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-2014 Free Software Foundation, Inc.
Written by Simon Josefsson.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/snprintf.c b/lib/snprintf.c
index 3cccf48..0b8cbf8 100644
--- a/lib/snprintf.c
+++ b/lib/snprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 2004, 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2006-2014 Free Software Foundation, Inc.
Written by Simon Josefsson and Paul Eggert.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/socket.c b/lib/socket.c
index 17fecc4..c10d4f6 100644
--- a/lib/socket.c
+++ b/lib/socket.c
@@ -1,6 +1,6 @@
/* socket.c --- wrappers for Windows socket function
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sockets.c b/lib/sockets.c
index d4652a2..98fe879 100644
--- a/lib/sockets.c
+++ b/lib/sockets.c
@@ -1,6 +1,6 @@
/* sockets.c --- wrappers for Windows socket functions
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sockets.h b/lib/sockets.h
index 4eb4dcb..dd99ec1 100644
--- a/lib/sockets.h
+++ b/lib/sockets.h
@@ -1,6 +1,6 @@
/* sockets.h - wrappers for Windows socket functions
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/stat-time.h b/lib/stat-time.h
index a3dff54..5700013 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -1,6 +1,6 @@
/* stat-related time functions.
- Copyright (C) 2005, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -23,6 +23,9 @@
#include <sys/stat.h>
#include <time.h>
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_STAT_TIME_INLINE
# define _GL_STAT_TIME_INLINE _GL_INLINE
diff --git a/lib/stat.c b/lib/stat.c
index c42962b..60bbd69 100644
--- a/lib/stat.c
+++ b/lib/stat.c
@@ -1,5 +1,5 @@
/* Work around platform bugs in stat.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index d9b2eec..29861ef 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -1,6 +1,6 @@
/* A substitute for ISO C11 <stdalign.h>.
- Copyright 2011-2013 Free Software Foundation, Inc.
+ Copyright 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -41,13 +41,28 @@
are 4 unless the option '-malign-double' is used.
The result cannot be used as a value for an 'enum' constant, if you
- want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */
+ want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc.
+
+ Include <stddef.h> for offsetof. */
#include <stddef.h>
-#if defined __cplusplus
+
+/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other
+ standard headers, defines conflicting implementations of _Alignas
+ and _Alignof that are no better than ours; override them. */
+#undef _Alignas
+#undef _Alignof
+
+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112
+# ifdef __cplusplus
+# if 201103 <= __cplusplus
+# define _Alignof(type) alignof (type)
+# else
template <class __t> struct __alignof_helper { char __a; __t __b; };
-# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
-#else
-# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+# endif
+# else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+# endif
#endif
#define alignof _Alignof
#define __alignof_is_defined 1
@@ -77,12 +92,17 @@
*/
-#if __GNUC__ || __IBMC__ || __IBMCPP__ || 0x5110 <= __SUNPRO_C
-# define _Alignas(a) __attribute__ ((__aligned__ (a)))
-#elif 1300 <= _MSC_VER
-# define _Alignas(a) __declspec (align (a))
+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112
+# if defined __cplusplus && 201103 <= __cplusplus
+# define _Alignas(a) alignas (a)
+# elif (__GNUC__ || __HP_cc || __HP_aCC || __IBMC__ || __IBMCPP__ \
+ || __ICC || 0x5110 <= __SUNPRO_C)
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+# elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+# endif
#endif
-#ifdef _Alignas
+#if defined _Alignas || (defined __STDC_VERSION && 201112 <= __STDC_VERSION__)
# define alignas _Alignas
# define __alignas_is_defined 1
#endif
diff --git a/lib/stdbool.in.h b/lib/stdbool.in.h
index bd629ed..2f34a13 100644
--- a/lib/stdbool.in.h
+++ b/lib/stdbool.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2003, 2006-2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2003, 2006-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 614c9bc..204c4bc 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -1,6 +1,6 @@
/* A substitute for POSIX 2008 <stddef.h>, for platforms that have issues.
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index 889bca7..b1296f9 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2002, 2004-2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2002, 2004-2014 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
This file is part of gnulib.
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index bc3fccb..faa778b 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdio.h>.
- Copyright (C) 2004, 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -124,6 +124,15 @@
#define _GL_STDIO_STRINGIZE(token) #token
#define _GL_STDIO_MACROEXPAND_AND_STRINGIZE(token) _GL_STDIO_STRINGIZE(token)
+/* When also using extern inline, suppress the use of static inline in
+ standard headers of problematic Apple configurations, as Libc at
+ least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
+ <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ Perhaps Apple will fix this some day. */
+#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
+ && defined __GNUC__ && defined __STDC__)
+# undef putc_unlocked
+#endif
#if @GNULIB_DPRINTF@
# if @REPLACE_DPRINTF@
@@ -579,13 +588,23 @@ _GL_CXXALIAS_SYS (fwrite, size_t,
<http://sources.redhat.com/bugzilla/show_bug.cgi?id=11959>,
which sometimes causes an unwanted diagnostic for fwrite calls.
This affects only function declaration attributes under certain
- versions of gcc, and is not needed for C++. */
+ versions of gcc and clang, and is not needed for C++. */
# if (0 < __USE_FORTIFY_LEVEL \
&& __GLIBC__ == 2 && 4 <= __GLIBC_MINOR__ && __GLIBC_MINOR__ <= 15 \
&& 3 < __GNUC__ + (4 <= __GNUC_MINOR__) \
&& !defined __cplusplus)
# undef fwrite
-# define fwrite(a, b, c, d) ({size_t __r = fwrite (a, b, c, d); __r; })
+# undef fwrite_unlocked
+extern size_t __REDIRECT (rpl_fwrite,
+ (const void *__restrict, size_t, size_t,
+ FILE *__restrict),
+ fwrite);
+extern size_t __REDIRECT (rpl_fwrite_unlocked,
+ (const void *__restrict, size_t, size_t,
+ FILE *__restrict),
+ fwrite_unlocked);
+# define fwrite rpl_fwrite
+# define fwrite_unlocked rpl_fwrite_unlocked
# endif
# endif
_GL_CXXALIASWARN (fwrite);
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 552fdf0..57d32cc 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2004, 2006-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/streq.h b/lib/streq.h
index 03ede61..0f7bc72 100644
--- a/lib/streq.h
+++ b/lib/streq.h
@@ -1,5 +1,5 @@
/* Optimized string comparison.
- Copyright (C) 2001-2002, 2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2007, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
diff --git a/lib/strftime.c b/lib/strftime.c
index 058ba11..eb458d1 100644
--- a/lib/strftime.c
+++ b/lib/strftime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-2001, 2003-2007, 2009-2013 Free Software Foundation, Inc.
+/* Copyright (C) 1991-2001, 2003-2007, 2009-2014 Free Software Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
Library.
Bugs can be reported to address@hidden
diff --git a/lib/strftime.h b/lib/strftime.h
index a521875..a394640 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -1,6 +1,6 @@
/* declarations for strftime.c
- Copyright (C) 2002, 2004, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/striconveh.c b/lib/striconveh.c
index bc841eb..1a2f62e 100644
--- a/lib/striconveh.c
+++ b/lib/striconveh.c
@@ -1,5 +1,5 @@
/* Character set conversion with error handling.
- Copyright (C) 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2014 Free Software Foundation, Inc.
Written by Bruno Haible and Simon Josefsson.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/striconveh.h b/lib/striconveh.h
index ea6a6dc..a4e425a 100644
--- a/lib/striconveh.h
+++ b/lib/striconveh.h
@@ -1,5 +1,5 @@
/* Character set conversion with error handling.
- Copyright (C) 2001-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible and Simon Josefsson.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/string.in.h b/lib/string.in.h
index 5dcf8de..eaaaa9d 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <string.h>.
- Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/stripslash.c b/lib/stripslash.c
index 16d4339..22295e5 100644
--- a/lib/stripslash.c
+++ b/lib/stripslash.c
@@ -1,6 +1,6 @@
/* stripslash.c -- remove redundant trailing slashes from a file name
- Copyright (C) 1990, 2001, 2003-2006, 2009-2013 Free Software Foundation,
+ Copyright (C) 1990, 2001, 2003-2006, 2009-2014 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/sys_file.in.h b/lib/sys_file.in.h
index 152311c..1df6946 100644
--- a/lib/sys_file.in.h
+++ b/lib/sys_file.in.h
@@ -1,6 +1,6 @@
/* Provide a more complete sys/file.h.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index 0e3e32d..7e5c3a3 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -1,5 +1,5 @@
/* Substitute for <sys/select.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -21,23 +21,27 @@
/* On OSF/1 and Solaris 2.6, <sys/types.h> and <sys/time.h>
both include <sys/select.h>.
+ On Cygwin, <sys/time.h> includes <sys/select.h>.
Simply delegate to the system's header in this case. */
#if (@HAVE_SYS_SELECT_H@ \
- && ((defined __osf__ && defined _SYS_TYPES_H_ && defined _OSF_SOURCE) \
+ && ((defined __osf__ && defined _SYS_TYPES_H_ \
+ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H \
+ && defined _OSF_SOURCE) \
|| (defined __sun && defined _SYS_TYPES_H \
&& (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \
- || defined __EXTENSIONS__))) \
- && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H)
+ || defined __EXTENSIONS__))))
# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H
# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
#elif (@HAVE_SYS_SELECT_H@ \
- && ((defined __osf__ && defined _SYS_TIME_H_ && defined _OSF_SOURCE) \
+ && (defined _CYGWIN_SYS_TIME_H \
+ || (defined __osf__ && defined _SYS_TIME_H_ \
+ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H \
+ && defined _OSF_SOURCE) \
|| (defined __sun && defined _SYS_TIME_H \
&& (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \
- || defined __EXTENSIONS__))) \
- && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H)
+ || defined __EXTENSIONS__))))
# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H
# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
diff --git a/lib/sys_socket.in.h b/lib/sys_socket.in.h
index 31ed042..0cbc3e4 100644
--- a/lib/sys_socket.in.h
+++ b/lib/sys_socket.in.h
@@ -1,6 +1,6 @@
/* Provide a sys/socket header file for systems lacking it (read: MinGW)
and for systems where it is incomplete.
- Copyright (C) 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2014 Free Software Foundation, Inc.
Written by Simon Josefsson.
This program is free software; you can redistribute it and/or modify
@@ -63,6 +63,9 @@
#ifndef address@hidden@_SYS_SOCKET_H
#define address@hidden@_SYS_SOCKET_H
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_SYS_SOCKET_INLINE
# define _GL_SYS_SOCKET_INLINE _GL_INLINE
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 12f99da..32c23a0 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -1,5 +1,5 @@
/* Provide a more complete sys/stat header file.
- Copyright (C) 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
index f2398c5..f19326e 100644
--- a/lib/sys_time.in.h
+++ b/lib/sys_time.in.h
@@ -1,6 +1,6 @@
/* Provide a more complete sys/time.h.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -24,6 +24,15 @@
#endif
@PRAGMA_COLUMNS@
+/* On Cygwin and on many BSDish systems, <sys/time.h> includes itself
+ recursively via <sys/select.h>.
+ Simply delegate to the system's header in this case; it is a no-op.
+ Without this extra ifdef, the C++ gettimeofday declaration below
+ would be a forward declaration in gnulib's nested <sys/time.h>. */
+#if defined _CYGWIN_SYS_TIME_H || defined _SYS_TIME_H || defined _SYS_TIME_H_
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+#else
+
/* The include_next requires a split double-inclusion guard. */
#if @HAVE_SYS_TIME_H@
# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
@@ -200,4 +209,5 @@ _GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable
- "
#endif
#endif /* address@hidden@_SYS_TIME_H */
+#endif /* _CYGWIN_SYS_TIME_H */
#endif /* address@hidden@_SYS_TIME_H */
diff --git a/lib/sys_times.in.h b/lib/sys_times.in.h
index 8ea8088..b3babfb 100644
--- a/lib/sys_times.in.h
+++ b/lib/sys_times.in.h
@@ -1,5 +1,5 @@
/* Provide a sys/times.h header file.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
index 520f6c8..c8d0bb4 100644
--- a/lib/sys_types.in.h
+++ b/lib/sys_types.in.h
@@ -1,6 +1,6 @@
/* Provide a more complete sys/types.h.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/sys_uio.in.h b/lib/sys_uio.in.h
index 6f605df..8cad7de 100644
--- a/lib/sys_uio.in.h
+++ b/lib/sys_uio.in.h
@@ -1,5 +1,5 @@
/* Substitute for <sys/uio.h>.
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/time.in.h b/lib/time.in.h
index 71dcc36..01681cc 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -1,6 +1,6 @@
/* A more-standard <time.h>.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -48,20 +48,13 @@
/* Some systems don't define struct timespec (e.g., AIX 4.1, Ultrix 4.3).
Or they define it with the wrong member names or define it in <sys/time.h>
- (e.g., FreeBSD circa 1997). Stock Mingw does not define it, but the
- pthreads-win32 library defines it in <pthread.h>. */
+ (e.g., FreeBSD circa 1997). Stock Mingw prior to 3.0 does not define it,
+ but the pthreads-win32 library defines it in <pthread.h>. */
# if ! @TIME_H_DEFINES_STRUCT_TIMESPEC@
# if @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
# include <sys/time.h>
# elif @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@
# include <pthread.h>
-/* The pthreads-win32 <pthread.h> also defines a couple of broken macros. */
-# undef asctime_r
-# undef ctime_r
-# undef gmtime_r
-# undef localtime_r
-# undef rand_r
-# undef strtok_r
# else
# ifdef __cplusplus
@@ -187,6 +180,39 @@ _GL_CXXALIASWARN (gmtime_r);
# endif
# endif
+/* Convert TIMER to RESULT, assuming local time and UTC respectively. See
+ <http://www.opengroup.org/susv3xsh/localtime.html> and
+ <http://www.opengroup.org/susv3xsh/gmtime.html>. */
+# if @GNULIB_GETTIMEOFDAY@
+# if @REPLACE_LOCALTIME@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef localtime
+# define localtime rpl_localtime
+# endif
+_GL_FUNCDECL_RPL (localtime, struct tm *, (time_t const *__timer)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (localtime, struct tm *, (time_t const *__timer));
+# else
+_GL_CXXALIAS_SYS (localtime, struct tm *, (time_t const *__timer));
+# endif
+_GL_CXXALIASWARN (localtime);
+# endif
+
+# if @GNULIB_GETTIMEOFDAY@
+# if @REPLACE_GMTIME@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gmtime
+# define gmtime rpl_gmtime
+# endif
+_GL_FUNCDECL_RPL (gmtime, struct tm *, (time_t const *__timer)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (gmtime, struct tm *, (time_t const *__timer));
+# else
+_GL_CXXALIAS_SYS (gmtime, struct tm *, (time_t const *__timer));
+# endif
+_GL_CXXALIASWARN (gmtime);
+# endif
+
/* Parse BUF as a time stamp, assuming FORMAT specifies its layout, and store
the resulting broken-down time into TM. See
<http://www.opengroup.org/susv3xsh/strptime.html>. */
diff --git a/lib/time_r.c b/lib/time_r.c
index 9a61794..0249750 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -1,6 +1,6 @@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2010-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/times.c b/lib/times.c
index cf2fa1d..605f235 100644
--- a/lib/times.c
+++ b/lib/times.c
@@ -1,6 +1,6 @@
/* Get process times
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/trunc.c b/lib/trunc.c
index 26a784b..e285733 100644
--- a/lib/trunc.c
+++ b/lib/trunc.c
@@ -1,5 +1,5 @@
/* Round towards zero.
- Copyright (C) 2007, 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 84bed4a..9880908 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -1,5 +1,5 @@
/* Substitute for and wrapper around <unistd.h>.
- Copyright (C) 2003-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -61,8 +61,10 @@
/* mingw, MSVC, BeOS, Haiku declare environ in <stdlib.h>, not in
<unistd.h>. */
/* Solaris declares getcwd not only in <unistd.h> but also in <stdlib.h>. */
+/* OSF Tru64 Unix cannot see gnulib rpl_strtod when system <stdlib.h> is
+ included here. */
/* But avoid namespace pollution on glibc systems. */
-#ifndef __GLIBC__
+#if !defined __GLIBC__ && !defined __osf__
# define __need_system_stdlib_h
# include <stdlib.h>
# undef __need_system_stdlib_h
@@ -114,6 +116,9 @@
# include <getopt.h>
#endif
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_UNISTD_INLINE
# define _GL_UNISTD_INLINE _GL_INLINE
@@ -649,10 +654,19 @@ _GL_WARN_ON_USE (getdomainname, "getdomainname is
unportable - "
#if @GNULIB_GETDTABLESIZE@
/* Return the maximum number of file descriptors in the current process.
In POSIX, this is same as sysconf (_SC_OPEN_MAX). */
-# if address@hidden@
+# if @REPLACE_GETDTABLESIZE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getdtablesize
+# define getdtablesize rpl_getdtablesize
+# endif
+_GL_FUNCDECL_RPL (getdtablesize, int, (void));
+_GL_CXXALIAS_RPL (getdtablesize, int, (void));
+# else
+# if address@hidden@
_GL_FUNCDECL_SYS (getdtablesize, int, (void));
-# endif
+# endif
_GL_CXXALIAS_SYS (getdtablesize, int, (void));
+# endif
_GL_CXXALIASWARN (getdtablesize);
#elif defined GNULIB_POSIXCHECK
# undef getdtablesize
diff --git a/lib/unistr.in.h b/lib/unistr.in.h
index 2d28b1f..73d2c23 100644
--- a/lib/unistr.in.h
+++ b/lib/unistr.in.h
@@ -1,5 +1,5 @@
/* Elementary Unicode string functions.
- Copyright (C) 2001-2002, 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2005-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
diff --git a/lib/unistr/u8-mbtouc-aux.c b/lib/unistr/u8-mbtouc-aux.c
index 0179498..02cdacd 100644
--- a/lib/unistr/u8-mbtouc-aux.c
+++ b/lib/unistr/u8-mbtouc-aux.c
@@ -1,5 +1,5 @@
/* Conversion UTF-8 to UCS-4.
- Copyright (C) 2001-2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-mbtouc-unsafe-aux.c
b/lib/unistr/u8-mbtouc-unsafe-aux.c
index 65f792c..bfa96f4 100644
--- a/lib/unistr/u8-mbtouc-unsafe-aux.c
+++ b/lib/unistr/u8-mbtouc-unsafe-aux.c
@@ -1,5 +1,5 @@
/* Conversion UTF-8 to UCS-4.
- Copyright (C) 2001-2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-mbtouc-unsafe.c b/lib/unistr/u8-mbtouc-unsafe.c
index 8aecdd4..9c2095b 100644
--- a/lib/unistr/u8-mbtouc-unsafe.c
+++ b/lib/unistr/u8-mbtouc-unsafe.c
@@ -1,5 +1,5 @@
/* Look at first character in UTF-8 string.
- Copyright (C) 1999-2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-mbtouc.c b/lib/unistr/u8-mbtouc.c
index 2e644bb..2b389de 100644
--- a/lib/unistr/u8-mbtouc.c
+++ b/lib/unistr/u8-mbtouc.c
@@ -1,5 +1,5 @@
/* Look at first character in UTF-8 string.
- Copyright (C) 1999-2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-mbtoucr.c b/lib/unistr/u8-mbtoucr.c
index 7b9d8a7..3a75a41 100644
--- a/lib/unistr/u8-mbtoucr.c
+++ b/lib/unistr/u8-mbtoucr.c
@@ -1,5 +1,5 @@
/* Look at first character in UTF-8 string, returning an error code.
- Copyright (C) 1999-2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2001.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-prev.c b/lib/unistr/u8-prev.c
index 5e97909..b2c2b9b 100644
--- a/lib/unistr/u8-prev.c
+++ b/lib/unistr/u8-prev.c
@@ -1,5 +1,5 @@
/* Iterate over previous character in UTF-8 string.
- Copyright (C) 2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2002.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-uctomb-aux.c b/lib/unistr/u8-uctomb-aux.c
index a6d21a4..8d94bf5 100644
--- a/lib/unistr/u8-uctomb-aux.c
+++ b/lib/unistr/u8-uctomb-aux.c
@@ -1,5 +1,5 @@
/* Conversion UCS-4 to UTF-8.
- Copyright (C) 2002, 2006-2007, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006-2007, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2002.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unistr/u8-uctomb.c b/lib/unistr/u8-uctomb.c
index 5e6a825..1ce271f 100644
--- a/lib/unistr/u8-uctomb.c
+++ b/lib/unistr/u8-uctomb.c
@@ -1,5 +1,5 @@
/* Store a character in UTF-8 string.
- Copyright (C) 2002, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2005-2006, 2009-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2002.
This program is free software: you can redistribute it and/or modify it
diff --git a/lib/unitypes.in.h b/lib/unitypes.in.h
index 50a59f1..e5ff992 100644
--- a/lib/unitypes.in.h
+++ b/lib/unitypes.in.h
@@ -1,5 +1,5 @@
/* Elementary types and macros for the GNU UniString library.
- Copyright (C) 2002, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
diff --git a/lib/vasnprintf.c b/lib/vasnprintf.c
index 2e6bc80..7282b05 100644
--- a/lib/vasnprintf.c
+++ b/lib/vasnprintf.c
@@ -1,5 +1,5 @@
/* vsprintf with automatic memory allocation.
- Copyright (C) 1999, 2002-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2002-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -5153,7 +5153,8 @@ VASNPRINTF (DCHAR_T *resultbuf, size_t *lengthp,
size_t tmp_length =
MAX_ROOM_NEEDED (&a, dp->arg_index,
dp->conversion, type, flags,
- width, has_precision,
+ has_width ? width : 0,
+ has_precision,
precision, pad_ourselves);
if (maxlen < tmp_length)
diff --git a/lib/vasnprintf.h b/lib/vasnprintf.h
index 8571eb7..a3f48e8 100644
--- a/lib/vasnprintf.h
+++ b/lib/vasnprintf.h
@@ -1,5 +1,5 @@
/* vsprintf with automatic memory allocation.
- Copyright (C) 2002-2004, 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2002-2004, 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/verify.h b/lib/verify.h
index 40b8ef5..78d543f 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -1,6 +1,6 @@
/* Compile-time assert-like macros.
- Copyright (C) 2005-2006, 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -18,7 +18,7 @@
/* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */
#ifndef _GL_VERIFY_H
-# define _GL_VERIFY_H
+#define _GL_VERIFY_H
/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per C11.
@@ -31,14 +31,24 @@
Use this only with GCC. If we were willing to slow 'configure'
down we could also use it with other compilers, but since this
affects only the quality of diagnostics, why bother? */
-# if (4 < __GNUC__ || (__GNUC__ == 4 && 6 <= __GNUC_MINOR__)) && !defined
__cplusplus
-# define _GL_HAVE__STATIC_ASSERT 1
-# endif
+#if (4 < __GNUC__ + (6 <= __GNUC_MINOR__) \
+ && (201112L <= __STDC_VERSION__ || !defined __STRICT_ANSI__) \
+ && !defined __cplusplus)
+# define _GL_HAVE__STATIC_ASSERT 1
+#endif
/* The condition (99 < __GNUC__) is temporary, until we know about the
first G++ release that supports static_assert. */
-# if (99 < __GNUC__) && defined __cplusplus
-# define _GL_HAVE_STATIC_ASSERT 1
-# endif
+#if (99 < __GNUC__) && defined __cplusplus
+# define _GL_HAVE_STATIC_ASSERT 1
+#endif
+
+/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other
+ system headers, defines a conflicting _Static_assert that is no
+ better than ours; override it. */
+#ifndef _GL_HAVE_STATIC_ASSERT
+# include <stddef.h>
+# undef _Static_assert
+#endif
/* Each of these macros verifies that its argument R is nonzero. To
be portable, R should be an integer constant expression. Unlike
@@ -141,50 +151,50 @@
Use a template type to work around the problem. */
/* Concatenate two preprocessor tokens. */
-# define _GL_CONCAT(x, y) _GL_CONCAT0 (x, y)
-# define _GL_CONCAT0(x, y) x##y
+#define _GL_CONCAT(x, y) _GL_CONCAT0 (x, y)
+#define _GL_CONCAT0(x, y) x##y
/* _GL_COUNTER is an integer, preferably one that changes each time we
use it. Use __COUNTER__ if it works, falling back on __LINE__
otherwise. __LINE__ isn't perfect, but it's better than a
constant. */
-# if defined __COUNTER__ && __COUNTER__ != __COUNTER__
-# define _GL_COUNTER __COUNTER__
-# else
-# define _GL_COUNTER __LINE__
-# endif
+#if defined __COUNTER__ && __COUNTER__ != __COUNTER__
+# define _GL_COUNTER __COUNTER__
+#else
+# define _GL_COUNTER __LINE__
+#endif
/* Generate a symbol with the given prefix, making it unique if
possible. */
-# define _GL_GENSYM(prefix) _GL_CONCAT (prefix, _GL_COUNTER)
+#define _GL_GENSYM(prefix) _GL_CONCAT (prefix, _GL_COUNTER)
/* Verify requirement R at compile-time, as an integer constant expression
that returns 1. If R is false, fail at compile-time, preferably
with a diagnostic that includes the string-literal DIAGNOSTIC. */
-# define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \
- (!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC)))
+#define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \
+ (!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC)))
-# ifdef __cplusplus
-# if !GNULIB_defined_struct__gl_verify_type
+#ifdef __cplusplus
+# if !GNULIB_defined_struct__gl_verify_type
template <int w>
struct _gl_verify_type {
unsigned int _gl_verify_error_if_negative: w;
};
-# define GNULIB_defined_struct__gl_verify_type 1
-# endif
-# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
- _gl_verify_type<(R) ? 1 : -1>
-# elif defined _GL_HAVE__STATIC_ASSERT
-# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
- struct { \
- _Static_assert (R, DIAGNOSTIC); \
- int _gl_dummy; \
- }
-# else
-# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
- struct { unsigned int _gl_verify_error_if_negative: (R) ? 1 : -1; }
+# define GNULIB_defined_struct__gl_verify_type 1
# endif
+# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
+ _gl_verify_type<(R) ? 1 : -1>
+#elif defined _GL_HAVE__STATIC_ASSERT
+# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
+ struct { \
+ _Static_assert (R, DIAGNOSTIC); \
+ int _gl_dummy; \
+ }
+#else
+# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
+ struct { unsigned int _gl_verify_error_if_negative: (R) ? 1 : -1; }
+#endif
/* Verify requirement R at compile-time, as a declaration without a
trailing ';'. If R is false, fail at compile-time, preferably
@@ -193,23 +203,23 @@ template <int w>
Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
-# ifdef _GL_HAVE__STATIC_ASSERT
-# define _GL_VERIFY _Static_assert
-# else
-# define _GL_VERIFY(R, DIAGNOSTIC) \
- extern int (*_GL_GENSYM (_gl_verify_function) (void)) \
- [_GL_VERIFY_TRUE (R, DIAGNOSTIC)]
-# endif
+#ifdef _GL_HAVE__STATIC_ASSERT
+# define _GL_VERIFY _Static_assert
+#else
+# define _GL_VERIFY(R, DIAGNOSTIC) \
+ extern int (*_GL_GENSYM (_gl_verify_function) (void)) \
+ [_GL_VERIFY_TRUE (R, DIAGNOSTIC)]
+#endif
/* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */
-# ifdef _GL_STATIC_ASSERT_H
-# if !defined _GL_HAVE__STATIC_ASSERT && !defined _Static_assert
-# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC)
-# endif
-# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert
-# define static_assert _Static_assert /* C11 requires this #define. */
-# endif
+#ifdef _GL_STATIC_ASSERT_H
+# if !defined _GL_HAVE__STATIC_ASSERT && !defined _Static_assert
+# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC)
# endif
+# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert
+# define static_assert _Static_assert /* C11 requires this #define. */
+# endif
+#endif
/* @assert.h omit start@ */
@@ -227,18 +237,42 @@ template <int w>
verify_true is obsolescent; please use verify_expr instead. */
-# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")")
+#define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")")
/* Verify requirement R at compile-time. Return the value of the
expression E. */
-# define verify_expr(R, E) \
- (_GL_VERIFY_TRUE (R, "verify_expr (" #R ", " #E ")") ? (E) : (E))
+#define verify_expr(R, E) \
+ (_GL_VERIFY_TRUE (R, "verify_expr (" #R ", " #E ")") ? (E) : (E))
/* Verify requirement R at compile-time, as a declaration without a
trailing ';'. */
-# define verify(R) _GL_VERIFY (R, "verify (" #R ")")
+#define verify(R) _GL_VERIFY (R, "verify (" #R ")")
+
+#ifndef __has_builtin
+# define __has_builtin(x) 0
+#endif
+
+/* Assume that R always holds. This lets the compiler optimize
+ accordingly. R should not have side-effects; it may or may not be
+ evaluated. Behavior is undefined if R is false. */
+
+#if (__has_builtin (__builtin_unreachable) \
+ || 4 < __GNUC__ + (5 <= __GNUC_MINOR__))
+# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
+#elif 1200 <= _MSC_VER
+# define assume(R) __assume (R)
+#elif (defined lint \
+ && (__has_builtin (__builtin_trap) \
+ || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <=
__GNUC_PATCHLEVEL__))))
+ /* Doing it this way helps various packages when configured with
+ --enable-gcc-warnings, which compiles with -Dlint. It's nicer
+ when 'assume' silences warnings even with older GCCs. */
+# define assume(R) ((R) ? (void) 0 : __builtin_trap ())
+#else
+# define assume(R) ((void) (0 && (R)))
+#endif
/* @assert.h omit end@ */
diff --git a/lib/vsnprintf.c b/lib/vsnprintf.c
index 4dd428c..26b1887 100644
--- a/lib/vsnprintf.c
+++ b/lib/vsnprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 2004, 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2006-2014 Free Software Foundation, Inc.
Written by Simon Josefsson and Yoann Vandoorselaere <address@hidden>.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/w32sock.h b/lib/w32sock.h
index 76c6f9f..3946d49 100644
--- a/lib/w32sock.h
+++ b/lib/w32sock.h
@@ -1,6 +1,6 @@
/* w32sock.h --- internal auxiliary functions for Windows socket functions
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/wchar.in.h b/lib/wchar.in.h
index 97f7dc8..1874b4d 100644
--- a/lib/wchar.in.h
+++ b/lib/wchar.in.h
@@ -1,6 +1,6 @@
/* A substitute for ISO C99 <wchar.h>, for platforms that have issues.
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
diff --git a/lib/wcrtomb.c b/lib/wcrtomb.c
index 0aab985..ebbdddc 100644
--- a/lib/wcrtomb.c
+++ b/lib/wcrtomb.c
@@ -1,5 +1,5 @@
/* Convert wide character to multibyte character.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/wctype.in.h b/lib/wctype.in.h
index 246ce9d..b5b6093 100644
--- a/lib/wctype.in.h
+++ b/lib/wctype.in.h
@@ -1,6 +1,6 @@
/* A substitute for ISO C99 <wctype.h>, for platforms that lack it.
- Copyright (C) 2006-2013 Free Software Foundation, Inc.
+ Copyright (C) 2006-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -44,6 +44,13 @@
# include <wchar.h>
#endif
+/* mingw has declarations of towupper and towlower in <ctype.h> as
+ well <wctype.h>. Include <ctype.h> in advance to avoid rpl_ prefix
+ being added to the declarations. */
+#ifdef __MINGW32__
+# include <ctype.h>
+#endif
+
/* Include the original <wctype.h> if it exists.
BeOS 5 has the functions but no <wctype.h>. */
/* The include_next requires a split double-inclusion guard. */
@@ -54,6 +61,9 @@
#ifndef address@hidden@_WCTYPE_H
#define address@hidden@_WCTYPE_H
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_WCTYPE_INLINE
# define _GL_WCTYPE_INLINE _GL_INLINE
diff --git a/lib/write.c b/lib/write.c
index d7d00de..51cc1d9 100644
--- a/lib/write.c
+++ b/lib/write.c
@@ -1,5 +1,5 @@
/* POSIX compatible write() function.
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/xsize.h b/lib/xsize.h
index a7a34c5..83cb960 100644
--- a/lib/xsize.h
+++ b/lib/xsize.h
@@ -1,6 +1,6 @@
/* xsize.h -- Checked size_t computations.
- Copyright (C) 2003, 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2008-2014 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
@@ -27,6 +27,9 @@
# include <stdint.h>
#endif
+#ifndef _GL_INLINE_HEADER_BEGIN
+ #error "Please include config.h first."
+#endif
_GL_INLINE_HEADER_BEGIN
#ifndef XSIZE_INLINE
# define XSIZE_INLINE _GL_INLINE
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 548fba3..702faac 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -27,6 +27,7 @@
#include <stdio.h>
#include <errno.h>
#include <string.h>
+#include <assert.h>
#include "libguile/_scm.h"
#include "libguile/__scm.h"
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 11a0cb1..e247aa7 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -67,24 +67,30 @@ boot_print_exception (SCM port, SCM frame, SCM key, SCM
args)
}
#undef FUNC_NAME
+static SCM print_exception_var;
+
+static void
+init_print_exception_var (void)
+{
+ print_exception_var
+ = scm_module_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("print-exception"));
+}
+
SCM
scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
#define FUNC_NAME "print-exception"
{
- static SCM print_exception = SCM_BOOL_F;
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_print_exception_var);
SCM_VALIDATE_OPOUTPORT (1, port);
if (scm_is_true (frame))
SCM_VALIDATE_FRAME (2, frame);
SCM_VALIDATE_SYMBOL (3, key);
SCM_VALIDATE_LIST (4, args);
-
- if (scm_is_false (print_exception))
- print_exception =
- scm_module_variable (scm_the_root_module (),
- scm_from_latin1_symbol ("print-exception"));
- return scm_call_4 (scm_variable_ref (print_exception),
+ return scm_call_4 (scm_variable_ref (print_exception_var),
port, frame, key, args);
}
#undef FUNC_NAME
diff --git a/libguile/debug.c b/libguile/debug.c
index 9e63f2c..f9bcc33 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -160,19 +160,21 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
#undef FUNC_NAME
#endif
+static SCM local_eval_var;
+
+static void
+init_local_eval_var (void)
+{
+ local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval");
+}
+
SCM
scm_local_eval (SCM exp, SCM env)
{
- static SCM local_eval_var = SCM_UNDEFINED;
- static scm_i_pthread_mutex_t local_eval_var_mutex
- = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
- scm_i_scm_pthread_mutex_lock (&local_eval_var_mutex);
- if (SCM_UNBNDP (local_eval_var))
- local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval");
- scm_i_pthread_mutex_unlock (&local_eval_var_mutex);
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_local_eval_var);
- return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
+ return scm_call_2 (scm_variable_ref (local_eval_var), exp, env);
}
static void
diff --git a/libguile/eval.c b/libguile/eval.c
index 3e828a1..39e66c5 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,
- * 2005,2006,2007,2008,2009,2010,2011,2012,2013
+ * 2005,2006,2007,2008,2009,2010,2011,2012,2013,2014
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -620,30 +620,37 @@ scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
args)
return scm_apply_0 (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)));
}
+static SCM map_var, for_each_var;
+
+static void init_map_var (void)
+{
+ map_var = scm_private_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("map"));
+}
+
+static void init_for_each_var (void)
+{
+ for_each_var = scm_private_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("for-each"));
+}
SCM
scm_map (SCM proc, SCM arg1, SCM args)
{
- static SCM var = SCM_BOOL_F;
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_map_var);
- if (scm_is_false (var))
- var = scm_private_variable (scm_the_root_module (),
- scm_from_latin1_symbol ("map"));
-
- return scm_apply_0 (scm_variable_ref (var),
+ return scm_apply_0 (scm_variable_ref (map_var),
scm_cons (proc, scm_cons (arg1, args)));
}
SCM
scm_for_each (SCM proc, SCM arg1, SCM args)
{
- static SCM var = SCM_BOOL_F;
-
- if (scm_is_false (var))
- var = scm_private_variable (scm_the_root_module (),
- scm_from_latin1_symbol ("for-each"));
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_for_each_var);
- return scm_apply_0 (scm_variable_ref (var),
+ return scm_apply_0 (scm_variable_ref (for_each_var),
scm_cons (proc, scm_cons (arg1, args)));
}
diff --git a/libguile/fports.c b/libguile/fports.c
index dc3d45c..672f575 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014 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
@@ -58,6 +59,7 @@
#include "libguile/hashtab.h"
#include "libguile/fports.h"
+#include "libguile/ports-internal.h"
#if SIZEOF_OFF_T == SIZEOF_INT
#define OFF_T_MAX INT_MAX
@@ -78,10 +80,10 @@ scm_t_bits scm_tc16_fport;
/* default buffer size, used if the O/S won't supply a value. */
static const size_t default_buffer_size = 1024;
-/* create FPORT buffer with specified sizes (or -1 to use default size or
- 0 for no buffer. */
+/* Create FPORT buffers with specified sizes (or -1 to use default size
+ or 0 for no buffer.) */
static void
-scm_fport_buffer_add (SCM port, long read_size, int write_size)
+scm_fport_buffer_add (SCM port, long read_size, long write_size)
#define FUNC_NAME "scm_fport_buffer_add"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -147,7 +149,9 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
"@item _IOFBF\n"
"block buffered, using a newly allocated buffer of @var{size}
bytes.\n"
"If @var{size} is omitted, a default size will be used.\n"
- "@end table")
+ "@end table\n\n"
+ "Only certain types of ports are supported, most importantly\n"
+ "file ports.")
#define FUNC_NAME s_scm_setvbuf
{
int cmode;
@@ -155,10 +159,17 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
size_t ndrained;
char *drained;
scm_t_port *pt;
+ scm_t_ptob_descriptor *ptob;
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPFPORT (1,port);
+ SCM_VALIDATE_OPENPORT (1, port);
+ ptob = SCM_PORT_DESCRIPTOR (port);
+
+ if (ptob->setvbuf == NULL)
+ scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+ "port that supports 'setvbuf'");
+
cmode = scm_to_int (mode);
if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
scm_out_of_range (FUNC_NAME, mode);
@@ -169,9 +180,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
cmode = _IOFBF;
}
else
- {
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) &
~(scm_t_bits)SCM_BUFLINE);
- }
+ SCM_SET_CELL_WORD_0 (port,
+ SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
if (SCM_UNBNDP (size))
{
@@ -216,12 +226,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
pt->read_end = pt->saved_read_end;
pt->read_buf_size = pt->saved_read_buf_size;
}
- if (pt->read_buf != &pt->shortbuf)
- scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
- if (pt->write_buf != &pt->shortbuf)
- scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
- scm_fport_buffer_add (port, csize, csize);
+ ptob->setvbuf (port, csize, csize);
if (ndrained > 0)
/* Put DRAINED back to PORT. */
@@ -974,6 +980,7 @@ scm_make_fptob ()
scm_set_port_seek (tc, fport_seek);
scm_set_port_truncate (tc, fport_truncate);
scm_set_port_input_waiting (tc, fport_input_waiting);
+ scm_set_port_setvbuf (tc, scm_fport_buffer_add);
return tc;
}
diff --git a/libguile/frames.c b/libguile/frames.c
index b0f451f..a651694 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -131,20 +131,26 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0,
0,
}
#undef FUNC_NAME
+static SCM frame_arguments_var;
+
+static void
+init_frame_arguments_var (void)
+{
+ frame_arguments_var
+ = scm_c_private_lookup ("system vm frame", "frame-arguments");
+}
+
SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
(SCM frame),
"")
#define FUNC_NAME s_scm_frame_arguments
{
- static SCM var = SCM_BOOL_F;
-
- SCM_VALIDATE_VM_FRAME (1, frame);
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_frame_arguments_var);
- if (scm_is_false (var))
- var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
- "frame-arguments");
+ SCM_VALIDATE_VM_FRAME (1, frame);
- return scm_call_1 (SCM_VARIABLE_REF (var), frame);
+ return scm_call_1 (scm_variable_ref (frame_arguments_var), frame);
}
#undef FUNC_NAME
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 6e88f3c..fc493bc 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- * 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -101,24 +101,19 @@ scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h)
size_t
scm_c_generalized_vector_length (SCM v)
{
- scm_t_array_handle h;
- size_t ret;
- scm_generalized_vector_get_handle (v, &h);
- ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
- scm_array_handle_release (&h);
- return ret;
+ return scm_c_array_length (v);
}
SCM
scm_c_generalized_vector_ref (SCM v, ssize_t idx)
{
- return scm_c_array_ref_1(v, idx);
+ return scm_c_array_ref_1 (v, idx);
}
void
scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val)
{
- scm_c_array_set_1_x(v, val, idx);
+ scm_c_array_set_1_x (v, val, idx);
}
void
diff --git a/libguile/goops.c b/libguile/goops.c
index 013a65c..2cf343f 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C)
1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
+/* Copyright (C)
1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -1711,16 +1711,24 @@ SCM_KEYWORD (k_name, "name");
SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
-
SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
+
+static SCM delayed_compile_var;
+
+static void
+init_delayed_compile_var (void)
+{
+ delayed_compile_var
+ = scm_c_private_lookup ("oop goops dispatch", "delayed-compile");
+}
+
static SCM
make_dispatch_procedure (SCM gf)
{
- static SCM var = SCM_BOOL_F;
- if (scm_is_false (var))
- var = scm_module_variable (scm_c_resolve_module ("oop goops dispatch"),
- sym_delayed_compile);
- return scm_call_1 (SCM_VARIABLE_REF (var), gf);
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_delayed_compile_var);
+
+ return scm_call_1 (scm_variable_ref (delayed_compile_var), gf);
}
static void
diff --git a/libguile/ports.c b/libguile/ports.c
index d8d27cc..e256d65 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
+ * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -331,6 +331,12 @@ scm_set_port_input_waiting (scm_t_bits tc, int
(*input_waiting) (SCM))
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
}
+void
+scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM, long, long))
+{
+ scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
+}
+
static void
scm_i_set_pending_eof (SCM port)
{
@@ -429,19 +435,22 @@ SCM_DEFINE (scm_current_error_port, "current-error-port",
0, 0, 0,
}
#undef FUNC_NAME
+static SCM current_warning_port_var;
+static scm_i_pthread_once_t current_warning_port_once =
SCM_I_PTHREAD_ONCE_INIT;
+
+static void
+init_current_warning_port_var (void)
+{
+ current_warning_port_var
+ = scm_c_private_variable ("guile", "current-warning-port");
+}
+
SCM
scm_current_warning_port (void)
{
- static SCM cwp_var = SCM_UNDEFINED;
- static scm_i_pthread_mutex_t cwp_var_mutex
- = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
- scm_i_scm_pthread_mutex_lock (&cwp_var_mutex);
- if (SCM_UNBNDP (cwp_var))
- cwp_var = scm_c_private_variable ("guile", "current-warning-port");
- scm_i_pthread_mutex_unlock (&cwp_var_mutex);
-
- return scm_call_0 (scm_variable_ref (cwp_var));
+ scm_i_pthread_once (¤t_warning_port_once,
+ init_current_warning_port_var);
+ return scm_call_0 (scm_variable_ref (current_warning_port_var));
}
SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
@@ -502,12 +511,9 @@ SCM_DEFINE (scm_set_current_error_port,
"set-current-error-port", 1, 0, 0,
SCM
scm_set_current_warning_port (SCM port)
{
- static SCM cwp_var = SCM_BOOL_F;
-
- if (scm_is_false (cwp_var))
- cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
-
- return scm_call_1 (scm_variable_ref (cwp_var), port);
+ scm_i_pthread_once (¤t_warning_port_once,
+ init_current_warning_port_var);
+ return scm_call_1 (scm_variable_ref (current_warning_port_var), port);
}
@@ -622,7 +628,6 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
}
#undef FUNC_NAME
-
/* The port table --- a weak set of all ports.
diff --git a/libguile/ports.h b/libguile/ports.h
index a7fde39..f2ab850 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -4,7 +4,7 @@
#define SCM_PORTS_H
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -200,6 +200,13 @@ typedef struct scm_t_ptob_descriptor
scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
void (*truncate) (SCM port, scm_t_off length);
+ /* When non-NULL, this is the method called by 'setvbuf' for this port.
+ It must create read and write buffers for PORT with the specified
+ sizes (a size of 0 is for unbuffered ports, which should use the
+ 'shortbuf' field.) Size -1 means to use the port's preferred buffer
+ size. */
+ void (*setvbuf) (SCM port, long read_size, long write_size);
+
unsigned flags;
} scm_t_ptob_descriptor;
@@ -238,6 +245,8 @@ SCM_API void scm_set_port_truncate (scm_t_bits tc,
void (*truncate) (SCM port,
scm_t_off length));
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting)
(SCM));
+SCM_API void scm_set_port_setvbuf (scm_t_bits tc,
+ void (*setvbuf) (SCM, long, long));
/* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index a8fc3f1..db0b3f6 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -37,6 +37,7 @@
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
+#include "libguile/ports-internal.h"
@@ -272,18 +273,59 @@ cbp_close (SCM port)
static scm_t_bits custom_binary_input_port_type = 0;
-/* Size of the buffer embedded in custom binary input ports. */
-#define CBIP_BUFFER_SIZE 4096
+/* Initial size of the buffer embedded in custom binary input ports. */
+#define CBIP_BUFFER_SIZE 8192
/* Return the bytevector associated with PORT. */
#define SCM_CBIP_BYTEVECTOR(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
+/* Set BV as the bytevector associated with PORT. */
+#define SCM_SET_CBIP_BYTEVECTOR(_port, _bv) \
+ SCM_SIMPLE_VECTOR_SET (SCM_PACK (SCM_STREAM (_port)), 4, (_bv))
+
/* Return the various procedures of PORT. */
#define SCM_CBIP_READ_PROC(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+/* Set PORT's internal buffer according to READ_SIZE. */
+static void
+cbip_setvbuf (SCM port, long read_size, long write_size)
+{
+ SCM bv;
+ scm_t_port *pt;
+
+ pt = SCM_PTAB_ENTRY (port);
+ bv = SCM_CBIP_BYTEVECTOR (port);
+
+ switch (read_size)
+ {
+ case 0:
+ /* Unbuffered: keep PORT's bytevector as is (it will be used in
+ future 'scm_c_read' calls), but point to the one-byte buffer. */
+ pt->read_buf = &pt->shortbuf;
+ pt->read_buf_size = 1;
+ break;
+
+ case -1:
+ /* Preferred size: keep the current bytevector and use it as the
+ backing store. */
+ pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ pt->read_buf_size = SCM_BYTEVECTOR_LENGTH (bv);
+ break;
+
+ default:
+ /* Fully buffered: allocate a buffer of READ_SIZE bytes. */
+ bv = scm_c_make_bytevector (read_size);
+ SCM_SET_CBIP_BYTEVECTOR (port, bv);
+ pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ pt->read_buf_size = read_size;
+ }
+
+ pt->read_pos = pt->read_end = pt->read_buf;
+}
+
static inline SCM
make_cbip (SCM read_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc)
@@ -330,26 +372,42 @@ cbip_fill_input (SCM port)
int result;
scm_t_port *c_port = SCM_PTAB_ENTRY (port);
- again:
if (c_port->read_pos >= c_port->read_end)
{
/* Invoke the user's `read!' procedure. */
+ int buffered;
size_t c_octets, c_requested;
SCM bv, read_proc, octets;
c_requested = c_port->read_buf_size;
+ read_proc = SCM_CBIP_READ_PROC (port);
- /* Use the bytevector associated with PORT as the buffer passed to the
- `read!' procedure, thereby avoiding additional allocations. */
bv = SCM_CBIP_BYTEVECTOR (port);
- read_proc = SCM_CBIP_READ_PROC (port);
+ buffered =
+ (c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
- /* The assumption here is that C_PORT's internal buffer wasn't changed
- behind our back. */
- assert (c_port->read_buf ==
- (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
- assert ((unsigned) c_port->read_buf_size
- == SCM_BYTEVECTOR_LENGTH (bv));
+ if (buffered)
+ {
+ /* Make sure the buffer isn't corrupt. BV can be passed directly
+ to READ_PROC. */
+ assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv));
+ c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ }
+ else
+ {
+ /* This is an unbuffered port. When called via the
+ 'get-bytevector-*' procedures, and thus via 'scm_c_read', we
+ are passed the caller-provided buffer, so we need to check its
+ size. */
+ if (SCM_BYTEVECTOR_LENGTH (bv) < c_requested)
+ {
+ /* Bad luck: we have to make another allocation. Save that
+ bytevector for later reuse, in the hope that the application
+ has regular access patterns. */
+ bv = scm_c_make_bytevector (c_requested);
+ SCM_SET_CBIP_BYTEVECTOR (port, bv);
+ }
+ }
octets = scm_call_3 (read_proc, bv, SCM_INUM0,
scm_from_size_t (c_requested));
@@ -357,11 +415,15 @@ cbip_fill_input (SCM port)
if (SCM_UNLIKELY (c_octets > c_requested))
scm_out_of_range (FUNC_NAME, octets);
- c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ if (!buffered)
+ /* Copy the data back to the internal buffer. */
+ memcpy ((char *) c_port->read_pos, SCM_BYTEVECTOR_CONTENTS (bv),
+ c_octets);
+
c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
- if (c_octets > 0)
- goto again;
+ if (c_octets != 0 || c_requested == 0)
+ result = (int) *c_port->read_pos;
else
result = EOF;
}
@@ -410,6 +472,7 @@ initialize_custom_binary_input_ports (void)
scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
scm_set_port_close (custom_binary_input_port_type, cbp_close);
+ scm_set_port_setvbuf (custom_binary_input_port_type, cbip_setvbuf);
}
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 9fefa83..d0a0c19 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -496,7 +496,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
}
#undef FUNC_NAME
-#if defined HAVE_ALARM && HAVE_DECL_ALARM
+#if HAVE_DECL_ALARM
SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
(SCM i),
"Set a timer to raise a @code{SIGALRM} signal after the specified\n"
diff --git a/libguile/strings.c b/libguile/strings.c
index 5adebb1..0b83311 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -280,6 +280,15 @@ scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state
*pstate)
SCM scm_nullstr;
+static SCM null_stringbuf;
+
+static void
+init_null_stringbuf (void)
+{
+ null_stringbuf = make_stringbuf (0);
+ SET_STRINGBUF_SHARED (null_stringbuf);
+}
+
/* Create a scheme string with space for LEN 8-bit Latin-1-encoded
characters. CHARSP, if not NULL, will be set to location of the
char array. If READ_ONLY_P, the returned string is read-only;
@@ -287,17 +296,13 @@ SCM scm_nullstr;
SCM
scm_i_make_string (size_t len, char **charsp, int read_only_p)
{
- static SCM null_stringbuf = SCM_BOOL_F;
SCM buf;
SCM res;
if (len == 0)
{
- if (SCM_UNLIKELY (scm_is_false (null_stringbuf)))
- {
- null_stringbuf = make_stringbuf (0);
- SET_STRINGBUF_SHARED (null_stringbuf);
- }
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_null_stringbuf);
buf = null_stringbuf;
}
else
diff --git a/libguile/strports.c b/libguile/strports.c
index 5910894..dd3bc59 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -456,6 +456,16 @@ scm_c_eval_string_in_module (const char *expr, SCM module)
}
+static SCM eval_string_var;
+static SCM k_module;
+
+static void
+init_eval_string_var_and_k_module (void)
+{
+ eval_string_var = scm_c_public_variable ("ice-9 eval-string", "eval-string");
+ k_module = scm_from_locale_keyword ("module");
+}
+
SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0,
(SCM string, SCM module),
"Evaluate @var{string} as the text representation of a Scheme\n"
@@ -467,23 +477,16 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1,
1, 0,
"procedure returns.")
#define FUNC_NAME s_scm_eval_string_in_module
{
- static SCM eval_string = SCM_UNDEFINED, k_module = SCM_UNDEFINED;
- static scm_i_pthread_mutex_t init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
- scm_i_scm_pthread_mutex_lock (&init_mutex);
- if (SCM_UNBNDP (eval_string))
- {
- eval_string = scm_c_public_variable ("ice-9 eval-string", "eval-string");
- k_module = scm_from_locale_keyword ("module");
- }
- scm_i_pthread_mutex_unlock (&init_mutex);
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_eval_string_var_and_k_module);
if (SCM_UNBNDP (module))
module = scm_current_module ();
else
SCM_VALIDATE_MODULE (2, module);
- return scm_call_3 (scm_variable_ref (eval_string), string, k_module, module);
+ return scm_call_3 (scm_variable_ref (eval_string_var),
+ string, k_module, module);
}
#undef FUNC_NAME
diff --git a/libguile/throw.c b/libguile/throw.c
index 244bcf1..e10695a 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -53,24 +53,14 @@
baggage. */
-#define CACHE_VAR(var,name) \
- static SCM var = SCM_BOOL_F; \
- if (scm_is_false (var)) \
- { \
- var = scm_module_variable (scm_the_root_module (), \
- scm_from_latin1_symbol (name)); \
- if (scm_is_false (var)) \
- abort (); \
- }
-
+static SCM catch_var, throw_var, with_throw_handler_var;
+
SCM
scm_catch (SCM key, SCM thunk, SCM handler)
{
- CACHE_VAR (var, "catch");
-
- return scm_call_3 (scm_variable_ref (var), key, thunk, handler);
+ return scm_call_3 (scm_variable_ref (catch_var), key, thunk, handler);
}
SCM
@@ -80,28 +70,32 @@ scm_catch_with_pre_unwind_handler (SCM key, SCM thunk, SCM
handler,
if (SCM_UNBNDP (pre_unwind_handler))
return scm_catch (key, thunk, handler);
else
- {
- CACHE_VAR (var, "catch");
-
- return scm_call_4 (scm_variable_ref (var), key, thunk, handler,
- pre_unwind_handler);
- }
+ return scm_call_4 (scm_variable_ref (catch_var), key, thunk, handler,
+ pre_unwind_handler);
+}
+
+static void
+init_with_throw_handler_var (void)
+{
+ with_throw_handler_var
+ = scm_module_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("with-throw-handler"));
}
SCM
scm_with_throw_handler (SCM key, SCM thunk, SCM handler)
{
- CACHE_VAR (var, "with-throw-handler");
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_with_throw_handler_var);
- return scm_call_3 (scm_variable_ref (var), key, thunk, handler);
+ return scm_call_3 (scm_variable_ref (with_throw_handler_var),
+ key, thunk, handler);
}
SCM
scm_throw (SCM key, SCM args)
{
- CACHE_VAR (var, "throw");
-
- return scm_apply_1 (scm_variable_ref (var), key, args);
+ return scm_apply_1 (scm_variable_ref (throw_var), key, args);
}
@@ -552,8 +546,10 @@ scm_init_throw ()
tc16_catch_closure = scm_make_smob_type ("catch-closure", 0);
scm_set_smob_apply (tc16_catch_closure, apply_catch_closure, 0, 0, 1);
- scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0, pre_init_catch));
- scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1, pre_init_throw));
+ catch_var = scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0,
+ pre_init_catch));
+ throw_var = scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1,
+ pre_init_throw));
#include "libguile/throw.x"
}
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 40bd9af..d367ca0 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009, 2010,
- * 2011, 2012 Free Software Foundation, Inc.
+ * 2011, 2012, 2014 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
@@ -35,7 +35,6 @@
#include "libguile/strings.h"
#include "libguile/srfi-13.h"
#include "libguile/dynwind.h"
-#include "libguile/deprecation.h"
#include "libguile/bdw-gc.h"
@@ -95,7 +94,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
size_t
scm_c_vector_length (SCM v)
{
- if (SCM_I_IS_VECTOR (v))
+ if (SCM_I_IS_NONWEAK_VECTOR (v))
return SCM_I_VECTOR_LENGTH (v);
else
scm_wrong_type_arg_msg (NULL, 0, v, "vector");
@@ -167,8 +166,6 @@ scm_c_vector_ref (SCM v, size_t k)
scm_out_of_range (NULL, scm_from_size_t (k));
return SCM_SIMPLE_VECTOR_REF (v, k);
}
- else if (SCM_I_WVECTP (v))
- return scm_c_weak_vector_ref (v, k);
else
scm_wrong_type_arg_msg (NULL, 0, v, "vector");
}
@@ -201,8 +198,6 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
scm_out_of_range (NULL, scm_from_size_t (k));
SCM_SIMPLE_VECTOR_SET (v, k, obj);
}
- else if (SCM_I_WVECTP (v))
- scm_c_weak_vector_set_x (v, k, obj);
else
scm_wrong_type_arg_msg (NULL, 0, v, "vector");
}
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
index 30e2ed6..b1fff1b 100644
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2006, 2008, 2009,
- * 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2010, 2011, 2012, 2013, 2014 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
@@ -37,8 +37,8 @@
#define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
-static SCM
-make_weak_vector (size_t len, SCM fill)
+SCM
+scm_c_make_weak_vector (size_t len, SCM fill)
#define FUNC_NAME "make-weak-vector"
{
SCM wv;
@@ -76,7 +76,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
"empty list.")
#define FUNC_NAME s_scm_make_weak_vector
{
- return make_weak_vector (scm_to_size_t (size), fill);
+ return scm_c_make_weak_vector (scm_to_size_t (size), fill);
}
#undef FUNC_NAME
@@ -98,7 +98,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, c_size);
- wv = make_weak_vector ((size_t) c_size, SCM_BOOL_F);
+ wv = scm_c_make_weak_vector ((size_t) c_size, SCM_BOOL_F);
for (i = 0; scm_is_pair (lst); lst = SCM_CDR (lst), i++)
scm_c_weak_vector_set_x (wv, i, SCM_CAR (lst));
@@ -114,7 +114,50 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
"weak hashes are also weak vectors.")
#define FUNC_NAME s_scm_weak_vector_p
{
- return scm_from_bool (SCM_I_WVECTP (obj));
+ return scm_from_bool (scm_is_weak_vector (obj));
+}
+#undef FUNC_NAME
+
+
+int
+scm_is_weak_vector (SCM obj)
+#define FUNC_NAME s_scm_weak_vector_p
+{
+ return SCM_I_WVECTP (obj);
+}
+#undef FUNC_NAME
+
+
+#define SCM_VALIDATE_WEAK_VECTOR(pos, var) \
+ SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_I_WVECTP, "weak vector")
+
+
+SCM_DEFINE (scm_weak_vector_length, "weak-vector-length", 1, 0, 0,
+ (SCM wvect),
+ "Like @code{vector-length}, but for weak vectors.")
+#define FUNC_NAME s_scm_weak_vector_length
+{
+ return scm_from_size_t (scm_c_weak_vector_length (wvect));
+}
+#undef FUNC_NAME
+
+
+size_t
+scm_c_weak_vector_length (SCM wvect)
+#define FUNC_NAME s_scm_weak_vector_length
+{
+ SCM_VALIDATE_WEAK_VECTOR (1, wvect);
+ return SCM_I_VECTOR_LENGTH (wvect);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_vector_ref, "weak-vector-ref", 2, 0, 0,
+ (SCM wvect, SCM k),
+ "Like @code{vector-ref}, but for weak vectors.")
+#define FUNC_NAME s_scm_weak_vector_ref
+{
+ return scm_c_weak_vector_ref (wvect, scm_to_size_t (k));
}
#undef FUNC_NAME
@@ -135,10 +178,13 @@ weak_vector_ref (void *data)
SCM
scm_c_weak_vector_ref (SCM wv, size_t k)
+#define FUNC_NAME s_scm_weak_vector_ref
{
struct weak_vector_ref_data d;
void *ret;
+ SCM_VALIDATE_WEAK_VECTOR (1, wv);
+
d.wv = wv;
d.k = k;
@@ -152,15 +198,31 @@ scm_c_weak_vector_ref (SCM wv, size_t k)
else
return SCM_BOOL_F;
}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_vector_set_x, "weak-vector-set!", 3, 0, 0,
+ (SCM wvect, SCM k, SCM obj),
+ "Like @code{vector-set!}, but for weak vectors.")
+#define FUNC_NAME s_scm_weak_vector_set_x
+{
+ scm_c_weak_vector_set_x (wvect, scm_to_size_t (k), obj);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
void
scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
+#define FUNC_NAME s_scm_weak_vector_set_x
{
SCM *elts;
struct weak_vector_ref_data d;
void *prev;
+ SCM_VALIDATE_WEAK_VECTOR (1, wv);
+
d.wv = wv;
d.k = k;
@@ -180,6 +242,7 @@ scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
SCM_I_REGISTER_DISAPPEARING_LINK ((void **) &elts[k],
SCM2PTR (x));
}
+#undef FUNC_NAME
diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h
index 1fd7cb5..11395a5 100644
--- a/libguile/weak-vector.h
+++ b/libguile/weak-vector.h
@@ -3,7 +3,7 @@
#ifndef SCM_WEAK_VECTOR_H
#define SCM_WEAK_VECTOR_H
-/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011, 2014 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
@@ -30,11 +30,18 @@
#define SCM_I_WVECTP(x) (SCM_HAS_TYP7 (x, scm_tc7_wvect))
-SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
+SCM_API SCM scm_make_weak_vector (SCM len, SCM fill);
SCM_API SCM scm_weak_vector (SCM l);
SCM_API SCM scm_weak_vector_p (SCM x);
-SCM_INTERNAL SCM scm_c_weak_vector_ref (SCM v, size_t k);
-SCM_INTERNAL void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
+SCM_API SCM scm_weak_vector_length (SCM v);
+SCM_API SCM scm_weak_vector_ref (SCM v, SCM k);
+SCM_API SCM scm_weak_vector_set_x (SCM v, SCM k, SCM x);
+
+SCM_API SCM scm_c_make_weak_vector (size_t len, SCM fill);
+SCM_API int scm_is_weak_vector (SCM obj);
+SCM_API size_t scm_c_weak_vector_length (SCM vec);
+SCM_API SCM scm_c_weak_vector_ref (SCM v, size_t k);
+SCM_API void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
SCM_INTERNAL void scm_init_weak_vectors (void);
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index d4ad759..8eca551 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,12 +1,28 @@
-# 00gnulib.m4 serial 2
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+# 00gnulib.m4 serial 3
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl This file must be named something that sorts before all other
dnl gnulib-provided .m4 files. It is needed until such time as we can
-dnl assume Autoconf 2.64, with its improved AC_DEFUN_ONCE semantics.
+dnl assume Autoconf 2.64, with its improved AC_DEFUN_ONCE and
+dnl m4_divert semantics.
+
+# Until autoconf 2.63, handling of the diversion stack required m4_init
+# to be called first; but this does not happen with aclocal. Wrapping
+# the entire execution in another layer of the diversion stack fixes this.
+# Worse, prior to autoconf 2.62, m4_wrap depended on the underlying m4
+# for whether it was FIFO or LIFO; in order to properly balance with
+# m4_init, we need to undo our push just before anything wrapped within
+# the m4_init body. The way to ensure this is to wrap both sides of
+# m4_init with a one-shot macro that does the pop at the right time.
+m4_ifndef([_m4_divert_diversion],
+[m4_divert_push([KILL])
+m4_define([gl_divert_fixup], [m4_divert_pop()m4_define([$0])])
+m4_define([m4_init],
+ [gl_divert_fixup()]m4_defn([m4_init])[gl_divert_fixup()])])
+
# AC_DEFUN_ONCE([NAME], VALUE)
# ----------------------------
diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4
index 89ff5be..ce3e39e 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,5 +1,5 @@
# absolute-header.m4 serial 16
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 270abd0..d7bdea6 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,5 +1,5 @@
# alloca.m4 serial 14
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2013 Free Software Foundation,
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/arpa_inet_h.m4 b/m4/arpa_inet_h.m4
index ea69af5..f01699a 100644
--- a/m4/arpa_inet_h.m4
+++ b/m4/arpa_inet_h.m4
@@ -1,5 +1,5 @@
# arpa_inet_h.m4 serial 13
-dnl Copyright (C) 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/autobuild.m4 b/m4/autobuild.m4
index 3147b5b..00d8709 100644
--- a/m4/autobuild.m4
+++ b/m4/autobuild.m4
@@ -1,5 +1,5 @@
# autobuild.m4 serial 7
-dnl Copyright (C) 2004, 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/btowc.m4 b/m4/btowc.m4
index 978a06e..9988944 100644
--- a/m4/btowc.m4
+++ b/m4/btowc.m4
@@ -1,5 +1,5 @@
# btowc.m4 serial 10
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/byteswap.m4 b/m4/byteswap.m4
index 7566903..6d6357c 100644
--- a/m4/byteswap.m4
+++ b/m4/byteswap.m4
@@ -1,5 +1,5 @@
# byteswap.m4 serial 4
-dnl Copyright (C) 2005, 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index cef3124..ace4556 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,6 +1,6 @@
# canonicalize.m4 serial 26
-dnl Copyright (C) 2003-2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/ceil.m4 b/m4/ceil.m4
index c617561..128353a 100644
--- a/m4/ceil.m4
+++ b/m4/ceil.m4
@@ -1,5 +1,5 @@
# ceil.m4 serial 9
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/check-math-lib.m4 b/m4/check-math-lib.m4
index 77570f4..a3894aa 100644
--- a/m4/check-math-lib.m4
+++ b/m4/check-math-lib.m4
@@ -1,5 +1,5 @@
# check-math-lib.m4 serial 4
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
index 767a1be..be36a42 100644
--- a/m4/clock_time.m4
+++ b/m4/clock_time.m4
@@ -1,5 +1,5 @@
# clock_time.m4 serial 10
-dnl Copyright (C) 2002-2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/close.m4 b/m4/close.m4
index bccd981..68510c5 100644
--- a/m4/close.m4
+++ b/m4/close.m4
@@ -1,5 +1,5 @@
# close.m4 serial 8
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/codeset.m4 b/m4/codeset.m4
index c2761be..d7de8d6 100644
--- a/m4/codeset.m4
+++ b/m4/codeset.m4
@@ -1,5 +1,5 @@
# codeset.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2000-2002, 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/configmake.m4 b/m4/configmake.m4
index 823ffc0..0cd86cf 100644
--- a/m4/configmake.m4
+++ b/m4/configmake.m4
@@ -1,5 +1,5 @@
-# configmake.m4 serial 1
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+# configmake.m4 serial 2
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -7,8 +7,9 @@ dnl with or without modifications, as long as this notice is
preserved.
# gl_CONFIGMAKE_PREP
# ------------------
# Guarantee all of the standard directory variables, even when used with
-# autoconf 2.59 (datarootdir wasn't supported until 2.59c) or automake
-# 1.9.6 (pkglibexecdir wasn't supported until 1.10b.).
+# autoconf 2.59 (datarootdir wasn't supported until 2.59c, and runstatedir
+# in 2.70) or automake 1.9.6 (pkglibexecdir wasn't supported until 1.10b,
+# and runstatedir in 1.14.1).
AC_DEFUN([gl_CONFIGMAKE_PREP],
[
dnl Technically, datadir should default to datarootdir. But if
@@ -43,6 +44,10 @@ AC_DEFUN([gl_CONFIGMAKE_PREP],
if test "x$localedir" = x; then
AC_SUBST([localedir], ['${datarootdir}/locale'])
fi
+ dnl Added in autoconf 2.70
+ if test "x$runstatedir" = x; then
+ AC_SUBST([runstatedir], ['${localstatedir}/run'])
+ fi
dnl Automake 1.9.6 only lacks pkglibexecdir; and since 1.11 merely
dnl provides it without AC_SUBST, this blind use of AC_SUBST is safe.
diff --git a/m4/copysign.m4 b/m4/copysign.m4
index 382a6c6..1bb2d6f 100644
--- a/m4/copysign.m4
+++ b/m4/copysign.m4
@@ -1,5 +1,5 @@
# copysign.m4 serial 1
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/dirent_h.m4 b/m4/dirent_h.m4
index 54c1663..3f2b16b 100644
--- a/m4/dirent_h.m4
+++ b/m4/dirent_h.m4
@@ -1,5 +1,5 @@
# dirent_h.m4 serial 16
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/dirfd.m4 b/m4/dirfd.m4
index 39bc789..b422769 100644
--- a/m4/dirfd.m4
+++ b/m4/dirfd.m4
@@ -2,7 +2,7 @@
dnl Find out how to get the file descriptor associated with an open DIR*.
-# Copyright (C) 2001-2006, 2008-2013 Free Software Foundation, Inc.
+# Copyright (C) 2001-2006, 2008-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/dirname.m4 b/m4/dirname.m4
index 5897a2a..d2627b8 100644
--- a/m4/dirname.m4
+++ b/m4/dirname.m4
@@ -1,5 +1,5 @@
#serial 10 -*- autoconf -*-
-dnl Copyright (C) 2002-2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/double-slash-root.m4 b/m4/double-slash-root.m4
index bd6f867..937f4bc 100644
--- a/m4/double-slash-root.m4
+++ b/m4/double-slash-root.m4
@@ -1,5 +1,5 @@
# double-slash-root.m4 serial 4 -*- Autoconf -*-
-dnl Copyright (C) 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index 269cfdc..89638a0 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,5 +1,5 @@
-#serial 19
-dnl Copyright (C) 2002, 2005, 2007, 2009-2013 Free Software Foundation, Inc.
+#serial 20
+dnl Copyright (C) 2002, 2005, 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -39,9 +39,11 @@ AC_DEFUN([gl_FUNC_DUP2],
/* Many gnulib modules require POSIX conformance of EBADF. */
if (dup2 (2, 1000000) == -1 && errno != EBADF)
result |= 16;
- /* Flush out a cygwin core dump. */
+ /* Flush out some cygwin core dumps. */
if (dup2 (2, -1) != -1 || errno != EBADF)
result |= 32;
+ dup2 (2, 255);
+ dup2 (2, 256);
return result;
])
],
@@ -65,6 +67,7 @@ AC_DEFUN([gl_FUNC_DUP2],
*yes) ;;
*)
REPLACE_DUP2=1
+ AC_CHECK_FUNCS([setdtablesize])
;;
esac
fi
diff --git a/m4/duplocale.m4 b/m4/duplocale.m4
index 9ef894c..d45891d 100644
--- a/m4/duplocale.m4
+++ b/m4/duplocale.m4
@@ -1,5 +1,5 @@
# duplocale.m4 serial 7
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/eealloc.m4 b/m4/eealloc.m4
index c640ec1..8a51fe7 100644
--- a/m4/eealloc.m4
+++ b/m4/eealloc.m4
@@ -1,5 +1,5 @@
# eealloc.m4 serial 3
-dnl Copyright (C) 2003, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/environ.m4 b/m4/environ.m4
index 593a33e..cfabe46 100644
--- a/m4/environ.m4
+++ b/m4/environ.m4
@@ -1,5 +1,5 @@
# environ.m4 serial 6
-dnl Copyright (C) 2001-2004, 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2004, 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/errno_h.m4 b/m4/errno_h.m4
index c813ea5..4ee9e6a 100644
--- a/m4/errno_h.m4
+++ b/m4/errno_h.m4
@@ -1,5 +1,5 @@
# errno_h.m4 serial 12
-dnl Copyright (C) 2004, 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/exponentd.m4 b/m4/exponentd.m4
index 09df468..7bee635 100644
--- a/m4/exponentd.m4
+++ b/m4/exponentd.m4
@@ -1,5 +1,5 @@
# exponentd.m4 serial 3
-dnl Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/exponentf.m4 b/m4/exponentf.m4
index 55a04e6..b2dfeef 100644
--- a/m4/exponentf.m4
+++ b/m4/exponentf.m4
@@ -1,5 +1,5 @@
# exponentf.m4 serial 2
-dnl Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/exponentl.m4 b/m4/exponentl.m4
index f877cf1..d6f4ba7 100644
--- a/m4/exponentl.m4
+++ b/m4/exponentl.m4
@@ -1,5 +1,5 @@
# exponentl.m4 serial 3
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index 07ba376..37f55ca 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,12 +1,12 @@
# serial 13 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
-# Copyright (C) 2003, 2006-2013 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# This definition of AC_USE_SYSTEM_EXTENSIONS is stolen from CVS
+# This definition of AC_USE_SYSTEM_EXTENSIONS is stolen from git
# Autoconf. Perhaps we can remove this once we can assume Autoconf
# 2.70 or later everywhere, but since Autoconf mutates rapidly
# enough in this area it's likely we'll need to redefine
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 5880d4f..240150e 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -1,6 +1,6 @@
dnl 'extern inline' a la ISO C99.
-dnl Copyright 2012-2013 Free Software Foundation, Inc.
+dnl Copyright 2012-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -8,34 +8,52 @@ dnl with or without modifications, as long as this notice is
preserved.
AC_DEFUN([gl_EXTERN_INLINE],
[
AH_VERBATIM([extern_inline],
-[/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'.
- _GL_EXTERN_INLINE is a portable alternative to 'extern inline'.
- _GL_INLINE_HEADER_BEGIN contains useful stuff to put
- in an include file, before uses of _GL_INLINE.
- It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic,
- when FOO is an inline function in the header; see
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
- _GL_INLINE_HEADER_END contains useful stuff to put
- in the same include file, after uses of _GL_INLINE.
+[/* Please see the Gnulib manual for how to use these macros.
+
+ Suppress extern inline with HP-UX cc, as it appears to be broken; see
+ <http://lists.gnu.org/archive/html/bug-texinfo/2013-02/msg00030.html>.
+
+ Suppress extern inline with Sun C in standards-conformance mode, as it
+ mishandles inline functions that call each other. E.g., for 'inline void f
+ (void) { } inline void g (void) { f (); }', c99 incorrectly complains
+ 'reference to static identifier "f" in extern inline function'.
+ This bug was observed with Sun C 5.12 SunOS_i386 2011/11/16.
- Suppress the use of extern inline on Apple's platforms,
- as Libc-825.25 (2012-09-19) is incompatible with it; see
+ Suppress the use of extern inline on problematic Apple configurations.
+ OS X 10.8 and earlier mishandle it; see, e.g.,
<http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and
+ for clang but remains for g++; see <http://trac.macports.org/ticket/41033>.
Perhaps Apple will fix this some day. */
+#if (defined __APPLE__ \
+ && (defined __header_inline \
+ ? (defined __cplusplus && defined __GNUC_STDC_INLINE__ \
+ && ! defined __clang__) \
+ : ((! defined _DONT_USE_CTYPE_INLINE_ \
+ && (defined __GNUC__ || defined __cplusplus)) \
+ || (defined _FORTIFY_SOURCE && 0 < _FORTIFY_SOURCE \
+ && defined __GNUC__ && ! defined __cplusplus))))
+# define _GL_EXTERN_INLINE_APPLE_BUG
+#endif
#if ((__GNUC__ \
? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
- : 199901L <= __STDC_VERSION__) \
- && !defined __APPLE__)
+ : (199901L <= __STDC_VERSION__ \
+ && !defined __HP_cc \
+ && !(defined __SUNPRO_C && __STDC__))) \
+ && !defined _GL_EXTERN_INLINE_APPLE_BUG)
# define _GL_INLINE inline
# define _GL_EXTERN_INLINE extern inline
-#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__) && !defined __APPLE__
-# if __GNUC_GNU_INLINE__
+# define _GL_EXTERN_INLINE_IN_USE
+#elif (2 < __GNUC__ + (7 <= __GNUC_MINOR__) && !defined __STRICT_ANSI__ \
+ && !defined _GL_EXTERN_INLINE_APPLE_BUG)
+# if defined __GNUC_GNU_INLINE__ && __GNUC_GNU_INLINE__
/* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
# else
# define _GL_INLINE extern inline
# endif
# define _GL_EXTERN_INLINE extern
+# define _GL_EXTERN_INLINE_IN_USE
#else
# define _GL_INLINE static _GL_UNUSED
# define _GL_EXTERN_INLINE static _GL_UNUSED
@@ -48,6 +66,10 @@ AC_DEFUN([gl_EXTERN_INLINE],
# define _GL_INLINE_HEADER_CONST_PRAGMA \
_Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
# endif
+ /* Suppress GCC's bogus "no previous prototype for 'FOO'"
+ and "no previous declaration for 'FOO'" diagnostics,
+ when FOO is an inline function in the header; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>. */
# define _GL_INLINE_HEADER_BEGIN \
_Pragma ("GCC diagnostic push") \
_Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
diff --git a/m4/fcntl-o.m4 b/m4/fcntl-o.m4
index 87cc4bd..43c9312 100644
--- a/m4/fcntl-o.m4
+++ b/m4/fcntl-o.m4
@@ -1,5 +1,5 @@
# fcntl-o.m4 serial 4
-dnl Copyright (C) 2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4
index 3cff1fd..fb2556d 100644
--- a/m4/fcntl_h.m4
+++ b/m4/fcntl_h.m4
@@ -1,6 +1,6 @@
# serial 15
# Configure fcntl.h.
-dnl Copyright (C) 2006-2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/float_h.m4 b/m4/float_h.m4
index 397f2d1..a27ef7f 100644
--- a/m4/float_h.m4
+++ b/m4/float_h.m4
@@ -1,5 +1,5 @@
# float_h.m4 serial 9
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/flock.m4 b/m4/flock.m4
index bbcc4f9..ad2d129 100644
--- a/m4/flock.m4
+++ b/m4/flock.m4
@@ -1,5 +1,5 @@
# flock.m4 serial 3
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/floor.m4 b/m4/floor.m4
index c176a99..a38c03d 100644
--- a/m4/floor.m4
+++ b/m4/floor.m4
@@ -1,5 +1,5 @@
# floor.m4 serial 8
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fpieee.m4 b/m4/fpieee.m4
index 97941bb..729afe8 100644
--- a/m4/fpieee.m4
+++ b/m4/fpieee.m4
@@ -1,5 +1,5 @@
# fpieee.m4 serial 2
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/frexp.m4 b/m4/frexp.m4
index 3909792..5798262 100644
--- a/m4/frexp.m4
+++ b/m4/frexp.m4
@@ -1,5 +1,5 @@
-# frexp.m4 serial 14
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+# frexp.m4 serial 15
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -93,7 +93,7 @@ AC_DEFUN([gl_FUNC_FREXP_WORKS],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
- AC_CHECK_FUNCS_ONCE([alarm])
+ AC_CHECK_DECLS_ONCE([alarm])
AC_CACHE_CHECK([whether frexp works], [gl_cv_func_frexp_works],
[
AC_RUN_IFELSE(
@@ -101,7 +101,8 @@ AC_DEFUN([gl_FUNC_FREXP_WORKS],
#include <float.h>
#include <math.h>
#include <string.h>
-#if HAVE_ALARM
+#if HAVE_DECL_ALARM
+# include <signal.h>
# include <unistd.h>
#endif
/* HP cc on HP-UX 10.20 has a bug with the constant expression -0.0.
@@ -124,9 +125,10 @@ int main()
int i;
volatile double x;
double zero = 0.0;
-#if HAVE_ALARM
+#if HAVE_DECL_ALARM
/* NeXTstep 3.3 frexp() runs into an endless loop when called on an infinite
number. Let the test fail in this case. */
+ signal (SIGALRM, SIG_DFL);
alarm (5);
#endif
/* Test on denormalized numbers. */
diff --git a/m4/fstat.m4 b/m4/fstat.m4
index b2cf2ad..ddd3fb9 100644
--- a/m4/fstat.m4
+++ b/m4/fstat.m4
@@ -1,5 +1,5 @@
# fstat.m4 serial 4
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/func.m4 b/m4/func.m4
index 5548d5e..0ab14c9 100644
--- a/m4/func.m4
+++ b/m4/func.m4
@@ -1,5 +1,5 @@
# func.m4 serial 2
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/getaddrinfo.m4 b/m4/getaddrinfo.m4
index 1d631f8..2e66584 100644
--- a/m4/getaddrinfo.m4
+++ b/m4/getaddrinfo.m4
@@ -1,5 +1,5 @@
# getaddrinfo.m4 serial 30
-dnl Copyright (C) 2004-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2004-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/getlogin.m4 b/m4/getlogin.m4
index 9b3f3cd..47b8f08 100644
--- a/m4/getlogin.m4
+++ b/m4/getlogin.m4
@@ -1,5 +1,5 @@
# getlogin.m4 serial 3
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
new file mode 100644
index 0000000..1c2d66e
--- /dev/null
+++ b/m4/gettimeofday.m4
@@ -0,0 +1,138 @@
+# serial 21
+
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2014 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([gettimeofday])
+
+ gl_gettimeofday_timezone=void
+ if test $ac_cv_func_gettimeofday != yes; then
+ HAVE_GETTIMEOFDAY=0
+ else
+ gl_FUNC_GETTIMEOFDAY_CLOBBER
+ AC_CACHE_CHECK([for gettimeofday with POSIX signature],
+ [gl_cv_func_gettimeofday_posix_signature],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+ struct timeval c;
+ int gettimeofday (struct timeval *restrict, void *restrict);
+ ]],
+ [[/* glibc uses struct timezone * rather than the POSIX void *
+ if _GNU_SOURCE is defined. However, since the only portable
+ use of gettimeofday uses NULL as the second parameter, and
+ since the glibc definition is actually more typesafe, it is
+ not worth wrapping this to get a compliant signature. */
+ int (*f) (struct timeval *restrict, void *restrict)
+ = gettimeofday;
+ int x = f (&c, 0);
+ return !(x | c.tv_sec | c.tv_usec);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=yes],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+int gettimeofday (struct timeval *restrict, struct timezone *restrict);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=almost],
+ [gl_cv_func_gettimeofday_posix_signature=no])])])
+ if test $gl_cv_func_gettimeofday_posix_signature = almost; then
+ gl_gettimeofday_timezone='struct timezone'
+ elif test $gl_cv_func_gettimeofday_posix_signature != yes; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ dnl If we override 'struct timeval', we also have to override gettimeofday.
+ if test $REPLACE_STRUCT_TIMEVAL = 1; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ m4_ifdef([gl_FUNC_TZSET_CLOBBER], [
+ gl_FUNC_TZSET_CLOBBER
+ case "$gl_cv_func_tzset_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([tzset], [rpl_tzset],
+ [Define to rpl_tzset if the wrapper function should be used.])
+ AC_DEFINE([TZSET_CLOBBERS_LOCALTIME], [1],
+ [Define if tzset clobbers localtime's static buffer.])
+ ;;
+ esac
+ ])
+ fi
+ AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone],
+ [Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday.])
+])
+
+
+dnl See if gettimeofday clobbers the static buffer that localtime uses
+dnl for its return value. The gettimeofday function from Mac OS X 10.0.4
+dnl (i.e., Darwin 1.3.7) has this problem.
+dnl
+dnl If it does, then arrange to use gettimeofday and localtime only via
+dnl the wrapper functions that work around the problem.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
+[
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_CACHE_CHECK([whether gettimeofday clobbers localtime buffer],
+ [gl_cv_func_gettimeofday_clobber],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <string.h>
+ #include <sys/time.h>
+ #include <time.h>
+ #include <stdlib.h>
+ ]],
+ [[
+ time_t t = 0;
+ struct tm *lt;
+ struct tm saved_lt;
+ struct timeval tv;
+ lt = localtime (&t);
+ saved_lt = *lt;
+ gettimeofday (&tv, NULL);
+ return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
+ ]])],
+ [gl_cv_func_gettimeofday_clobber=no],
+ [gl_cv_func_gettimeofday_clobber=yes],
+ [# When cross-compiling:
+ case "$host_os" in
+ # Guess all is fine on glibc systems.
+ *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
+ esac
+ ])])
+
+ case "$gl_cv_func_gettimeofday_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([GETTIMEOFDAY_CLOBBERS_LOCALTIME], [1],
+ [Define if gettimeofday clobbers the localtime buffer.])
+ ;;
+ esac
+])
+
+AC_DEFUN([gl_GETTIMEOFDAY_REPLACE_LOCALTIME], [
+ REPLACE_GMTIME=1
+ REPLACE_LOCALTIME=1
+])
+
+# Prerequisites of lib/gettimeofday.c.
+AC_DEFUN([gl_PREREQ_GETTIMEOFDAY], [
+ AC_CHECK_HEADERS([sys/timeb.h])
+ AC_CHECK_FUNCS([_ftime])
+])
diff --git a/m4/glibc21.m4 b/m4/glibc21.m4
index 613fb2a..ab58b71 100644
--- a/m4/glibc21.m4
+++ b/m4/glibc21.m4
@@ -1,5 +1,5 @@
# glibc21.m4 serial 5
-dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2013 Free Software Foundation,
+dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index d41ec7b..7682c1e 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -1,4 +1,4 @@
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 0ae5a9e..3b61b23 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,5 +1,5 @@
-# gnulib-common.m4 serial 33
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+# gnulib-common.m4 serial 34
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -375,3 +375,7 @@ AC_DEFUN([gl_CACHE_VAL_SILENT],
AC_CACHE_VAL([$1], [$2])
as_echo_n="$saved_as_echo_n"
])
+
+# AS_VAR_COPY was added in autoconf 2.63b
+m4_define_default([AS_VAR_COPY],
+[AS_LITERAL_IF([$1[]$2], [$1=$$2], [eval $1=\$$2])])
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 8a1b801..a188709 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -1,5 +1,5 @@
# DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -39,6 +39,7 @@ AC_DEFUN([gl_EARLY],
m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable
AC_REQUIRE([gl_PROG_AR_RANLIB])
AC_REQUIRE([AM_PROG_CC_C_O])
+ # Code from module absolute-header:
# Code from module accept:
# Code from module alignof:
# Code from module alloca:
@@ -93,6 +94,7 @@ AC_DEFUN([gl_EARLY],
# Code from module getsockname:
# Code from module getsockopt:
# Code from module gettext-h:
+ # Code from module gettimeofday:
# Code from module git-version-gen:
# Code from module gitlog-to-changelog:
# Code from module gnu-web-doc-update:
@@ -129,6 +131,7 @@ AC_DEFUN([gl_EARLY],
# Code from module localcharset:
# Code from module locale:
# Code from module localeconv:
+ # Code from module lock:
# Code from module log:
# Code from module log1p:
# Code from module lstat:
@@ -209,6 +212,8 @@ AC_DEFUN([gl_EARLY],
# Code from module sys_times:
# Code from module sys_types:
# Code from module sys_uio:
+ # Code from module threadlib:
+ gl_THREADLIB_EARLY
# Code from module time:
# Code from module time_r:
# Code from module times:
@@ -388,6 +393,12 @@ AC_SUBST([LTALLOCA])
gl_SYS_SOCKET_MODULE_INDICATOR([getsockopt])
AC_SUBST([LIBINTL])
AC_SUBST([LTLIBINTL])
+ gl_FUNC_GETTIMEOFDAY
+ if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
+ AC_LIBOBJ([gettimeofday])
+ gl_PREREQ_GETTIMEOFDAY
+ fi
+ gl_SYS_TIME_MODULE_INDICATOR([gettimeofday])
# Autoconf 2.61a.99 and earlier don't support linking a file only
# in VPATH builds. But since GNUmakefile is for maintainer use
# only, it does not matter if we skip the link with older autoconf.
@@ -500,6 +511,8 @@ AC_SUBST([LTALLOCA])
gl_PREREQ_LOCALECONV
fi
gl_LOCALE_MODULE_INDICATOR([localeconv])
+ gl_LOCK
+ gl_MODULE_INDICATOR([lock])
AC_REQUIRE([gl_FUNC_LOG])
if test $REPLACE_LOG = 1; then
AC_LIBOBJ([log])
@@ -746,6 +759,7 @@ AC_SUBST([LTALLOCA])
AC_PROG_MKDIR_P
gl_HEADER_SYS_UIO
AC_PROG_MKDIR_P
+ gl_THREADLIB
gl_HEADER_TIME_H
gl_TIME_R
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@@ -997,6 +1011,10 @@ AC_DEFUN([gl_FILE_LIST], [
lib/getsockname.c
lib/getsockopt.c
lib/gettext.h
+ lib/gettimeofday.c
+ lib/glthread/lock.c
+ lib/glthread/lock.h
+ lib/glthread/threadlib.c
lib/iconv.c
lib/iconv.in.h
lib/iconv_close.c
@@ -1190,6 +1208,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/func.m4
m4/getaddrinfo.m4
m4/getlogin.m4
+ m4/gettimeofday.m4
m4/glibc21.m4
m4/gnulib-common.m4
m4/hostent.m4
@@ -1224,6 +1243,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/locale-zh.m4
m4/locale_h.m4
m4/localeconv.m4
+ m4/lock.m4
m4/log.m4
m4/log1p.m4
m4/longlong.m4
@@ -1296,6 +1316,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/sys_times_h.m4
m4/sys_types_h.m4
m4/sys_uio_h.m4
+ m4/threadlib.m4
m4/time_h.m4
m4/time_r.m4
m4/times.m4
diff --git a/m4/gnulib-tool.m4 b/m4/gnulib-tool.m4
index f3dea1a..a588e15 100644
--- a/m4/gnulib-tool.m4
+++ b/m4/gnulib-tool.m4
@@ -1,5 +1,5 @@
# gnulib-tool.m4 serial 2
-dnl Copyright (C) 2004-2005, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2004-2005, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/hostent.m4 b/m4/hostent.m4
index 72be876..dd8fc07 100644
--- a/m4/hostent.m4
+++ b/m4/hostent.m4
@@ -1,5 +1,5 @@
# hostent.m4 serial 2
-dnl Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/iconv.m4 b/m4/iconv.m4
index a503646..4b29c5f 100644
--- a/m4/iconv.m4
+++ b/m4/iconv.m4
@@ -1,5 +1,5 @@
# iconv.m4 serial 18 (gettext-0.18.2)
-dnl Copyright (C) 2000-2002, 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/iconv_h.m4 b/m4/iconv_h.m4
index f0519d9..e992fa3 100644
--- a/m4/iconv_h.m4
+++ b/m4/iconv_h.m4
@@ -1,5 +1,5 @@
# iconv_h.m4 serial 8
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/iconv_open-utf.m4 b/m4/iconv_open-utf.m4
index 0ab3a18..31ced26 100644
--- a/m4/iconv_open-utf.m4
+++ b/m4/iconv_open-utf.m4
@@ -1,5 +1,5 @@
# iconv_open-utf.m4 serial 1
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/iconv_open.m4 b/m4/iconv_open.m4
index 1dcf414..e0bfd72 100644
--- a/m4/iconv_open.m4
+++ b/m4/iconv_open.m4
@@ -1,5 +1,5 @@
# iconv_open.m4 serial 14
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 108d945..69ad3db 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,5 +1,5 @@
# include_next.m4 serial 23
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -192,56 +192,9 @@ dnl until we can assume autoconf 2.64 or newer.
if test AS_VAR_GET(gl_header_exists) = yes; then
AS_VAR_POPDEF([gl_header_exists])
])
- AC_LANG_CONFTEST(
- [AC_LANG_SOURCE(
- [[#include <]]m4_dquote(m4_defn([gl_HEADER_NAME]))[[>]]
- )])
- dnl AIX "xlc -E" and "cc -E" omit #line directives for header
- dnl files that contain only a #include of other header files and
- dnl no non-comment tokens of their own. This leads to a failure
- dnl to detect the absolute name of <dirent.h>, <signal.h>,
- dnl <poll.h> and others. The workaround is to force preservation
- dnl of comments through option -C. This ensures all necessary
- dnl #line directives are present. GCC supports option -C as
well.
- case "$host_os" in
- aix*) gl_absname_cpp="$ac_cpp -C" ;;
- *) gl_absname_cpp="$ac_cpp" ;;
- esac
-changequote(,)
- case "$host_os" in
- mingw*)
- dnl For the sake of native Windows compilers (excluding
gcc),
- dnl treat backslash as a directory separator, like /.
- dnl Actually, these compilers use a double-backslash as
- dnl directory separator, inside the
- dnl # line "filename"
- dnl directives.
- gl_dirsep_regex='[/\\]'
- ;;
- *)
- gl_dirsep_regex='\/'
- ;;
- esac
- dnl A sed expression that turns a string into a basic regular
- dnl expression, for use within "/.../".
- gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
-changequote([,])
- gl_header_literal_regex=`echo ']m4_defn([gl_HEADER_NAME])[' \
- | sed -e "$gl_make_literal_regex_sed"`
-
gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
-
s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
-changequote(,)dnl
- s|^/[^/]|//&|
-changequote([,])dnl
- p
- q
- }'
- dnl eval is necessary to expand gl_absname_cpp.
- dnl Ultrix and Pyramid sh refuse to redirect output of eval,
- dnl so use subshell.
- AS_VAR_SET(gl_next_header,
- ['"'`(eval "$gl_absname_cpp conftest.$ac_ext")
2>&AS_MESSAGE_LOG_FD |
- sed -n "$gl_absolute_header_sed"`'"'])
+ gl_ABSOLUTE_HEADER_ONE(gl_HEADER_NAME)
+ AS_VAR_COPY([gl_header], [gl_cv_absolute_]AS_TR_SH(gl_HEADER_NAME))
+ AS_VAR_SET(gl_next_header, ['"'$gl_header'"'])
m4_if([$2], [check],
[else
AS_VAR_SET(gl_next_header, ['<'gl_HEADER_NAME'>'])
diff --git a/m4/inet_ntop.m4 b/m4/inet_ntop.m4
index 476f063..5b27759 100644
--- a/m4/inet_ntop.m4
+++ b/m4/inet_ntop.m4
@@ -1,5 +1,5 @@
# inet_ntop.m4 serial 19
-dnl Copyright (C) 2005-2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/inet_pton.m4 b/m4/inet_pton.m4
index e86db82..136ed24 100644
--- a/m4/inet_pton.m4
+++ b/m4/inet_pton.m4
@@ -1,5 +1,5 @@
# inet_pton.m4 serial 17
-dnl Copyright (C) 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/inline.m4 b/m4/inline.m4
index 3a50621..c49957f 100644
--- a/m4/inline.m4
+++ b/m4/inline.m4
@@ -1,5 +1,5 @@
# inline.m4 serial 4
-dnl Copyright (C) 2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/intmax_t.m4 b/m4/intmax_t.m4
index 6ea7053..af5561e 100644
--- a/m4/intmax_t.m4
+++ b/m4/intmax_t.m4
@@ -1,5 +1,5 @@
# intmax_t.m4 serial 8
-dnl Copyright (C) 1997-2004, 2006-2007, 2009-2013 Free Software Foundation,
+dnl Copyright (C) 1997-2004, 2006-2007, 2009-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/inttypes_h.m4 b/m4/inttypes_h.m4
index 5f05ac5..87be9cf 100644
--- a/m4/inttypes_h.m4
+++ b/m4/inttypes_h.m4
@@ -1,5 +1,5 @@
# inttypes_h.m4 serial 10
-dnl Copyright (C) 1997-2004, 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 1997-2004, 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isfinite.m4 b/m4/isfinite.m4
index b54b403..53ad909 100644
--- a/m4/isfinite.m4
+++ b/m4/isfinite.m4
@@ -1,5 +1,5 @@
# isfinite.m4 serial 13
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isinf.m4 b/m4/isinf.m4
index 513a1ba..7174ace 100644
--- a/m4/isinf.m4
+++ b/m4/isinf.m4
@@ -1,5 +1,5 @@
# isinf.m4 serial 9
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isnan.m4 b/m4/isnan.m4
index ababb25..5793403 100644
--- a/m4/isnan.m4
+++ b/m4/isnan.m4
@@ -1,5 +1,5 @@
# isnan.m4 serial 5
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isnand.m4 b/m4/isnand.m4
index ee05e0f..36e4ea3 100644
--- a/m4/isnand.m4
+++ b/m4/isnand.m4
@@ -1,5 +1,5 @@
# isnand.m4 serial 11
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isnanf.m4 b/m4/isnanf.m4
index f01886a..1f2717d 100644
--- a/m4/isnanf.m4
+++ b/m4/isnanf.m4
@@ -1,5 +1,5 @@
# isnanf.m4 serial 14
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/isnanl.m4 b/m4/isnanl.m4
index ed5bbf8..98b2b69 100644
--- a/m4/isnanl.m4
+++ b/m4/isnanl.m4
@@ -1,5 +1,5 @@
# isnanl.m4 serial 17
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/langinfo_h.m4 b/m4/langinfo_h.m4
index 73bef8b..e8d78f9 100644
--- a/m4/langinfo_h.m4
+++ b/m4/langinfo_h.m4
@@ -1,5 +1,5 @@
# langinfo_h.m4 serial 7
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index 1e605e3..a1b564a 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,6 +1,6 @@
# Enable large files on systems where this is not the default.
-# Copyright 1992-1996, 1998-2013 Free Software Foundation, Inc.
+# Copyright 1992-1996, 1998-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/ld-version-script.m4 b/m4/ld-version-script.m4
index 63386f1..f8b4a5c 100644
--- a/m4/ld-version-script.m4
+++ b/m4/ld-version-script.m4
@@ -1,5 +1,5 @@
# ld-version-script.m4 serial 3
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/ldexp.m4 b/m4/ldexp.m4
index 7a75b1b..9c4f066 100644
--- a/m4/ldexp.m4
+++ b/m4/ldexp.m4
@@ -1,5 +1,5 @@
# ldexp.m4 serial 1
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/lib-ld.m4 b/m4/lib-ld.m4
index c145e47..ddc569f 100644
--- a/m4/lib-ld.m4
+++ b/m4/lib-ld.m4
@@ -1,5 +1,5 @@
# lib-ld.m4 serial 6
-dnl Copyright (C) 1996-2003, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 1996-2003, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/lib-link.m4 b/m4/lib-link.m4
index 073f040..3522d99 100644
--- a/m4/lib-link.m4
+++ b/m4/lib-link.m4
@@ -1,5 +1,5 @@
# lib-link.m4 serial 26 (gettext-0.18.2)
-dnl Copyright (C) 2001-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/lib-prefix.m4 b/m4/lib-prefix.m4
index 60908e8..31f49e4 100644
--- a/m4/lib-prefix.m4
+++ b/m4/lib-prefix.m4
@@ -1,5 +1,5 @@
# lib-prefix.m4 serial 7 (gettext-0.18)
-dnl Copyright (C) 2001-2005, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2005, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/libunistring-base.m4 b/m4/libunistring-base.m4
index d105c72..d003267 100644
--- a/m4/libunistring-base.m4
+++ b/m4/libunistring-base.m4
@@ -1,5 +1,5 @@
# libunistring-base.m4 serial 5
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/libunistring.m4 b/m4/libunistring.m4
index fa74d72..35980dd 100644
--- a/m4/libunistring.m4
+++ b/m4/libunistring.m4
@@ -1,5 +1,5 @@
# libunistring.m4 serial 11
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/localcharset.m4 b/m4/localcharset.m4
index 2e93e58..ada2f01 100644
--- a/m4/localcharset.m4
+++ b/m4/localcharset.m4
@@ -1,5 +1,5 @@
# localcharset.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/locale-fr.m4 b/m4/locale-fr.m4
index ef199e3..27db5ab 100644
--- a/m4/locale-fr.m4
+++ b/m4/locale-fr.m4
@@ -1,5 +1,5 @@
# locale-fr.m4 serial 17
-dnl Copyright (C) 2003, 2005-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/locale-ja.m4 b/m4/locale-ja.m4
index 132a3e7..c88fe8b 100644
--- a/m4/locale-ja.m4
+++ b/m4/locale-ja.m4
@@ -1,5 +1,5 @@
# locale-ja.m4 serial 12
-dnl Copyright (C) 2003, 2005-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/locale-zh.m4 b/m4/locale-zh.m4
index 4eed73f..d3b2347 100644
--- a/m4/locale-zh.m4
+++ b/m4/locale-zh.m4
@@ -1,5 +1,5 @@
# locale-zh.m4 serial 12
-dnl Copyright (C) 2003, 2005-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/locale_h.m4 b/m4/locale_h.m4
index 8bd12e8..2838588 100644
--- a/m4/locale_h.m4
+++ b/m4/locale_h.m4
@@ -1,5 +1,5 @@
# locale_h.m4 serial 19
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/localeconv.m4 b/m4/localeconv.m4
index b8bb596..1fd2919 100644
--- a/m4/localeconv.m4
+++ b/m4/localeconv.m4
@@ -1,5 +1,5 @@
# localeconv.m4 serial 1
-dnl Copyright (C) 2012-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/lock.m4 b/m4/lock.m4
new file mode 100644
index 0000000..73a3c54
--- /dev/null
+++ b/m4/lock.m4
@@ -0,0 +1,42 @@
+# lock.m4 serial 13 (gettext-0.18.2)
+dnl Copyright (C) 2005-2014 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+AC_DEFUN([gl_LOCK],
+[
+ AC_REQUIRE([gl_THREADLIB])
+ if test "$gl_threads_api" = posix; then
+ # OSF/1 4.0 and Mac OS X 10.1 lack the pthread_rwlock_t type and the
+ # pthread_rwlock_* functions.
+ AC_CHECK_TYPE([pthread_rwlock_t],
+ [AC_DEFINE([HAVE_PTHREAD_RWLOCK], [1],
+ [Define if the POSIX multithreading library has read/write locks.])],
+ [],
+ [#include <pthread.h>])
+ # glibc defines PTHREAD_MUTEX_RECURSIVE as enum, not as a macro.
+ AC_COMPILE_IFELSE([
+ AC_LANG_PROGRAM(
+ [[#include <pthread.h>]],
+ [[
+#if __FreeBSD__ == 4
+error "No, in FreeBSD 4.0 recursive mutexes actually don't work."
+#elif (defined __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ \
+ && __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1070)
+error "No, in Mac OS X < 10.7 recursive mutexes actually don't work."
+#else
+int x = (int)PTHREAD_MUTEX_RECURSIVE;
+return !x;
+#endif
+ ]])],
+ [AC_DEFINE([HAVE_PTHREAD_MUTEX_RECURSIVE], [1],
+ [Define if the <pthread.h> defines PTHREAD_MUTEX_RECURSIVE.])])
+ fi
+ gl_PREREQ_LOCK
+])
+
+# Prerequisites of lib/glthread/lock.c.
+AC_DEFUN([gl_PREREQ_LOCK], [:])
diff --git a/m4/log.m4 b/m4/log.m4
index 31a6adf..146a96f 100644
--- a/m4/log.m4
+++ b/m4/log.m4
@@ -1,5 +1,5 @@
# log.m4 serial 4
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/log1p.m4 b/m4/log1p.m4
index 8a81511..25440b0 100644
--- a/m4/log1p.m4
+++ b/m4/log1p.m4
@@ -1,5 +1,5 @@
# log1p.m4 serial 3
-dnl Copyright (C) 2012-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/longlong.m4 b/m4/longlong.m4
index 3af6ab5..eefb37c 100644
--- a/m4/longlong.m4
+++ b/m4/longlong.m4
@@ -1,5 +1,5 @@
# longlong.m4 serial 17
-dnl Copyright (C) 1999-2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 1999-2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index 5f4db64..c5e72b8 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,6 +1,6 @@
# serial 26
-# Copyright (C) 1997-2001, 2003-2013 Free Software Foundation, Inc.
+# Copyright (C) 1997-2001, 2003-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/malloc.m4 b/m4/malloc.m4
index 4b24a0b..322ad6e 100644
--- a/m4/malloc.m4
+++ b/m4/malloc.m4
@@ -1,5 +1,5 @@
# malloc.m4 serial 14
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/malloca.m4 b/m4/malloca.m4
index 791ce10..dcc1a08 100644
--- a/m4/malloca.m4
+++ b/m4/malloca.m4
@@ -1,5 +1,5 @@
# malloca.m4 serial 1
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2013 Free Software Foundation,
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/math_h.m4 b/m4/math_h.m4
index bf0845f..9e2adfb 100644
--- a/m4/math_h.m4
+++ b/m4/math_h.m4
@@ -1,5 +1,5 @@
# math_h.m4 serial 114
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mathfunc.m4 b/m4/mathfunc.m4
index 67b601f..6f0e6aa 100644
--- a/m4/mathfunc.m4
+++ b/m4/mathfunc.m4
@@ -1,5 +1,5 @@
# mathfunc.m4 serial 11
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mbrtowc.m4 b/m4/mbrtowc.m4
index 4c9f388..a9d1570 100644
--- a/m4/mbrtowc.m4
+++ b/m4/mbrtowc.m4
@@ -1,5 +1,5 @@
# mbrtowc.m4 serial 25
-dnl Copyright (C) 2001-2002, 2004-2005, 2008-2013 Free Software Foundation,
+dnl Copyright (C) 2001-2002, 2004-2005, 2008-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/mbsinit.m4 b/m4/mbsinit.m4
index 2e6d092..e1598a1 100644
--- a/m4/mbsinit.m4
+++ b/m4/mbsinit.m4
@@ -1,5 +1,5 @@
# mbsinit.m4 serial 8
-dnl Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4
index ed00117..068155a 100644
--- a/m4/mbstate_t.m4
+++ b/m4/mbstate_t.m4
@@ -1,5 +1,5 @@
# mbstate_t.m4 serial 13
-dnl Copyright (C) 2000-2002, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mbtowc.m4 b/m4/mbtowc.m4
index e479461..cacfe16 100644
--- a/m4/mbtowc.m4
+++ b/m4/mbtowc.m4
@@ -1,5 +1,5 @@
# mbtowc.m4 serial 2
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/memchr.m4 b/m4/memchr.m4
index 2d8abe7..b9f126c 100644
--- a/m4/memchr.m4
+++ b/m4/memchr.m4
@@ -1,5 +1,5 @@
# memchr.m4 serial 12
-dnl Copyright (C) 2002-2004, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mmap-anon.m4 b/m4/mmap-anon.m4
index 9b60ddf..94ae2e2 100644
--- a/m4/mmap-anon.m4
+++ b/m4/mmap-anon.m4
@@ -1,5 +1,5 @@
# mmap-anon.m4 serial 10
-dnl Copyright (C) 2005, 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mode_t.m4 b/m4/mode_t.m4
index d5b66d4..db6e192 100644
--- a/m4/mode_t.m4
+++ b/m4/mode_t.m4
@@ -1,5 +1,5 @@
# mode_t.m4 serial 2
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/msvc-inval.m4 b/m4/msvc-inval.m4
index 9a6a47a..7f26087 100644
--- a/m4/msvc-inval.m4
+++ b/m4/msvc-inval.m4
@@ -1,5 +1,5 @@
# msvc-inval.m4 serial 1
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/msvc-nothrow.m4 b/m4/msvc-nothrow.m4
index a39618a..9e32c17 100644
--- a/m4/msvc-nothrow.m4
+++ b/m4/msvc-nothrow.m4
@@ -1,5 +1,5 @@
# msvc-nothrow.m4 serial 1
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
index 552ec7e..2cb956d 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,5 +1,5 @@
# multiarch.m4 serial 7
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/netdb_h.m4 b/m4/netdb_h.m4
index 2c69f99..cd7d482 100644
--- a/m4/netdb_h.m4
+++ b/m4/netdb_h.m4
@@ -1,5 +1,5 @@
# netdb_h.m4 serial 11
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/netinet_in_h.m4 b/m4/netinet_in_h.m4
index 21971b2..1d447d6 100644
--- a/m4/netinet_in_h.m4
+++ b/m4/netinet_in_h.m4
@@ -1,5 +1,5 @@
# netinet_in_h.m4 serial 5
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/nl_langinfo.m4 b/m4/nl_langinfo.m4
index 25e2101..6976e77 100644
--- a/m4/nl_langinfo.m4
+++ b/m4/nl_langinfo.m4
@@ -1,5 +1,5 @@
# nl_langinfo.m4 serial 5
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/nocrash.m4 b/m4/nocrash.m4
index 105b884..5a5d77d 100644
--- a/m4/nocrash.m4
+++ b/m4/nocrash.m4
@@ -1,5 +1,5 @@
# nocrash.m4 serial 4
-dnl Copyright (C) 2005, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/nproc.m4 b/m4/nproc.m4
index 0261938..937c4a9 100644
--- a/m4/nproc.m4
+++ b/m4/nproc.m4
@@ -1,5 +1,5 @@
# nproc.m4 serial 4
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/off_t.m4 b/m4/off_t.m4
index d355d01..f5885b3 100644
--- a/m4/off_t.m4
+++ b/m4/off_t.m4
@@ -1,5 +1,5 @@
# off_t.m4 serial 1
-dnl Copyright (C) 2012-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/open.m4 b/m4/open.m4
index a6cb101..68f116f 100644
--- a/m4/open.m4
+++ b/m4/open.m4
@@ -1,5 +1,5 @@
# open.m4 serial 14
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index e11bf57..114f91f 100644
--- a/m4/pathmax.m4
+++ b/m4/pathmax.m4
@@ -1,5 +1,5 @@
# pathmax.m4 serial 10
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2013 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/pipe.m4 b/m4/pipe.m4
index 5831283..d3532d5 100644
--- a/m4/pipe.m4
+++ b/m4/pipe.m4
@@ -1,5 +1,5 @@
# pipe.m4 serial 2
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/pipe2.m4 b/m4/pipe2.m4
index 6ccee10..1cff1fe 100644
--- a/m4/pipe2.m4
+++ b/m4/pipe2.m4
@@ -1,5 +1,5 @@
# pipe2.m4 serial 2
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/poll.m4 b/m4/poll.m4
index f0f0b80..f523b18 100644
--- a/m4/poll.m4
+++ b/m4/poll.m4
@@ -1,5 +1,5 @@
# poll.m4 serial 17
-dnl Copyright (c) 2003, 2005-2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (c) 2003, 2005-2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/poll_h.m4 b/m4/poll_h.m4
index 4930674..fcfe7fa 100644
--- a/m4/poll_h.m4
+++ b/m4/poll_h.m4
@@ -1,5 +1,5 @@
# poll_h.m4 serial 2
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/printf.m4 b/m4/printf.m4
index ef44f78..9346ab0 100644
--- a/m4/printf.m4
+++ b/m4/printf.m4
@@ -1,5 +1,5 @@
# printf.m4 serial 50
-dnl Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/putenv.m4 b/m4/putenv.m4
index 03ed4f9..d79321b 100644
--- a/m4/putenv.m4
+++ b/m4/putenv.m4
@@ -1,5 +1,5 @@
-# putenv.m4 serial 19
-dnl Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# putenv.m4 serial 20
+dnl Copyright (C) 2002-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -52,5 +52,5 @@ AC_DEFUN([gl_FUNC_PUTENV],
# Prerequisites of lib/putenv.c.
AC_DEFUN([gl_PREREQ_PUTENV],
[
- AC_CHECK_FUNCS([_putenv])
+ AC_CHECK_DECLS([_putenv])
])
diff --git a/m4/raise.m4 b/m4/raise.m4
index 7df3317..8656578 100644
--- a/m4/raise.m4
+++ b/m4/raise.m4
@@ -1,5 +1,5 @@
# raise.m4 serial 3
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/read.m4 b/m4/read.m4
index 81f0f3a..176b0b0 100644
--- a/m4/read.m4
+++ b/m4/read.m4
@@ -1,5 +1,5 @@
# read.m4 serial 4
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index 96e5042..f9ce868 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,5 +1,5 @@
# readlink.m4 serial 12
-dnl Copyright (C) 2003, 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/regex.m4 b/m4/regex.m4
index ae89e31..08bd46a 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,6 +1,6 @@
-# serial 63
+# serial 65
-# Copyright (C) 1996-2001, 2003-2013 Free Software Foundation, Inc.
+# Copyright (C) 1996-2001, 2003-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -27,7 +27,8 @@ AC_DEFUN([gl_REGEX],
# following run test, then default to *not* using the included regex.c.
# If cross compiling, assume the test would fail and use the included
# regex.c.
- AC_CHECK_FUNCS_ONCE([alarm])
+ AC_CHECK_DECLS_ONCE([alarm])
+ AC_CHECK_HEADERS_ONCE([malloc.h])
AC_CACHE_CHECK([for working re_compile_pattern],
[gl_cv_func_re_compile_pattern_working],
[AC_RUN_IFELSE(
@@ -37,9 +38,19 @@ AC_DEFUN([gl_REGEX],
#include <locale.h>
#include <limits.h>
#include <string.h>
- #if HAVE_ALARM
- # include <unistd.h>
+
+ #if defined M_CHECK_ACTION || HAVE_DECL_ALARM
# include <signal.h>
+ # include <unistd.h>
+ #endif
+
+ #if HAVE_MALLOC_H
+ # include <malloc.h>
+ #endif
+
+ #ifdef M_CHECK_ACTION
+ /* Exit with distinguishable exit code. */
+ static void sigabrt_no_core (int sig) { raise (SIGTERM); }
#endif
]],
[[int result = 0;
@@ -49,11 +60,18 @@ AC_DEFUN([gl_REGEX],
const char *s;
struct re_registers regs;
-#if HAVE_ALARM
- /* Some builds of glibc go into an infinite loop on this test. */
+ /* Some builds of glibc go into an infinite loop on this
+ test. Use alarm to force death, and mallopt to avoid
+ malloc recursion in diagnosing the corrupted heap. */
+#if HAVE_DECL_ALARM
signal (SIGALRM, SIG_DFL);
alarm (2);
#endif
+#ifdef M_CHECK_ACTION
+ signal (SIGABRT, sigabrt_no_core);
+ mallopt (M_CHECK_ACTION, 2);
+#endif
+
if (setlocale (LC_ALL, "en_US.UTF-8"))
{
{
@@ -84,17 +102,28 @@ AC_DEFUN([gl_REGEX],
*/
static char const pat[] = "[^x]x";
static char const data[] =
- "\xe1\x80\x80\xe1\x80\xbb\xe1\x80\xbd\xe1\x80\x94\xe1\x80"
- "\xba\xe1\x80\xaf\xe1\x80\x95\xe1\x80\xbax";
+ /*
<U1000><U103B><U103D><U1014><U103A><U102F><U1015><U103A> */
+ "\xe1\x80\x80"
+ "\xe1\x80\xbb"
+ "\xe1\x80\xbd"
+ "\xe1\x80\x94"
+ "\xe1\x80\xba"
+ "\xe1\x80\xaf"
+ "\xe1\x80\x95"
+ "\xe1\x80\xba"
+ "x";
re_set_syntax (0);
memset (®ex, 0, sizeof regex);
s = re_compile_pattern (pat, sizeof pat - 1, ®ex);
if (s)
result |= 1;
- else if (re_search (®ex, data, sizeof data - 1,
- 0, sizeof data - 1, 0)
- != 21)
- result |= 1;
+ else
+ {
+ i = re_search (®ex, data, sizeof data - 1,
+ 0, sizeof data - 1, 0);
+ if (i != 0 && i != 21)
+ result |= 1;
+ }
}
if (! setlocale (LC_ALL, "C"))
@@ -255,7 +284,8 @@ AC_DEFUN([gl_PREREQ_REGEX],
AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
AC_REQUIRE([gl_EEMALLOC])
+ AC_REQUIRE([gl_GLIBC21])
AC_CHECK_HEADERS([libintl.h])
- AC_CHECK_FUNCS_ONCE([isblank iswctype wcscoll])
+ AC_CHECK_FUNCS_ONCE([isblank iswctype])
AC_CHECK_DECLS([isblank], [], [], [[#include <ctype.h>]])
])
diff --git a/m4/rename.m4 b/m4/rename.m4
index 66430aa..ea57794 100644
--- a/m4/rename.m4
+++ b/m4/rename.m4
@@ -1,6 +1,6 @@
# serial 26
-# Copyright (C) 2001, 2003, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2001, 2003, 2005-2006, 2009-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/rmdir.m4 b/m4/rmdir.m4
index f6a02dd..db6a939 100644
--- a/m4/rmdir.m4
+++ b/m4/rmdir.m4
@@ -1,5 +1,5 @@
# rmdir.m4 serial 13
-dnl Copyright (C) 2002, 2005, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/round.m4 b/m4/round.m4
index aab67ac..13049b7 100644
--- a/m4/round.m4
+++ b/m4/round.m4
@@ -1,5 +1,5 @@
# round.m4 serial 16
-dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/safe-read.m4 b/m4/safe-read.m4
index be5207a..f0c42e0 100644
--- a/m4/safe-read.m4
+++ b/m4/safe-read.m4
@@ -1,5 +1,5 @@
# safe-read.m4 serial 6
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2013 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2014 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/safe-write.m4 b/m4/safe-write.m4
index bc2a33f..66648bb 100644
--- a/m4/safe-write.m4
+++ b/m4/safe-write.m4
@@ -1,5 +1,5 @@
# safe-write.m4 serial 4
-dnl Copyright (C) 2002, 2005-2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/select.m4 b/m4/select.m4
index d025355..1d2fcb3 100644
--- a/m4/select.m4
+++ b/m4/select.m4
@@ -1,5 +1,5 @@
# select.m4 serial 7
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/servent.m4 b/m4/servent.m4
index 01c037a..4dc7a9f 100644
--- a/m4/servent.m4
+++ b/m4/servent.m4
@@ -1,5 +1,5 @@
# servent.m4 serial 2
-dnl Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/setenv.m4 b/m4/setenv.m4
index cb5351a..0f46a7b 100644
--- a/m4/setenv.m4
+++ b/m4/setenv.m4
@@ -1,5 +1,5 @@
# setenv.m4 serial 26
-dnl Copyright (C) 2001-2004, 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2004, 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
index 3de9f27..c8f664f 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,5 +1,5 @@
# signal_h.m4 serial 18
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/signbit.m4 b/m4/signbit.m4
index d58caaf..9ed48c7 100644
--- a/m4/signbit.m4
+++ b/m4/signbit.m4
@@ -1,5 +1,5 @@
# signbit.m4 serial 13
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/size_max.m4 b/m4/size_max.m4
index 4b247ab..7e192d5 100644
--- a/m4/size_max.m4
+++ b/m4/size_max.m4
@@ -1,5 +1,5 @@
# size_max.m4 serial 10
-dnl Copyright (C) 2003, 2005-2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/snprintf.m4 b/m4/snprintf.m4
index 3698e84..888db35 100644
--- a/m4/snprintf.m4
+++ b/m4/snprintf.m4
@@ -1,5 +1,5 @@
# snprintf.m4 serial 6
-dnl Copyright (C) 2002-2004, 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/socketlib.m4 b/m4/socketlib.m4
index b08a72f..041498b 100644
--- a/m4/socketlib.m4
+++ b/m4/socketlib.m4
@@ -1,5 +1,5 @@
# socketlib.m4 serial 1
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sockets.m4 b/m4/sockets.m4
index b407391..da6ff74 100644
--- a/m4/sockets.m4
+++ b/m4/sockets.m4
@@ -1,5 +1,5 @@
# sockets.m4 serial 7
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/socklen.m4 b/m4/socklen.m4
index e3efd6e..4c07f86 100644
--- a/m4/socklen.m4
+++ b/m4/socklen.m4
@@ -1,5 +1,5 @@
# socklen.m4 serial 10
-dnl Copyright (C) 2005-2007, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2007, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sockpfaf.m4 b/m4/sockpfaf.m4
index 89557b1..31d436f 100644
--- a/m4/sockpfaf.m4
+++ b/m4/sockpfaf.m4
@@ -1,5 +1,5 @@
# sockpfaf.m4 serial 8
-dnl Copyright (C) 2004, 2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index 6338134..fbe1d06 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,5 +1,5 @@
# ssize_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2001-2003, 2006, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
index d777f74..ea5c4fc 100644
--- a/m4/stat-time.m4
+++ b/m4/stat-time.m4
@@ -1,6 +1,6 @@
# Checks for stat-related time functions.
-# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2013 Free Software
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2014 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
diff --git a/m4/stat.m4 b/m4/stat.m4
index 2456297..1ae327b 100644
--- a/m4/stat.m4
+++ b/m4/stat.m4
@@ -1,6 +1,6 @@
# serial 11
-# Copyright (C) 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2009-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index 3d7993d..9efafe5 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -1,6 +1,6 @@
# Check for stdalign.h that conforms to C11.
-dnl Copyright 2011-2013 Free Software Foundation, Inc.
+dnl Copyright 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -31,10 +31,12 @@ AC_DEFUN([gl_STDALIGN_H],
/* Test _Alignas only on platforms where gnulib can help. */
#if \
- (__GNUC__ || __IBMC__ || __IBMCPP__ \
+ ((defined __cplusplus && 201103 <= __cplusplus) \
+ || __GNUC__ || __IBMC__ || __IBMCPP__ || __ICC \
|| 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER)
- int alignas (8) alignas_int = 1;
- char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1];
+ struct alignas_test { char c; char alignas (8) alignas_8; };
+ char test_alignas[offsetof (struct alignas_test, alignas_8) == 8
+ ? 1 : -1];
#endif
]])],
[gl_cv_header_working_stdalign_h=yes],
diff --git a/m4/stdbool.m4 b/m4/stdbool.m4
index 80d5559..006ed52 100644
--- a/m4/stdbool.m4
+++ b/m4/stdbool.m4
@@ -1,6 +1,6 @@
# Check for stdbool.h that conforms to C99.
-dnl Copyright (C) 2002-2006, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 5da8ab1..c555e29 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,6 +1,6 @@
dnl A placeholder for POSIX 2008 <stddef.h>, for platforms that have issues.
# stddef_h.m4 serial 4
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 27cdcdb..1981d9d 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,5 +1,5 @@
# stdint.m4 serial 43
-dnl Copyright (C) 2001-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdint_h.m4 b/m4/stdint_h.m4
index 511ab4e..7fc2ce9 100644
--- a/m4/stdint_h.m4
+++ b/m4/stdint_h.m4
@@ -1,5 +1,5 @@
# stdint_h.m4 serial 9
-dnl Copyright (C) 1997-2004, 2006, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 1997-2004, 2006, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
index ebade06..d15913a 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,5 +1,5 @@
# stdio_h.m4 serial 43
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 2027ab3..03b448b 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,5 +1,5 @@
# stdlib_h.m4 serial 42
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/strftime.m4 b/m4/strftime.m4
index b31f495..0ba3dd0 100644
--- a/m4/strftime.m4
+++ b/m4/strftime.m4
@@ -1,6 +1,6 @@
# serial 33
-# Copyright (C) 1996-1997, 1999-2007, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index cc5fbbb..64e683f 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -1,6 +1,6 @@
# Configure a GNU-like replacement for <string.h>.
-# Copyright (C) 2007-2013 Free Software Foundation, Inc.
+# Copyright (C) 2007-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_file_h.m4 b/m4/sys_file_h.m4
index 0cec958..ad78efb 100644
--- a/m4/sys_file_h.m4
+++ b/m4/sys_file_h.m4
@@ -1,7 +1,7 @@
# Configure a replacement for <sys/file.h>.
# serial 6
-# Copyright (C) 2008-2013 Free Software Foundation, Inc.
+# Copyright (C) 2008-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_select_h.m4 b/m4/sys_select_h.m4
index 4962328..1a502b4 100644
--- a/m4/sys_select_h.m4
+++ b/m4/sys_select_h.m4
@@ -1,5 +1,5 @@
# sys_select_h.m4 serial 20
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
index 9486377..114d828 100644
--- a/m4/sys_socket_h.m4
+++ b/m4/sys_socket_h.m4
@@ -1,5 +1,5 @@
# sys_socket_h.m4 serial 23
-dnl Copyright (C) 2005-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index 6dd3d99..eaa7642 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,5 +1,5 @@
# sys_stat_h.m4 serial 28 -*- Autoconf -*-
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4
index 0ac71ac..5c79300 100644
--- a/m4/sys_time_h.m4
+++ b/m4/sys_time_h.m4
@@ -1,7 +1,7 @@
# Configure a replacement for <sys/time.h>.
# serial 8
-# Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2007, 2009-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_times_h.m4 b/m4/sys_times_h.m4
index 6006985..fad63c4 100644
--- a/m4/sys_times_h.m4
+++ b/m4/sys_times_h.m4
@@ -1,7 +1,7 @@
# Configure a replacement for <sys/times.h>.
# serial 8
-# Copyright (C) 2008-2013 Free Software Foundation, Inc.
+# Copyright (C) 2008-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index 6132727..9748905 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -1,10 +1,10 @@
-# sys_types_h.m4 serial 4
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+# sys_types_h.m4 serial 5
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
-AC_DEFUN([gl_SYS_TYPES_H],
+AC_DEFUN_ONCE([gl_SYS_TYPES_H],
[
AC_REQUIRE([gl_SYS_TYPES_H_DEFAULTS])
gl_NEXT_HEADERS([sys/types.h])
diff --git a/m4/sys_uio_h.m4 b/m4/sys_uio_h.m4
index c75cbbd..ba6b4b5 100644
--- a/m4/sys_uio_h.m4
+++ b/m4/sys_uio_h.m4
@@ -1,5 +1,5 @@
# sys_uio_h.m4 serial 1
-dnl Copyright (C) 2011-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/threadlib.m4 b/m4/threadlib.m4
new file mode 100644
index 0000000..a881702
--- /dev/null
+++ b/m4/threadlib.m4
@@ -0,0 +1,371 @@
+# threadlib.m4 serial 10 (gettext-0.18.2)
+dnl Copyright (C) 2005-2014 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+dnl gl_THREADLIB
+dnl ------------
+dnl Tests for a multithreading library to be used.
+dnl If the configure.ac contains a definition of the gl_THREADLIB_DEFAULT_NO
+dnl (it must be placed before the invocation of gl_THREADLIB_EARLY!), then the
+dnl default is 'no', otherwise it is system dependent. In both cases, the user
+dnl can change the choice through the options --enable-threads=choice or
+dnl --disable-threads.
+dnl Defines at most one of the macros USE_POSIX_THREADS, USE_SOLARIS_THREADS,
+dnl USE_PTH_THREADS, USE_WINDOWS_THREADS
+dnl Sets the variables LIBTHREAD and LTLIBTHREAD to the linker options for use
+dnl in a Makefile (LIBTHREAD for use without libtool, LTLIBTHREAD for use with
+dnl libtool).
+dnl Sets the variables LIBMULTITHREAD and LTLIBMULTITHREAD similarly, for
+dnl programs that really need multithread functionality. The difference
+dnl between LIBTHREAD and LIBMULTITHREAD is that on platforms supporting weak
+dnl symbols, typically LIBTHREAD="" whereas LIBMULTITHREAD="-lpthread".
+dnl Adds to CPPFLAGS the flag -D_REENTRANT or -D_THREAD_SAFE if needed for
+dnl multithread-safe programs.
+
+AC_DEFUN([gl_THREADLIB_EARLY],
+[
+ AC_REQUIRE([gl_THREADLIB_EARLY_BODY])
+])
+
+dnl The guts of gl_THREADLIB_EARLY. Needs to be expanded only once.
+
+AC_DEFUN([gl_THREADLIB_EARLY_BODY],
+[
+ dnl Ordering constraints: This macro modifies CPPFLAGS in a way that
+ dnl influences the result of the autoconf tests that test for *_unlocked
+ dnl declarations, on AIX 5 at least. Therefore it must come early.
+ AC_BEFORE([$0], [gl_FUNC_GLIBC_UNLOCKED_IO])dnl
+ AC_BEFORE([$0], [gl_ARGP])dnl
+
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ dnl _GNU_SOURCE is needed for pthread_rwlock_t on glibc systems.
+ dnl AC_USE_SYSTEM_EXTENSIONS was introduced in autoconf 2.60 and obsoletes
+ dnl AC_GNU_SOURCE.
+ m4_ifdef([AC_USE_SYSTEM_EXTENSIONS],
+ [AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])],
+ [AC_REQUIRE([AC_GNU_SOURCE])])
+ dnl Check for multithreading.
+ m4_ifdef([gl_THREADLIB_DEFAULT_NO],
+ [m4_divert_text([DEFAULTS], [gl_use_threads_default=no])],
+ [m4_divert_text([DEFAULTS], [gl_use_threads_default=])])
+ AC_ARG_ENABLE([threads],
+AC_HELP_STRING([--enable-threads={posix|solaris|pth|windows}], [specify
multithreading API])m4_ifdef([gl_THREADLIB_DEFAULT_NO], [], [
+AC_HELP_STRING([--disable-threads], [build without multithread safety])]),
+ [gl_use_threads=$enableval],
+ [if test -n "$gl_use_threads_default"; then
+ gl_use_threads="$gl_use_threads_default"
+ else
+changequote(,)dnl
+ case "$host_os" in
+ dnl Disable multithreading by default on OSF/1, because it interferes
+ dnl with fork()/exec(): When msgexec is linked with -lpthread, its
+ dnl child process gets an endless segmentation fault inside execvp().
+ dnl Disable multithreading by default on Cygwin 1.5.x, because it has
+ dnl bugs that lead to endless loops or crashes. See
+ dnl <http://cygwin.com/ml/cygwin/2009-08/msg00283.html>.
+ osf*) gl_use_threads=no ;;
+ cygwin*)
+ case `uname -r` in
+ 1.[0-5].*) gl_use_threads=no ;;
+ *) gl_use_threads=yes ;;
+ esac
+ ;;
+ *) gl_use_threads=yes ;;
+ esac
+changequote([,])dnl
+ fi
+ ])
+ if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then
+ # For using <pthread.h>:
+ case "$host_os" in
+ osf*)
+ # On OSF/1, the compiler needs the flag -D_REENTRANT so that it
+ # groks <pthread.h>. cc also understands the flag -pthread, but
+ # we don't use it because 1. gcc-2.95 doesn't understand -pthread,
+ # 2. putting a flag into CPPFLAGS that has an effect on the linker
+ # causes the AC_LINK_IFELSE test below to succeed unexpectedly,
+ # leading to wrong values of LIBTHREAD and LTLIBTHREAD.
+ CPPFLAGS="$CPPFLAGS -D_REENTRANT"
+ ;;
+ esac
+ # Some systems optimize for single-threaded programs by default, and
+ # need special flags to disable these optimizations. For example, the
+ # definition of 'errno' in <errno.h>.
+ case "$host_os" in
+ aix* | freebsd*) CPPFLAGS="$CPPFLAGS -D_THREAD_SAFE" ;;
+ solaris*) CPPFLAGS="$CPPFLAGS -D_REENTRANT" ;;
+ esac
+ fi
+])
+
+dnl The guts of gl_THREADLIB. Needs to be expanded only once.
+
+AC_DEFUN([gl_THREADLIB_BODY],
+[
+ AC_REQUIRE([gl_THREADLIB_EARLY_BODY])
+ gl_threads_api=none
+ LIBTHREAD=
+ LTLIBTHREAD=
+ LIBMULTITHREAD=
+ LTLIBMULTITHREAD=
+ if test "$gl_use_threads" != no; then
+ dnl Check whether the compiler and linker support weak declarations.
+ AC_CACHE_CHECK([whether imported symbols can be declared weak],
+ [gl_cv_have_weak],
+ [gl_cv_have_weak=no
+ dnl First, test whether the compiler accepts it syntactically.
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[extern void xyzzy ();
+#pragma weak xyzzy]],
+ [[xyzzy();]])],
+ [gl_cv_have_weak=maybe])
+ if test $gl_cv_have_weak = maybe; then
+ dnl Second, test whether it actually works. On Cygwin 1.7.2, with
+ dnl gcc 4.3, symbols declared weak always evaluate to the address 0.
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <stdio.h>
+#pragma weak fputs
+int main ()
+{
+ return (fputs == NULL);
+}]])],
+ [gl_cv_have_weak=yes],
+ [gl_cv_have_weak=no],
+ [dnl When cross-compiling, assume that only ELF platforms support
+ dnl weak symbols.
+ AC_EGREP_CPP([Extensible Linking Format],
+ [#ifdef __ELF__
+ Extensible Linking Format
+ #endif
+ ],
+ [gl_cv_have_weak="guessing yes"],
+ [gl_cv_have_weak="guessing no"])
+ ])
+ fi
+ ])
+ if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then
+ # On OSF/1, the compiler needs the flag -pthread or -D_REENTRANT so that
+ # it groks <pthread.h>. It's added above, in gl_THREADLIB_EARLY_BODY.
+ AC_CHECK_HEADER([pthread.h],
+ [gl_have_pthread_h=yes], [gl_have_pthread_h=no])
+ if test "$gl_have_pthread_h" = yes; then
+ # Other possible tests:
+ # -lpthreads (FSU threads, PCthreads)
+ # -lgthreads
+ gl_have_pthread=
+ # Test whether both pthread_mutex_lock and pthread_mutexattr_init exist
+ # in libc. IRIX 6.5 has the first one in both libc and libpthread, but
+ # the second one only in libpthread, and lock.c needs it.
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <pthread.h>]],
+ [[pthread_mutex_lock((pthread_mutex_t*)0);
+ pthread_mutexattr_init((pthread_mutexattr_t*)0);]])],
+ [gl_have_pthread=yes])
+ # Test for libpthread by looking for pthread_kill. (Not pthread_self,
+ # since it is defined as a macro on OSF/1.)
+ if test -n "$gl_have_pthread"; then
+ # The program links fine without libpthread. But it may actually
+ # need to link with libpthread in order to create multiple threads.
+ AC_CHECK_LIB([pthread], [pthread_kill],
+ [LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread
+ # On Solaris and HP-UX, most pthread functions exist also in libc.
+ # Therefore pthread_in_use() needs to actually try to create a
+ # thread: pthread_create from libc will fail, whereas
+ # pthread_create will actually create a thread.
+ case "$host_os" in
+ solaris* | hpux*)
+ AC_DEFINE([PTHREAD_IN_USE_DETECTION_HARD], [1],
+ [Define if the pthread_in_use() detection is hard.])
+ esac
+ ])
+ else
+ # Some library is needed. Try libpthread and libc_r.
+ AC_CHECK_LIB([pthread], [pthread_kill],
+ [gl_have_pthread=yes
+ LIBTHREAD=-lpthread LTLIBTHREAD=-lpthread
+ LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread])
+ if test -z "$gl_have_pthread"; then
+ # For FreeBSD 4.
+ AC_CHECK_LIB([c_r], [pthread_kill],
+ [gl_have_pthread=yes
+ LIBTHREAD=-lc_r LTLIBTHREAD=-lc_r
+ LIBMULTITHREAD=-lc_r LTLIBMULTITHREAD=-lc_r])
+ fi
+ fi
+ if test -n "$gl_have_pthread"; then
+ gl_threads_api=posix
+ AC_DEFINE([USE_POSIX_THREADS], [1],
+ [Define if the POSIX multithreading library can be used.])
+ if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then
+ if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
+ AC_DEFINE([USE_POSIX_THREADS_WEAK], [1],
+ [Define if references to the POSIX multithreading library
should be made weak.])
+ LIBTHREAD=
+ LTLIBTHREAD=
+ fi
+ fi
+ fi
+ fi
+ fi
+ if test -z "$gl_have_pthread"; then
+ if test "$gl_use_threads" = yes || test "$gl_use_threads" = solaris; then
+ gl_have_solaristhread=
+ gl_save_LIBS="$LIBS"
+ LIBS="$LIBS -lthread"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+#include <thread.h>
+#include <synch.h>
+ ]],
+ [[thr_self();]])],
+ [gl_have_solaristhread=yes])
+ LIBS="$gl_save_LIBS"
+ if test -n "$gl_have_solaristhread"; then
+ gl_threads_api=solaris
+ LIBTHREAD=-lthread
+ LTLIBTHREAD=-lthread
+ LIBMULTITHREAD="$LIBTHREAD"
+ LTLIBMULTITHREAD="$LTLIBTHREAD"
+ AC_DEFINE([USE_SOLARIS_THREADS], [1],
+ [Define if the old Solaris multithreading library can be used.])
+ if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
+ AC_DEFINE([USE_SOLARIS_THREADS_WEAK], [1],
+ [Define if references to the old Solaris multithreading library
should be made weak.])
+ LIBTHREAD=
+ LTLIBTHREAD=
+ fi
+ fi
+ fi
+ fi
+ if test "$gl_use_threads" = pth; then
+ gl_save_CPPFLAGS="$CPPFLAGS"
+ AC_LIB_LINKFLAGS([pth])
+ gl_have_pth=
+ gl_save_LIBS="$LIBS"
+ LIBS="$LIBS $LIBPTH"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[#include <pth.h>]], [[pth_self();]])],
+ [gl_have_pth=yes])
+ LIBS="$gl_save_LIBS"
+ if test -n "$gl_have_pth"; then
+ gl_threads_api=pth
+ LIBTHREAD="$LIBPTH"
+ LTLIBTHREAD="$LTLIBPTH"
+ LIBMULTITHREAD="$LIBTHREAD"
+ LTLIBMULTITHREAD="$LTLIBTHREAD"
+ AC_DEFINE([USE_PTH_THREADS], [1],
+ [Define if the GNU Pth multithreading library can be used.])
+ if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then
+ if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
+ AC_DEFINE([USE_PTH_THREADS_WEAK], [1],
+ [Define if references to the GNU Pth multithreading library
should be made weak.])
+ LIBTHREAD=
+ LTLIBTHREAD=
+ fi
+ fi
+ else
+ CPPFLAGS="$gl_save_CPPFLAGS"
+ fi
+ fi
+ if test -z "$gl_have_pthread"; then
+ case "$gl_use_threads" in
+ yes | windows | win32) # The 'win32' is for backward compatibility.
+ if { case "$host_os" in
+ mingw*) true;;
+ *) false;;
+ esac
+ }; then
+ gl_threads_api=windows
+ AC_DEFINE([USE_WINDOWS_THREADS], [1],
+ [Define if the native Windows multithreading API can be used.])
+ fi
+ ;;
+ esac
+ fi
+ fi
+ AC_MSG_CHECKING([for multithread API to use])
+ AC_MSG_RESULT([$gl_threads_api])
+ AC_SUBST([LIBTHREAD])
+ AC_SUBST([LTLIBTHREAD])
+ AC_SUBST([LIBMULTITHREAD])
+ AC_SUBST([LTLIBMULTITHREAD])
+])
+
+AC_DEFUN([gl_THREADLIB],
+[
+ AC_REQUIRE([gl_THREADLIB_EARLY])
+ AC_REQUIRE([gl_THREADLIB_BODY])
+])
+
+
+dnl gl_DISABLE_THREADS
+dnl ------------------
+dnl Sets the gl_THREADLIB default so that threads are not used by default.
+dnl The user can still override it at installation time, by using the
+dnl configure option '--enable-threads'.
+
+AC_DEFUN([gl_DISABLE_THREADS], [
+ m4_divert_text([INIT_PREPARE], [gl_use_threads_default=no])
+])
+
+
+dnl Survey of platforms:
+dnl
+dnl Platform Available Compiler Supports test-lock
+dnl flavours option weak result
+dnl --------------- --------- --------- -------- ---------
+dnl Linux 2.4/glibc posix -lpthread Y OK
+dnl
+dnl GNU Hurd/glibc posix
+dnl
+dnl FreeBSD 5.3 posix -lc_r Y
+dnl posix -lkse ? Y
+dnl posix -lpthread ? Y
+dnl posix -lthr Y
+dnl
+dnl FreeBSD 5.2 posix -lc_r Y
+dnl posix -lkse Y
+dnl posix -lthr Y
+dnl
+dnl FreeBSD 4.0,4.10 posix -lc_r Y OK
+dnl
+dnl NetBSD 1.6 --
+dnl
+dnl OpenBSD 3.4 posix -lpthread Y OK
+dnl
+dnl Mac OS X 10.[123] posix -lpthread Y OK
+dnl
+dnl Solaris 7,8,9 posix -lpthread Y Sol 7,8: 0.0; Sol 9:
OK
+dnl solaris -lthread Y Sol 7,8: 0.0; Sol 9:
OK
+dnl
+dnl HP-UX 11 posix -lpthread N (cc) OK
+dnl Y (gcc)
+dnl
+dnl IRIX 6.5 posix -lpthread Y 0.5
+dnl
+dnl AIX 4.3,5.1 posix -lpthread N AIX 4: 0.5; AIX 5: OK
+dnl
+dnl OSF/1 4.0,5.1 posix -pthread (cc) N OK
+dnl -lpthread (gcc) Y
+dnl
+dnl Cygwin posix -lpthread Y OK
+dnl
+dnl Any of the above pth -lpth 0.0
+dnl
+dnl Mingw windows N OK
+dnl
+dnl BeOS 5 --
+dnl
+dnl The test-lock result shows what happens if in test-lock.c EXPLICIT_YIELD is
+dnl turned off:
+dnl OK if all three tests terminate OK,
+dnl 0.5 if the first test terminates OK but the second one loops endlessly,
+dnl 0.0 if the first test already loops endlessly.
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 3b83900..9852778 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,8 +1,8 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2013 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2014 Free Software Foundation, Inc.
-# serial 7
+# serial 8
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -106,4 +106,13 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
REPLACE_MKTIME=GNULIB_PORTCHECK; AC_SUBST([REPLACE_MKTIME])
REPLACE_NANOSLEEP=GNULIB_PORTCHECK; AC_SUBST([REPLACE_NANOSLEEP])
REPLACE_TIMEGM=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMEGM])
+
+ dnl Hack so that the time module doesn't depend on the sys_time module.
+ dnl First, default GNULIB_GETTIMEOFDAY to 0 if sys_time is absent.
+ : ${GNULIB_GETTIMEOFDAY=0}; AC_SUBST([GNULIB_GETTIMEOFDAY])
+ dnl Second, it's OK to not use GNULIB_PORTCHECK for REPLACE_GMTIME
+ dnl and REPLACE_LOCALTIME, as portability to Solaris 2.6 and earlier
+ dnl is no longer a big deal.
+ REPLACE_GMTIME=0; AC_SUBST([REPLACE_GMTIME])
+ REPLACE_LOCALTIME=0; AC_SUBST([REPLACE_LOCALTIME])
])
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index c388a83..7e15600 100644
--- a/m4/time_r.m4
+++ b/m4/time_r.m4
@@ -1,6 +1,6 @@
dnl Reentrant time functions: localtime_r, gmtime_r.
-dnl Copyright (C) 2003, 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/times.m4 b/m4/times.m4
index a0c8667..3ee364b 100644
--- a/m4/times.m4
+++ b/m4/times.m4
@@ -1,5 +1,5 @@
# times.m4 serial 2
-dnl Copyright (C) 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index 55e7ea3..486351b 100644
--- a/m4/tm_gmtoff.m4
+++ b/m4/tm_gmtoff.m4
@@ -1,5 +1,5 @@
# tm_gmtoff.m4 serial 3
-dnl Copyright (C) 2002, 2009-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2009-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/trunc.m4 b/m4/trunc.m4
index 079cbcb..ba87bd0 100644
--- a/m4/trunc.m4
+++ b/m4/trunc.m4
@@ -1,5 +1,5 @@
# trunc.m4 serial 9
-dnl Copyright (C) 2007, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 32dcfa5..1fa197e 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,5 +1,5 @@
-# unistd_h.m4 serial 66
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+# unistd_h.m4 serial 67
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -160,6 +160,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD])
REPLACE_GETDOMAINNAME=0; AC_SUBST([REPLACE_GETDOMAINNAME])
+ REPLACE_GETDTABLESIZE=0; AC_SUBST([REPLACE_GETDTABLESIZE])
REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R])
REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS])
REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE])
diff --git a/m4/vasnprintf.m4 b/m4/vasnprintf.m4
index d730e43..106192e 100644
--- a/m4/vasnprintf.m4
+++ b/m4/vasnprintf.m4
@@ -1,5 +1,5 @@
# vasnprintf.m4 serial 36
-dnl Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/visibility.m4 b/m4/visibility.m4
index 6cbd7e5..552e397 100644
--- a/m4/visibility.m4
+++ b/m4/visibility.m4
@@ -1,5 +1,5 @@
# visibility.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2005, 2008, 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2008, 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/vsnprintf.m4 b/m4/vsnprintf.m4
index 4900764..07f739d 100644
--- a/m4/vsnprintf.m4
+++ b/m4/vsnprintf.m4
@@ -1,5 +1,5 @@
# vsnprintf.m4 serial 6
-dnl Copyright (C) 2002-2004, 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/warn-on-use.m4 b/m4/warn-on-use.m4
index e43beeb..cc690f8 100644
--- a/m4/warn-on-use.m4
+++ b/m4/warn-on-use.m4
@@ -1,5 +1,5 @@
# warn-on-use.m4 serial 5
-dnl Copyright (C) 2010-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index 4b2ac38..43156f4 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,5 +1,5 @@
-# warnings.m4 serial 7
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+# warnings.m4 serial 11
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -25,19 +25,36 @@ m4_ifdef([AS_VAR_APPEND],
AC_DEFUN([gl_COMPILER_OPTION_IF],
[AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl
+AS_LITERAL_IF([$1],
+ [m4_pushdef([gl_Positive], m4_bpatsubst([$1], [^-Wno-], [-W]))],
+ [gl_positive="$1"
+case $gl_positive in
+ -Wno-*) gl_positive=-W`expr "X$gl_positive" : 'X-Wno-\(.*\)'` ;;
+esac
+m4_pushdef([gl_Positive], [$gl_positive])])dnl
AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [
gl_save_compiler_FLAGS="$gl_Flags"
- gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $1"])
- AC_COMPILE_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])],
- [AS_VAR_SET(gl_Warn, [yes])],
- [AS_VAR_SET(gl_Warn, [no])])
+ gl_AS_VAR_APPEND(m4_defn([gl_Flags]),
+ [" $gl_unknown_warnings_are_errors ]m4_defn([gl_Positive])["])
+ AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])],
+ [AS_VAR_SET(gl_Warn, [yes])],
+ [AS_VAR_SET(gl_Warn, [no])])
gl_Flags="$gl_save_compiler_FLAGS"
])
AS_VAR_IF(gl_Warn, [yes], [$2], [$3])
+m4_popdef([gl_Positive])dnl
AS_VAR_POPDEF([gl_Flags])dnl
AS_VAR_POPDEF([gl_Warn])dnl
])
+# gl_UNKNOWN_WARNINGS_ARE_ERRORS
+# ------------------------------
+# Clang doesn't complain about unknown warning options unless one also
+# specifies -Wunknown-warning-option -Werror. Detect this.
+AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS],
+[gl_COMPILER_OPTION_IF([-Werror -Wunknown-warning-option],
+ [gl_unknown_warnings_are_errors='-Wunknown-warning-option -Werror'],
+ [gl_unknown_warnings_are_errors=])])
# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS],
# [PROGRAM = AC_LANG_PROGRAM()])
@@ -47,7 +64,8 @@ AS_VAR_POPDEF([gl_Warn])dnl
#
# If VARIABLE is a variable name, AC_SUBST it.
AC_DEFUN([gl_WARN_ADD],
-[gl_COMPILER_OPTION_IF([$1],
+[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS])
+gl_COMPILER_OPTION_IF([$1],
[gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])],
[],
[$3])
diff --git a/m4/wchar_h.m4 b/m4/wchar_h.m4
index bedb15a..85db952 100644
--- a/m4/wchar_h.m4
+++ b/m4/wchar_h.m4
@@ -1,6 +1,6 @@
dnl A placeholder for ISO C99 <wchar.h>, for platforms that have issues.
-dnl Copyright (C) 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/wchar_t.m4 b/m4/wchar_t.m4
index e1e1e69..839a04c 100644
--- a/m4/wchar_t.m4
+++ b/m4/wchar_t.m4
@@ -1,5 +1,5 @@
# wchar_t.m4 serial 4 (gettext-0.18.2)
-dnl Copyright (C) 2002-2003, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/wcrtomb.m4 b/m4/wcrtomb.m4
index f56b5ba..844ef6a 100644
--- a/m4/wcrtomb.m4
+++ b/m4/wcrtomb.m4
@@ -1,5 +1,5 @@
# wcrtomb.m4 serial 11
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/wctype_h.m4 b/m4/wctype_h.m4
index 82ada0e..3fac0ee 100644
--- a/m4/wctype_h.m4
+++ b/m4/wctype_h.m4
@@ -2,7 +2,7 @@
dnl A placeholder for ISO C99 <wctype.h>, for platforms that lack it.
-dnl Copyright (C) 2006-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/wint_t.m4 b/m4/wint_t.m4
index d7cd3db..9b07b07 100644
--- a/m4/wint_t.m4
+++ b/m4/wint_t.m4
@@ -1,5 +1,5 @@
# wint_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/write.m4 b/m4/write.m4
index a79b2cc..820dd4f 100644
--- a/m4/write.m4
+++ b/m4/write.m4
@@ -1,5 +1,5 @@
# write.m4 serial 5
-dnl Copyright (C) 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/xsize.m4 b/m4/xsize.m4
index 8ea9f2c..3af23ec 100644
--- a/m4/xsize.m4
+++ b/m4/xsize.m4
@@ -1,5 +1,5 @@
# xsize.m4 serial 5
-dnl Copyright (C) 2003-2004, 2008-2013 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2004, 2008-2014 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/maint.mk b/maint.mk
index 2b454a1..d5bb427 100644
--- a/maint.mk
+++ b/maint.mk
@@ -2,7 +2,7 @@
# This Makefile fragment tries to be general-purpose enough to be
# used by many projects via the gnulib maintainer-makefile module.
-## Copyright (C) 2001-2013 Free Software Foundation, Inc.
+## Copyright (C) 2001-2014 Free Software Foundation, Inc.
##
## This program is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
@@ -591,7 +591,7 @@ sc_prohibit_root_dev_ino_without_use:
sc_prohibit_openat_without_use:
@h='openat.h' \
-
re='\<(openat_(permissive|needs_fchdir|(save|restore)_fail)|l?(stat|ch(own|mod))at|(euid)?accessat)\>'
\
+
re='\<(openat_(permissive|needs_fchdir|(save|restore)_fail)|l?(stat|ch(own|mod))at|(euid)?accessat|(FCHMOD|FCHOWN|STAT)AT_INLINE)\>'
\
$(_sc_header_without_use)
# Prohibit the inclusion of c-ctype.h without an actual use.
@@ -809,7 +809,7 @@ sc_prohibit_always_true_header_tests:
$(_sc_search_regexp)
sc_prohibit_defined_have_decl_tests:
- @prohibit='#[ ]*if(n?def|.*\<defined)\>[ (]+HAVE_DECL_' \
+ @prohibit='(#[ ]*ifn?def|\<defined)\>[ (]+HAVE_DECL_' \
halt='HAVE_DECL macros are always defined' \
$(_sc_search_regexp)
@@ -1283,15 +1283,17 @@ vc-diff-check:
rel-files = $(DIST_ARCHIVES)
gnulib_dir ?= $(srcdir)/gnulib
-gnulib-version = $$(cd $(gnulib_dir) && git describe)
+gnulib-version = $$(cd $(gnulib_dir) \
+ && { git describe || git rev-parse --short=10 HEAD; } )
bootstrap-tools ?= autoconf,automake,gnulib
+gpgv = $$(gpgv2 --version >/dev/null && echo gpgv2 || echo gpgv)
# If it's not already specified, derive the GPG key ID from
# the signed tag we've just applied to mark this release.
gpg_key_ID ?= \
$$(cd $(srcdir) \
&& git cat-file tag v$(VERSION) \
- | gpgv --status-fd 1 --keyring /dev/null - - 2>/dev/null \
+ | $(gpgv) --status-fd 1 --keyring /dev/null - - 2>/dev/null \
| awk '/^\[GNUPG:\] ERRSIG / {print $$3; exit}')
translation_project_ ?= address@hidden
@@ -1393,8 +1395,8 @@ public-submodule-commit:
&& git --version >/dev/null 2>&1; then \
cd $(srcdir) && \
git submodule --quiet foreach \
- test '"$$(git rev-parse "$$sha1")"' \
- = '"$$(git merge-base origin "$$sha1")"' \
+ 'test "$$(git rev-parse "$$sha1")" \
+ = "$$(git merge-base origin "$$sha1")"' \
|| { echo '$(ME): found non-public submodule commit' >&2; \
exit 1; }; \
else \
@@ -1424,6 +1426,7 @@ alpha beta stable: $(local-check) writable-files
$(submodule-checks)
$(AM_V_at)$(MAKE) -s emit_upload_commands RELEASE_TYPE=$@
release:
+ $(AM_V_GEN)$(MAKE) _version
$(AM_V_GEN)$(MAKE) $(release-type)
# Override this in cfg.mk if you follow different procedures.
diff --git a/module/Makefile.am b/module/Makefile.am
index 4c75221..d262818 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,6 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+## Copyright (C) 2009, 2010, 2011, 2012, 2013,
+## 2014 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -279,6 +280,8 @@ SCRIPTS_SOURCES += \
endif BUILD_ICE_9_POPEN
+srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
+
SRFI_SOURCES = \
srfi/srfi-2.scm \
srfi/srfi-4.scm \
@@ -304,13 +307,16 @@ SRFI_SOURCES = \
srfi/srfi-38.scm \
srfi/srfi-41.scm \
srfi/srfi-42.scm \
+ srfi/srfi-43.scm \
srfi/srfi-39.scm \
srfi/srfi-45.scm \
srfi/srfi-60.scm \
+ srfi/srfi-64.scm \
srfi/srfi-67.scm \
srfi/srfi-69.scm \
srfi/srfi-88.scm \
- srfi/srfi-98.scm
+ srfi/srfi-98.scm \
+ srfi/srfi-111.scm
RNRS_SOURCES = \
rnrs/base.scm \
@@ -417,6 +423,7 @@ NOCOMP_SOURCES = \
ice-9/r6rs-libraries.scm \
ice-9/quasisyntax.scm \
srfi/srfi-42/ec.scm \
+ srfi/srfi-64/testing.scm \
srfi/srfi-67/compare.scm \
system/base/lalr.upstream.scm \
system/repl/describe.scm \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 91728a6..b6ba03c 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -717,6 +717,64 @@ file with the given name already exists, the effect is
unspecified."
((do "step" x y)
y)))
+(define-syntax define-values
+ (lambda (orig-form)
+ (syntax-case orig-form ()
+ ((_ () expr)
+ ;; XXX Work around the lack of hygienic top-level identifiers
+ (with-syntax (((dummy) (generate-temporaries '(dummy))))
+ #`(define dummy
+ (call-with-values (lambda () expr)
+ (lambda () #f)))))
+ ((_ (var) expr)
+ (identifier? #'var)
+ #`(define var
+ (call-with-values (lambda () expr)
+ (lambda (v) v))))
+ ((_ (var0 ... varn) expr)
+ (and-map identifier? #'(var0 ... varn))
+ ;; XXX Work around the lack of hygienic toplevel identifiers
+ (with-syntax (((dummy) (generate-temporaries '(dummy))))
+ #`(begin
+ ;; Avoid mutating the user-visible variables
+ (define dummy
+ (call-with-values (lambda () expr)
+ (lambda (var0 ... varn)
+ (list var0 ... varn))))
+ (define var0
+ (let ((v (car dummy)))
+ (set! dummy (cdr dummy))
+ v))
+ ...
+ (define varn
+ (let ((v (car dummy)))
+ (set! dummy #f) ; blackhole dummy
+ v)))))
+ ((_ var expr)
+ (identifier? #'var)
+ #'(define var
+ (call-with-values (lambda () expr)
+ list)))
+ ((_ (var0 ... . varn) expr)
+ (and-map identifier? #'(var0 ... varn))
+ ;; XXX Work around the lack of hygienic toplevel identifiers
+ (with-syntax (((dummy) (generate-temporaries '(dummy))))
+ #`(begin
+ ;; Avoid mutating the user-visible variables
+ (define dummy
+ (call-with-values (lambda () expr)
+ (lambda (var0 ... . varn)
+ (list var0 ... varn))))
+ (define var0
+ (let ((v (car dummy)))
+ (set! dummy (cdr dummy))
+ v))
+ ...
+ (define varn
+ (let ((v (car dummy)))
+ (set! dummy #f) ; blackhole dummy
+ v))))))))
+
(define-syntax-rule (delay exp)
(make-promise (lambda () exp)))
@@ -2030,7 +2088,7 @@ written into the port is returned."
(define-syntax-rule (add-to-load-path elt)
"Add ELT to Guile's load path, at compile-time and at run-time."
- (eval-when (compile load eval)
+ (eval-when (expand load eval)
(set! %load-path (cons elt %load-path))))
(define %load-verbosely #f)
@@ -3420,7 +3478,7 @@ but it fails to load."
(interface options)
(interface)))
(define-syntax-rule (option-set! opt val)
- (eval-when (eval load compile expand)
+ (eval-when (expand load eval)
(options (append (options) (list 'opt val)))))))))
(define-option-interface
@@ -3586,7 +3644,7 @@ but it fails to load."
;; Return a list of expressions that evaluate to the appropriate
;; arguments for resolve-interface according to SPEC.
-(eval-when (compile)
+(eval-when (expand)
(if (memq 'prefix (read-options))
(error "boot-9 must be compiled with #:kw, not :kw")))
@@ -3691,7 +3749,7 @@ but it fails to load."
(filename (let ((f (assq-ref (or (syntax-source x) '())
'filename)))
(and (string? f) f))))
- #'(eval-when (eval load compile expand)
+ #'(eval-when (expand load eval)
(let ((m (define-module* '(name name* ...)
#:filename filename quoted-arg ...)))
(set-current-module m)
@@ -3751,7 +3809,7 @@ but it fails to load."
(syntax-case x ()
((_ spec ...)
(with-syntax (((quoted-args ...) (quotify #'(spec ...))))
- #'(eval-when (eval load compile expand)
+ #'(eval-when (expand load eval)
(process-use-modules (list quoted-args ...))
*unspecified*))))))
@@ -3838,19 +3896,19 @@ but it fails to load."
names)))
(define-syntax-rule (export name ...)
- (eval-when (eval load compile expand)
+ (eval-when (expand load eval)
(call-with-deferred-observers
(lambda ()
(module-export! (current-module) '(name ...))))))
(define-syntax-rule (re-export name ...)
- (eval-when (eval load compile expand)
+ (eval-when (expand load eval)
(call-with-deferred-observers
(lambda ()
(module-re-export! (current-module) '(name ...))))))
(define-syntax-rule (export! name ...)
- (eval-when (eval load compile expand)
+ (eval-when (expand load eval)
(call-with-deferred-observers
(lambda ()
(module-replace! (current-module) '(name ...))))))
diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index ca949b4..1d12dd0 100644
--- a/module/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -83,7 +83,7 @@
locale-yes-regexp locale-no-regexp))
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version))
"scm_init_i18n"))
diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm
index 1633dcb..57b5047 100644
--- a/module/ice-9/poll.scm
+++ b/module/ice-9/poll.scm
@@ -34,7 +34,7 @@
poll-set-remove!
poll))
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version))
"scm_init_poll"))
diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index 48a52e6..b166e9d 100644
--- a/module/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -24,7 +24,7 @@
:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
open-output-pipe open-input-output-pipe))
-(eval-when (load eval compile)
+(eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version))
"scm_init_popen"))
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index 428d951..a68df3c 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -217,7 +217,7 @@
(syntax-case stx ()
((_ import-set ...)
(with-syntax (((library-reference ...) (map strip-for #'(import-set
...))))
- #'(eval-when (eval load compile expand)
+ #'(eval-when (expand load eval)
(let ((iface (resolve-r6rs-interface 'library-reference)))
(call-with-deferred-observers
(lambda ()
diff --git a/module/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm
index 31d79ec..0df8e1a 100644
--- a/module/ice-9/weak-vector.scm
+++ b/module/ice-9/weak-vector.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 2003, 2006, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2011, 2014 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
@@ -19,7 +19,12 @@
(define-module (ice-9 weak-vector)
- #:export (make-weak-vector list->weak-vector weak-vector weak-vector?))
+ #:export (make-weak-vector
+ list->weak-vector
+ weak-vector
+ weak-vector?
+ weak-vector-ref
+ weak-vector-set!))
(eval-when (load eval compile)
(load-extension (string-append "libguile-" (effective-version))
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index 84c07a0..2ea5642 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
;;; open-coding primitive procedures
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -45,7 +45,7 @@
values
eq? eqv? equal?
memq memv
- = < > <= >= zero?
+ = < > <= >= zero? positive? negative?
+ * - / 1- 1+ quotient remainder modulo
ash logand logior logxor lognot
not
@@ -161,7 +161,7 @@
(define *effect-free-primitives*
`(values
eq? eqv? equal?
- = < > <= >= zero?
+ = < > <= >= zero? positive? negative?
ash logand logior logxor lognot
+ * - / 1- 1+ quotient remainder modulo
not
@@ -374,6 +374,12 @@
(define-primitive-expander zero? (x)
(= x 0))
+(define-primitive-expander positive? (x)
+ (> x 0))
+
+(define-primitive-expander negative? (x)
+ (< x 0))
+
;; FIXME: All the code that uses `const?' is redundant with `peval'.
(define-primitive-expander +
@@ -519,6 +525,28 @@
(define-primitive-expander f64vector-set! (vec i x)
(bytevector-ieee-double-native-set! vec (* i 8) x))
+(define (chained-comparison-expander prim-name)
+ (case-lambda
+ ((src) (make-const src #t))
+ ((src a) #f)
+ ((src a b) #f)
+ ((src a b . rest)
+ (let* ((b-sym (gensym "b"))
+ (b* (make-lexical-ref src 'b b-sym)))
+ (make-let src
+ '(b)
+ (list b-sym)
+ (list b)
+ (make-conditional src
+ (make-primcall src prim-name (list a b*))
+ (make-primcall src prim-name (cons b* rest))
+ (make-const src #f)))))))
+
+(for-each (lambda (prim-name)
+ (hashq-set! *primitive-expand-table* prim-name
+ (chained-comparison-expander prim-name)))
+ '(< > <= >= =))
+
;; Appropriate for use with either 'eqv?' or 'equal?'.
(define (maybe-simplify-to-eq prim)
(case-lambda
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 1b86399..a64e03b 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011,
2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011,
2013, 2014 Free Software Foundation, Inc.
;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <address@hidden>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -135,10 +135,10 @@
(define *goops-module* (current-module))
;; First initialize the builtin part of GOOPS
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(%init-goops-builtins))
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(use-modules ((language tree-il primitives) :select
(add-interesting-primitive!)))
(add-interesting-primitive! 'class-of))
@@ -149,7 +149,7 @@
;; FIXME: deprecate.
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(define min-fixnum (- (expt 2 29)))
(define max-fixnum (- (expt 2 29) 1)))
diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm
index ace89b4..8c546e0 100644
--- a/module/oop/goops/compile.scm
+++ b/module/oop/goops/compile.scm
@@ -19,7 +19,7 @@
;; There are circularities here; you can't import (oop goops compile)
;; before (oop goops). So when compiling, make sure that things are
;; kosher.
-(eval-when (compile) (resolve-module '(oop goops)))
+(eval-when (expand) (resolve-module '(oop goops)))
(define-module (oop goops compile)
:use-module (oop goops)
diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm
index 76f16fb..0198a9f 100644
--- a/module/oop/goops/dispatch.scm
+++ b/module/oop/goops/dispatch.scm
@@ -19,7 +19,7 @@
;; There are circularities here; you can't import (oop goops compile)
;; before (oop goops). So when compiling, make sure that things are
;; kosher.
-(eval-when (compile) (resolve-module '(oop goops)))
+(eval-when (expand) (resolve-module '(oop goops)))
(define-module (oop goops dispatch)
#:use-module (oop goops)
diff --git a/module/srfi/srfi-2.scm b/module/srfi/srfi-111.scm
similarity index 56%
copy from module/srfi/srfi-2.scm
copy to module/srfi/srfi-111.scm
index c09323f..3d3cd89 100644
--- a/module/srfi/srfi-2.scm
+++ b/module/srfi/srfi-111.scm
@@ -1,31 +1,37 @@
-;;; srfi-2.scm --- and-let*
+;;; srfi-111.scm -- SRFI 111 Boxes
-;; Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
-;;
+;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
-;;
+;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;; Commentary:
-
-;; This module is fully documented in the Guile Reference Manual.
-
-;;; Code:
+(define-module (srfi srfi-111)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:export (box box? unbox set-box!))
-(define-module (srfi srfi-2)
- :use-module (ice-9 and-let-star)
- :re-export-syntax (and-let*))
+(cond-expand-provide (current-module) '(srfi-111))
-(cond-expand-provide (current-module) '(srfi-2))
+(define-record-type <box>
+ (box value)
+ box?
+ (value unbox set-box!))
-;;; srfi-2.scm ends here
+(set-record-type-printer! <box>
+ (lambda (box port)
+ (display "#<box " port)
+ (display (number->string (object-address box) 16) port)
+ (display " value: ")
+ (write (unbox box) port)
+ (display ">" port)))
diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm
new file mode 100644
index 0000000..88a3f3f
--- /dev/null
+++ b/module/srfi/srfi-43.scm
@@ -0,0 +1,1077 @@
+;;; srfi-43.scm -- SRFI 43 Vector library
+
+;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Mark H Weaver <address@hidden>
+
+(define-module (srfi srfi-43)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:re-export (make-vector vector vector? vector-ref vector-set!
+ vector-length)
+ #:replace (vector-copy vector-fill! list->vector vector->list)
+ #:export (vector-empty? vector= vector-unfold vector-unfold-right
+ vector-reverse-copy
+ vector-append vector-concatenate
+ vector-fold vector-fold-right
+ vector-map vector-map!
+ vector-for-each vector-count
+ vector-index vector-index-right
+ vector-skip vector-skip-right
+ vector-binary-search
+ vector-any vector-every
+ vector-swap! vector-reverse!
+ vector-copy! vector-reverse-copy!
+ reverse-vector->list
+ reverse-list->vector))
+
+(cond-expand-provide (current-module) '(srfi-43))
+
+(define (error-from who msg . args)
+ (apply error
+ (string-append (symbol->string who) ": " msg)
+ args))
+
+(define-syntax-rule (assert-nonneg-exact-integer k who)
+ (unless (and (exact-integer? k)
+ (not (negative? k)))
+ (error-from who "expected non-negative exact integer, got" k)))
+
+(define-syntax-rule (assert-procedure f who)
+ (unless (procedure? f)
+ (error-from who "expected procedure, got" f)))
+
+(define-syntax-rule (assert-vector v who)
+ (unless (vector? v)
+ (error-from who "expected vector, got" v)))
+
+(define-syntax-rule (assert-valid-index i len who)
+ (unless (and (exact-integer? i)
+ (<= 0 i len))
+ (error-from who "invalid index" i)))
+
+(define-syntax-rule (assert-valid-start start len who)
+ (unless (and (exact-integer? start)
+ (<= 0 start len))
+ (error-from who "invalid start index" start)))
+
+(define-syntax-rule (assert-valid-range start end len who)
+ (unless (and (exact-integer? start)
+ (exact-integer? end)
+ (<= 0 start end len))
+ (error-from who "invalid index range" start end)))
+
+(define-syntax-rule (assert-vectors vs who)
+ (let loop ((vs vs))
+ (unless (null? vs)
+ (assert-vector (car vs) who)
+ (loop (cdr vs)))))
+
+;; Return the length of the shortest vector in VS.
+;; VS must have at least one element.
+(define (min-length vs)
+ (let loop ((vs (cdr vs))
+ (result (vector-length (car vs))))
+ (if (null? vs)
+ result
+ (loop (cdr vs) (min result (vector-length (car vs)))))))
+
+;; Return a list of the Ith elements of the vectors in VS.
+(define (vectors-ref vs i)
+ (let loop ((vs vs) (xs '()))
+ (if (null? vs)
+ (reverse! xs)
+ (loop (cdr vs) (cons (vector-ref (car vs) i)
+ xs)))))
+
+(define vector-unfold
+ (case-lambda
+ "(vector-unfold f length initial-seed ...) -> vector
+
+The fundamental vector constructor. Create a vector whose length is
+LENGTH and iterates across each index k from 0 up to LENGTH - 1,
+applying F at each iteration to the current index and current seeds,
+in that order, to receive n + 1 values: first, the element to put in
+the kth slot of the new vector and n new seeds for the next iteration.
+It is an error for the number of seeds to vary between iterations."
+ ((f len)
+ (assert-procedure f 'vector-unfold)
+ (assert-nonneg-exact-integer len 'vector-unfold)
+ (let ((v (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! v i (f i))
+ (loop (+ i 1))))
+ v))
+ ((f len seed)
+ (assert-procedure f 'vector-unfold)
+ (assert-nonneg-exact-integer len 'vector-unfold)
+ (let ((v (make-vector len)))
+ (let loop ((i 0) (seed seed))
+ (unless (= i len)
+ (receive (x seed) (f i seed)
+ (vector-set! v i x)
+ (loop (+ i 1) seed))))
+ v))
+ ((f len seed1 seed2)
+ (assert-procedure f 'vector-unfold)
+ (assert-nonneg-exact-integer len 'vector-unfold)
+ (let ((v (make-vector len)))
+ (let loop ((i 0) (seed1 seed1) (seed2 seed2))
+ (unless (= i len)
+ (receive (x seed1 seed2) (f i seed1 seed2)
+ (vector-set! v i x)
+ (loop (+ i 1) seed1 seed2))))
+ v))
+ ((f len . seeds)
+ (assert-procedure f 'vector-unfold)
+ (assert-nonneg-exact-integer len 'vector-unfold)
+ (let ((v (make-vector len)))
+ (let loop ((i 0) (seeds seeds))
+ (unless (= i len)
+ (receive (x . seeds) (apply f i seeds)
+ (vector-set! v i x)
+ (loop (+ i 1) seeds))))
+ v))))
+
+(define vector-unfold-right
+ (case-lambda
+ "(vector-unfold-right f length initial-seed ...) -> vector
+
+The fundamental vector constructor. Create a vector whose length is
+LENGTH and iterates across each index k from LENGTH - 1 down to 0,
+applying F at each iteration to the current index and current seeds,
+in that order, to receive n + 1 values: first, the element to put in
+the kth slot of the new vector and n new seeds for the next iteration.
+It is an error for the number of seeds to vary between iterations."
+ ((f len)
+ (assert-procedure f 'vector-unfold-right)
+ (assert-nonneg-exact-integer len 'vector-unfold-right)
+ (let ((v (make-vector len)))
+ (let loop ((i (- len 1)))
+ (unless (negative? i)
+ (vector-set! v i (f i))
+ (loop (- i 1))))
+ v))
+ ((f len seed)
+ (assert-procedure f 'vector-unfold-right)
+ (assert-nonneg-exact-integer len 'vector-unfold-right)
+ (let ((v (make-vector len)))
+ (let loop ((i (- len 1)) (seed seed))
+ (unless (negative? i)
+ (receive (x seed) (f i seed)
+ (vector-set! v i x)
+ (loop (- i 1) seed))))
+ v))
+ ((f len seed1 seed2)
+ (assert-procedure f 'vector-unfold-right)
+ (assert-nonneg-exact-integer len 'vector-unfold-right)
+ (let ((v (make-vector len)))
+ (let loop ((i (- len 1)) (seed1 seed1) (seed2 seed2))
+ (unless (negative? i)
+ (receive (x seed1 seed2) (f i seed1 seed2)
+ (vector-set! v i x)
+ (loop (- i 1) seed1 seed2))))
+ v))
+ ((f len . seeds)
+ (assert-procedure f 'vector-unfold-right)
+ (assert-nonneg-exact-integer len 'vector-unfold-right)
+ (let ((v (make-vector len)))
+ (let loop ((i (- len 1)) (seeds seeds))
+ (unless (negative? i)
+ (receive (x . seeds) (apply f i seeds)
+ (vector-set! v i x)
+ (loop (- i 1) seeds))))
+ v))))
+
+(define guile-vector-copy (@ (guile) vector-copy))
+
+;; TODO: Enhance Guile core 'vector-copy' to do this.
+(define vector-copy
+ (case-lambda*
+ "(vector-copy vec [start [end [fill]]]) -> vector
+
+Allocate a new vector whose length is END - START and fills it with
+elements from vec, taking elements from vec starting at index START
+and stopping at index END. START defaults to 0 and END defaults to
+the value of (vector-length VEC). If END extends beyond the length of
+VEC, the slots in the new vector that obviously cannot be filled by
+elements from VEC are filled with FILL, whose default value is
+unspecified."
+ ((v) (guile-vector-copy v))
+ ((v start)
+ (assert-vector v 'vector-copy)
+ (let ((len (vector-length v)))
+ (assert-valid-start start len 'vector-copy)
+ (let ((result (make-vector (- len start))))
+ (vector-move-left! v start len result 0)
+ result)))
+ ((v start end #:optional (fill *unspecified*))
+ (assert-vector v 'vector-copy)
+ (let ((len (vector-length v)))
+ (unless (and (exact-integer? start)
+ (exact-integer? end)
+ (<= 0 start end))
+ (error-from 'vector-copy "invalid index range" start end))
+ (let ((result (make-vector (- end start) fill)))
+ (vector-move-left! v start (min end len) result 0)
+ result)))))
+
+(define vector-reverse-copy
+ (let ()
+ (define (%vector-reverse-copy vec start end)
+ (let* ((len (- end start))
+ (result (make-vector len)))
+ (let loop ((i 0) (j (- end 1)))
+ (unless (= i len)
+ (vector-set! result i (vector-ref vec j))
+ (loop (+ i 1) (- j 1))))
+ result))
+ (case-lambda
+ "(vector-reverse-copy vec [start [end]]) -> vector
+
+Allocate a new vector whose length is END - START and fills it with
+elements from vec, taking elements from vec in reverse order starting
+at index START and stopping at index END. START defaults to 0 and END
+defaults to the value of (vector-length VEC)."
+ ((vec)
+ (assert-vector vec 'vector-reverse-copy)
+ (%vector-reverse-copy vec 0 (vector-length vec)))
+ ((vec start)
+ (assert-vector vec 'vector-reverse-copy)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'vector-reverse-copy)
+ (%vector-reverse-copy vec start len)))
+ ((vec start end)
+ (assert-vector vec 'vector-reverse-copy)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'vector-reverse-copy)
+ (%vector-reverse-copy vec start end))))))
+
+(define (%vector-concatenate vs)
+ (let* ((result-len (let loop ((vs vs) (len 0))
+ (if (null? vs)
+ len
+ (loop (cdr vs) (+ len (vector-length (car vs)))))))
+ (result (make-vector result-len)))
+ (let loop ((vs vs) (pos 0))
+ (unless (null? vs)
+ (let* ((v (car vs))
+ (len (vector-length v)))
+ (vector-move-left! v 0 len result pos)
+ (loop (cdr vs) (+ pos len)))))
+ result))
+
+(define vector-append
+ (case-lambda
+ "(vector-append vec ...) -> vector
+
+Return a newly allocated vector that contains all elements in order
+from the subsequent locations in VEC ..."
+ (() (vector))
+ ((v)
+ (assert-vector v 'vector-append)
+ (guile-vector-copy v))
+ ((v1 v2)
+ (assert-vector v1 'vector-append)
+ (assert-vector v2 'vector-append)
+ (let ((len1 (vector-length v1))
+ (len2 (vector-length v2)))
+ (let ((result (make-vector (+ len1 len2))))
+ (vector-move-left! v1 0 len1 result 0)
+ (vector-move-left! v2 0 len2 result len1)
+ result)))
+ (vs
+ (assert-vectors vs 'vector-append)
+ (%vector-concatenate vs))))
+
+(define (vector-concatenate vs)
+ "(vector-concatenate list-of-vectors) -> vector
+
+Append each vector in LIST-OF-VECTORS. Equivalent to:
+ (apply vector-append LIST-OF-VECTORS)"
+ (assert-vectors vs 'vector-append)
+ (%vector-concatenate vs))
+
+(define (vector-empty? vec)
+ "(vector-empty? vec) -> boolean
+
+Return true if VEC is empty, i.e. its length is 0, and false if not."
+ (assert-vector vec 'vector-empty?)
+ (zero? (vector-length vec)))
+
+(define vector=
+ (let ()
+ (define (all-of-length? len vs)
+ (or (null? vs)
+ (and (= len (vector-length (car vs)))
+ (all-of-length? len (cdr vs)))))
+ (define (=up-to? i elt=? v1 v2)
+ (or (negative? i)
+ (let ((x1 (vector-ref v1 i))
+ (x2 (vector-ref v2 i)))
+ (and (or (eq? x1 x2) (elt=? x1 x2))
+ (=up-to? (- i 1) elt=? v1 v2)))))
+ (case-lambda
+ "(vector= elt=? vec ...) -> boolean
+
+Return true if the vectors VEC ... have equal lengths and equal
+elements according to ELT=?. ELT=? is always applied to two
+arguments. Element comparison must be consistent with eq?, in the
+following sense: if (eq? a b) returns true, then (elt=? a b) must also
+return true. The order in which comparisons are performed is
+unspecified."
+ ((elt=?)
+ (assert-procedure elt=? 'vector=)
+ #t)
+ ((elt=? v)
+ (assert-procedure elt=? 'vector=)
+ (assert-vector v 'vector=)
+ #t)
+ ((elt=? v1 v2)
+ (assert-procedure elt=? 'vector=)
+ (assert-vector v1 'vector=)
+ (assert-vector v2 'vector=)
+ (let ((len (vector-length v1)))
+ (and (= len (vector-length v2))
+ (=up-to? (- len 1) elt=? v1 v2))))
+ ((elt=? v1 . vs)
+ (assert-procedure elt=? 'vector=)
+ (assert-vector v1 'vector=)
+ (assert-vectors vs 'vector=)
+ (let ((len (vector-length v1)))
+ (and (all-of-length? len vs)
+ (let loop ((vs vs))
+ (or (null? vs)
+ (and (=up-to? (- len 1) elt=? v1 (car vs))
+ (loop (cdr vs)))))))))))
+
+(define vector-fold
+ (case-lambda
+ "(vector-fold kons knil vec1 vec2 ...) -> value
+
+The fundamental vector iterator. KONS is iterated over each index in
+all of the vectors, stopping at the end of the shortest; KONS is
+applied as (KONS i state (vector-ref VEC1 i) (vector-ref VEC2 i) ...)
+where STATE is the current state value, and I is the current index.
+The current state value begins with KNIL, and becomes whatever KONS
+returned at the respective iteration. The iteration is strictly
+left-to-right."
+ ((kcons knil v)
+ (assert-procedure kcons 'vector-fold)
+ (assert-vector v 'vector-fold)
+ (let ((len (vector-length v)))
+ (let loop ((i 0) (state knil))
+ (if (= i len)
+ state
+ (loop (+ i 1) (kcons i state (vector-ref v i)))))))
+ ((kcons knil v1 v2)
+ (assert-procedure kcons 'vector-fold)
+ (assert-vector v1 'vector-fold)
+ (assert-vector v2 'vector-fold)
+ (let ((len (min (vector-length v1) (vector-length v2))))
+ (let loop ((i 0) (state knil))
+ (if (= i len)
+ state
+ (loop (+ i 1)
+ (kcons i state (vector-ref v1 i) (vector-ref v2 i)))))))
+ ((kcons knil . vs)
+ (assert-procedure kcons 'vector-fold)
+ (assert-vectors vs 'vector-fold)
+ (let ((len (min-length vs)))
+ (let loop ((i 0) (state knil))
+ (if (= i len)
+ state
+ (loop (+ i 1) (apply kcons i state (vectors-ref vs i)))))))))
+
+(define vector-fold-right
+ (case-lambda
+ "(vector-fold-right kons knil vec1 vec2 ...) -> value
+
+The fundamental vector iterator. KONS is iterated over each index in
+all of the vectors, starting at the end of the shortest; KONS is
+applied as (KONS i state (vector-ref VEC1 i) (vector-ref VEC2 i) ...)
+where STATE is the current state value, and I is the current index.
+The current state value begins with KNIL, and becomes whatever KONS
+returned at the respective iteration. The iteration is strictly
+right-to-left."
+ ((kcons knil v)
+ (assert-procedure kcons 'vector-fold-right)
+ (assert-vector v 'vector-fold-right)
+ (let ((len (vector-length v)))
+ (let loop ((i (- len 1)) (state knil))
+ (if (negative? i)
+ state
+ (loop (- i 1) (kcons i state (vector-ref v i)))))))
+ ((kcons knil v1 v2)
+ (assert-procedure kcons 'vector-fold-right)
+ (assert-vector v1 'vector-fold-right)
+ (assert-vector v2 'vector-fold-right)
+ (let ((len (min (vector-length v1) (vector-length v2))))
+ (let loop ((i (- len 1)) (state knil))
+ (if (negative? i)
+ state
+ (loop (- i 1)
+ (kcons i state (vector-ref v1 i) (vector-ref v2 i)))))))
+ ((kcons knil . vs)
+ (assert-procedure kcons 'vector-fold-right)
+ (assert-vectors vs 'vector-fold-right)
+ (let ((len (min-length vs)))
+ (let loop ((i (- len 1)) (state knil))
+ (if (negative? i)
+ state
+ (loop (- i 1) (apply kcons i state (vectors-ref vs i)))))))))
+
+(define vector-map
+ (case-lambda
+ "(vector-map f vec2 vec2 ...) -> vector
+
+Return a new vector of the shortest size of the vector arguments.
+Each element at index i of the new vector is mapped from the old
+vectors by (F i (vector-ref VEC1 i) (vector-ref VEC2 i) ...). The
+dynamic order of application of F is unspecified."
+ ((f v)
+ (assert-procedure f 'vector-map)
+ (assert-vector v 'vector-map)
+ (let* ((len (vector-length v))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result i (f i (vector-ref v i)))
+ (loop (+ i 1))))
+ result))
+ ((f v1 v2)
+ (assert-procedure f 'vector-map)
+ (assert-vector v1 'vector-map)
+ (assert-vector v2 'vector-map)
+ (let* ((len (min (vector-length v1) (vector-length v2)))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result i (f i (vector-ref v1 i) (vector-ref v2 i)))
+ (loop (+ i 1))))
+ result))
+ ((f . vs)
+ (assert-procedure f 'vector-map)
+ (assert-vectors vs 'vector-map)
+ (let* ((len (min-length vs))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result i (apply f i (vectors-ref vs i)))
+ (loop (+ i 1))))
+ result))))
+
+(define vector-map!
+ (case-lambda
+ "(vector-map! f vec2 vec2 ...) -> unspecified
+
+Similar to vector-map, but rather than mapping the new elements into a
+new vector, the new mapped elements are destructively inserted into
+VEC1. The dynamic order of application of F is unspecified."
+ ((f v)
+ (assert-procedure f 'vector-map!)
+ (assert-vector v 'vector-map!)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! v i (f i (vector-ref v i)))
+ (loop (+ i 1))))))
+ ((f v1 v2)
+ (assert-procedure f 'vector-map!)
+ (assert-vector v1 'vector-map!)
+ (assert-vector v2 'vector-map!)
+ (let ((len (min (vector-length v1) (vector-length v2))))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! v1 i (f i (vector-ref v1 i) (vector-ref v2 i)))
+ (loop (+ i 1))))))
+ ((f . vs)
+ (assert-procedure f 'vector-map!)
+ (assert-vectors vs 'vector-map!)
+ (let ((len (min-length vs))
+ (v1 (car vs)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! v1 i (apply f i (vectors-ref vs i)))
+ (loop (+ i 1))))))))
+
+(define vector-for-each
+ (case-lambda
+ "(vector-for-each f vec1 vec2 ...) -> unspecified
+
+Call (F i VEC1[i] VEC2[i] ...) for each index i less than the length
+of the shortest vector passed. The iteration is strictly
+left-to-right."
+ ((f v)
+ (assert-procedure f 'vector-for-each)
+ (assert-vector v 'vector-for-each)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (f i (vector-ref v i))
+ (loop (+ i 1))))))
+ ((f v1 v2)
+ (assert-procedure f 'vector-for-each)
+ (assert-vector v1 'vector-for-each)
+ (assert-vector v2 'vector-for-each)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i 0))
+ (unless (= i len)
+ (f i (vector-ref v1 i) (vector-ref v2 i))
+ (loop (+ i 1))))))
+ ((f . vs)
+ (assert-procedure f 'vector-for-each)
+ (assert-vectors vs 'vector-for-each)
+ (let ((len (min-length vs)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (apply f i (vectors-ref vs i))
+ (loop (+ i 1))))))))
+
+(define vector-count
+ (case-lambda
+ "(vector-count pred? vec1 vec2 ...) -> exact nonnegative integer
+
+Count the number of indices i for which (PRED? VEC1[i] VEC2[i] ...)
+returns true, where i is less than the length of the shortest vector
+passed."
+ ((pred? v)
+ (assert-procedure pred? 'vector-count)
+ (assert-vector v 'vector-count)
+ (let ((len (vector-length v)))
+ (let loop ((i 0) (count 0))
+ (cond ((= i len) count)
+ ((pred? i (vector-ref v i))
+ (loop (+ i 1) (+ count 1)))
+ (else
+ (loop (+ i 1) count))))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-count)
+ (assert-vector v1 'vector-count)
+ (assert-vector v2 'vector-count)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i 0) (count 0))
+ (cond ((= i len) count)
+ ((pred? i (vector-ref v1 i) (vector-ref v2 i))
+ (loop (+ i 1) (+ count 1)))
+ (else
+ (loop (+ i 1) count))))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-count)
+ (assert-vectors vs 'vector-count)
+ (let ((len (min-length vs)))
+ (let loop ((i 0) (count 0))
+ (cond ((= i len) count)
+ ((apply pred? i (vectors-ref vs i))
+ (loop (+ i 1) (+ count 1)))
+ (else
+ (loop (+ i 1) count))))))))
+
+(define vector-index
+ (case-lambda
+ "(vector-index pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Find and return the index of the first elements in VEC1 VEC2 ... that
+satisfy PRED?. If no matching element is found by the end of the
+shortest vector, return #f."
+ ((pred? v)
+ (assert-procedure pred? 'vector-index)
+ (assert-vector v 'vector-index)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (pred? (vector-ref v i))
+ i
+ (loop (+ i 1)))))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-index)
+ (assert-vector v1 'vector-index)
+ (assert-vector v2 'vector-index)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (pred? (vector-ref v1 i)
+ (vector-ref v2 i))
+ i
+ (loop (+ i 1)))))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-index)
+ (assert-vectors vs 'vector-index)
+ (let ((len (min-length vs)))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (apply pred? (vectors-ref vs i))
+ i
+ (loop (+ i 1)))))))))
+
+(define vector-index-right
+ (case-lambda
+ "(vector-index-right pred? vec1 vec2 ...) -> exact nonnegative integer or
#f
+
+Find and return the index of the last elements in VEC1 VEC2 ... that
+satisfy PRED?, searching from right-to-left. If no matching element
+is found before the end of the shortest vector, return #f."
+ ((pred? v)
+ (assert-procedure pred? 'vector-index-right)
+ (assert-vector v 'vector-index-right)
+ (let ((len (vector-length v)))
+ (let loop ((i (- len 1)))
+ (and (>= i 0)
+ (if (pred? (vector-ref v i))
+ i
+ (loop (- i 1)))))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-index-right)
+ (assert-vector v1 'vector-index-right)
+ (assert-vector v2 'vector-index-right)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i (- len 1)))
+ (and (>= i 0)
+ (if (pred? (vector-ref v1 i)
+ (vector-ref v2 i))
+ i
+ (loop (- i 1)))))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-index-right)
+ (assert-vectors vs 'vector-index-right)
+ (let ((len (min-length vs)))
+ (let loop ((i (- len 1)))
+ (and (>= i 0)
+ (if (apply pred? (vectors-ref vs i))
+ i
+ (loop (- i 1)))))))))
+
+(define vector-skip
+ (case-lambda
+ "(vector-skip pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Find and return the index of the first elements in VEC1 VEC2 ... that
+do not satisfy PRED?. If no matching element is found by the end of
+the shortest vector, return #f."
+ ((pred? v)
+ (assert-procedure pred? 'vector-skip)
+ (assert-vector v 'vector-skip)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (pred? (vector-ref v i))
+ (loop (+ i 1))
+ i)))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-skip)
+ (assert-vector v1 'vector-skip)
+ (assert-vector v2 'vector-skip)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (pred? (vector-ref v1 i)
+ (vector-ref v2 i))
+ (loop (+ i 1))
+ i)))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-skip)
+ (assert-vectors vs 'vector-skip)
+ (let ((len (min-length vs)))
+ (let loop ((i 0))
+ (and (< i len)
+ (if (apply pred? (vectors-ref vs i))
+ (loop (+ i 1))
+ i)))))))
+
+(define vector-skip-right
+ (case-lambda
+ "(vector-skip-right pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Find and return the index of the last elements in VEC1 VEC2 ... that
+do not satisfy PRED?, searching from right-to-left. If no matching
+element is found before the end of the shortest vector, return #f."
+ ((pred? v)
+ (assert-procedure pred? 'vector-skip-right)
+ (assert-vector v 'vector-skip-right)
+ (let ((len (vector-length v)))
+ (let loop ((i (- len 1)))
+ (and (not (negative? i))
+ (if (pred? (vector-ref v i))
+ (loop (- i 1))
+ i)))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-skip-right)
+ (assert-vector v1 'vector-skip-right)
+ (assert-vector v2 'vector-skip-right)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i (- len 1)))
+ (and (not (negative? i))
+ (if (pred? (vector-ref v1 i)
+ (vector-ref v2 i))
+ (loop (- i 1))
+ i)))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-skip-right)
+ (assert-vectors vs 'vector-skip-right)
+ (let ((len (min-length vs)))
+ (let loop ((i (- len 1)))
+ (and (not (negative? i))
+ (if (apply pred? (vectors-ref vs i))
+ (loop (- i 1))
+ i)))))))
+
+(define vector-binary-search
+ (let ()
+ (define (%vector-binary-search vec value cmp start end)
+ (let loop ((lo start) (hi end))
+ (and (< lo hi)
+ (let* ((i (quotient (+ lo hi) 2))
+ (x (vector-ref vec i))
+ (c (cmp x value)))
+ (cond ((zero? c) i)
+ ((positive? c) (loop lo i))
+ ((negative? c) (loop (+ i 1) hi)))))))
+ (case-lambda
+ "(vector-binary-search vec value cmp [start [end]]) -> exact nonnegative
integer or #f
+
+Find and return an index of VEC between START and END whose value is
+VALUE using a binary search. If no matching element is found, return
+#f. The default START is 0 and the default END is the length of VEC.
+CMP must be a procedure of two arguments such that (CMP A B) returns
+a negative integer if A < B, a positive integer if A > B, or zero if
+A = B. The elements of VEC must be sorted in non-decreasing order
+according to CMP."
+ ((vec value cmp)
+ (assert-vector vec 'vector-binary-search)
+ (assert-procedure cmp 'vector-binary-search)
+ (%vector-binary-search vec value cmp 0 (vector-length vec)))
+
+ ((vec value cmp start)
+ (assert-vector vec 'vector-binary-search)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'vector-binary-search)
+ (%vector-binary-search vec value cmp start len)))
+
+ ((vec value cmp start end)
+ (assert-vector vec 'vector-binary-search)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'vector-binary-search)
+ (%vector-binary-search vec value cmp start end))))))
+
+(define vector-any
+ (case-lambda
+ "(vector-any pred? vec1 vec2 ...) -> value or #f
+
+Find the first parallel set of elements from VEC1 VEC2 ... for which
+PRED? returns a true value. If such a parallel set of elements
+exists, vector-any returns the value that PRED? returned for that set
+of elements. The iteration is strictly left-to-right."
+ ((pred? v)
+ (assert-procedure pred? 'vector-any)
+ (assert-vector v 'vector-any)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (and (< i len)
+ (or (pred? (vector-ref v i))
+ (loop (+ i 1)))))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-any)
+ (assert-vector v1 'vector-any)
+ (assert-vector v2 'vector-any)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (let loop ((i 0))
+ (and (< i len)
+ (or (pred? (vector-ref v1 i)
+ (vector-ref v2 i))
+ (loop (+ i 1)))))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-any)
+ (assert-vectors vs 'vector-any)
+ (let ((len (min-length vs)))
+ (let loop ((i 0))
+ (and (< i len)
+ (or (apply pred? (vectors-ref vs i))
+ (loop (+ i 1)))))))))
+
+(define vector-every
+ (case-lambda
+ "(vector-every pred? vec1 vec2 ...) -> value or #f
+
+If, for every index i less than the length of the shortest vector
+argument, the set of elements VEC1[i] VEC2[i] ... satisfies PRED?,
+vector-every returns the value that PRED? returned for the last set of
+elements, at the last index of the shortest vector. The iteration is
+strictly left-to-right."
+ ((pred? v)
+ (assert-procedure pred? 'vector-every)
+ (assert-vector v 'vector-every)
+ (let ((len (vector-length v)))
+ (or (zero? len)
+ (let loop ((i 0))
+ (let ((val (pred? (vector-ref v i)))
+ (next-i (+ i 1)))
+ (if (or (not val) (= next-i len))
+ val
+ (loop next-i)))))))
+ ((pred? v1 v2)
+ (assert-procedure pred? 'vector-every)
+ (assert-vector v1 'vector-every)
+ (assert-vector v2 'vector-every)
+ (let ((len (min (vector-length v1)
+ (vector-length v2))))
+ (or (zero? len)
+ (let loop ((i 0))
+ (let ((val (pred? (vector-ref v1 i)
+ (vector-ref v2 i)))
+ (next-i (+ i 1)))
+ (if (or (not val) (= next-i len))
+ val
+ (loop next-i)))))))
+ ((pred? . vs)
+ (assert-procedure pred? 'vector-every)
+ (assert-vectors vs 'vector-every)
+ (let ((len (min-length vs)))
+ (or (zero? len)
+ (let loop ((i 0))
+ (let ((val (apply pred? (vectors-ref vs i)))
+ (next-i (+ i 1)))
+ (if (or (not val) (= next-i len))
+ val
+ (loop next-i)))))))))
+
+(define (vector-swap! vec i j)
+ "(vector-swap! vec i j) -> unspecified
+
+Swap the values of the locations in VEC at I and J."
+ (assert-vector vec 'vector-swap!)
+ (let ((len (vector-length vec)))
+ (assert-valid-index i len 'vector-swap!)
+ (assert-valid-index j len 'vector-swap!)
+ (let ((tmp (vector-ref vec i)))
+ (vector-set! vec i (vector-ref vec j))
+ (vector-set! vec j tmp))))
+
+;; TODO: Enhance Guile core 'vector-fill!' to do this.
+(define vector-fill!
+ (let ()
+ (define guile-vector-fill!
+ (@ (guile) vector-fill!))
+ (define (%vector-fill! vec fill start end)
+ (let loop ((i start))
+ (when (< i end)
+ (vector-set! vec i fill)
+ (loop (+ i 1)))))
+ (case-lambda
+ "(vector-fill! vec fill [start [end]]) -> unspecified
+
+Assign the value of every location in VEC between START and END to
+FILL. START defaults to 0 and END defaults to the length of VEC."
+ ((vec fill)
+ (guile-vector-fill! vec fill))
+ ((vec fill start)
+ (assert-vector vec 'vector-fill!)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'vector-fill!)
+ (%vector-fill! vec fill start len)))
+ ((vec fill start end)
+ (assert-vector vec 'vector-fill!)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'vector-fill!)
+ (%vector-fill! vec fill start end))))))
+
+(define (%vector-reverse! vec start end)
+ (let loop ((i start) (j (- end 1)))
+ (when (< i j)
+ (let ((tmp (vector-ref vec i)))
+ (vector-set! vec i (vector-ref vec j))
+ (vector-set! vec j tmp)
+ (loop (+ i 1) (- j 1))))))
+
+(define vector-reverse!
+ (case-lambda
+ "(vector-reverse! vec [start [end]]) -> unspecified
+
+Destructively reverse the contents of VEC between START and END.
+START defaults to 0 and END defaults to the length of VEC."
+ ((vec)
+ (assert-vector vec 'vector-reverse!)
+ (%vector-reverse! vec 0 (vector-length vec)))
+ ((vec start)
+ (assert-vector vec 'vector-reverse!)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'vector-reverse!)
+ (%vector-reverse! vec start len)))
+ ((vec start end)
+ (assert-vector vec 'vector-reverse!)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'vector-reverse!)
+ (%vector-reverse! vec start end)))))
+
+(define-syntax-rule (define-vector-copier! copy! docstring inner-proc)
+ (define copy!
+ (let ((%copy! inner-proc))
+ (case-lambda
+ docstring
+ ((target tstart source)
+ (assert-vector target 'copy!)
+ (assert-vector source 'copy!)
+ (let ((tlen (vector-length target))
+ (slen (vector-length source)))
+ (assert-valid-start tstart tlen 'copy!)
+ (unless (>= tlen (+ tstart slen))
+ (error-from 'copy! "would write past end of target"))
+ (%copy! target tstart source 0 slen)))
+
+ ((target tstart source sstart)
+ (assert-vector target 'copy!)
+ (assert-vector source 'copy!)
+ (let ((tlen (vector-length target))
+ (slen (vector-length source)))
+ (assert-valid-start tstart tlen 'copy!)
+ (assert-valid-start sstart slen 'copy!)
+ (unless (>= tlen (+ tstart (- slen sstart)))
+ (error-from 'copy! "would write past end of target"))
+ (%copy! target tstart source sstart slen)))
+
+ ((target tstart source sstart send)
+ (assert-vector target 'copy!)
+ (assert-vector source 'copy!)
+ (let ((tlen (vector-length target))
+ (slen (vector-length source)))
+ (assert-valid-start tstart tlen 'copy!)
+ (assert-valid-range sstart send slen 'copy!)
+ (unless (>= tlen (+ tstart (- send sstart)))
+ (error-from 'copy! "would write past end of target"))
+ (%copy! target tstart source sstart send)))))))
+
+(define-vector-copier! vector-copy!
+ "(vector-copy! target tstart source [sstart [send]]) -> unspecified
+
+Copy a block of elements from SOURCE to TARGET, both of which must be
+vectors, starting in TARGET at TSTART and starting in SOURCE at
+SSTART, ending when SEND - SSTART elements have been copied. It is an
+error for TARGET to have a length less than TSTART + (SEND - SSTART).
+SSTART defaults to 0 and SEND defaults to the length of SOURCE."
+ (lambda (target tstart source sstart send)
+ (if (< tstart sstart)
+ (vector-move-left! source sstart send target tstart)
+ (vector-move-right! source sstart send target tstart))))
+
+(define-vector-copier! vector-reverse-copy!
+ "(vector-reverse-copy! target tstart source [sstart [send]]) -> unspecified
+
+Like vector-copy!, but copy the elements in the reverse order. It is
+an error if TARGET and SOURCE are identical vectors and the TARGET and
+SOURCE ranges overlap; however, if TSTART = SSTART,
+vector-reverse-copy! behaves as (vector-reverse! TARGET TSTART SEND)
+would."
+ (lambda (target tstart source sstart send)
+ (if (and (eq? target source) (= tstart sstart))
+ (%vector-reverse! target sstart send)
+ (let loop ((i tstart) (j (- send 1)))
+ (when (>= j sstart)
+ (vector-set! target i (vector-ref source j))
+ (loop (+ i 1) (- j 1)))))))
+
+(define vector->list
+ (let ()
+ (define (%vector->list vec start end)
+ (let loop ((i (- end 1))
+ (result '()))
+ (if (< i start)
+ result
+ (loop (- i 1) (cons (vector-ref vec i) result)))))
+ (case-lambda
+ "(vector->list vec [start [end]]) -> proper-list
+
+Return a newly allocated list containing the elements in VEC between
+START and END. START defaults to 0 and END defaults to the length of
+VEC."
+ ((vec)
+ (assert-vector vec 'vector->list)
+ (%vector->list vec 0 (vector-length vec)))
+ ((vec start)
+ (assert-vector vec 'vector->list)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'vector->list)
+ (%vector->list vec start len)))
+ ((vec start end)
+ (assert-vector vec 'vector->list)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'vector->list)
+ (%vector->list vec start end))))))
+
+(define reverse-vector->list
+ (let ()
+ (define (%reverse-vector->list vec start end)
+ (let loop ((i start)
+ (result '()))
+ (if (>= i end)
+ result
+ (loop (+ i 1) (cons (vector-ref vec i) result)))))
+ (case-lambda
+ "(reverse-vector->list vec [start [end]]) -> proper-list
+
+Return a newly allocated list containing the elements in VEC between
+START and END in reverse order. START defaults to 0 and END defaults
+to the length of VEC."
+ ((vec)
+ (assert-vector vec 'reverse-vector->list)
+ (%reverse-vector->list vec 0 (vector-length vec)))
+ ((vec start)
+ (assert-vector vec 'reverse-vector->list)
+ (let ((len (vector-length vec)))
+ (assert-valid-start start len 'reverse-vector->list)
+ (%reverse-vector->list vec start len)))
+ ((vec start end)
+ (assert-vector vec 'reverse-vector->list)
+ (let ((len (vector-length vec)))
+ (assert-valid-range start end len 'reverse-vector->list)
+ (%reverse-vector->list vec start end))))))
+
+;; TODO: change to use 'case-lambda' and improve error checking.
+(define* (list->vector lst #:optional (start 0) (end (length lst)))
+ "(list->vector proper-list [start [end]]) -> vector
+
+Return a newly allocated vector of the elements from PROPER-LIST with
+indices between START and END. START defaults to 0 and END defaults
+to the length of PROPER-LIST."
+ (let* ((len (- end start))
+ (result (make-vector len)))
+ (let loop ((i 0) (lst (drop lst start)))
+ (if (= i len)
+ result
+ (begin (vector-set! result i (car lst))
+ (loop (+ i 1) (cdr lst)))))))
+
+;; TODO: change to use 'case-lambda' and improve error checking.
+(define* (reverse-list->vector lst #:optional (start 0) (end (length lst)))
+ "(reverse-list->vector proper-list [start [end]]) -> vector
+
+Return a newly allocated vector of the elements from PROPER-LIST with
+indices between START and END, in reverse order. START defaults to 0
+and END defaults to the length of PROPER-LIST."
+ (let* ((len (- end start))
+ (result (make-vector len)))
+ (let loop ((i (- len 1)) (lst (drop lst start)))
+ (if (negative? i)
+ result
+ (begin (vector-set! result i (car lst))
+ (loop (- i 1) (cdr lst)))))))
diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
new file mode 100644
index 0000000..81dcc5d
--- /dev/null
+++ b/module/srfi/srfi-64.scm
@@ -0,0 +1,55 @@
+;;; srfi-64.scm -- SRFI 64 - A Scheme API for test suites.
+
+;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (srfi srfi-64)
+ #:export
+ (test-begin
+ test-end test-assert test-eqv test-eq test-equal
+ test-approximate test-assert test-error test-apply test-with-runner
+ test-match-nth test-match-all test-match-any test-match-name
+ test-skip test-expect-fail test-read-eval-string
+ test-runner-group-path test-group test-group-with-cleanup
+ test-result-ref test-result-set! test-result-clear test-result-remove
+ test-result-kind test-passed?
+ test-log-to-file
+ test-runner? test-runner-reset test-runner-null
+ test-runner-simple test-runner-current test-runner-factory test-runner-get
+ test-runner-create test-runner-test-name
+ test-runner-pass-count test-runner-pass-count!
+ test-runner-fail-count test-runner-fail-count!
+ test-runner-xpass-count test-runner-xpass-count!
+ test-runner-xfail-count test-runner-xfail-count!
+ test-runner-skip-count test-runner-skip-count!
+ test-runner-group-stack test-runner-group-stack!
+ test-runner-on-test-begin test-runner-on-test-begin!
+ test-runner-on-test-end test-runner-on-test-end!
+ test-runner-on-group-begin test-runner-on-group-begin!
+ test-runner-on-group-end test-runner-on-group-end!
+ test-runner-on-final test-runner-on-final!
+ test-runner-on-bad-count test-runner-on-bad-count!
+ test-runner-on-bad-end-name test-runner-on-bad-end-name!
+ test-result-alist test-result-alist!
+ test-runner-aux-value test-runner-aux-value!
+ test-on-group-begin-simple test-on-group-end-simple
+ test-on-bad-count-simple test-on-bad-end-name-simple
+ test-on-final-simple test-on-test-end-simple
+ test-on-final-simple))
+
+(cond-expand-provide (current-module) '(srfi-64))
+
+(include-from-path "srfi/srfi-64/testing.scm")
diff --git a/module/srfi/srfi-64/testing.scm b/module/srfi/srfi-64/testing.scm
new file mode 100644
index 0000000..d686662
--- /dev/null
+++ b/module/srfi/srfi-64/testing.scm
@@ -0,0 +1,1040 @@
+;; Copyright (c) 2005, 2006, 2007, 2012, 2013 Per Bothner
+;; Added "full" support for Chicken, Gauche, Guile and SISC.
+;; Alex Shinn, Copyright (c) 2005.
+;; Modified for Scheme Spheres by Ãlvaro Castro-Castilla, Copyright (c) 2012.
+;; Support for Guile 2 by Mark H Weaver <address@hidden>, Copyright (c) 2014.
+;;
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(cond-expand
+ (chicken
+ (require-extension syntax-case))
+ (guile-2
+ (use-modules (srfi srfi-9)
+ ;; In 2.0.9, srfi-34 and srfi-35 are not well integrated
+ ;; with either Guile's native exceptions or R6RS exceptions.
+ ;;(srfi srfi-34) (srfi srfi-35)
+ (srfi srfi-39)))
+ (guile
+ (use-modules (ice-9 syncase) (srfi srfi-9)
+ ;;(srfi srfi-34) (srfi srfi-35) - not in Guile 1.6.7
+ (srfi srfi-39)))
+ (sisc
+ (require-extension (srfi 9 34 35 39)))
+ (kawa
+ (module-compile-options warn-undefined-variable: #t
+ warn-invoke-unknown-method: #t)
+ (provide 'srfi-64)
+ (provide 'testing)
+ (require 'srfi-34)
+ (require 'srfi-35))
+ (else ()
+ ))
+
+(cond-expand
+ (kawa
+ (define-syntax %test-export
+ (syntax-rules ()
+ ((%test-export test-begin . other-names)
+ (module-export %test-begin . other-names)))))
+ (else
+ (define-syntax %test-export
+ (syntax-rules ()
+ ((%test-export . names) (if #f #f))))))
+
+;; List of exported names
+(%test-export
+ test-begin ;; must be listed first, since in Kawa (at least) it is "magic".
+ test-end test-assert test-eqv test-eq test-equal
+ test-approximate test-assert test-error test-apply test-with-runner
+ test-match-nth test-match-all test-match-any test-match-name
+ test-skip test-expect-fail test-read-eval-string
+ test-runner-group-path test-group test-group-with-cleanup
+ test-result-ref test-result-set! test-result-clear test-result-remove
+ test-result-kind test-passed?
+ test-log-to-file
+ ; Misc test-runner functions
+ test-runner? test-runner-reset test-runner-null
+ test-runner-simple test-runner-current test-runner-factory test-runner-get
+ test-runner-create test-runner-test-name
+ ;; test-runner field setter and getter functions - see %test-record-define:
+ test-runner-pass-count test-runner-pass-count!
+ test-runner-fail-count test-runner-fail-count!
+ test-runner-xpass-count test-runner-xpass-count!
+ test-runner-xfail-count test-runner-xfail-count!
+ test-runner-skip-count test-runner-skip-count!
+ test-runner-group-stack test-runner-group-stack!
+ test-runner-on-test-begin test-runner-on-test-begin!
+ test-runner-on-test-end test-runner-on-test-end!
+ test-runner-on-group-begin test-runner-on-group-begin!
+ test-runner-on-group-end test-runner-on-group-end!
+ test-runner-on-final test-runner-on-final!
+ test-runner-on-bad-count test-runner-on-bad-count!
+ test-runner-on-bad-end-name test-runner-on-bad-end-name!
+ test-result-alist test-result-alist!
+ test-runner-aux-value test-runner-aux-value!
+ ;; default/simple call-back functions, used in default test-runner,
+ ;; but can be called to construct more complex ones.
+ test-on-group-begin-simple test-on-group-end-simple
+ test-on-bad-count-simple test-on-bad-end-name-simple
+ test-on-final-simple test-on-test-end-simple
+ test-on-final-simple)
+
+(cond-expand
+ (srfi-9
+ (define-syntax %test-record-define
+ (syntax-rules ()
+ ((%test-record-define alloc runner? (name index setter getter) ...)
+ (define-record-type test-runner
+ (alloc)
+ runner?
+ (name setter getter) ...)))))
+ (else
+ (define %test-runner-cookie (list "test-runner"))
+ (define-syntax %test-record-define
+ (syntax-rules ()
+ ((%test-record-define alloc runner? (name index getter setter) ...)
+ (begin
+ (define (runner? obj)
+ (and (vector? obj)
+ (> (vector-length obj) 1)
+ (eq (vector-ref obj 0) %test-runner-cookie)))
+ (define (alloc)
+ (let ((runner (make-vector 23)))
+ (vector-set! runner 0 %test-runner-cookie)
+ runner))
+ (begin
+ (define (getter runner)
+ (vector-ref runner index)) ...)
+ (begin
+ (define (setter runner value)
+ (vector-set! runner index value)) ...)))))))
+
+(%test-record-define
+ %test-runner-alloc test-runner?
+ ;; Cumulate count of all tests that have passed and were expected to.
+ (pass-count 1 test-runner-pass-count test-runner-pass-count!)
+ (fail-count 2 test-runner-fail-count test-runner-fail-count!)
+ (xpass-count 3 test-runner-xpass-count test-runner-xpass-count!)
+ (xfail-count 4 test-runner-xfail-count test-runner-xfail-count!)
+ (skip-count 5 test-runner-skip-count test-runner-skip-count!)
+ (skip-list 6 %test-runner-skip-list %test-runner-skip-list!)
+ (fail-list 7 %test-runner-fail-list %test-runner-fail-list!)
+ ;; Normally #t, except when in a test-apply.
+ (run-list 8 %test-runner-run-list %test-runner-run-list!)
+ (skip-save 9 %test-runner-skip-save %test-runner-skip-save!)
+ (fail-save 10 %test-runner-fail-save %test-runner-fail-save!)
+ (group-stack 11 test-runner-group-stack test-runner-group-stack!)
+ (on-test-begin 12 test-runner-on-test-begin test-runner-on-test-begin!)
+ (on-test-end 13 test-runner-on-test-end test-runner-on-test-end!)
+ ;; Call-back when entering a group. Takes (runner suite-name count).
+ (on-group-begin 14 test-runner-on-group-begin test-runner-on-group-begin!)
+ ;; Call-back when leaving a group.
+ (on-group-end 15 test-runner-on-group-end test-runner-on-group-end!)
+ ;; Call-back when leaving the outermost group.
+ (on-final 16 test-runner-on-final test-runner-on-final!)
+ ;; Call-back when expected number of tests was wrong.
+ (on-bad-count 17 test-runner-on-bad-count test-runner-on-bad-count!)
+ ;; Call-back when name in test=end doesn't match test-begin.
+ (on-bad-end-name 18 test-runner-on-bad-end-name test-runner-on-bad-end-name!)
+ ;; Cumulate count of all tests that have been done.
+ (total-count 19 %test-runner-total-count %test-runner-total-count!)
+ ;; Stack (list) of (count-at-start . expected-count):
+ (count-list 20 %test-runner-count-list %test-runner-count-list!)
+ (result-alist 21 test-result-alist test-result-alist!)
+ ;; Field can be used by test-runner for any purpose.
+ ;; test-runner-simple uses it for a log file.
+ (aux-value 22 test-runner-aux-value test-runner-aux-value!)
+)
+
+(define (test-runner-reset runner)
+ (test-result-alist! runner '())
+ (test-runner-pass-count! runner 0)
+ (test-runner-fail-count! runner 0)
+ (test-runner-xpass-count! runner 0)
+ (test-runner-xfail-count! runner 0)
+ (test-runner-skip-count! runner 0)
+ (%test-runner-total-count! runner 0)
+ (%test-runner-count-list! runner '())
+ (%test-runner-run-list! runner #t)
+ (%test-runner-skip-list! runner '())
+ (%test-runner-fail-list! runner '())
+ (%test-runner-skip-save! runner '())
+ (%test-runner-fail-save! runner '())
+ (test-runner-group-stack! runner '()))
+
+(define (test-runner-group-path runner)
+ (reverse (test-runner-group-stack runner)))
+
+(define (%test-null-callback runner) #f)
+
+(define (test-runner-null)
+ (let ((runner (%test-runner-alloc)))
+ (test-runner-reset runner)
+ (test-runner-on-group-begin! runner (lambda (runner name count) #f))
+ (test-runner-on-group-end! runner %test-null-callback)
+ (test-runner-on-final! runner %test-null-callback)
+ (test-runner-on-test-begin! runner %test-null-callback)
+ (test-runner-on-test-end! runner %test-null-callback)
+ (test-runner-on-bad-count! runner (lambda (runner count expected) #f))
+ (test-runner-on-bad-end-name! runner (lambda (runner begin end) #f))
+ runner))
+
+;; Not part of the specification. FIXME
+;; Controls whether a log file is generated.
+(define test-log-to-file #t)
+
+(define (test-runner-simple)
+ (let ((runner (%test-runner-alloc)))
+ (test-runner-reset runner)
+ (test-runner-on-group-begin! runner test-on-group-begin-simple)
+ (test-runner-on-group-end! runner test-on-group-end-simple)
+ (test-runner-on-final! runner test-on-final-simple)
+ (test-runner-on-test-begin! runner test-on-test-begin-simple)
+ (test-runner-on-test-end! runner test-on-test-end-simple)
+ (test-runner-on-bad-count! runner test-on-bad-count-simple)
+ (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
+ runner))
+
+(cond-expand
+ (srfi-39
+ (define test-runner-current (make-parameter #f))
+ (define test-runner-factory (make-parameter test-runner-simple)))
+ (else
+ (define %test-runner-current #f)
+ (define-syntax test-runner-current
+ (syntax-rules ()
+ ((test-runner-current)
+ %test-runner-current)
+ ((test-runner-current runner)
+ (set! %test-runner-current runner))))
+ (define %test-runner-factory test-runner-simple)
+ (define-syntax test-runner-factory
+ (syntax-rules ()
+ ((test-runner-factory)
+ %test-runner-factory)
+ ((test-runner-factory runner)
+ (set! %test-runner-factory runner))))))
+
+;; A safer wrapper to test-runner-current.
+(define (test-runner-get)
+ (let ((r (test-runner-current)))
+ (if (not r)
+ (cond-expand
+ (srfi-23 (error "test-runner not initialized - test-begin missing?"))
+ (else #t)))
+ r))
+
+(define (%test-specifier-matches spec runner)
+ (spec runner))
+
+(define (test-runner-create)
+ ((test-runner-factory)))
+
+(define (%test-any-specifier-matches list runner)
+ (let ((result #f))
+ (let loop ((l list))
+ (cond ((null? l) result)
+ (else
+ (if (%test-specifier-matches (car l) runner)
+ (set! result #t))
+ (loop (cdr l)))))))
+
+;; Returns #f, #t, or 'xfail.
+(define (%test-should-execute runner)
+ (let ((run (%test-runner-run-list runner)))
+ (cond ((or
+ (not (or (eqv? run #t)
+ (%test-any-specifier-matches run runner)))
+ (%test-any-specifier-matches
+ (%test-runner-skip-list runner)
+ runner))
+ (test-result-set! runner 'result-kind 'skip)
+ #f)
+ ((%test-any-specifier-matches
+ (%test-runner-fail-list runner)
+ runner)
+ (test-result-set! runner 'result-kind 'xfail)
+ 'xfail)
+ (else #t))))
+
+(define (%test-begin suite-name count)
+ (if (not (test-runner-current))
+ (test-runner-current (test-runner-create)))
+ (let ((runner (test-runner-current)))
+ ((test-runner-on-group-begin runner) runner suite-name count)
+ (%test-runner-skip-save! runner
+ (cons (%test-runner-skip-list runner)
+ (%test-runner-skip-save runner)))
+ (%test-runner-fail-save! runner
+ (cons (%test-runner-fail-list runner)
+ (%test-runner-fail-save runner)))
+ (%test-runner-count-list! runner
+ (cons (cons (%test-runner-total-count runner)
+ count)
+ (%test-runner-count-list runner)))
+ (test-runner-group-stack! runner (cons suite-name
+ (test-runner-group-stack runner)))))
+(cond-expand
+ (kawa
+ ;; Kawa has test-begin built in, implemented as:
+ ;; (begin
+ ;; (cond-expand (srfi-64 #!void) (else (require 'srfi-64)))
+ ;; (%test-begin suite-name [count]))
+ ;; This puts test-begin but only test-begin in the default environment.,
+ ;; which makes normal test suites loadable without non-portable commands.
+ )
+ (else
+ (define-syntax test-begin
+ (syntax-rules ()
+ ((test-begin suite-name)
+ (%test-begin suite-name #f))
+ ((test-begin suite-name count)
+ (%test-begin suite-name count))))))
+
+(define (test-on-group-begin-simple runner suite-name count)
+ (if (null? (test-runner-group-stack runner))
+ (begin
+ (display "%%%% Starting test ")
+ (display suite-name)
+ (if test-log-to-file
+ (let* ((log-file-name
+ (if (string? test-log-to-file) test-log-to-file
+ (string-append suite-name ".log")))
+ (log-file
+ (cond-expand (mzscheme
+ (open-output-file log-file-name
'truncate/replace))
+ (else (open-output-file log-file-name)))))
+ (display "%%%% Starting test " log-file)
+ (display suite-name log-file)
+ (newline log-file)
+ (test-runner-aux-value! runner log-file)
+ (display " (Writing full log to \"")
+ (display log-file-name)
+ (display "\")")))
+ (newline)))
+ (let ((log (test-runner-aux-value runner)))
+ (if (output-port? log)
+ (begin
+ (display "Group begin: " log)
+ (display suite-name log)
+ (newline log))))
+ #f)
+
+(define (test-on-group-end-simple runner)
+ (let ((log (test-runner-aux-value runner)))
+ (if (output-port? log)
+ (begin
+ (display "Group end: " log)
+ (display (car (test-runner-group-stack runner)) log)
+ (newline log))))
+ #f)
+
+(define (%test-on-bad-count-write runner count expected-count port)
+ (display "*** Total number of tests was " port)
+ (display count port)
+ (display " but should be " port)
+ (display expected-count port)
+ (display ". ***" port)
+ (newline port)
+ (display "*** Discrepancy indicates testsuite error or exceptions. ***" port)
+ (newline port))
+
+(define (test-on-bad-count-simple runner count expected-count)
+ (%test-on-bad-count-write runner count expected-count (current-output-port))
+ (let ((log (test-runner-aux-value runner)))
+ (if (output-port? log)
+ (%test-on-bad-count-write runner count expected-count log))))
+
+(define (test-on-bad-end-name-simple runner begin-name end-name)
+ (let ((msg (string-append (%test-format-line runner) "test-end " begin-name
+ " does not match test-begin " end-name)))
+ (cond-expand
+ (srfi-23 (error msg))
+ (else (display msg) (newline)))))
+
+
+(define (%test-final-report1 value label port)
+ (if (> value 0)
+ (begin
+ (display label port)
+ (display value port)
+ (newline port))))
+
+(define (%test-final-report-simple runner port)
+ (%test-final-report1 (test-runner-pass-count runner)
+ "# of expected passes " port)
+ (%test-final-report1 (test-runner-xfail-count runner)
+ "# of expected failures " port)
+ (%test-final-report1 (test-runner-xpass-count runner)
+ "# of unexpected successes " port)
+ (%test-final-report1 (test-runner-fail-count runner)
+ "# of unexpected failures " port)
+ (%test-final-report1 (test-runner-skip-count runner)
+ "# of skipped tests " port))
+
+(define (test-on-final-simple runner)
+ (%test-final-report-simple runner (current-output-port))
+ (let ((log (test-runner-aux-value runner)))
+ (if (output-port? log)
+ (%test-final-report-simple runner log))))
+
+(define (%test-format-line runner)
+ (let* ((line-info (test-result-alist runner))
+ (source-file (assq 'source-file line-info))
+ (source-line (assq 'source-line line-info))
+ (file (if source-file (cdr source-file) "")))
+ (if source-line
+ (string-append file ":"
+ (number->string (cdr source-line)) ": ")
+ "")))
+
+(define (%test-end suite-name line-info)
+ (let* ((r (test-runner-get))
+ (groups (test-runner-group-stack r))
+ (line (%test-format-line r)))
+ (test-result-alist! r line-info)
+ (if (null? groups)
+ (let ((msg (string-append line "test-end not in a group")))
+ (cond-expand
+ (srfi-23 (error msg))
+ (else (display msg) (newline)))))
+ (if (and suite-name (not (equal? suite-name (car groups))))
+ ((test-runner-on-bad-end-name r) r suite-name (car groups)))
+ (let* ((count-list (%test-runner-count-list r))
+ (expected-count (cdar count-list))
+ (saved-count (caar count-list))
+ (group-count (- (%test-runner-total-count r) saved-count)))
+ (if (and expected-count
+ (not (= expected-count group-count)))
+ ((test-runner-on-bad-count r) r group-count expected-count))
+ ((test-runner-on-group-end r) r)
+ (test-runner-group-stack! r (cdr (test-runner-group-stack r)))
+ (%test-runner-skip-list! r (car (%test-runner-skip-save r)))
+ (%test-runner-skip-save! r (cdr (%test-runner-skip-save r)))
+ (%test-runner-fail-list! r (car (%test-runner-fail-save r)))
+ (%test-runner-fail-save! r (cdr (%test-runner-fail-save r)))
+ (%test-runner-count-list! r (cdr count-list))
+ (if (null? (test-runner-group-stack r))
+ ((test-runner-on-final r) r)))))
+
+(define-syntax test-group
+ (syntax-rules ()
+ ((test-group suite-name . body)
+ (let ((r (test-runner-current)))
+ ;; Ideally should also set line-number, if available.
+ (test-result-alist! r (list (cons 'test-name suite-name)))
+ (if (%test-should-execute r)
+ (dynamic-wind
+ (lambda () (test-begin suite-name))
+ (lambda () . body)
+ (lambda () (test-end suite-name))))))))
+
+(define-syntax test-group-with-cleanup
+ (syntax-rules ()
+ ((test-group-with-cleanup suite-name form cleanup-form)
+ (test-group suite-name
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () form)
+ (lambda () cleanup-form))))
+ ((test-group-with-cleanup suite-name cleanup-form)
+ (test-group-with-cleanup suite-name #f cleanup-form))
+ ((test-group-with-cleanup suite-name form1 form2 form3 . rest)
+ (test-group-with-cleanup suite-name (begin form1 form2) form3 . rest))))
+
+(define (test-on-test-begin-simple runner)
+ (let ((log (test-runner-aux-value runner)))
+ (if (output-port? log)
+ (let* ((results (test-result-alist runner))
+ (source-file (assq 'source-file results))
+ (source-line (assq 'source-line results))
+ (source-form (assq 'source-form results))
+ (test-name (assq 'test-name results)))
+ (display "Test begin:" log)
+ (newline log)
+ (if test-name (%test-write-result1 test-name log))
+ (if source-file (%test-write-result1 source-file log))
+ (if source-line (%test-write-result1 source-line log))
+ (if source-form (%test-write-result1 source-form log))))))
+
+(define-syntax test-result-ref
+ (syntax-rules ()
+ ((test-result-ref runner pname)
+ (test-result-ref runner pname #f))
+ ((test-result-ref runner pname default)
+ (let ((p (assq pname (test-result-alist runner))))
+ (if p (cdr p) default)))))
+
+(define (test-on-test-end-simple runner)
+ (let ((log (test-runner-aux-value runner))
+ (kind (test-result-ref runner 'result-kind)))
+ (if (memq kind '(fail xpass))
+ (let* ((results (test-result-alist runner))
+ (source-file (assq 'source-file results))
+ (source-line (assq 'source-line results))
+ (test-name (assq 'test-name results)))
+ (if (or source-file source-line)
+ (begin
+ (if source-file (display (cdr source-file)))
+ (display ":")
+ (if source-line (display (cdr source-line)))
+ (display ": ")))
+ (display (if (eq? kind 'xpass) "XPASS" "FAIL"))
+ (if test-name
+ (begin
+ (display " ")
+ (display (cdr test-name))))
+ (newline)))
+ (if (output-port? log)
+ (begin
+ (display "Test end:" log)
+ (newline log)
+ (let loop ((list (test-result-alist runner)))
+ (if (pair? list)
+ (let ((pair (car list)))
+ ;; Write out properties not written out by on-test-begin.
+ (if (not (memq (car pair)
+ '(test-name source-file source-line
source-form)))
+ (%test-write-result1 pair log))
+ (loop (cdr list)))))))))
+
+(define (%test-write-result1 pair port)
+ (display " " port)
+ (display (car pair) port)
+ (display ": " port)
+ (write (cdr pair) port)
+ (newline port))
+
+(define (test-result-set! runner pname value)
+ (let* ((alist (test-result-alist runner))
+ (p (assq pname alist)))
+ (if p
+ (set-cdr! p value)
+ (test-result-alist! runner (cons (cons pname value) alist)))))
+
+(define (test-result-clear runner)
+ (test-result-alist! runner '()))
+
+(define (test-result-remove runner pname)
+ (let* ((alist (test-result-alist runner))
+ (p (assq pname alist)))
+ (if p
+ (test-result-alist! runner
+ (let loop ((r alist))
+ (if (eq? r p) (cdr r)
+ (cons (car r) (loop (cdr r)))))))))
+
+(define (test-result-kind . rest)
+ (let ((runner (if (pair? rest) (car rest) (test-runner-current))))
+ (test-result-ref runner 'result-kind)))
+
+(define (test-passed? . rest)
+ (let ((runner (if (pair? rest) (car rest) (test-runner-get))))
+ (memq (test-result-ref runner 'result-kind) '(pass xpass))))
+
+(define (%test-report-result)
+ (let* ((r (test-runner-get))
+ (result-kind (test-result-kind r)))
+ (case result-kind
+ ((pass)
+ (test-runner-pass-count! r (+ 1 (test-runner-pass-count r))))
+ ((fail)
+ (test-runner-fail-count! r (+ 1 (test-runner-fail-count r))))
+ ((xpass)
+ (test-runner-xpass-count! r (+ 1 (test-runner-xpass-count r))))
+ ((xfail)
+ (test-runner-xfail-count! r (+ 1 (test-runner-xfail-count r))))
+ (else
+ (test-runner-skip-count! r (+ 1 (test-runner-skip-count r)))))
+ (%test-runner-total-count! r (+ 1 (%test-runner-total-count r)))
+ ((test-runner-on-test-end r) r)))
+
+(cond-expand
+ (guile
+ (define-syntax %test-evaluate-with-catch
+ (syntax-rules ()
+ ((%test-evaluate-with-catch test-expression)
+ (catch #t
+ (lambda () test-expression)
+ (lambda (key . args)
+ (test-result-set! (test-runner-current) 'actual-error
+ (cons key args))
+ #f))))))
+ (kawa
+ (define-syntax %test-evaluate-with-catch
+ (syntax-rules ()
+ ((%test-evaluate-with-catch test-expression)
+ (try-catch test-expression
+ (ex <java.lang.Throwable>
+ (test-result-set! (test-runner-current) 'actual-error ex)
+ #f))))))
+ (srfi-34
+ (define-syntax %test-evaluate-with-catch
+ (syntax-rules ()
+ ((%test-evaluate-with-catch test-expression)
+ (guard (err (else #f)) test-expression)))))
+ (chicken
+ (define-syntax %test-evaluate-with-catch
+ (syntax-rules ()
+ ((%test-evaluate-with-catch test-expression)
+ (condition-case test-expression (ex () #f))))))
+ (else
+ (define-syntax %test-evaluate-with-catch
+ (syntax-rules ()
+ ((%test-evaluate-with-catch test-expression)
+ test-expression)))))
+
+(cond-expand
+ ((or kawa mzscheme)
+ (cond-expand
+ (mzscheme
+ (define-for-syntax (%test-syntax-file form)
+ (let ((source (syntax-source form)))
+ (cond ((string? source) file)
+ ((path? source) (path->string source))
+ (else #f)))))
+ (kawa
+ (define (%test-syntax-file form)
+ (syntax-source form))))
+ (define (%test-source-line2 form)
+ (let* ((line (syntax-line form))
+ (file (%test-syntax-file form))
+ (line-pair (if line (list (cons 'source-line line)) '())))
+ (cons (cons 'source-form (syntax-object->datum form))
+ (if file (cons (cons 'source-file file) line-pair) line-pair)))))
+ (guile-2
+ (define (%test-source-line2 form)
+ (let* ((src-props (syntax-source form))
+ (file (and src-props (assq-ref src-props 'filename)))
+ (line (and src-props (assq-ref src-props 'line)))
+ (file-alist (if file
+ `((source-file . ,file))
+ '()))
+ (line-alist (if line
+ `((source-line . ,(+ line 1)))
+ '())))
+ (datum->syntax (syntax here)
+ `((source-form . ,(syntax->datum form))
+ ,@file-alist
+ ,@line-alist)))))
+ (else
+ (define (%test-source-line2 form)
+ '())))
+
+(define (%test-on-test-begin r)
+ (%test-should-execute r)
+ ((test-runner-on-test-begin r) r)
+ (not (eq? 'skip (test-result-ref r 'result-kind))))
+
+(define (%test-on-test-end r result)
+ (test-result-set! r 'result-kind
+ (if (eq? (test-result-ref r 'result-kind) 'xfail)
+ (if result 'xpass 'xfail)
+ (if result 'pass 'fail))))
+
+(define (test-runner-test-name runner)
+ (test-result-ref runner 'test-name ""))
+
+(define-syntax %test-comp2body
+ (syntax-rules ()
+ ((%test-comp2body r comp expected expr)
+ (let ()
+ (if (%test-on-test-begin r)
+ (let ((exp expected))
+ (test-result-set! r 'expected-value exp)
+ (let ((res (%test-evaluate-with-catch expr)))
+ (test-result-set! r 'actual-value res)
+ (%test-on-test-end r (comp exp res)))))
+ (%test-report-result)))))
+
+(define (%test-approximate= error)
+ (lambda (value expected)
+ (let ((rval (real-part value))
+ (ival (imag-part value))
+ (rexp (real-part expected))
+ (iexp (imag-part expected)))
+ (and (>= rval (- rexp error))
+ (>= ival (- iexp error))
+ (<= rval (+ rexp error))
+ (<= ival (+ iexp error))))))
+
+(define-syntax %test-comp1body
+ (syntax-rules ()
+ ((%test-comp1body r expr)
+ (let ()
+ (if (%test-on-test-begin r)
+ (let ()
+ (let ((res (%test-evaluate-with-catch expr)))
+ (test-result-set! r 'actual-value res)
+ (%test-on-test-end r res))))
+ (%test-report-result)))))
+
+(cond-expand
+ ((or kawa mzscheme guile-2)
+ ;; Should be made to work for any Scheme with syntax-case
+ ;; However, I haven't gotten the quoting working. FIXME.
+ (define-syntax test-end
+ (lambda (x)
+ (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
+ (((mac suite-name) line)
+ (syntax
+ (%test-end suite-name line)))
+ (((mac) line)
+ (syntax
+ (%test-end #f line))))))
+ (define-syntax test-assert
+ (lambda (x)
+ (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
+ (((mac tname expr) line)
+ (syntax
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r (cons (cons 'test-name tname) line))
+ (%test-comp1body r expr))))
+ (((mac expr) line)
+ (syntax
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r line)
+ (%test-comp1body r expr)))))))
+ (define (%test-comp2 comp x)
+ (syntax-case (list x (list (syntax quote) (%test-source-line2 x)) comp) ()
+ (((mac tname expected expr) line comp)
+ (syntax
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r (cons (cons 'test-name tname) line))
+ (%test-comp2body r comp expected expr))))
+ (((mac expected expr) line comp)
+ (syntax
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r line)
+ (%test-comp2body r comp expected expr))))))
+ (define-syntax test-eqv
+ (lambda (x) (%test-comp2 (syntax eqv?) x)))
+ (define-syntax test-eq
+ (lambda (x) (%test-comp2 (syntax eq?) x)))
+ (define-syntax test-equal
+ (lambda (x) (%test-comp2 (syntax equal?) x)))
+ (define-syntax test-approximate ;; FIXME - needed for non-Kawa
+ (lambda (x)
+ (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
+ (((mac tname expected expr error) line)
+ (syntax
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r (cons (cons 'test-name tname) line))
+ (%test-comp2body r (%test-approximate= error) expected expr))))
+ (((mac expected expr error) line)
+ (syntax
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r line)
+ (%test-comp2body r (%test-approximate= error) expected expr))))))))
+ (else
+ (define-syntax test-end
+ (syntax-rules ()
+ ((test-end)
+ (%test-end #f '()))
+ ((test-end suite-name)
+ (%test-end suite-name '()))))
+ (define-syntax test-assert
+ (syntax-rules ()
+ ((test-assert tname test-expression)
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r '((test-name . tname)))
+ (%test-comp1body r test-expression)))
+ ((test-assert test-expression)
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r '())
+ (%test-comp1body r test-expression)))))
+ (define-syntax %test-comp2
+ (syntax-rules ()
+ ((%test-comp2 comp tname expected expr)
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r (list (cons 'test-name tname)))
+ (%test-comp2body r comp expected expr)))
+ ((%test-comp2 comp expected expr)
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r '())
+ (%test-comp2body r comp expected expr)))))
+ (define-syntax test-equal
+ (syntax-rules ()
+ ((test-equal . rest)
+ (%test-comp2 equal? . rest))))
+ (define-syntax test-eqv
+ (syntax-rules ()
+ ((test-eqv . rest)
+ (%test-comp2 eqv? . rest))))
+ (define-syntax test-eq
+ (syntax-rules ()
+ ((test-eq . rest)
+ (%test-comp2 eq? . rest))))
+ (define-syntax test-approximate
+ (syntax-rules ()
+ ((test-approximate tname expected expr error)
+ (%test-comp2 (%test-approximate= error) tname expected expr))
+ ((test-approximate expected expr error)
+ (%test-comp2 (%test-approximate= error) expected expr))))))
+
+(cond-expand
+ (guile
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (cond ((%test-on-test-begin r)
+ (let ((et etype))
+ (test-result-set! r 'expected-error et)
+ (%test-on-test-end r
+ (catch #t
+ (lambda ()
+ (test-result-set! r 'actual-value expr)
+ #f)
+ (lambda (key . args)
+ ;; TODO: decide how to specify expected
+ ;; error types for Guile.
+ (test-result-set! r 'actual-error
+ (cons key args))
+ #t)))
+ (%test-report-result))))))))
+ (mzscheme
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (%test-comp1body r (with-handlers (((lambda (h) #t) (lambda (h) #t)))
+ (let ()
+ (test-result-set! r 'actual-value
expr)
+ #f)))))))
+ (chicken
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (%test-comp1body r (condition-case expr (ex () #t)))))))
+ (kawa
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r #t expr)
+ (cond ((%test-on-test-begin r)
+ (test-result-set! r 'expected-error #t)
+ (%test-on-test-end r
+ (try-catch
+ (let ()
+ (test-result-set! r 'actual-value expr)
+ #f)
+ (ex <java.lang.Throwable>
+ (test-result-set! r 'actual-error ex)
+ #t)))
+ (%test-report-result))))
+ ((%test-error r etype expr)
+ (if (%test-on-test-begin r)
+ (let ((et etype))
+ (test-result-set! r 'expected-error et)
+ (%test-on-test-end r
+ (try-catch
+ (let ()
+ (test-result-set! r 'actual-value expr)
+ #f)
+ (ex <java.lang.Throwable>
+ (test-result-set! r 'actual-error ex)
+ (cond ((and (instance? et
<gnu.bytecode.ClassType>)
+
(gnu.bytecode.ClassType:isSubclass et <java.lang.Throwable>))
+ (instance? ex et))
+ (else #t)))))
+ (%test-report-result)))))))
+ ((and srfi-34 srfi-35)
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (%test-comp1body r (guard (ex ((condition-type? etype)
+ (and (condition? ex) (condition-has-type? ex etype)))
+ ((procedure? etype)
+ (etype ex))
+ ((equal? etype #t)
+ #t)
+ (else #t))
+ expr #f))))))
+ (srfi-34
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (%test-comp1body r (guard (ex (else #t)) expr #f))))))
+ (else
+ (define-syntax %test-error
+ (syntax-rules ()
+ ((%test-error r etype expr)
+ (begin
+ ((test-runner-on-test-begin r) r)
+ (test-result-set! r 'result-kind 'skip)
+ (%test-report-result)))))))
+
+(cond-expand
+ ((or kawa mzscheme guile-2)
+
+ (define-syntax test-error
+ (lambda (x)
+ (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
+ (((mac tname etype expr) line)
+ (syntax
+ (let* ((r (test-runner-get))
+ (name tname))
+ (test-result-alist! r (cons (cons 'test-name tname) line))
+ (%test-error r etype expr))))
+ (((mac etype expr) line)
+ (syntax
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r line)
+ (%test-error r etype expr))))
+ (((mac expr) line)
+ (syntax
+ (let* ((r (test-runner-get)))
+ (test-result-alist! r line)
+ (%test-error r #t expr))))))))
+ (else
+ (define-syntax test-error
+ (syntax-rules ()
+ ((test-error name etype expr)
+ (let ((r (test-runner-get)))
+ (test-result-alist! r `((test-name . ,name)))
+ (%test-error r etype expr)))
+ ((test-error etype expr)
+ (let ((r (test-runner-get)))
+ (test-result-alist! r '())
+ (%test-error r etype expr)))
+ ((test-error expr)
+ (let ((r (test-runner-get)))
+ (test-result-alist! r '())
+ (%test-error r #t expr)))))))
+
+(define (test-apply first . rest)
+ (if (test-runner? first)
+ (test-with-runner first (apply test-apply rest))
+ (let ((r (test-runner-current)))
+ (if r
+ (let ((run-list (%test-runner-run-list r)))
+ (cond ((null? rest)
+ (%test-runner-run-list! r (reverse run-list))
+ (first)) ;; actually apply procedure thunk
+ (else
+ (%test-runner-run-list!
+ r
+ (if (eq? run-list #t) (list first) (cons first run-list)))
+ (apply test-apply rest)
+ (%test-runner-run-list! r run-list))))
+ (let ((r (test-runner-create)))
+ (test-with-runner r (apply test-apply first rest))
+ ((test-runner-on-final r) r))))))
+
+(define-syntax test-with-runner
+ (syntax-rules ()
+ ((test-with-runner runner form ...)
+ (let ((saved-runner (test-runner-current)))
+ (dynamic-wind
+ (lambda () (test-runner-current runner))
+ (lambda () form ...)
+ (lambda () (test-runner-current saved-runner)))))))
+
+;;; Predicates
+
+(define (%test-match-nth n count)
+ (let ((i 0))
+ (lambda (runner)
+ (set! i (+ i 1))
+ (and (>= i n) (< i (+ n count))))))
+
+(define-syntax test-match-nth
+ (syntax-rules ()
+ ((test-match-nth n)
+ (test-match-nth n 1))
+ ((test-match-nth n count)
+ (%test-match-nth n count))))
+
+(define (%test-match-all . pred-list)
+ (lambda (runner)
+ (let ((result #t))
+ (let loop ((l pred-list))
+ (if (null? l)
+ result
+ (begin
+ (if (not ((car l) runner))
+ (set! result #f))
+ (loop (cdr l))))))))
+
+(define-syntax test-match-all
+ (syntax-rules ()
+ ((test-match-all pred ...)
+ (%test-match-all (%test-as-specifier pred) ...))))
+
+(define (%test-match-any . pred-list)
+ (lambda (runner)
+ (let ((result #f))
+ (let loop ((l pred-list))
+ (if (null? l)
+ result
+ (begin
+ (if ((car l) runner)
+ (set! result #t))
+ (loop (cdr l))))))))
+
+(define-syntax test-match-any
+ (syntax-rules ()
+ ((test-match-any pred ...)
+ (%test-match-any (%test-as-specifier pred) ...))))
+
+;; Coerce to a predicate function:
+(define (%test-as-specifier specifier)
+ (cond ((procedure? specifier) specifier)
+ ((integer? specifier) (test-match-nth 1 specifier))
+ ((string? specifier) (test-match-name specifier))
+ (else
+ (error "not a valid test specifier"))))
+
+(define-syntax test-skip
+ (syntax-rules ()
+ ((test-skip pred ...)
+ (let ((runner (test-runner-get)))
+ (%test-runner-skip-list! runner
+ (cons (test-match-all (%test-as-specifier
pred) ...)
+ (%test-runner-skip-list runner)))))))
+
+(define-syntax test-expect-fail
+ (syntax-rules ()
+ ((test-expect-fail pred ...)
+ (let ((runner (test-runner-get)))
+ (%test-runner-fail-list! runner
+ (cons (test-match-all (%test-as-specifier
pred) ...)
+ (%test-runner-fail-list runner)))))))
+
+(define (test-match-name name)
+ (lambda (runner)
+ (equal? name (test-runner-test-name runner))))
+
+(define (test-read-eval-string string)
+ (let* ((port (open-input-string string))
+ (form (read port)))
+ (if (eof-object? (read-char port))
+ (cond-expand
+ (guile (eval form (current-module)))
+ (else (eval form)))
+ (cond-expand
+ (srfi-23 (error "(not at eof)"))
+ (else "error")))))
+
diff --git a/module/srfi/srfi-88.scm b/module/srfi/srfi-88.scm
index b9056a4..043a4a7 100644
--- a/module/srfi/srfi-88.scm
+++ b/module/srfi/srfi-88.scm
@@ -35,7 +35,7 @@
;; Change the keyword syntax both at compile time and run time; the latter is
;; useful at the REPL.
-(eval-when (compile load)
+(eval-when (expand load eval)
(read-set! keywords 'postfix))
(define (keyword->string k)
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 01a71b8..3304eb0 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -55,7 +55,7 @@
define-wrapped-pointer-type))
-(eval-when (load eval compile)
+(eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version))
"scm_init_foreign"))
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index ec90677..4f3391c 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -1,6 +1,6 @@
;;; Repl server
-;; Copyright (C) 2003, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2010, 2011, 2014 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
@@ -67,36 +67,15 @@
(bind sock AF_UNIX path)
sock))
-(define call-with-sigint
- (if (not (provided? 'posix))
- (lambda (thunk) (thunk))
- (lambda (thunk)
- (let ((handler #f))
- (dynamic-wind
- (lambda ()
- (set! handler
- (sigaction SIGINT (lambda (sig) (throw 'interrupt)))))
- thunk
- (lambda ()
- (if handler
- ;; restore Scheme handler, SIG_IGN or SIG_DFL.
- (sigaction SIGINT (car handler) (cdr handler))
- ;; restore original C handler.
- (sigaction SIGINT #f))))))))
-
(define* (run-server #:optional (server-socket (make-tcp-server-socket)))
(define (accept-new-client)
(catch #t
- (lambda () (call-with-sigint (lambda () (accept server-socket))))
+ (lambda () (accept server-socket))
(lambda (k . args)
(cond
((port-closed? server-socket)
;; Shutting down.
#f)
- ((eq? k 'interrupt)
- ;; Interrupt.
- (close-socket! server-socket)
- #f)
(else
(warn "Error accepting client" k args)
;; Retry after a timeout.
@@ -121,12 +100,10 @@
(define (serve-client client addr)
(with-continuation-barrier
(lambda ()
- (with-input-from-port client
- (lambda ()
- (with-output-to-port client
- (lambda ()
- (with-error-to-port client
- (lambda ()
- (with-fluids ((*repl-stack* '()))
- (start-repl))))))))))
+ (parameterize ((current-input-port client)
+ (current-output-port client)
+ (current-error-port client)
+ (current-warning-port client))
+ (with-fluids ((*repl-stack* '()))
+ (start-repl)))))
(close-socket! client))
diff --git a/module/texinfo/serialize.scm b/module/texinfo/serialize.scm
index d0c6f50..f3840c4 100644
--- a/module/texinfo/serialize.scm
+++ b/module/texinfo/serialize.scm
@@ -60,7 +60,7 @@
;; Why? Well, because syntax-case defines `include', and carps about its
;; wrong usage below...
-(eval-when (eval load compile)
+(eval-when (expand load eval)
(define (include exp lp command type formals args accum)
(list* "\n"
(list-intersperse
diff --git a/module/web/http.scm b/module/web/http.scm
index d22c70c..aa75142 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -918,10 +918,10 @@ as an ordered alist."
(define (write-credentials val port)
(display (car val) port)
- (if (pair? (cdr val))
- (begin
- (display #\space port)
- (write-key-value-list (cdr val) port))))
+ (display #\space port)
+ (case (car val)
+ ((basic) (display (cdr val) port))
+ (else (write-key-value-list (cdr val) port))))
;; challenges = 1#challenge
;; challenge = auth-scheme 1*SP 1#auth-param
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 01345a4..4d08d06 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -138,12 +138,15 @@ SCM_TESTS = tests/00-initial-env.test \
tests/srfi-39.test \
tests/srfi-41.test \
tests/srfi-42.test \
+ tests/srfi-43.test \
tests/srfi-45.test \
tests/srfi-60.test \
+ tests/srfi-64.test \
tests/srfi-67.test \
tests/srfi-69.test \
tests/srfi-88.test \
tests/srfi-105.test \
+ tests/srfi-111.test \
tests/srfi-4.test \
tests/srfi-9.test \
tests/statprof.test \
@@ -177,7 +180,8 @@ EXTRA_DIST = \
guile-test \
test-suite/lib.scm \
$(SCM_TESTS) \
- tests/rnrs-test-a.scm
+ tests/rnrs-test-a.scm \
+ tests/srfi-64-test.scm \
ChangeLog-2008
diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test
index 470de45..fc4c9d8 100644
--- a/test-suite/tests/guardians.test
+++ b/test-suite/tests/guardians.test
@@ -1,7 +1,7 @@
;;;; guardians.test --- test suite for Guile Guardians -*- scheme -*-
;;;; Jim Blandy <address@hidden> --- July 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 2014 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
@@ -209,7 +209,7 @@
(gc)
(let ((p (cons #f #f)))
(g p)
- (vector-set! v 0 p)
+ (weak-vector-set! v 0 p)
(set! p #f)) ;; clear refs left on the stack
(if (not (eq? (g) #f))
(throw 'unresolved)
@@ -225,7 +225,7 @@
(gc)
(let ((p (cons #f #f)))
(g p)
- (vector-set! v 0 p)
+ (weak-vector-set! v 0 p)
(set! p #f)) ;; clear refs left on the stack
(begin
(gc)
@@ -233,7 +233,7 @@
(throw 'unresolved)
(begin
(gc)
- (or (not (vector-ref v 0))
+ (or (not (weak-vector-ref v 0))
(throw 'unresolved))))))))
(with-test-prefix "guarding weak containers"
@@ -243,11 +243,11 @@
(v (weak-vector #f)))
;; Note: We don't pass `(cons #f #f)' as an argument to `weak-vector'
;; otherwise references to it are likely to be left on the stack.
- (vector-set! v 0 (cons #f #f))
+ (weak-vector-set! v 0 (cons #f #f))
(g v)
(gc)
- (if (equal? (vector-ref v 0) (cons #f #f))
+ (if (equal? (weak-vector-ref v 0) (cons #f #f))
(throw 'unresolved)
#t))))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 3d0bba5..bad4118 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
;;;; Jim Blandy <address@hidden> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; 2011, 2012, 2013, 2014 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
@@ -1468,6 +1468,18 @@
(with-test-prefix "setvbuf"
+ (pass-if-exception "closed port"
+ exception:wrong-type-arg
+ (let ((port (open-input-file "/dev/null")))
+ (close-port port)
+ (setvbuf port _IOFBF)))
+
+ (pass-if-exception "string port"
+ exception:wrong-type-arg
+ (let ((port (open-input-string "Hey!")))
+ (close-port port)
+ (setvbuf port _IOFBF)))
+
(pass-if "line/column number preserved"
;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
;; line and/or column number.
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 4bd8a70..b0ffa76 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -23,6 +23,7 @@
#:use-module (test-suite guile-test)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (rnrs io simple)
#:use-module (rnrs exceptions)
@@ -456,6 +457,148 @@ not `set-port-position!'"
(u8-list->bytevector
(map char->integer (string->list "Port!")))))))
+ (pass-if-equal "custom binary input port buffered partial reads"
+ "Hello Port!"
+ ;; Check what happens when READ! returns less than COUNT bytes.
+ (let* ((src (string->utf8 "Hello Port!"))
+ (chunks '(2 4 5)) ; provide 2 bytes, then 4, etc.
+ (offset 0)
+ (read! (lambda (bv start count)
+ (match chunks
+ ((count rest ...)
+ (bytevector-copy! src offset bv start count)
+ (set! chunks rest)
+ (set! offset (+ offset count))
+ count)
+ (()
+ 0))))
+ (port (make-custom-binary-input-port "the port"
+ read! #f #f #f)))
+ (get-string-all port)))
+
+ (pass-if-equal "custom binary input port unbuffered & 'port-position'"
+ '(0 2 5 11)
+ ;; Check that the value returned by 'port-position' is correct, and
+ ;; that each 'port-position' call leads one call to the
+ ;; 'get-position' method.
+ (let* ((str "Hello Port!")
+ (output (make-bytevector (string-length str)))
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (read! (lambda (bv start count)
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (pos '())
+ (get-pos (lambda ()
+ (let ((p (port-position source)))
+ (set! pos (cons p pos))
+ p)))
+ (port (make-custom-binary-input-port "the port" read!
+ get-pos #f #f)))
+ (setvbuf port _IONBF)
+ (and (= 0 (port-position port))
+ (begin
+ (get-bytevector-n! port output 0 2)
+ (= 2 (port-position port)))
+ (begin
+ (get-bytevector-n! port output 2 3)
+ (= 5 (port-position port)))
+ (let ((bv (string->utf8 (get-string-all port))))
+ (bytevector-copy! bv 0 output 5 (bytevector-length bv))
+ (= (string-length str) (port-position port)))
+ (bytevector=? output (string->utf8 str))
+ (reverse pos))))
+
+ (pass-if-equal "custom binary input port unbuffered & 'read!' calls"
+ `((2 "He") (3 "llo") (42 " Port!"))
+ (let* ((str "Hello Port!")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 2)
+ (get-bytevector-n port 3)
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, unbuffered then buffered"
+ `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consecteturâ¦")
+ (777 ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consecteturâ¦")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IOFBF 777)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, buffered then unbuffered"
+ `((18
+ 42 14 ; scm_c_read tries to fill the 42-byte buffer
+ 42)
+ ("Lorem " "ipsum dolor " "sit amet, consectetur blaâ¦" ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consectetur blaâ¦")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IOFBF 18)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IONBF)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (list (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
(pass-if "custom binary input port `close-proc' is called"
(let* ((closed? #f)
(read! (lambda (bv start count) 0))
diff --git a/test-suite/tests/srfi-111.test b/test-suite/tests/srfi-111.test
new file mode 100644
index 0000000..e2d76c6
--- /dev/null
+++ b/test-suite/tests/srfi-111.test
@@ -0,0 +1,65 @@
+;;;; srfi-111.test --- Test suite for SRFI-111 (Boxes). -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+(define-module (test-srfi-111)
+ #:use-module (test-suite lib)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-111))
+
+(with-test-prefix "srfi-111"
+
+ (let ((test-vals '(#f #t #\space "string" -5 #e1e100 1e-30 #(a vector))))
+ (pass-if-equal "box and unbox"
+ test-vals
+ (map (lambda (x)
+ (unbox (box x)))
+ test-vals))
+
+ (pass-if "box?"
+ (and (box? (box 5))
+ (not (any box? test-vals))))
+
+ (pass-if-equal "set-box!"
+ "string"
+ (let ((b (box #f)))
+ (set-box! b "string")
+ (unbox b)))
+
+ (pass-if "eq? on boxes"
+ (let ((box1 (box #f))
+ (box2 (box #f)))
+ (and (eq? box1 box1)
+ (eq? box2 box2)
+ (not (eq? box1 box2)))))
+
+ (pass-if "eqv? on boxes"
+ (let ((box1 (box #f))
+ (box2 (box #f)))
+ (and (eqv? box1 box1)
+ (eqv? box2 box2)
+ (not (eqv? box1 box2)))))
+
+ (pass-if "equal? on boxes"
+ (let ((box1 (box "foo"))
+ (box2 (box "bar")))
+ (and (equal? box1 box1)
+ (equal? box2 box2)
+ (not (equal? box1 box2))
+ ;; Guile extension, not guaranteed by SRFI-111.
+ (begin (set-box! box2 (string #\f #\o #\o))
+ (equal? box1 box2)))))))
diff --git a/test-suite/tests/srfi-43.test b/test-suite/tests/srfi-43.test
new file mode 100644
index 0000000..554843e
--- /dev/null
+++ b/test-suite/tests/srfi-43.test
@@ -0,0 +1,1375 @@
+;;;; srfi-43.test --- test suite for SRFI-43 Vector library -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+;;;
+;;; Originally written by Shiro Kawai and placed in the public domain
+;;; 10/5/2005.
+;;;
+;;; Many tests added, and adapted for Guile's (test-suite lib)
+;;; by Mark H Weaver <address@hidden>, Jan 2014.
+;;;
+
+(define-module (test-suite test-srfi-43)
+ #:use-module (srfi srfi-43)
+ #:use-module (test-suite lib))
+
+(define-syntax-rule (pass-if-error name body0 body ...)
+ (pass-if name
+ (catch #t
+ (lambda () body0 body ... #f)
+ (lambda (key . args) #t))))
+
+;;;
+;;; Constructors
+;;;
+
+;;
+;; make-vector
+;;
+
+(with-test-prefix "make-vector"
+
+ (pass-if-equal "simple, no init"
+ 5
+ (vector-length (make-vector 5)))
+
+ (pass-if-equal "empty"
+ '#()
+ (make-vector 0))
+
+ (pass-if-error "negative length"
+ (make-vector -4))
+
+ (pass-if-equal "simple with init"
+ '#(3 3 3 3 3)
+ (make-vector 5 3))
+
+ (pass-if-equal "empty with init"
+ '#()
+ (make-vector 0 3))
+
+ (pass-if-error "negative length"
+ (make-vector -1 3)))
+
+;;
+;; vector
+;;
+
+(with-test-prefix "vector"
+
+ (pass-if-equal "no args"
+ '#()
+ (vector))
+
+ (pass-if-equal "simple"
+ '#(1 2 3 4 5)
+ (vector 1 2 3 4 5)))
+
+;;
+;; vector-unfold
+;;
+
+(with-test-prefix "vector-unfold"
+
+ (pass-if-equal "no seeds"
+ '#(0 1 2 3 4 5 6 7 8 9)
+ (vector-unfold values 10))
+
+ (pass-if-equal "no seeds, zero len"
+ '#()
+ (vector-unfold values 0))
+
+ (pass-if-error "no seeds, negative len"
+ (vector-unfold values -1))
+
+ (pass-if-equal "1 seed"
+ '#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)
+ (vector-unfold (lambda (i x) (values x (- x 1)))
+ 10 0))
+
+ (pass-if-equal "1 seed, zero len"
+ '#()
+ (vector-unfold values 0 1))
+
+ (pass-if-error "1 seed, negative len"
+ (vector-unfold values -2 1))
+
+ (pass-if-equal "2 seeds"
+ '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24)
+ (-5 25) (-6 26) (-7 27) (-8 28) (-9 29))
+ (vector-unfold (lambda (i x y) (values (list x y) (- x 1) (+ y 1)))
+ 10 0 20))
+
+ (pass-if-equal "2 seeds, zero len"
+ '#()
+ (vector-unfold values 0 1 2))
+
+ (pass-if-error "2 seeds, negative len"
+ (vector-unfold values -2 1 2))
+
+ (pass-if-equal "3 seeds"
+ '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38)
+ (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48))
+ (vector-unfold (lambda (i x y z)
+ (values (list x y z) (- x 1) (+ y 1) (+ z 2)))
+ 10 0 20 30))
+
+ (pass-if-equal "3 seeds, zero len"
+ '#()
+ (vector-unfold values 0 1 2 3))
+
+ (pass-if-error "3 seeds, negative len"
+ (vector-unfold values -2 1 2 3)))
+
+;;
+;; vector-unfold-right
+;;
+
+(with-test-prefix "vector-unfold-right"
+
+ (pass-if-equal "no seeds, zero len"
+ '#()
+ (vector-unfold-right values 0))
+
+ (pass-if-error "no seeds, negative len"
+ (vector-unfold-right values -1))
+
+ (pass-if-equal "1 seed"
+ '#(9 8 7 6 5 4 3 2 1 0)
+ (vector-unfold-right (lambda (i x) (values x (+ x 1))) 10 0))
+
+ (pass-if-equal "1 seed, zero len"
+ '#()
+ (vector-unfold-right values 0 1))
+
+ (pass-if-error "1 seed, negative len"
+ (vector-unfold-right values -1 1))
+
+ (pass-if-equal "1 seed, reverse vector"
+ '#(e d c b a)
+ (let ((vector '#(a b c d e)))
+ (vector-unfold-right
+ (lambda (i x) (values (vector-ref vector x) (+ x 1)))
+ (vector-length vector)
+ 0)))
+
+ (pass-if-equal "2 seeds"
+ '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24)
+ (-5 25) (-6 26) (-7 27) (-8 28) (-9 29))
+ (vector-unfold-right (lambda (i x y) (values (list x y) (+ x 1) (- y 1)))
+ 10 -9 29))
+
+ (pass-if-equal "2 seeds, zero len"
+ '#()
+ (vector-unfold-right values 0 1 2))
+
+ (pass-if-error "2 seeds, negative len"
+ (vector-unfold-right values -1 1 2))
+
+ (pass-if-equal "3 seeds"
+ '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38)
+ (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48))
+ (vector-unfold-right (lambda (i x y z)
+ (values (list x y z) (+ x 1) (- y 1) (- z 2)))
+ 10 -9 29 48))
+
+ (pass-if-equal "3 seeds, zero len"
+ '#()
+ (vector-unfold-right values 0 1 2 3))
+
+ (pass-if-error "3 seeds, negative len"
+ (vector-unfold-right values -1 1 2 3)))
+
+;;
+;; vector-copy
+;;
+
+(with-test-prefix "vector-copy"
+
+ (pass-if-equal "1 arg"
+ '#(a b c d e f g h i)
+ (vector-copy '#(a b c d e f g h i)))
+
+ (pass-if-equal "2 args"
+ '#(g h i)
+ (vector-copy '#(a b c d e f g h i) 6))
+
+ (pass-if-equal "3 args"
+ '#(d e f)
+ (vector-copy '#(a b c d e f g h i) 3 6))
+
+ (pass-if-equal "4 args"
+ '#(g h i x x x)
+ (vector-copy '#(a b c d e f g h i) 6 12 'x))
+
+ (pass-if-equal "3 args, empty range"
+ '#()
+ (vector-copy '#(a b c d e f g h i) 6 6))
+
+ (pass-if-error "3 args, invalid range"
+ (vector-copy '#(a b c d e f g h i) 4 2)))
+
+;;
+;; vector-reverse-copy
+;;
+
+(with-test-prefix "vector-reverse-copy"
+
+ (pass-if-equal "1 arg"
+ '#(e d c b a)
+ (vector-reverse-copy '#(a b c d e)))
+
+ (pass-if-equal "2 args"
+ '#(e d c)
+ (vector-reverse-copy '#(a b c d e) 2))
+
+ (pass-if-equal "3 args"
+ '#(d c b)
+ (vector-reverse-copy '#(a b c d e) 1 4))
+
+ (pass-if-equal "3 args, empty result"
+ '#()
+ (vector-reverse-copy '#(a b c d e) 1 1))
+
+ (pass-if-error "2 args, invalid range"
+ (vector-reverse-copy '#(a b c d e) 2 1)))
+
+;;
+;; vector-append
+;;
+
+(with-test-prefix "vector-append"
+
+ (pass-if-equal "no args"
+ '#()
+ (vector-append))
+
+ (pass-if-equal "1 arg"
+ '(#(1 2) #f)
+ (let* ((v (vector 1 2))
+ (v-copy (vector-append v)))
+ (list v-copy (eq? v v-copy))))
+
+ (pass-if-equal "2 args"
+ '#(x y)
+ (vector-append '#(x) '#(y)))
+
+ (pass-if-equal "3 args"
+ '#(x y x y x y)
+ (let ((v '#(x y)))
+ (vector-append v v v)))
+
+ (pass-if-equal "3 args with empty vector"
+ '#(x y)
+ (vector-append '#(x) '#() '#(y)))
+
+ (pass-if-error "3 args with non-vectors"
+ (vector-append '#() 'b 'c)))
+
+;;
+;; vector-concatenate
+;;
+
+(with-test-prefix "vector-concatenate"
+
+ (pass-if-equal "2 vectors"
+ '#(a b c d)
+ (vector-concatenate '(#(a b) #(c d))))
+
+ (pass-if-equal "no vectors"
+ '#()
+ (vector-concatenate '()))
+
+ (pass-if-error "non-vector in list"
+ (vector-concatenate '(#(a b) c))))
+
+;;;
+;;; Predicates
+;;;
+
+;;
+;; vector?
+;;
+
+(with-test-prefix "vector?"
+ (pass-if "empty vector" (vector? '#()))
+ (pass-if "simple" (vector? '#(a b)))
+ (pass-if "list" (not (vector? '(a b))))
+ (pass-if "symbol" (not (vector? 'a))))
+
+;;
+;; vector-empty?
+;;
+
+(with-test-prefix "vector-empty?"
+ (pass-if "empty vector" (vector-empty? '#()))
+ (pass-if "singleton vector" (not (vector-empty? '#(a))))
+ (pass-if-error "non-vector" (vector-empty 'a)))
+
+;;
+;; vector=
+;;
+
+(with-test-prefix "vector="
+
+ (pass-if "2 equal vectors"
+ (vector= eq? '#(a b c d) '#(a b c d)))
+
+ (pass-if "3 equal vectors"
+ (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d)))
+
+ (pass-if "2 empty vectors"
+ (vector= eq? '#() '#()))
+
+ (pass-if "no vectors"
+ (vector= eq?))
+
+ (pass-if "1 vector"
+ (vector= eq? '#(a)))
+
+ (pass-if "2 unequal vectors of equal length"
+ (not (vector= eq? '#(a b c d) '#(a b d c))))
+
+ (pass-if "3 unequal vectors of equal length"
+ (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b d c))))
+
+ (pass-if "2 vectors of unequal length"
+ (not (vector= eq? '#(a b c) '#(a b c d))))
+
+ (pass-if "3 vectors of unequal length"
+ (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b c))))
+
+ (pass-if "2 vectors: empty, non-empty"
+ (not (vector= eq? '#() '#(a b d c))))
+
+ (pass-if "2 vectors: non-empty, empty"
+ (not (vector= eq? '#(a b d c) '#())))
+
+ (pass-if "2 equal vectors, elt= is equal?"
+ (vector= equal? '#("a" "b" "c") '#("a" "b" "c")))
+
+ (pass-if "2 equal vectors, elt= is ="
+ (vector= = '#(1/2 1/3 1/4 1/5) '#(1/2 1/3 1/4 1/5)))
+
+ (pass-if-error "vector and list"
+ (vector= equal? '#("a" "b" "c") '("a" "b" "c")))
+
+ (pass-if-error "non-procedure"
+ (vector= 1 '#("a" "b" "c") '("a" "b" "c"))))
+
+;;;
+;;; Selectors
+;;;
+
+;;
+;; vector-ref
+;;
+
+(with-test-prefix "vector-ref"
+ (pass-if-equal "simple 0" 'a (vector-ref '#(a b c) 0))
+ (pass-if-equal "simple 1" 'b (vector-ref '#(a b c) 1))
+ (pass-if-equal "simple 2" 'c (vector-ref '#(a b c) 2))
+ (pass-if-error "negative index" (vector-ref '#(a b c) -1))
+ (pass-if-error "index beyond end" (vector-ref '#(a b c) 3))
+ (pass-if-error "empty vector" (vector-ref '#() 0))
+ (pass-if-error "non-vector" (vector-ref '(a b c) 0))
+ (pass-if-error "inexact index" (vector-ref '#(a b c) 1.0)))
+
+;;
+;; vector-length
+;;
+
+(with-test-prefix "vector-length"
+ (pass-if-equal "empty vector" 0 (vector-length '#()))
+ (pass-if-equal "simple" 3 (vector-length '#(a b c)))
+ (pass-if-error "non-vector" (vector-length '(a b c))))
+
+;;;
+;;; Iteration
+;;;
+
+;;
+;; vector-fold
+;;
+
+(with-test-prefix "vector-fold"
+
+ (pass-if-equal "1 vector"
+ 10
+ (vector-fold (lambda (i seed val) (+ seed val))
+ 0
+ '#(0 1 2 3 4)))
+
+ (pass-if-equal "1 empty vector"
+ 'a
+ (vector-fold (lambda (i seed val) (+ seed val))
+ 'a
+ '#()))
+
+ (pass-if-equal "1 vector, use index"
+ 30
+ (vector-fold (lambda (i seed val) (+ seed (* i val)))
+ 0
+ '#(0 1 2 3 4)))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ '(1 -7 1 -1)
+ (vector-fold (lambda (i seed x y) (cons (- x y) seed))
+ '()
+ '#(6 1 2 3 4) '#(7 0 9 2)))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ '(51 33 31 19)
+ (vector-fold (lambda (i seed x y z) (cons (- x y z) seed))
+ '()
+ '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70)))
+
+ (pass-if-error "5 args, non-vector"
+ (vector-fold (lambda (i seed x y z) (cons (- x y z) seed))
+ '()
+ '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70)))
+
+ (pass-if-error "non-procedure"
+ (vector-fold 1 '() '#(6 1 2 3 4) '#(7 0 9 2))))
+
+;;
+;; vector-fold-right
+;;
+
+(with-test-prefix "vector-fold-right"
+
+ (pass-if-equal "1 vector"
+ '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e))
+ (vector-fold-right (lambda (i seed val) (cons (cons i val) seed))
+ '()
+ '#(a b c d e)))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ '(-1 1 -7 1)
+ (vector-fold-right (lambda (i seed x y) (cons (- x y) seed))
+ '()
+ '#(6 1 2 3 7) '#(7 0 9 2)))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ '(19 31 33 51)
+ (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed))
+ '()
+ '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70)))
+
+ (pass-if-error "5 args, non-vector"
+ (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed))
+ '()
+ '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70)))
+
+ (pass-if-error "non-procedure"
+ (vector-fold-right 1 '() '#(6 1 2 3 4) '#(7 0 9 2))))
+
+;;
+;; vector-map
+;;
+
+(with-test-prefix "vector-map"
+
+ (pass-if-equal "1 vector"
+ '#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e))
+ (vector-map cons '#(a b c d e)))
+
+ (pass-if-equal "1 empty vector"
+ '#()
+ (vector-map cons '#()))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ '#(5 8 11 14)
+ (vector-map + '#(0 1 2 3 4) '#(5 6 7 8)))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ '#(15 28 41 54)
+ (vector-map + '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60)))
+
+ (pass-if-error "4 args, non-vector"
+ (vector-map + '#(0 1 2 3 4) '(5 6 7 8) '#(10 20 30 40 50 60)))
+
+ (pass-if-error "3 args, non-vector"
+ (vector-map + '#(0 1 2 3 4) '(5 6 7 8)))
+
+ (pass-if-error "non-procedure"
+ (vector-map #f '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60))))
+
+;;
+;; vector-map!
+;;
+
+(with-test-prefix "vector-map!"
+
+ (pass-if-equal "1 vector"
+ '#(0 1 4 9 16)
+ (let ((v (vector 0 1 2 3 4)))
+ (vector-map! * v)
+ v))
+
+ (pass-if-equal "1 empty vector"
+ '#()
+ (let ((v (vector)))
+ (vector-map! * v)
+ v))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ '#(5 8 11 14 4)
+ (let ((v (vector 0 1 2 3 4)))
+ (vector-map! + v '#(5 6 7 8))
+ v))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ '#(15 28 41 54 4)
+ (let ((v (vector 0 1 2 3 4)))
+ (vector-map! + v '#(5 6 7 8) '#(10 20 30 40 50 60))
+ v))
+
+ (pass-if-error "non-vector"
+ (let ((v (vector 0 1 2 3 4)))
+ (vector-map! + v '#(5 6 7 8) '(10 20 30 40 50 60))
+ v))
+
+ (pass-if-error "non-procedure"
+ (let ((v (vector 0 1 2 3 4)))
+ (vector-map! '(1 . 2) v '#(5 6 7 8) '#(10 20 30 40 50 60))
+ v)))
+
+;;
+;; vector-for-each
+;;
+
+(with-test-prefix "vector-for-each"
+
+ (pass-if-equal "1 vector"
+ '(4 6 6 4 0)
+ (let ((lst '()))
+ (vector-for-each (lambda (i x)
+ (set! lst (cons (* i x) lst)))
+ '#(5 4 3 2 1))
+ lst))
+
+ (pass-if-equal "1 empty vector"
+ '()
+ (let ((lst '()))
+ (vector-for-each (lambda (i x)
+ (set! lst (cons (* i x) lst)))
+ '#())
+ lst))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ '(13 11 7 2)
+ (let ((lst '()))
+ (vector-for-each (lambda (i x y)
+ (set! lst (cons (+ (* i x) y) lst)))
+ '#(5 4 3 2 1)
+ '#(2 3 5 7))
+ lst))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ '(-6 -6 -6 -9)
+ (let ((lst '()))
+ (vector-for-each (lambda (i x y z)
+ (set! lst (cons (+ (* i x) (- y z)) lst)))
+ '#(5 4 3 2 1)
+ '#(2 3 5 7)
+ '#(11 13 17 19 23 29))
+ lst))
+
+ (pass-if-error "non-vector"
+ (let ((lst '()))
+ (vector-for-each (lambda (i x y z)
+ (set! lst (cons (+ (* i x) (- y z)) lst)))
+ '#(5 4 3 2 1)
+ '(2 3 5 7)
+ '#(11 13 17 19 23 29))
+ lst))
+
+ (pass-if-error "non-procedure"
+ (let ((lst '()))
+ (vector-for-each '#(not a procedure)
+ '#(5 4 3 2 1)
+ '#(2 3 5 7)
+ '#(11 13 17 19 23 29))
+ lst)))
+
+;;
+;; vector-count
+;;
+
+(with-test-prefix "vector-count"
+
+ (pass-if-equal "1 vector"
+ 3
+ (vector-count (lambda (i x) (even? (+ i x))) '#(2 3 5 7 11)))
+
+ (pass-if-equal "1 empty vector"
+ 0
+ (vector-count values '#()))
+
+ (pass-if-equal "2 vectors, unequal lengths"
+ 3
+ (vector-count (lambda (i x y) (< x (* i y)))
+ '#(8 2 7 8 9 1 0)
+ '#(7 6 4 3 1)))
+
+ (pass-if-equal "3 vectors, unequal lengths"
+ 2
+ (vector-count (lambda (i x y z) (<= x (- y i) z))
+ '#(3 6 3 0 2 4 1)
+ '#(8 7 4 4 9)
+ '#(7 6 8 3 1 7 9)))
+
+ (pass-if-error "non-vector"
+ (vector-count (lambda (i x y z) (<= x (- y i) z))
+ '#(3 6 3 0 2 4 1)
+ '#(8 7 4 4 9)
+ '(7 6 8 3 1 7 9)))
+
+ (pass-if-error "non-procedure"
+ (vector-count '(1 2)
+ '#(3 6 3 0 2 4 1)
+ '#(8 7 4 4 9)
+ '#(7 6 8 3 1 7 9))))
+
+;;;
+;;; Searching
+;;;
+
+;;
+;; vector-index
+;;
+
+(with-test-prefix "vector-index"
+
+ (pass-if-equal "1 vector"
+ 2
+ (vector-index even? '#(3 1 4 1 6 9)))
+
+ (pass-if-equal "2 vectors, unequal lengths, success"
+ 1
+ (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-equal "2 vectors, unequal lengths, failure"
+ #f
+ (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "non-procedure"
+ (vector-index 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "3 args, non-vector"
+ (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
+
+ (pass-if-error "4 args, non-vector"
+ (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3)))
+
+ (pass-if-equal "3 vectors, unequal lengths, success"
+ 1
+ (vector-index <
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 6 1 7 2)
+ '#(2 7 1 8)))
+
+ (pass-if-equal "3 vectors, unequal lengths, failure"
+ #f
+ (vector-index <
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 7 1 7 2)
+ '#(2 7 1 7)))
+
+ (pass-if-equal "empty vector"
+ #f
+ (vector-index < '#() '#(2 7 1 8 2))))
+
+;;
+;; vector-index-right
+;;
+
+(with-test-prefix "vector-index-right"
+
+ (pass-if-equal "1 vector"
+ 4
+ (vector-index-right even? '#(3 1 4 1 6 9)))
+
+ (pass-if-equal "2 vectors, unequal lengths, success"
+ 3
+ (vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-equal "2 vectors, unequal lengths, failure"
+ #f
+ (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "non-procedure"
+ (vector-index-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "3 args, non-vector"
+ (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
+
+ (pass-if-error "4 args, non-vector"
+ (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3)))
+
+ (pass-if-equal "3 vectors, unequal lengths, success"
+ 3
+ (vector-index-right <
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 6 1 7 2)
+ '#(2 7 1 8)))
+
+ (pass-if-equal "3 vectors, unequal lengths, failure"
+ #f
+ (vector-index-right <
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 7 1 7 2)
+ '#(2 7 1 7)))
+
+ (pass-if-equal "empty vector"
+ #f
+ (vector-index-right < '#() '#(2 7 1 8 2))))
+
+;;
+;; vector-skip
+;;
+
+(with-test-prefix "vector-skip"
+
+ (pass-if-equal "1 vector"
+ 2
+ (vector-skip odd? '#(3 1 4 1 6 9)))
+
+ (pass-if-equal "2 vectors, unequal lengths, success"
+ 1
+ (vector-skip >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-equal "2 vectors, unequal lengths, failure"
+ #f
+ (vector-skip (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "non-procedure"
+ (vector-skip 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "3 args, non-vector"
+ (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
+
+ (pass-if-error "4 args, non-vector"
+ (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3)))
+
+ (pass-if-equal "3 vectors, unequal lengths, success"
+ 1
+ (vector-skip (negate <)
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 6 1 7 2)
+ '#(2 7 1 8)))
+
+ (pass-if-equal "3 vectors, unequal lengths, failure"
+ #f
+ (vector-skip (negate <)
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 7 1 7 2)
+ '#(2 7 1 7)))
+
+ (pass-if-equal "empty vector"
+ #f
+ (vector-skip (negate <) '#() '#(2 7 1 8 2))))
+
+;;
+;; vector-skip-right
+;;
+
+(with-test-prefix "vector-skip-right"
+
+ (pass-if-equal "1 vector"
+ 4
+ (vector-skip-right odd? '#(3 1 4 1 6 9)))
+
+ (pass-if-equal "2 vectors, unequal lengths, success"
+ 3
+ (vector-skip-right >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-equal "2 vectors, unequal lengths, failure"
+ #f
+ (vector-skip-right (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "non-procedure"
+ (vector-skip-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
+
+ (pass-if-error "3 args, non-vector"
+ (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
+
+ (pass-if-error "4 args, non-vector"
+ (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3)))
+
+ (pass-if-equal "3 vectors, unequal lengths, success"
+ 3
+ (vector-skip-right (negate <)
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 6 1 7 2)
+ '#(2 7 1 8)))
+
+ (pass-if-equal "3 vectors, unequal lengths, failure"
+ #f
+ (vector-skip-right (negate <)
+ '#(3 1 4 1 5 9 2 5 6)
+ '#(2 7 1 7 2)
+ '#(2 7 1 7)))
+
+ (pass-if-equal "empty vector"
+ #f
+ (vector-skip-right (negate <) '#() '#(2 7 1 8 2))))
+
+;;
+;; vector-binary-search
+;;
+
+(with-test-prefix "vector-binary-search"
+
+ (define (char-cmp c1 c2)
+ (cond ((char<? c1 c2) -1)
+ ((char=? c1 c2) 0)
+ (else 1)))
+
+ (pass-if-equal "success"
+ 6
+ (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
+ #\g
+ char-cmp))
+
+ (pass-if-equal "failure"
+ #f
+ (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g)
+ #\q
+ char-cmp))
+
+ (pass-if-equal "singleton vector, success"
+ 0
+ (vector-binary-search '#(#\a)
+ #\a
+ char-cmp))
+
+ (pass-if-equal "empty vector"
+ #f
+ (vector-binary-search '#()
+ #\a
+ char-cmp))
+
+ (pass-if-error "first element"
+ (vector-binary-search '(#\a #\b #\c)
+ #\a
+ char-cmp))
+
+ (pass-if-equal "specify range, success"
+ 3
+ (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
+ #\d
+ char-cmp
+ 2 6))
+
+ (pass-if-equal "specify range, failure"
+ #f
+ (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
+ #\g
+ char-cmp
+ 2 6)))
+
+;;
+;; vector-any
+;;
+
+(with-test-prefix "vector-any"
+
+ (pass-if-equal "1 vector, success"
+ #t
+ (vector-any even? '#(3 1 4 1 5 9 2)))
+
+ (pass-if-equal "1 vector, failure"
+ #f
+ (vector-any even? '#(3 1 5 1 5 9 1)))
+
+ (pass-if-equal "1 vector, left-to-right"
+ #t
+ (vector-any even? '#(3 1 4 1 5 #f 2)))
+
+ (pass-if-equal "1 vector, left-to-right"
+ 4
+ (vector-any (lambda (x) (and (even? x) x))
+ '#(3 1 4 1 5 #f 2)))
+
+ (pass-if-equal "1 empty vector"
+ #f
+ (vector-any even? '#()))
+
+ (pass-if-equal "2 vectors, unequal lengths, success"
+ '(1 2)
+ (vector-any (lambda (x y) (and (< x y) (list x y)))
+ '#(3 1 4 1 5 #f)
+ '#(1 0 1 2 3)))
+
+ (pass-if-equal "2 vectors, unequal lengths, failure"
+ #f
+ (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3)))
+
+ (pass-if-equal "3 vectors, unequal lengths, success"
+ '(1 2 3)
+ (vector-any (lambda (x y z) (and (< x y z) (list x y z)))
+ '#(3 1 4 1 3 #f)
+ '#(1 0 1 2 4)
+ '#(2 1 6 3 5)))
+
+ (pass-if-equal "3 vectors, unequal lengths, failure"
+ #f
+ (vector-any <
+ '#(3 1 4 1 5 #f)
+ '#(1 0 3 2)
+ '#(2 1 6 2 3))))
+
+;;
+;; vector-every
+;;
+
+(with-test-prefix "vector-every"
+
+ (pass-if-equal "1 vector, failure"
+ #f
+ (vector-every odd? '#(3 1 4 1 5 9 2)))
+
+ (pass-if-equal "1 vector, success"
+ 11
+ (vector-every (lambda (x) (and (odd? x) x))
+ '#(3 5 7 1 5 9 11)))
+
+ (pass-if-equal "1 vector, left-to-right, failure"
+ #f
+ (vector-every odd? '#(3 1 4 1 5 #f 2)))
+
+ (pass-if-equal "1 empty vector"
+ #t
+ (vector-every even? '#()))
+
+ (pass-if-equal "2 vectors, unequal lengths, left-to-right, failure"
+ #f
+ (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f)))
+
+ (pass-if-equal "2 vectors, unequal lengths, left-to-right, success"
+ '(5 3)
+ (vector-every (lambda (x y) (and (>= x y) (list x y)))
+ '#(3 1 4 1 5)
+ '#(1 0 1 0 3 #f)))
+
+ (pass-if-equal "3 vectors, unequal lengths, left-to-right, failure"
+ #f
+ (vector-every >=
+ '#(3 1 4 1 5)
+ '#(1 0 1 2 3 #f)
+ '#(0 0 1 2)))
+
+ (pass-if-equal "3 vectors, unequal lengths, left-to-right, success"
+ '(8 5 4)
+ (vector-every (lambda (x y z) (and (>= x y z) (list x y z)))
+ '#(3 5 4 8 5)
+ '#(2 3 4 5 3 #f)
+ '#(1 2 3 4))))
+
+;;;
+;;; Mutators
+;;;
+
+;;
+;; vector-set!
+;;
+
+(with-test-prefix "vector-set!"
+
+ (pass-if-equal "simple"
+ '#(0 a 2)
+ (let ((v (vector 0 1 2)))
+ (vector-set! v 1 'a)
+ v))
+
+ (pass-if-error "index beyond end" (vector-set! (vector 0 1 2) 3 'a))
+ (pass-if-error "negative index" (vector-set! (vector 0 1 2) -1 'a))
+ (pass-if-error "empty vector" (vector-set! (vector) 0 'a)))
+
+;;
+;; vector-swap!
+;;
+
+(with-test-prefix "vector-swap!"
+
+ (pass-if-equal "simple"
+ '#(b a c)
+ (let ((v (vector 'a 'b 'c)))
+ (vector-swap! v 0 1)
+ v))
+
+ (pass-if-equal "same index"
+ '#(a b c)
+ (let ((v (vector 'a 'b 'c)))
+ (vector-swap! v 1 1)
+ v))
+
+ (pass-if-error "index beyond end" (vector-swap! (vector 'a 'b 'c) 0 3))
+ (pass-if-error "negative index" (vector-swap! (vector 'a 'b 'c) -1 1))
+ (pass-if-error "empty vector" (vector-swap! (vector) 0 0)))
+
+;;
+;; vector-fill!
+;;
+
+(with-test-prefix "vector-fill!"
+
+ (pass-if-equal "2 args"
+ '#(z z z z z)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-fill! v 'z)
+ v))
+
+ (pass-if-equal "3 args"
+ '#(a b z z z)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-fill! v 'z 2)
+ v))
+
+ (pass-if-equal "4 args"
+ '#(a z z d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-fill! v 'z 1 3)
+ v))
+
+ (pass-if-equal "4 args, entire vector"
+ '#(z z z z z)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-fill! v 'z 0 5)
+ v))
+
+ (pass-if-equal "4 args, empty range"
+ '#(a b c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-fill! v 'z 2 2)
+ v))
+
+ (pass-if-error "index beyond end" (vector-fill! (vector 'a 'b 'c) 'z 0 4))
+ (pass-if-error "invalid range" (vector-fill! (vector 'a 'b 'c) 'z 2 1))
+ (pass-if-error "negative index" (vector-fill! (vector 'a 'b 'c) 'z -1 1))
+
+ ;; This is intentionally allowed in Guile, as an extension:
+ ;;(pass-if-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0))
+ )
+
+;;
+;; vector-reverse!
+;;
+
+(with-test-prefix "vector-reverse!"
+
+ (pass-if-equal "1 arg"
+ '#(e d c b a)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse! v)
+ v))
+
+ (pass-if-equal "2 args"
+ '#(a b f e d c)
+ (let ((v (vector 'a 'b 'c 'd 'e 'f)))
+ (vector-reverse! v 2)
+ v))
+
+ (pass-if-equal "3 args"
+ '#(a d c b e f)
+ (let ((v (vector 'a 'b 'c 'd 'e 'f)))
+ (vector-reverse! v 1 4)
+ v))
+
+ (pass-if-equal "3 args, empty range"
+ '#(a b c d e f)
+ (let ((v (vector 'a 'b 'c 'd 'e 'f)))
+ (vector-reverse! v 3 3)
+ v))
+
+ (pass-if-equal "3 args, singleton range"
+ '#(a b c d e f)
+ (let ((v (vector 'a 'b 'c 'd 'e 'f)))
+ (vector-reverse! v 3 4)
+ v))
+
+ (pass-if-equal "empty vector"
+ '#()
+ (let ((v (vector)))
+ (vector-reverse! v)
+ v))
+
+ (pass-if-error "index beyond end" (vector-reverse! (vector 'a 'b) 0 3))
+ (pass-if-error "invalid range" (vector-reverse! (vector 'a 'b) 2 1))
+ (pass-if-error "negative index" (vector-reverse! (vector 'a 'b) -1 1))
+
+ ;; This is intentionally allowed in Guile, as an extension:
+ ;;(pass-if-error "vector-reverse! e3" (vector-reverse! (vector) 0 0))
+ )
+
+;;
+;; vector-copy!
+;;
+
+(with-test-prefix "vector-copy!"
+
+ (pass-if-equal "3 args, 0 tstart"
+ '#(1 2 3 d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 0 '#(1 2 3))
+ v))
+
+ (pass-if-equal "3 args, 2 tstart"
+ '#(a b 1 2 3)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 2 '#(1 2 3))
+ v))
+
+ (pass-if-equal "4 args"
+ '#(a b 2 3 e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 2 '#(1 2 3) 1)
+ v))
+
+ (pass-if-equal "5 args"
+ '#(a b 3 4 5)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 2 '#(1 2 3 4 5) 2 5)
+ v))
+
+ (pass-if-equal "5 args, empty range"
+ '#(a b c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 2 '#(1 2 3) 1 1)
+ v))
+
+ (pass-if-equal "overlapping source/target, moving right"
+ '#(b c c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 0 v 1 3)
+ v))
+
+ (pass-if-equal "overlapping source/target, moving left"
+ '#(a b b c d)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 2 v 1 4)
+ v))
+
+ (pass-if-equal "overlapping source/target, not moving"
+ '#(a b c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-copy! v 0 v 0)
+ v))
+
+ (pass-if-error "tstart beyond end"
+ (vector-copy! (vector 1 2) 3 '#(1 2 3)))
+ (pass-if-error "would overwrite target end"
+ (vector-copy! (vector 1 2) 0 '#(1 2 3)))
+ (pass-if-error "would overwrite target end"
+ (vector-copy! (vector 1 2) 1 '#(1 2 3) 1)))
+
+;;
+;; vector-reverse-copy!
+;;
+
+(with-test-prefix "vector-reverse-copy!"
+
+ (pass-if-equal "3 args, 0 tstart"
+ '#(3 2 1 d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 0 '#(1 2 3))
+ v))
+
+ (pass-if-equal "3 args, 2 tstart"
+ '#(a b 3 2 1)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 2 '#(1 2 3))
+ v))
+
+ (pass-if-equal "4 args"
+ '#(a b 3 2 e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 2 '#(1 2 3) 1)
+ v))
+
+ (pass-if-equal "5 args"
+ '#(a b 4 3 2)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4)
+ v))
+
+ (pass-if-equal "5 args, empty range"
+ '#(a b c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2)
+ v))
+
+ (pass-if-equal "3 args, overlapping source/target"
+ '#(e d c b a)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 0 v)
+ v))
+
+ (pass-if-equal "5 args, overlapping source/target"
+ '#(b a c d e)
+ (let ((v (vector 'a 'b 'c 'd 'e)))
+ (vector-reverse-copy! v 0 v 0 2)
+ v))
+
+ (pass-if-error "3 args, would overwrite target end"
+ (vector-reverse-copy! (vector 'a 'b) 2 '#(a b)))
+ (pass-if-error "3 args, negative tstart"
+ (vector-reverse-copy! (vector 'a 'b) -1 '#(a b)))
+ (pass-if-error "3 args, would overwrite target end"
+ (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c)))
+ (pass-if-error "5 args, send beyond end"
+ (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 1 4))
+ (pass-if-error "5 args, negative sstart"
+ (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) -1 2))
+ (pass-if-error "5 args, invalid source range"
+ (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 2 1)))
+
+;;;
+;;; Conversion
+;;;
+
+;;
+;; vector->list
+;;
+
+(with-test-prefix "vector->list"
+
+ (pass-if-equal "1 arg"
+ '(a b c)
+ (vector->list '#(a b c)))
+
+ (pass-if-equal "2 args"
+ '(b c)
+ (vector->list '#(a b c) 1))
+
+ (pass-if-equal "3 args"
+ '(b c d)
+ (vector->list '#(a b c d e) 1 4))
+
+ (pass-if-equal "3 args, empty range"
+ '()
+ (vector->list '#(a b c d e) 1 1))
+
+ (pass-if-equal "1 arg, empty vector"
+ '()
+ (vector->list '#()))
+
+ (pass-if-error "index beyond end" (vector->list '#(a b c) 1 6))
+ (pass-if-error "negative index" (vector->list '#(a b c) -1 1))
+ (pass-if-error "invalid range" (vector->list '#(a b c) 2 1)))
+
+;;
+;; reverse-vector->list
+;;
+
+(with-test-prefix "reverse-vector->list"
+
+ (pass-if-equal "1 arg"
+ '(c b a)
+ (reverse-vector->list '#(a b c)))
+
+ (pass-if-equal "2 args"
+ '(c b)
+ (reverse-vector->list '#(a b c) 1))
+
+ (pass-if-equal "3 args"
+ '(d c b)
+ (reverse-vector->list '#(a b c d e) 1 4))
+
+ (pass-if-equal "3 args, empty range"
+ '()
+ (reverse-vector->list '#(a b c d e) 1 1))
+
+ (pass-if-equal "1 arg, empty vector"
+ '()
+ (reverse-vector->list '#()))
+
+ (pass-if-error "index beyond end" (reverse-vector->list '#(a b c) 1 6))
+ (pass-if-error "negative index" (reverse-vector->list '#(a b c) -1 1))
+ (pass-if-error "invalid range" (reverse-vector->list '#(a b c) 2 1)))
+
+;;
+;; list->vector
+;;
+
+(with-test-prefix "list->vector"
+
+ (pass-if-equal "1 arg"
+ '#(a b c)
+ (list->vector '(a b c)))
+
+ (pass-if-equal "1 empty list"
+ '#()
+ (list->vector '()))
+
+ (pass-if-equal "2 args"
+ '#(2 3)
+ (list->vector '(0 1 2 3) 2))
+
+ (pass-if-equal "3 args"
+ '#(0 1)
+ (list->vector '(0 1 2 3) 0 2))
+
+ (pass-if-equal "3 args, empty range"
+ '#()
+ (list->vector '(0 1 2 3) 2 2))
+
+ (pass-if-error "index beyond end" (list->vector '(0 1 2 3) 0 5))
+ (pass-if-error "negative index" (list->vector '(0 1 2 3) -1 1))
+ (pass-if-error "invalid range" (list->vector '(0 1 2 3) 2 1)))
+
+;;
+;; reverse-list->vector
+;;
+
+(with-test-prefix "reverse-list->vector"
+
+ (pass-if-equal "1 arg"
+ '#(c b a)
+ (reverse-list->vector '(a b c)))
+
+ (pass-if-equal "1 empty list"
+ '#()
+ (reverse-list->vector '()))
+
+ (pass-if-equal "2 args"
+ '#(3 2)
+ (reverse-list->vector '(0 1 2 3) 2))
+
+ (pass-if-equal "3 args"
+ '#(1 0)
+ (reverse-list->vector '(0 1 2 3) 0 2))
+
+ (pass-if-equal "3 args, empty range"
+ '#()
+ (reverse-list->vector '(0 1 2 3) 2 2))
+
+ (pass-if-error "index beyond end"
+ (reverse-list->vector '(0 1 2 3) 0 5))
+
+ (pass-if-error "negative index"
+ (reverse-list->vector '(0 1 2 3) -1 1))
+
+ (pass-if-error "invalid range"
+ (reverse-list->vector '(0 1 2 3) 2 1)))
+
+;;; Local Variables:
+;;; eval: (put 'pass-if-error 'scheme-indent-function 1)
+;;; End:
diff --git a/test-suite/tests/srfi-64-test.scm
b/test-suite/tests/srfi-64-test.scm
new file mode 100644
index 0000000..3cd67d0
--- /dev/null
+++ b/test-suite/tests/srfi-64-test.scm
@@ -0,0 +1,934 @@
+;;;
+;;; This is a test suite written in the notation of
+;;; SRFI-64, A Scheme API for test suites
+;;;
+
+(test-begin "SRFI 64 - Meta-Test Suite")
+
+;;;
+;;; Ironically, in order to set up the meta-test environment,
+;;; we have to invoke one of the most sophisticated features:
+;;; custom test runners
+;;;
+
+;;; The `prop-runner' invokes `thunk' in the context of a new
+;;; test runner, and returns the indicated properties of the
+;;; last-executed test result.
+
+(define (prop-runner props thunk)
+ (let ((r (test-runner-null))
+ (plist '()))
+ ;;
+ (test-runner-on-test-end!
+ r
+ (lambda (runner)
+ (set! plist (test-result-alist runner))))
+ ;;
+ (test-with-runner r (thunk))
+ ;; reorder the properties so they are in the order
+ ;; given by `props'. Note that any property listed in `props'
+ ;; that is not in the property alist will occur as #f
+ (map (lambda (k)
+ (assq k plist))
+ props)))
+
+;;; `on-test-runner' creates a null test runner and then
+;;; arranged for `visit' to be called with the runner
+;;; whenever a test is run. The results of the calls to
+;;; `visit' are returned in a list
+
+(define (on-test-runner thunk visit)
+ (let ((r (test-runner-null))
+ (results '()))
+ ;;
+ (test-runner-on-test-end!
+ r
+ (lambda (runner)
+ (set! results (cons (visit r) results))))
+ ;;
+ (test-with-runner r (thunk))
+ (reverse results)))
+
+;;;
+;;; The `triv-runner' invokes `thunk'
+;;; and returns a list of 6 lists, the first 5 of which
+;;; are a list of the names of the tests that, respectively,
+;;; PASS, FAIL, XFAIL, XPASS, and SKIP.
+;;; The last item is a list of counts.
+;;;
+
+(define (triv-runner thunk)
+ (let ((r (test-runner-null))
+ (accum-pass '())
+ (accum-fail '())
+ (accum-xfail '())
+ (accum-xpass '())
+ (accum-skip '()))
+ ;;
+ (test-runner-on-bad-count!
+ r
+ (lambda (runner count expected-count)
+ (error (string-append "bad count " (number->string count)
+ " but expected "
+ (number->string expected-count)))))
+ (test-runner-on-bad-end-name!
+ r
+ (lambda (runner begin end)
+ (error (string-append "bad end group name " end
+ " but expected " begin))))
+ (test-runner-on-test-end!
+ r
+ (lambda (runner)
+ (let ((n (test-runner-test-name runner)))
+ (case (test-result-kind runner)
+ ((pass) (set! accum-pass (cons n accum-pass)))
+ ((fail) (set! accum-fail (cons n accum-fail)))
+ ((xpass) (set! accum-xpass (cons n accum-xpass)))
+ ((xfail) (set! accum-xfail (cons n accum-xfail)))
+ ((skip) (set! accum-skip (cons n accum-skip)))))))
+ ;;
+ (test-with-runner r (thunk))
+ (list (reverse accum-pass) ; passed as expected
+ (reverse accum-fail) ; failed, but was expected to pass
+ (reverse accum-xfail) ; failed as expected
+ (reverse accum-xpass) ; passed, but was expected to fail
+ (reverse accum-skip) ; was not executed
+ (list (test-runner-pass-count r)
+ (test-runner-fail-count r)
+ (test-runner-xfail-count r)
+ (test-runner-xpass-count r)
+ (test-runner-skip-count r)))))
+
+(define (path-revealing-runner thunk)
+ (let ((r (test-runner-null))
+ (seq '()))
+ ;;
+ (test-runner-on-test-end!
+ r
+ (lambda (runner)
+ (set! seq (cons (list (test-runner-group-path runner)
+ (test-runner-test-name runner))
+ seq))))
+ (test-with-runner r (thunk))
+ (reverse seq)))
+
+;;;
+;;; Now we can start testing compliance with SRFI-64
+;;;
+
+(test-begin "1. Simple test-cases")
+
+(test-begin "1.1. test-assert")
+
+(define (t)
+ (triv-runner
+ (lambda ()
+ (test-assert "a" #t)
+ (test-assert "b" #f))))
+
+(test-equal
+ "1.1.1. Very simple"
+ '(("a") ("b") () () () (1 1 0 0 0))
+ (t))
+
+(test-equal
+ "1.1.2. A test with no name"
+ '(("a") ("") () () () (1 1 0 0 0))
+ (triv-runner (lambda () (test-assert "a" #t) (test-assert #f))))
+
+(test-equal
+ "1.1.3. Tests can have the same name"
+ '(("a" "a") () () () () (2 0 0 0 0))
+ (triv-runner (lambda () (test-assert "a" #t) (test-assert "a" #t))))
+
+(define (choke)
+ (vector-ref '#(1 2) 3))
+
+(test-equal
+ "1.1.4. One way to FAIL is to throw an error"
+ '(() ("a") () () () (0 1 0 0 0))
+ (triv-runner (lambda () (test-assert "a" (choke)))))
+
+(test-end);1.1
+
+(test-begin "1.2. test-eqv")
+
+(define (mean x y)
+ (/ (+ x y) 2.0))
+
+(test-equal
+ "1.2.1. Simple numerical equivalence"
+ '(("c") ("a" "b") () () () (1 2 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-eqv "a" (mean 3 5) 4)
+ (test-eqv "b" (mean 3 5) 4.5)
+ (test-eqv "c" (mean 3 5) 4.0))))
+
+(test-end);1.2
+
+(test-end "1. Simple test-cases")
+
+;;;
+;;;
+;;;
+
+(test-begin "2. Tests for catching errors")
+
+(test-begin "2.1. test-error")
+
+(test-equal
+ "2.1.1. Baseline test; PASS with no optional args"
+ '(("") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ ;; PASS
+ (test-error (vector-ref '#(1 2) 9)))))
+
+(test-equal
+ "2.1.2. Baseline test; FAIL with no optional args"
+ '(() ("") () () () (0 1 0 0 0))
+ (triv-runner
+ (lambda ()
+ ;; FAIL: the expr does not raise an error and `test-error' is
+ ;; claiming that it will, so this test should FAIL
+ (test-error (vector-ref '#(1 2) 0)))))
+
+(test-equal
+ "2.1.3. PASS with a test name and error type"
+ '(("a") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ ;; PASS
+ (test-error "a" #t (vector-ref '#(1 2) 9)))))
+
+(test-end "2.1. test-error")
+
+(test-end "2. Tests for catching errors")
+
+;;;
+;;;
+;;;
+
+(test-begin "3. Test groups and paths")
+
+(test-equal
+ "3.1. test-begin with unspecific test-end"
+ '(("b") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "b" #t)
+ (test-end))))
+
+(test-equal
+ "3.2. test-begin with name-matching test-end"
+ '(("b") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "b" #t)
+ (test-end "a"))))
+
+;;; since the error raised by `test-end' on a mismatch is not a test
+;;; error, we actually expect the triv-runner itself to fail
+
+(test-error
+ "3.3. test-begin with mismatched test-end"
+#t
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "b" #t)
+ (test-end "x"))))
+
+(test-equal
+ "3.4. test-begin with name and count"
+ '(("b" "c") () () () () (2 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-begin "a" 2)
+ (test-assert "b" #t)
+ (test-assert "c" #t)
+ (test-end "a"))))
+
+;; similarly here, a mismatched count is a lexical error
+;; and not a test failure...
+
+(test-error
+ "3.5. test-begin with mismatched count"
+ #t
+ (triv-runner
+ (lambda ()
+ (test-begin "a" 99)
+ (test-assert "b" #t)
+ (test-end "a"))))
+
+(test-equal
+ "3.6. introspecting on the group path"
+ '((() "w")
+ (("a" "b") "x")
+ (("a" "b") "y")
+ (("a") "z"))
+ ;;
+ ;; `path-revealing-runner' is designed to return a list
+ ;; of the tests executed, in order. Each entry is a list
+ ;; (GROUP-PATH TEST-NAME), and each GROUP-PATH is a list
+ ;; of test groups starting from the topmost
+ ;;
+ (path-revealing-runner
+ (lambda ()
+ (test-assert "w" #t)
+ (test-begin "a")
+ (test-begin "b")
+ (test-assert "x" #t)
+ (test-assert "y" #t)
+ (test-end)
+ (test-assert "z" #t))))
+
+
+(test-end "3. Test groups and paths")
+
+;;;
+;;;
+;;;
+
+(test-begin "4. Handling set-up and cleanup")
+
+(test-equal "4.1. Normal exit path"
+ '(in 1 2 out)
+ (let ((ex '()))
+ (define (do s)
+ (set! ex (cons s ex)))
+ ;;
+ (triv-runner
+ (lambda ()
+ (test-group-with-cleanup
+ "foo"
+ (do 'in)
+ (do 1)
+ (do 2)
+ (do 'out))))
+ (reverse ex)))
+
+(test-equal "4.2. Exception exit path"
+ '(in 1 out)
+ (let ((ex '()))
+ (define (do s)
+ (set! ex (cons s ex)))
+ ;;
+ ;; the outer runner is to run the `test-error' in, to
+ ;; catch the exception raised in the inner runner,
+ ;; since we don't want to depend on any other
+ ;; exception-catching support
+ ;;
+ (triv-runner
+ (lambda ()
+ (test-error
+ (triv-runner
+ (lambda ()
+ (test-group-with-cleanup
+ "foo"
+ (do 'in) (test-assert #t)
+ (do 1) (test-assert #t)
+ (choke) (test-assert #t)
+ (do 2) (test-assert #t)
+ (do 'out)))))))
+ (reverse ex)))
+
+(test-end "4. Handling set-up and cleanup")
+
+;;;
+;;;
+;;;
+
+(test-begin "5. Test specifiers")
+
+(test-begin "5.1. test-match-named")
+
+(test-equal "5.1.1. match test names"
+ '(("y") () () () ("x") (1 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-skip (test-match-name "x"))
+ (test-assert "x" #t)
+ (test-assert "y" #t))))
+
+(test-equal "5.1.2. but not group names"
+ '(("z") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-skip (test-match-name "x"))
+ (test-begin "x")
+ (test-assert "z" #t)
+ (test-end))))
+
+(test-end)
+
+(test-begin "5.2. test-match-nth")
+;; See also: [6.4. Short-circuit evaluation]
+
+(test-equal "5.2.1. skip the nth one after"
+ '(("v" "w" "y" "z") () () () ("x") (4 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-nth 2))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP
+ (test-assert "y" #t) ; 3
+ (test-assert "z" #t)))) ; 4
+
+(test-equal "5.2.2. skip m, starting at n"
+ '(("v" "w" "z") () () () ("x" "y") (3 0 0 0 2))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-nth 2 2))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP
+ (test-assert "y" #t) ; 3 SKIP
+ (test-assert "z" #t)))) ; 4
+
+(test-end)
+
+(test-begin "5.3. test-match-any")
+(test-equal "5.3.1. basic disjunction"
+ '(("v" "w" "z") () () () ("x" "y") (3 0 0 0 2))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-any (test-match-nth 3)
+ (test-match-name "x")))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP(NAME)
+ (test-assert "y" #t) ; 3 SKIP(COUNT)
+ (test-assert "z" #t)))) ; 4
+
+(test-equal "5.3.2. disjunction is commutative"
+ '(("v" "w" "z") () () () ("x" "y") (3 0 0 0 2))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-any (test-match-name "x")
+ (test-match-nth 3)))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP(NAME)
+ (test-assert "y" #t) ; 3 SKIP(COUNT)
+ (test-assert "z" #t)))) ; 4
+
+(test-end)
+
+(test-begin "5.4. test-match-all")
+(test-equal "5.4.1. basic conjunction"
+ '(("v" "w" "y" "z") () () () ("x") (4 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-all (test-match-nth 2 2)
+ (test-match-name "x")))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP(NAME) & SKIP(COUNT)
+ (test-assert "y" #t) ; 3 SKIP(COUNT)
+ (test-assert "z" #t)))) ; 4
+
+(test-equal "5.4.2. conjunction is commutative"
+ '(("v" "w" "y" "z") () () () ("x") (4 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-assert "v" #t)
+ (test-skip (test-match-all (test-match-name "x")
+ (test-match-nth 2 2)))
+ (test-assert "w" #t) ; 1
+ (test-assert "x" #t) ; 2 SKIP(NAME) & SKIP(COUNT)
+ (test-assert "y" #t) ; 3 SKIP(COUNT)
+ (test-assert "z" #t)))) ; 4
+
+(test-end)
+
+(test-end "5. Test specifiers")
+
+;;;
+;;;
+;;;
+
+(test-begin "6. Skipping selected tests")
+
+(test-equal
+ "6.1. Skip by specifier - match-name"
+ '(("x") () () () ("y") (1 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip (test-match-name "y"))
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; SKIP
+ (test-end))))
+
+(test-equal
+ "6.2. Shorthand specifiers"
+ '(("x") () () () ("y") (1 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "y")
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; SKIP
+ (test-end))))
+
+(test-begin "6.3. Specifier Stack")
+
+(test-equal
+ "6.3.1. Clearing the Specifier Stack"
+ '(("x" "x") ("y") () () ("y") (2 1 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "y")
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; SKIP
+ (test-end)
+ (test-begin "b")
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; FAIL
+ (test-end))))
+
+(test-equal
+ "6.3.2. Inheriting the Specifier Stack"
+ '(("x" "x") () () () ("y" "y") (2 0 0 0 2))
+ (triv-runner
+ (lambda ()
+ (test-skip "y")
+ (test-begin "a")
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; SKIP
+ (test-end)
+ (test-begin "b")
+ (test-assert "x" #t) ; PASS
+ (test-assert "y" #f) ; SKIP
+ (test-end))))
+
+(test-end);6.3
+
+(test-begin "6.4. Short-circuit evaluation")
+
+(test-equal
+ "6.4.1. In test-match-all"
+ '(("x") ("y" "x" "z") () () ("y") (1 3 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip (test-match-all "y" (test-match-nth 2)))
+ ;; let's label the substructure forms so we can
+ ;; see which one `test-match-nth' is going to skip
+ ;; ; # "y" 2 result
+ (test-assert "x" #t) ; 1 - #f #f PASS
+ (test-assert "y" #f) ; 2 - #t #t SKIP
+ (test-assert "y" #f) ; 3 - #t #f FAIL
+ (test-assert "x" #f) ; 4 - #f #f FAIL
+ (test-assert "z" #f) ; 5 - #f #f FAIL
+ (test-end))))
+
+(test-equal
+ "6.4.2. In separate skip-list entries"
+ '(("x") ("x" "z") () () ("y" "y") (1 2 0 0 2))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "y")
+ (test-skip (test-match-nth 2))
+ ;; let's label the substructure forms so we can
+ ;; see which one `test-match-nth' is going to skip
+ ;; ; # "y" 2 result
+ (test-assert "x" #t) ; 1 - #f #f PASS
+ (test-assert "y" #f) ; 2 - #t #t SKIP
+ (test-assert "y" #f) ; 3 - #t #f SKIP
+ (test-assert "x" #f) ; 4 - #f #f FAIL
+ (test-assert "z" #f) ; 5 - #f #f FAIL
+ (test-end))))
+
+(test-begin "6.4.3. Skipping test suites")
+
+(test-equal
+ "6.4.3.1. Introduced using 'test-begin'"
+ '(("x") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "b")
+ (test-begin "b") ; not skipped
+ (test-assert "x" #t)
+ (test-end "b")
+ (test-end "a"))))
+
+(test-expect-fail 1) ;; ???
+(test-equal
+ "6.4.3.2. Introduced using 'test-group'"
+ '(() () () () () (0 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "b")
+ (test-group
+ "b" ; skipped
+ (test-assert "x" #t))
+ (test-end "a"))))
+
+(test-equal
+ "6.4.3.3. Non-skipped 'test-group'"
+ '(("x") () () () () (1 0 0 0 0))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-skip "c")
+ (test-group "b" (test-assert "x" #t))
+ (test-end "a"))))
+
+(test-end) ; 6.4.3
+
+(test-end);6.4
+
+(test-end "6. Skipping selected tests")
+
+;;;
+;;;
+;;;
+
+(test-begin "7. Expected failures")
+
+(test-equal "7.1. Simple example"
+ '(() ("x") ("z") () () (0 1 1 0 0))
+ (triv-runner
+ (lambda ()
+ (test-assert "x" #f)
+ (test-expect-fail "z")
+ (test-assert "z" #f))))
+
+(test-equal "7.2. Expected exception"
+ '(() ("x") ("z") () () (0 1 1 0 0))
+ (triv-runner
+ (lambda ()
+ (test-assert "x" #f)
+ (test-expect-fail "z")
+ (test-assert "z" (choke)))))
+
+(test-equal "7.3. Unexpectedly PASS"
+ '(() () ("y") ("x") () (0 0 1 1 0))
+ (triv-runner
+ (lambda ()
+ (test-expect-fail "x")
+ (test-expect-fail "y")
+ (test-assert "x" #t)
+ (test-assert "y" #f))))
+
+
+
+(test-end "7. Expected failures")
+
+;;;
+;;;
+;;;
+
+(test-begin "8. Test-runner")
+
+;;;
+;;; Because we want this test suite to be accurate even
+;;; when the underlying implementation chooses to use, e.g.,
+;;; a global variable to implement what could be thread variables
+;;; or SRFI-39 parameter objects, we really need to save and restore
+;;; their state ourselves
+;;;
+(define (with-factory-saved thunk)
+ (let* ((saved (test-runner-factory))
+ (result (thunk)))
+ (test-runner-factory saved)
+ result))
+
+(test-begin "8.1. test-runner-current")
+(test-assert "8.1.1. automatically restored"
+ (let ((a 0)
+ (b 1)
+ (c 2))
+ ;
+ (triv-runner
+ (lambda ()
+ (set! a (test-runner-current))
+ ;;
+ (triv-runner
+ (lambda ()
+ (set! b (test-runner-current))))
+ ;;
+ (set! c (test-runner-current))))
+ ;;
+ (and (eq? a c)
+ (not (eq? a b)))))
+
+(test-end)
+
+(test-begin "8.2. test-runner-simple")
+(test-assert "8.2.1. default on-test hook"
+ (eq? (test-runner-on-test-end (test-runner-simple))
+ test-on-test-end-simple))
+(test-assert "8.2.2. default on-final hook"
+ (eq? (test-runner-on-final (test-runner-simple))
+ test-on-final-simple))
+(test-end)
+
+(test-begin "8.3. test-runner-factory")
+
+(test-assert "8.3.1. default factory"
+ (eq? (test-runner-factory) test-runner-simple))
+
+(test-assert "8.3.2. settable factory"
+ (with-factory-saved
+ (lambda ()
+ (test-runner-factory test-runner-null)
+ ;; we have no way, without bringing in other SRFIs,
+ ;; to make sure the following doesn't print anything,
+ ;; but it shouldn't:
+ (test-with-runner
+ (test-runner-create)
+ (lambda ()
+ (test-begin "a")
+ (test-assert #t) ; pass
+ (test-assert #f) ; fail
+ (test-assert (vector-ref '#(3) 10)) ; fail with error
+ (test-end "a")))
+ (eq? (test-runner-factory) test-runner-null))))
+
+(test-end)
+
+;;; This got tested about as well as it could in 8.3.2
+
+(test-begin "8.4. test-runner-create")
+(test-end)
+
+;;; This got tested about as well as it could in 8.3.2
+
+(test-begin "8.5. test-runner-factory")
+(test-end)
+
+(test-begin "8.6. test-apply")
+(test-equal "8.6.1. Simple (form 1) test-apply"
+ '(("w" "p" "v") () () () ("x") (3 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "w" #t)
+ (test-apply
+ (test-match-name "p")
+ (lambda ()
+ (test-begin "p")
+ (test-assert "x" #t)
+ (test-end)
+ (test-begin "z")
+ (test-assert "p" #t) ; only this one should execute in here
+ (test-end)))
+ (test-assert "v" #t))))
+
+(test-equal "8.6.2. Simple (form 2) test-apply"
+ '(("w" "p" "v") () () () ("x") (3 0 0 0 1))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "w" #t)
+ (test-apply
+ (test-runner-current)
+ (test-match-name "p")
+ (lambda ()
+ (test-begin "p")
+ (test-assert "x" #t)
+ (test-end)
+ (test-begin "z")
+ (test-assert "p" #t) ; only this one should execute in here
+ (test-end)))
+ (test-assert "v" #t))))
+
+(test-expect-fail 1) ;; depends on all test-match-nth being called.
+(test-equal "8.6.3. test-apply with skips"
+ '(("w" "q" "v") () () () ("x" "p" "x") (3 0 0 0 3))
+ (triv-runner
+ (lambda ()
+ (test-begin "a")
+ (test-assert "w" #t)
+ (test-skip (test-match-nth 2))
+ (test-skip (test-match-nth 4))
+ (test-apply
+ (test-runner-current)
+ (test-match-name "p")
+ (test-match-name "q")
+ (lambda ()
+ ; only execute if SKIP=no and APPLY=yes
+ (test-assert "x" #t) ; # 1 SKIP=no APPLY=no
+ (test-assert "p" #t) ; # 2 SKIP=yes APPLY=yes
+ (test-assert "q" #t) ; # 3 SKIP=no APPLY=yes
+ (test-assert "x" #f) ; # 4 SKIP=yes APPLY=no
+ 0))
+ (test-assert "v" #t))))
+
+;;; Unfortunately, since there is no way to UNBIND the current test runner,
+;;; there is no way to test the behavior of `test-apply' in the absence
+;;; of a current runner within our little meta-test framework.
+;;;
+;;; To test the behavior manually, you should be able to invoke:
+;;;
+;;; (test-apply "a" (lambda () (test-assert "a" #t)))
+;;;
+;;; from the top level (with SRFI 64 available) and it should create a
+;;; new, default (simple) test runner.
+
+(test-end)
+
+;;; This entire suite depends heavily on 'test-with-runner'. If it didn't
+;;; work, this suite would probably go down in flames
+(test-begin "8.7. test-with-runner")
+(test-end)
+
+;;; Again, this suite depends heavily on many of the test-runner
+;;; components. We'll just test those that aren't being exercised
+;;; by the meta-test framework
+(test-begin "8.8. test-runner components")
+
+(define (auxtrack-runner thunk)
+ (let ((r (test-runner-null)))
+ (test-runner-aux-value! r '())
+ (test-runner-on-test-end! r (lambda (r)
+ (test-runner-aux-value!
+ r
+ (cons (test-runner-test-name r)
+ (test-runner-aux-value r)))))
+ (test-with-runner r (thunk))
+ (reverse (test-runner-aux-value r))))
+
+(test-equal "8.8.1. test-runner-aux-value"
+ '("x" "" "y")
+ (auxtrack-runner
+ (lambda ()
+ (test-assert "x" #t)
+ (test-begin "a")
+ (test-assert #t)
+ (test-end)
+ (test-assert "y" #f))))
+
+(test-end) ; 8.8
+
+(test-end "8. Test-runner")
+
+(test-begin "9. Test Result Properties")
+
+(test-begin "9.1. test-result-alist")
+
+(define (symbol-alist? l)
+ (if (null? l)
+ #t
+ (and (pair? l)
+ (pair? (car l))
+ (symbol? (caar l))
+ (symbol-alist? (cdr l)))))
+
+;;; check the various syntactic forms
+
+(test-assert (symbol-alist?
+ (car (on-test-runner
+ (lambda ()
+ (test-assert #t))
+ (lambda (r)
+ (test-result-alist r))))))
+
+(test-assert (symbol-alist?
+ (car (on-test-runner
+ (lambda ()
+ (test-assert #t))
+ (lambda (r)
+ (test-result-alist r))))))
+
+;;; check to make sure the required properties are returned
+
+(test-equal '((result-kind . pass))
+ (prop-runner
+ '(result-kind)
+ (lambda ()
+ (test-assert #t)))
+ )
+
+(test-equal
+ '((result-kind . fail)
+ (expected-value . 2)
+ (actual-value . 3))
+ (prop-runner
+ '(result-kind expected-value actual-value)
+ (lambda ()
+ (test-equal 2 (+ 1 2)))))
+
+(test-end "9.1. test-result-alist")
+
+(test-begin "9.2. test-result-ref")
+
+(test-equal '(pass)
+ (on-test-runner
+ (lambda ()
+ (test-assert #t))
+ (lambda (r)
+ (test-result-ref r 'result-kind))))
+
+(test-equal '(pass)
+ (on-test-runner
+ (lambda ()
+ (test-assert #t))
+ (lambda (r)
+ (test-result-ref r 'result-kind))))
+
+(test-equal '(fail pass)
+ (on-test-runner
+ (lambda ()
+ (test-assert (= 1 2))
+ (test-assert (= 1 1)))
+ (lambda (r)
+ (test-result-ref r 'result-kind))))
+
+(test-end "9.2. test-result-ref")
+
+(test-begin "9.3. test-result-set!")
+
+(test-equal '(100 100)
+ (on-test-runner
+ (lambda ()
+ (test-assert (= 1 2))
+ (test-assert (= 1 1)))
+ (lambda (r)
+ (test-result-set! r 'foo 100)
+ (test-result-ref r 'foo))))
+
+(test-end "9.3. test-result-set!")
+
+(test-end "9. Test Result Properties")
+
+;;;
+;;;
+;;;
+
+#| Time to stop having fun...
+
+(test-begin "9. For fun, some meta-test errors")
+
+(test-equal
+ "9.1. Really PASSes, but test like it should FAIL"
+ '(() ("b") () () ())
+ (triv-runner
+ (lambda ()
+ (test-assert "b" #t))))
+
+(test-expect-fail "9.2. Expect to FAIL and do so")
+(test-expect-fail "9.3. Expect to FAIL but PASS")
+(test-skip "9.4. SKIP this one")
+
+(test-assert "9.2. Expect to FAIL and do so" #f)
+(test-assert "9.3. Expect to FAIL but PASS" #t)
+(test-assert "9.4. SKIP this one" #t)
+
+(test-end)
+ |#
+
+(test-end "SRFI 64 - Meta-Test Suite")
+
+;;;
diff --git a/test-suite/tests/srfi-64.test b/test-suite/tests/srfi-64.test
new file mode 100644
index 0000000..190d6b2
--- /dev/null
+++ b/test-suite/tests/srfi-64.test
@@ -0,0 +1,45 @@
+;;;; srfi-64.test --- Test suite for SRFI-64. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2014 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 as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+(define-module (test-srfi-64)
+ #:use-module ((test-suite lib) #:select (report))
+ #:use-module (srfi srfi-64))
+
+(define (guile-test-runner)
+ (let ((runner (test-runner-null)))
+ (test-runner-on-test-end! runner
+ (lambda (runner)
+ (let* ((result-alist (test-result-alist runner))
+ (result-kind (assq-ref result-alist 'result-kind))
+ (test-name (list (assq-ref result-alist 'test-name))))
+ (case result-kind
+ ((pass) (report 'pass test-name))
+ ((xpass) (report 'upass test-name))
+ ((skip) (report 'untested test-name))
+ ((fail xfail)
+ (apply report result-kind test-name result-alist))
+ (else #t)))))
+ runner))
+
+(test-with-runner
+ (guile-test-runner)
+ (primitive-load-path "tests/srfi-64-test.scm"))
+
+;;; Local Variables:
+;;; eval: (put 'test-runner-on-test-end! 'scheme-indent-function 1)
+;;; End:
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index d88e791..6c2891c 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -82,6 +82,8 @@
(define exception:too-many-args
"too many arguments")
+(define exception:wrong-number-of-values
+ '(wrong-number-of-args . "number of (values)|(arguments)"))
(define exception:zero-expression-sequence
"sequence of zero expressions")
@@ -977,6 +979,178 @@
(eval '(let () (define x #t))
(interaction-environment))))
+(with-test-prefix "top-level define-values"
+
+ (pass-if "zero values"
+ (eval '(begin (define-values () (values))
+ #t)
+ (interaction-environment)))
+
+ (pass-if-equal "one value"
+ 1
+ (eval '(begin (define-values (x) 1)
+ x)
+ (interaction-environment)))
+
+ (pass-if-equal "two values"
+ '(2 3)
+ (eval '(begin (define-values (x y) (values 2 3))
+ (list x y))
+ (interaction-environment)))
+
+ (pass-if-equal "three values"
+ '(4 5 6)
+ (eval '(begin (define-values (x y z) (values 4 5 6))
+ (list x y z))
+ (interaction-environment)))
+
+ (pass-if-equal "one value with tail"
+ '(a (b c d))
+ (eval '(begin (define-values (x . y) (values 'a 'b 'c 'd))
+ (list x y))
+ (interaction-environment)))
+
+ (pass-if-equal "two values with tail"
+ '(x y (z w))
+ (eval '(begin (define-values (x y . z) (values 'x 'y 'z 'w))
+ (list x y z))
+ (interaction-environment)))
+
+ (pass-if-equal "just tail"
+ '(1 2 3)
+ (eval '(begin (define-values x (values 1 2 3))
+ x)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 0 values, got 1"
+ exception:wrong-number-of-values
+ (eval '(define-values () 1)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 0"
+ exception:wrong-number-of-values
+ (eval '(define-values (x) (values))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 2"
+ exception:wrong-number-of-values
+ (eval '(define-values (x) (values 1 2))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value with tail, got 0"
+ exception:wrong-number-of-values
+ (eval '(define-values (x . y) (values))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 2 value with tail, got 1"
+ exception:wrong-number-of-values
+ (eval '(define-values (x y . z) 1)
+ (interaction-environment)))
+
+ (pass-if "redefinition"
+ (let ((m (make-module)))
+ (beautify-user-module! m)
+
+ ;; The previous values of `floor' and `round' must still be
+ ;; visible at the time the new `floor' and `round' are defined.
+ (eval '(define-values (floor round) (values floor round)) m)
+ (and (eq? (module-ref m 'floor) floor)
+ (eq? (module-ref m 'round) round))))
+
+ (with-test-prefix "missing expression"
+
+ (pass-if-syntax-error "(define-values)"
+ exception:generic-syncase-error
+ (eval '(define-values)
+ (interaction-environment)))))
+
+(with-test-prefix "internal define-values"
+
+ (pass-if "zero values"
+ (let ()
+ (define-values () (values))
+ #t))
+
+ (pass-if-equal "one value"
+ 1
+ (let ()
+ (define-values (x) 1)
+ x))
+
+ (pass-if-equal "two values"
+ '(2 3)
+ (let ()
+ (define-values (x y) (values 2 3))
+ (list x y)))
+
+ (pass-if-equal "three values"
+ '(4 5 6)
+ (let ()
+ (define-values (x y z) (values 4 5 6))
+ (list x y z)))
+
+ (pass-if-equal "one value with tail"
+ '(a (b c d))
+ (let ()
+ (define-values (x . y) (values 'a 'b 'c 'd))
+ (list x y)))
+
+ (pass-if-equal "two values with tail"
+ '(x y (z w))
+ (let ()
+ (define-values (x y . z) (values 'x 'y 'z 'w))
+ (list x y z)))
+
+ (pass-if-equal "just tail"
+ '(1 2 3)
+ (let ()
+ (define-values x (values 1 2 3))
+ x))
+
+ (pass-if-exception "expected 0 values, got 1"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values () 1)
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 0"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x) (values))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 2"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x) (values 1 2))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value with tail, got 0"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x . y) (values))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 2 value with tail, got 1"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x y . z) 1)
+ #f)
+ (interaction-environment)))
+
+ (with-test-prefix "missing expression"
+
+ (pass-if-syntax-error "(define-values)"
+ exception:generic-syncase-error
+ (eval '(let ()
+ (define-values)
+ #f)
+ (interaction-environment)))))
+
(with-test-prefix "set!"
(with-test-prefix "missing or extra expressions"
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index 1d53fc4..21c8ddc 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -1,5 +1,6 @@
;;;; weaks.test --- tests guile's weaks -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011, 2012 Free
Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011, 2012, 2014
+;;;; 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
@@ -57,13 +58,13 @@
(pass-if "create"
(let* ((lst '(a b c d e f g))
(wv (list->weak-vector lst)))
- (and (eq? (vector-ref wv 0) 'a)
- (eq? (vector-ref wv 1) 'b)
- (eq? (vector-ref wv 2) 'c)
- (eq? (vector-ref wv 3) 'd)
- (eq? (vector-ref wv 4) 'e)
- (eq? (vector-ref wv 5) 'f)
- (eq? (vector-ref wv 6) 'g))))
+ (and (eq? (weak-vector-ref wv 0) 'a)
+ (eq? (weak-vector-ref wv 1) 'b)
+ (eq? (weak-vector-ref wv 2) 'c)
+ (eq? (weak-vector-ref wv 3) 'd)
+ (eq? (weak-vector-ref wv 4) 'e)
+ (eq? (weak-vector-ref wv 5) 'f)
+ (eq? (weak-vector-ref wv 6) 'g))))
(pass-if-exception "bad-args"
exception:wrong-type-arg
(list->weak-vector 32)))
@@ -99,11 +100,11 @@
(define global-weak (make-weak-vector 10 #f))
(begin
- (vector-set! global-weak 0 (string-copy "string"))
- (vector-set! global-weak 1 (string-copy "beans"))
- (vector-set! global-weak 2 (string-copy "to"))
- (vector-set! global-weak 3 (string-copy "utah"))
- (vector-set! global-weak 4 (string-copy "yum yum"))
+ (weak-vector-set! global-weak 0 (string-copy "string"))
+ (weak-vector-set! global-weak 1 (string-copy "beans"))
+ (weak-vector-set! global-weak 2 (string-copy "to"))
+ (weak-vector-set! global-weak 3 (string-copy "utah"))
+ (weak-vector-set! global-weak 4 (string-copy "yum yum"))
(gc))
;;; Normal weak vectors
@@ -113,17 +114,17 @@
"weak-vector"
(pass-if "lives"
(begin
- (vector-set! x 0 bar)
+ (weak-vector-set! x 0 bar)
(gc)
- (and (vector-ref x 0) (eq? bar (vector-ref x 0)))))
+ (and (weak-vector-ref x 0) (eq? bar (weak-vector-ref x 0)))))
(pass-if "dies"
(begin
(gc)
- (or (and (not (vector-ref global-weak 0))
- (not (vector-ref global-weak 1))
- (not (vector-ref global-weak 2))
- (not (vector-ref global-weak 3))
- (not (vector-ref global-weak 4)))
+ (or (and (not (weak-vector-ref global-weak 0))
+ (not (weak-vector-ref global-weak 1))
+ (not (weak-vector-ref global-weak 2))
+ (not (weak-vector-ref global-weak 3))
+ (not (weak-vector-ref global-weak 4)))
(throw 'unresolved))))))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index aa607af..45cce02 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -49,14 +49,14 @@
(define-syntax pass-if-round-trip
(syntax-rules ()
((_ str)
- (pass-if (format #f "~s round trip" str)
- (equal? (call-with-output-string
- (lambda (port)
- (call-with-values
- (lambda () (read-header (open-input-string str)))
- (lambda (sym val)
- (write-header sym val port)))))
- str)))))
+ (pass-if-equal (format #f "~s round trip" str)
+ str
+ (call-with-output-string
+ (lambda (port)
+ (call-with-values
+ (lambda () (read-header (open-input-string str)))
+ (lambda (sym val)
+ (write-header sym val port)))))))))
(define-syntax pass-if-any-error
(syntax-rules ()
@@ -292,6 +292,9 @@
(pass-if-parse authorization "Digest foooo" '(digest foooo))
(pass-if-parse authorization "Digest foo=bar,baz=qux"
'(digest (foo . "bar") (baz . "qux")))
+ (pass-if-round-trip "Authorization: basic foooo\r\n")
+ (pass-if-round-trip "Authorization: digest foooo\r\n")
+ (pass-if-round-trip "Authorization: digest foo=bar, baz=qux\r\n")
(pass-if-parse expect "100-continue, foo" '((100-continue) (foo)))
(pass-if-parse from "address@hidden" "address@hidden")
(pass-if-parse host "qux" '("qux" . #f))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, ra0, updated. v2.1.0-726-ga5340d7,
Andy Wingo <=