[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-329-g26d1480
|
From: |
Mark H Weaver |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-329-g26d1480 |
|
Date: |
Thu, 28 Mar 2013 09:13:00 +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=26d148066f9cb20e395a7dc4fefdf2e2ef0b2fb0
The branch, master has been updated
via 26d148066f9cb20e395a7dc4fefdf2e2ef0b2fb0 (commit)
via 579127cce488ce208d62e68e679e34fbbdc17367 (commit)
via 10b8cf1ebdba6989e8c9b23838d2f20d6cb7d60b (commit)
via 82ab673ceafa3174d9e5f8dfec08221ba69addba (commit)
via 80b809f114e9f3978aa6571affd343f34732fb94 (commit)
via 50d08cd8943dd54762d76746d5eec53af178eeae (commit)
via ed4aa26489d33c22bcdbce2bb037a87df41bef16 (commit)
via 8a177d316c0062afe74f9a761ef460e297435e59 (commit)
via 8cd109bf0a10e37c26bf476fed81a0d4282d13c6 (commit)
via ffc8eca636a8e9311d35c9adba2fc80476ab11ca (commit)
via c548da6949fef565dd1267afa5bbf2c21edda366 (commit)
via 41502bd00f12a6bce97484d33f5519e97a04cf2a (commit)
via d291d7990d72b5cb8a18b20e524e1c8324297e92 (commit)
via 65ad02b96d4118970406b1474aa00bbe801aa61a (commit)
via 59b0f9d7635ea7e272e2976ab69764a570d7f6ff (commit)
via 5bb40f9df02c3395b198f254fdd43e7468b5ceee (commit)
via 570fdeceacaad7f6e928123f40e8bb5f72677dcb (commit)
via 11ed42771dec06626457eae58f2f334df1397f72 (commit)
via f28885f4957882c4d96bdfee11d26cd265539aac (commit)
via 45417ab1066b3f7f65ff4ff4f6ca2733c75bd521 (commit)
via 86fafc440220b0ab1d76439e89ac8114a9c7660d (commit)
via fbac7c6113056bc6ee85996b10bdc08325c742a5 (commit)
via e8a57fb052c4d9c27681183bd0cf2be31142d58a (commit)
via 43c2a48323803e9aae41ba896ce6b6a0067343ad (commit)
via c5c7c1146f2488f92b11b1edbe36fa99ffdf2771 (commit)
via 6cfdc6b87881a592b7ad99db8d9ea0ee13a4101b (commit)
via 2bb7a730137013d2cc931e3b5932f6235d76e1e1 (commit)
via 8fe4c4eccbd6fcd5e26d955cc3b59aef60f561ee (commit)
via 4215ea75a525a848ce9d73fad9c03983e8b3cd0d (commit)
via 797b2aa69aeb7db607250bad83d31a31f8f4d1c7 (commit)
via c52ce75a1f87e72d675fc5a6ad95ef26dd517e10 (commit)
via 14ae4725ab5cdfc334786012c0b4fdacc2851be2 (commit)
via edb6de0becea3a52a4e5e3fa73a090928f0cbd61 (commit)
via 8edab37f17cd60cf6986da822dfbdad6067aef66 (commit)
via ddb717423619cb2c36fb798dc12552b70cd9b0ad (commit)
via 687a87bf012f0c0afa79dd9bebf7d173d1243880 (commit)
via 4400266478b4a477c6747f9eed38f7c6021491d8 (commit)
via c8248c8ed5459991e7d2d6d8f20f652295c19514 (commit)
via 1d64b4edb9da4011ad06c0fab1c6225ec20b0876 (commit)
via 8150dfa1f2f84d151ced5f723dc69ce0cae1cd32 (commit)
via a9ea4f909b9970c755b0a7c4cd9da907e66496fc (commit)
via e5029c585382471f81717f8e1539854d90579512 (commit)
via 5f24f1b53ed2c1746670ae8828a05cc7b63354e8 (commit)
via 1ea37620c2c1794f7685b312d2530676a078ada7 (commit)
via 982377849029f2840ebb105cda49390fecca4fe4 (commit)
via b1c46fd30a4615b4ab534d6bd824a81e3f536660 (commit)
via 2e08ff38b735020e8ed5403acb637e6041d3d743 (commit)
via dc8712611597c6d5be918a69b0ce719e0675f6fe (commit)
via 01b83dbd1a11735519b7d6ca7b02006b45861c9c (commit)
via f361bb937aed7b26a18580c78e66657ed44be294 (commit)
via 912f5f34458fd6998b129e65685adbaf44356860 (commit)
via de2811cc41e86f8f558cfe99172a1987cbcad47a (commit)
via dbab8aaacaa7ce4d1d3db09d422615b6fcd6724f (commit)
via dfd1d3b144d97522b2a4e82dc583a43e0b4f8b93 (commit)
via 24475b860b02880b1cfdf4e03f9659a8af09eb72 (commit)
via 7f34acd8a48198c7fec2daf8d2f4161eaa9963ec (commit)
via 1eb6a33a30ea27f97fc401a25a3014e10e3c6f98 (commit)
via e08a12b5356c20ed0418bcaee136eb3632c5616f (commit)
via a285b18ca820e089e2e5d02f8ed07a1e341dffc3 (commit)
via d2df3950a905f7acab70633717beddfd90455b68 (commit)
via b5870f25ad70dc70df99f69ff2652d73ec07343c (commit)
via 428f9e95fccb7105f00d22e80312e9f5a7a263a4 (commit)
via ccd0ae1fbb1c8c942a89bf84272377b341739e0f (commit)
via 988ca6b212fce6d9419d1ffce8f115425ade3a9f (commit)
via a4b4fbbdaa3542e35ea436179200d071b57ff1ca (commit)
via e9381f58d1b0c9d8882328efecf938b45817e3dd (commit)
via cfe24bc4deef6f52ad3e07ffc513160890db4ff3 (commit)
via 84dfde82ae8f6ec247c1c147c1e2ae50b207bad9 (commit)
via 94c53e0601c3fb4a4dcd6d3bd602347a8253c167 (commit)
via aa59904eaec70c95fa95960f98ba9cbc62010e8d (commit)
via b7548cd2dc4ead3c0ad3d2fb5c9fc43d54e6ce8d (commit)
via 6ab4de612510b7c8668f0b50388258392f25b157 (commit)
via d3c88f18261b78f1ca9903f2f179b7f812288e1c (commit)
via 7dfcaf2616f6a6a712aa8cbb454aca00419db08f (commit)
via 3baf6e8b0577c32610cc6ba97af209185c16845a (commit)
via b0dbbacbe40fc8aa0b057101f84aed96ac4bea07 (commit)
via ce09e6bd0f2903566c14b4edf2659c19f2eb95b1 (commit)
via 14b59d61028c94c8072f2f171fbc987102ad714d (commit)
via 629987edfb1d03bcbdb6bf7f15d1ec0ff928e6f8 (commit)
via ba59471eeeeb6738f87e1c9c4050ce4698a7c9d8 (commit)
via eac7a5d03909291e62c671ead3d1c6a0ff84d4f0 (commit)
via 44e30ef241e342406d69c7d9c480c630d6106612 (commit)
via cdd125e8d475a6d02606322fb4c54dc76bbc8072 (commit)
via 4fd38267bca2987c6340c019a498ea6bacc6c5ec (commit)
via 1adba49ab20ac283ca62963f115910f1cf7b63ad (commit)
via 09b204d38756f0fa9ab4319874c8ce2838488dd0 (commit)
via 7e369c38993cc7cf4063a6cadc8496552abf323d (commit)
via 4c187d46d40aff1601f38675c11f92a73a13a7c9 (commit)
via 19113f1ca7a747de06d7b43c6c1eca4cd58d05e5 (commit)
via 9ddf06dceee3a2bf5480a3e261ec01aaa91a1f67 (commit)
via 929d11b2c1e1060a51bf7e395ab0ddd48e599144 (commit)
via aab9d46c83c2ad03abb0a2dc000167e552de2c29 (commit)
via d0ecf8eb9e154dcc253b1ea302d67d41bcc4ee36 (commit)
via 8d48877d2cacebeb1352404b0e2514a60416c8a4 (commit)
via 83dce818ec912def820808c059ee6f9c3801585e (commit)
via 7f893030abaf49711f948d76f124e18bfa9e4181 (commit)
via 1b787ef9ec3a08f12d7b46403f4d508e583499a2 (commit)
via e20cec744fad8299afd9bbb6ac49505b15437618 (commit)
via 6db7ee7b3ae8a7dbd6dc194921024287bed40a0a (commit)
via e6a7a86d7ec9fe1dcb77686ca549766e1641a961 (commit)
via 0c8a2c380d705a5113f01d5f8e042897969ca844 (commit)
via cba521fe42484b6689769a484408de56545d8678 (commit)
via a2dead1b0fb6523598e3acbbe91127eaf47fe98c (commit)
via f57ea23ac8e1436f37ceeda3ea8625243c20e645 (commit)
via 29ace173b170a5d77e6becb30fb1d9f253a373d5 (commit)
via 69b6da07c386446d16a11cc41cb64b486199413c (commit)
via 994d87be35769480b04c9f96085a7a0b41040c9d (commit)
via 183d2ace576710079a2bcf2a8bfcbc39b7d9becc (commit)
via 01b69e79f617db3c68b117512b6fe29978ba0ebb (commit)
via 0f595d7d1d57b12036bef801538163d3773567c3 (commit)
via 764246cfbbfff21b3127fff500e972e1dc4314e3 (commit)
via 8dd01861a9a0331b912a1ae6310e64eb6b47c29c (commit)
via b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0 (commit)
via 5ccc3764b3e17a328dad515d9a74123653f1fef9 (commit)
via aacc689677316ebb1ea45bb8fb22f921ebaf97d5 (commit)
via a5d8f98c60344548f0b6a70828b95f2b2e1f7553 (commit)
via b946e08a6ae6e73bda1f76017fcb75f41cd4b288 (commit)
via 9130ec74cf55a2531a364ef16b6608489b583f16 (commit)
via cc2948aa3189b7bd29c23e7a93ccb1217a1b4eff (commit)
via 4124994771e8fe54557a7af85e2af9c68e6ea2a3 (commit)
via 94a7029acf5ca59615bb486b1e9e196e572df6f0 (commit)
via be6a36a05d79662243c384212032783cffab5316 (commit)
via 587f4edd3947880fb0235f84cc18b62f133a9255 (commit)
via 3ec19a7884ba789a9b4f91f61415aa4b84642690 (commit)
via 444b26f739d88ab410d561f1abda67b3d6c0f491 (commit)
via 08904661a2b1c6d461b2f5abfe3226a4023453fb (commit)
via c085589b1c34fa88d28c23cb5e3659fecdb09f33 (commit)
via 72ad03fcbddb3b87de5577b7225f6dc6f892ac93 (commit)
via 1746b8ffdba174fde4a8e293309a18d112750588 (commit)
via 7a17979ea4ae769c60ca4ca291cca877701c08e1 (commit)
via c21939bc247e2e36a5d698c60ba4a03cd3bbaf38 (commit)
via 4bab7f01be8a1ce321f1e30235e1077f1ea0804c (commit)
via 65fa3923060dd66b166fd858bcd6f462f37ee8c0 (commit)
via eaf21539d4afb8df5d1b549215fd397b23004947 (commit)
via 99d1843e2a06f422cbe349804a67d2972c4dedd9 (commit)
via f5ea559aa04186534ea6771e3c15d5201fe85c67 (commit)
via 0e4288608896eeda4ad6f18cfe91d45be7c87c35 (commit)
via 90f51aba0d2b28ac4819f8800f2dcf8d67edbd28 (commit)
via e716f4410fb3f6c614def5a9b33a39185f637002 (commit)
via 5a4a4454c5302ed511eafde5a7759ebf00fbee17 (commit)
via 854ada4f1af8d72859b77e8764729f3cca45460a (commit)
via 0725031fe3a95d4e61e76ffa7aa1c79d4bebb00f (commit)
via 9b6316eabcd3438ca01d1bf7269702af24c3ec5f (commit)
via 90a162323251bfda86d82b2a3c0c7b12ce8a0bb7 (commit)
via 6f160a6e99a68347d11864d4a9bf15da851c9202 (commit)
via 84ebfef4e69130288d68d68c9e872402aa91363d (commit)
via 3dac6181c18508a194f240d633c8c3f7304adb3f (commit)
via af07e10429c1513c2348289888b240926264b32b (commit)
from 8ae26afefee947c71314733c419519fb616bf36d (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 26d148066f9cb20e395a7dc4fefdf2e2ef0b2fb0
Merge: 8ae26af 579127c
Author: Mark H Weaver <address@hidden>
Date: Thu Mar 28 05:09:53 2013 -0400
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
configure.ac
libguile/deprecated.c
libguile/deprecated.h
libguile/filesys.h
libguile/fluids.c
libguile/fports.c
libguile/gc.c
libguile/guile.c
libguile/numbers.c
libguile/objcodes.c
libguile/r6rs-ports.c
libguile/smob.c
libguile/socket.c
libguile/threads.h
module/language/scheme/decompile-tree-il.scm
module/language/tree-il/peval.scm
test-suite/tests/syncase.test
-----------------------------------------------------------------------
Summary of changes:
GNUmakefile | 2 +-
Makefile.am | 19 +-
NEWS | 317 +++++-
THANKS | 4 +-
build-aux/announce-gen | 2 +-
build-aux/config.rpath | 2 +-
build-aux/gendocs.sh | 160 ++-
build-aux/git-version-gen | 38 +-
build-aux/gitlog-to-changelog | 2 +-
build-aux/gnu-web-doc-update | 33 +-
build-aux/gnupload | 19 +-
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 | 4 +-
build-aux/useless-if-before-free | 2 +-
build-aux/vc-list-files | 2 +-
configure.ac | 35 +-
doc/gendocs_template | 2 +-
doc/r5rs/r5rs.texi | 3 +-
doc/ref/Makefile.am | 7 +
doc/ref/api-compound.texi | 24 +-
doc/ref/api-control.texi | 8 +-
doc/ref/api-data.texi | 80 +-
doc/ref/api-debug.texi | 6 +-
doc/ref/api-evaluation.texi | 21 +-
doc/ref/api-macros.texi | 18 +-
doc/ref/api-modules.texi | 33 +-
doc/ref/api-options.texi | 7 +
doc/ref/api-procedures.texi | 14 +-
doc/ref/api-scheduling.texi | 19 +-
doc/ref/api-smobs.texi | 6 +-
doc/ref/api-undocumented.texi | 6 +-
doc/ref/api-utility.texi | 6 +-
doc/ref/compiler.texi | 17 +-
doc/ref/guile-invoke.texi | 28 +-
doc/ref/guile.texi | 2 +-
doc/ref/intro.texi | 21 +-
doc/ref/misc-modules.texi | 3 +
doc/ref/posix.texi | 43 +-
doc/ref/r6rs.texi | 14 +-
doc/ref/scheme-using.texi | 20 +-
doc/ref/srfi-modules.texi | 751 ++++++++++++-
doc/ref/sxml.texi | 9 +-
doc/ref/texinfo.texi | 8 +-
doc/ref/web.texi | 96 +-
gnulib-local/build-aux/git-version-gen.diff | 47 +-
guile-readline/readline.c | 32 +-
lib/Makefile.am | 171 +++-
lib/accept.c | 2 +-
lib/alignof.h | 2 +-
lib/alloca.c | 478 ++++++++
lib/alloca.in.h | 2 +-
lib/arpa_inet.in.h | 2 +-
lib/asnprintf.c | 2 +-
lib/basename-lgpl.c | 2 +-
lib/binary-io.h | 2 +-
lib/bind.c | 2 +-
lib/btowc.c | 2 +-
lib/byteswap.in.h | 2 +-
lib/c-ctype.c | 2 +-
lib/c-ctype.h | 2 +-
lib/c-strcase.h | 2 +-
lib/c-strcasecmp.c | 2 +-
lib/c-strcaseeq.h | 2 +-
lib/c-strncasecmp.c | 2 +-
lib/canonicalize-lgpl.c | 78 +-
lib/ceil.c | 2 +-
lib/close.c | 2 +-
lib/config.charset | 2 +-
lib/connect.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 | 160 +++
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 | 6 +-
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 | 8 +-
lib/getlogin.c | 41 +
lib/getpeername.c | 2 +-
lib/getsockname.c | 2 +-
lib/getsockopt.c | 2 +-
lib/gettext.h | 2 +-
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/isinf.c | 2 +-
lib/isnan.c | 2 +-
lib/isnand-nolibm.h | 2 +-
lib/isnand.c | 2 +-
lib/isnanf.c | 2 +-
lib/isnanl.c | 2 +-
lib/itold.c | 2 +-
lib/langinfo.in.h | 2 +-
lib/listen.c | 2 +-
lib/localcharset.c | 2 +-
lib/localcharset.h | 2 +-
lib/locale.in.h | 21 +-
lib/localeconv.c | 2 +-
lib/log.c | 2 +-
lib/log1p.c | 2 +-
lib/lstat.c | 4 +-
lib/malloc.c | 2 +-
lib/malloca.c | 2 +-
lib/malloca.h | 2 +-
lib/math.c | 3 +
lib/math.in.h | 15 +-
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 | 2 +-
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 | 4 +-
lib/pathmax.h | 2 +-
lib/pipe.c | 50 +
lib/pipe2.c | 2 +-
lib/poll.c | 611 ++++++++++
lib/poll.in.h | 103 ++
lib/printf-args.c | 2 +-
lib/printf-args.h | 2 +-
lib/printf-parse.c | 2 +-
lib/printf-parse.h | 2 +-
lib/putenv.c | 34 +-
lib/raise.c | 4 +-
lib/read.c | 4 +-
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 | 64 +-
lib/regex.c | 21 +-
lib/regex.h | 23 +-
lib/regex_internal.c | 31 +-
lib/regex_internal.h | 70 +-
lib/regexec.c | 49 +-
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 | 547 +++++++++
lib/send.c | 2 +-
lib/sendto.c | 2 +-
lib/setenv.c | 10 +-
lib/setsockopt.c | 2 +-
lib/shutdown.c | 2 +-
lib/signal.in.h | 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 | 2 +-
lib/stat.c | 4 +-
lib/stdalign.in.h | 2 +-
lib/stdbool.in.h | 2 +-
lib/stddef.in.h | 2 +-
lib/stdint.in.h | 4 +-
lib/stdio.in.h | 23 +-
lib/stdlib.in.h | 23 +-
lib/streq.h | 2 +-
lib/strftime.c | 16 +-
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 | 309 +++++
lib/sys_socket.c | 3 +
lib/sys_socket.in.h | 11 +-
lib/sys_stat.in.h | 8 +-
lib/sys_time.in.h | 190 ++--
lib/sys_times.in.h | 80 ++
lib/sys_types.in.h | 2 +-
lib/sys_uio.in.h | 2 +-
lib/time.in.h | 2 +-
lib/time_r.c | 2 +-
lib/times.c | 66 +
lib/trunc.c | 2 +-
lib/unistd.c | 3 +
lib/unistd.in.h | 35 +-
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 | 4 +-
lib/vasnprintf.h | 2 +-
lib/verify.h | 2 +-
lib/vsnprintf.c | 2 +-
lib/w32sock.h | 2 +-
lib/wchar.in.h | 2 +-
lib/wcrtomb.c | 2 +-
lib/wctype-h.c | 4 +
lib/wctype.in.h | 40 +-
lib/write.c | 4 +-
lib/xsize.h | 2 +-
libguile/Makefile.am | 26 +-
libguile/__scm.h | 2 +-
libguile/bdw-gc.h | 7 +-
libguile/c-tokenize.lex | 3 +-
libguile/debug.c | 8 +-
libguile/error.c | 17 +-
libguile/filesys.c | 252 +++--
libguile/filesys.h | 4 +-
libguile/fluids.c | 11 +-
libguile/foreign.c | 115 ++-
libguile/fports.c | 143 +--
libguile/gc.c | 16 +-
libguile/guardians.c | 8 +-
libguile/guile.c | 36 +-
libguile/i18n.c | 4 +-
libguile/init.c | 3 +-
libguile/iselect.h | 34 +-
libguile/list.c | 2 -
libguile/load.c | 127 ++-
libguile/load.h | 3 +-
libguile/memoize.c | 25 +-
libguile/mkstemp.c | 4 +-
libguile/net_db.c | 56 +-
libguile/numbers.c | 1644 ++++++++++++++++----------
libguile/numbers.h | 3 +-
libguile/objcodes.c | 5 +-
libguile/poll.c | 15 +-
libguile/ports.c | 12 +-
libguile/posix.c | 108 +--
libguile/r6rs-ports.c | 16 +-
libguile/random.c | 14 +-
libguile/scmsigs.c | 34 +-
libguile/smob.c | 49 +-
libguile/socket.c | 51 +-
libguile/srfi-14.i.c | 8 +-
libguile/stime.c | 9 +-
libguile/strports.c | 9 +-
libguile/struct.c | 10 +-
libguile/struct.h | 6 +-
libguile/texi-fragments-to-docstrings | 55 +
libguile/threads.c | 34 +-
libguile/threads.h | 7 +-
libguile/vm.c | 18 +-
libguile/win32-socket.c | 632 ----------
libguile/win32-socket.h | 42 -
m4/00gnulib.m4 | 2 +-
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 | 2 +-
m4/dirent_h.m4 | 2 +-
m4/dirfd.m4 | 2 +-
m4/dirname.m4 | 2 +-
m4/double-slash-root.m4 | 2 +-
m4/dup2.m4 | 84 ++
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 | 49 +-
m4/extern-inline.m4 | 23 +-
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 | 2 +-
m4/fstat.m4 | 9 +-
m4/func.m4 | 2 +-
m4/getaddrinfo.m4 | 5 +-
m4/getlogin.m4 | 14 +
m4/glibc21.m4 | 2 +-
m4/gnulib-cache.m4 | 10 +-
m4/gnulib-common.m4 | 8 +-
m4/gnulib-comp.m4 | 77 ++-
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 | 2 +-
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/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 | 25 +-
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/log.m4 | 2 +-
m4/log1p.m4 | 2 +-
m4/longlong.m4 | 2 +-
m4/lstat.m4 | 10 +-
m4/malloc.m4 | 2 +-
m4/malloca.m4 | 2 +-
m4/math_h.m4 | 5 +-
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 | 5 +-
m4/pathmax.m4 | 2 +-
m4/pipe.m4 | 15 +
m4/pipe2.m4 | 2 +-
m4/poll.m4 | 103 ++
m4/poll_h.m4 | 47 +
m4/printf.m4 | 2 +-
m4/putenv.m4 | 8 +-
m4/raise.m4 | 8 +-
m4/read.m4 | 9 +-
m4/readlink.m4 | 2 +-
m4/regex.m4 | 85 +-
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 | 113 ++
m4/servent.m4 | 2 +-
m4/setenv.m4 | 2 +-
m4/signal_h.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 | 10 +-
m4/stdalign.m4 | 2 +-
m4/stdbool.m4 | 2 +-
m4/stddef_h.m4 | 2 +-
m4/stdint.m4 | 2 +-
m4/stdint_h.m4 | 2 +-
m4/stdio_h.m4 | 5 +-
m4/stdlib_h.m4 | 8 +-
m4/strftime.m4 | 2 +-
m4/string_h.m4 | 2 +-
m4/sys_file_h.m4 | 2 +-
m4/sys_select_h.m4 | 95 ++
m4/sys_socket_h.m4 | 5 +-
m4/sys_stat_h.m4 | 7 +-
m4/sys_time_h.m4 | 2 +-
m4/sys_times_h.m4 | 51 +
m4/sys_types_h.m4 | 2 +-
m4/sys_uio_h.m4 | 2 +-
m4/time_h.m4 | 2 +-
m4/time_r.m4 | 2 +-
m4/times.m4 | 14 +
m4/tm_gmtoff.m4 | 2 +-
m4/trunc.m4 | 2 +-
m4/unistd_h.m4 | 5 +-
m4/vasnprintf.m4 | 5 +-
m4/visibility.m4 | 2 +-
m4/vsnprintf.m4 | 2 +-
m4/warn-on-use.m4 | 2 +-
m4/warnings.m4 | 2 +-
m4/wchar_h.m4 | 2 +-
m4/wchar_t.m4 | 2 +-
m4/wcrtomb.m4 | 2 +-
m4/wctype_h.m4 | 6 +-
m4/wint_t.m4 | 2 +-
m4/write.m4 | 9 +-
m4/xsize.m4 | 2 +-
maint.mk | 17 +-
meta/Makefile.am | 10 +-
meta/guile.in | 4 +-
meta/guile.m4 | 171 ++-
module/Makefile.am | 4 +-
module/ice-9/boot-9.scm | 330 ++++--
module/ice-9/futures.scm | 23 +-
module/ice-9/mapping.scm | 82 +-
module/ice-9/psyntax-pp.scm | 36 +-
module/ice-9/psyntax.scm | 13 +-
module/language/glil/compile-assembly.scm | 53 +-
module/language/glil/decompile-assembly.scm | 191 ---
module/language/glil/spec.scm | 2 -
module/language/scheme/decompile-tree-il.scm | 35 +-
module/language/tree-il.scm | 22 +-
module/language/tree-il/canonicalize.scm | 17 +-
module/language/tree-il/compile-glil.scm | 17 +-
module/language/tree-il/cse.scm | 8 +-
module/language/tree-il/debug.scm | 7 +-
module/language/tree-il/effects.scm | 9 +-
module/language/tree-il/peval.scm | 4 +-
module/srfi/srfi-27.scm | 2 +
module/srfi/srfi-31.scm | 2 +
module/srfi/srfi-37.scm | 5 +-
module/srfi/srfi-38.scm | 1 +
module/srfi/srfi-39.scm | 2 +
module/srfi/srfi-4.scm | 1 +
module/srfi/srfi-41.scm | 482 ++++++++
module/srfi/srfi-42.scm | 2 +
module/srfi/srfi-45.scm | 13 +-
module/srfi/srfi-67.scm | 2 +
module/srfi/srfi-69.scm | 2 +-
module/system/base/compile.scm | 7 +-
module/system/base/target.scm | 38 +-
module/system/repl/command.scm | 12 +-
module/texinfo.scm | 5 +-
module/texinfo/plain-text.scm | 35 +-
module/texinfo/string-utils.scm | 15 +-
module/web/client.scm | 6 +-
module/web/http.scm | 93 ++-
module/web/response.scm | 33 +-
module/web/uri.scm | 28 +-
test-suite/Makefile.am | 1 +
test-suite/standalone/Makefile.am | 8 +-
test-suite/standalone/test-ffi | 15 +
test-suite/standalone/test-ffi-lib.c | 17 +
test-suite/standalone/test-round.c | 11 +-
test-suite/standalone/test-smob-mark.c | 133 +++
test-suite/tests/00-socket.test | 6 +-
test-suite/tests/alist.test | 4 +-
test-suite/tests/asm-to-bytecode.test | 15 +-
test-suite/tests/elisp.test | 8 +-
test-suite/tests/encoding-iso88591.test | 10 +-
test-suite/tests/encoding-iso88597.test | 10 +-
test-suite/tests/encoding-utf8.test | 10 +-
test-suite/tests/filesys.test | 74 ++-
test-suite/tests/fluids.test | 32 +-
test-suite/tests/future.test | 18 +-
test-suite/tests/gc.test | 4 +-
test-suite/tests/hash.test | 12 +-
test-suite/tests/i18n.test | 20 +-
test-suite/tests/modules.test | 2 +-
test-suite/tests/numbers.test | 575 +++++++--
test-suite/tests/optargs.test | 13 +
test-suite/tests/ports.test | 8 +-
test-suite/tests/srfi-35.test | 16 +-
test-suite/tests/srfi-37.test | 24 +-
test-suite/tests/srfi-41.test | 680 +++++++++++
test-suite/tests/srfi-45.test | 10 +-
test-suite/tests/syncase.test | 10 +
test-suite/tests/texinfo.serialize.test | 4 +-
test-suite/tests/texinfo.string-utils.test | 9 +-
test-suite/tests/texinfo.test | 66 +-
test-suite/tests/threads.test | 9 +-
test-suite/tests/tree-il.test | 18 +-
test-suite/tests/vlist.test | 8 +-
test-suite/tests/web-http.test | 114 ++
523 files changed, 10476 insertions(+), 3945 deletions(-)
mode change 100755 => 100644 build-aux/gendocs.sh
create mode 100644 lib/alloca.c
create mode 100644 lib/dup2.c
create mode 100644 lib/getlogin.c
create mode 100644 lib/math.c
create mode 100644 lib/pipe.c
create mode 100644 lib/poll.c
create mode 100644 lib/poll.in.h
create mode 100644 lib/select.c
create mode 100644 lib/sys_select.in.h
create mode 100644 lib/sys_socket.c
create mode 100644 lib/sys_times.in.h
create mode 100644 lib/times.c
create mode 100644 lib/unistd.c
create mode 100644 lib/wctype-h.c
create mode 100644 libguile/texi-fragments-to-docstrings
delete mode 100644 libguile/win32-socket.c
delete mode 100644 libguile/win32-socket.h
create mode 100644 m4/dup2.m4
create mode 100644 m4/getlogin.m4
create mode 100644 m4/pipe.m4
create mode 100644 m4/poll.m4
create mode 100644 m4/poll_h.m4
create mode 100644 m4/select.m4
create mode 100644 m4/sys_select_h.m4
create mode 100644 m4/sys_times_h.m4
create mode 100644 m4/times.m4
delete mode 100644 module/language/glil/decompile-assembly.scm
create mode 100644 module/srfi/srfi-41.scm
create mode 100644 test-suite/standalone/test-smob-mark.c
create mode 100644 test-suite/tests/srfi-41.test
diff --git a/GNUmakefile b/GNUmakefile
index 58f2ead..8759034 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2001, 2003, 2006-2013 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/Makefile.am b/Makefile.am
index 3aa5ddd..8cdcc7e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007,
-## 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+## 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -42,6 +42,19 @@ SUBDIRS = \
libguileincludedir = $(pkgincludedir)/$(GUILE_EFFECTIVE_VERSION)
libguileinclude_HEADERS = libguile.h
+schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
+schemelib_DATA = libguile/guile-procedures.txt
+
+# Build it from here so that all the modules are compiled by the time we
+# build it.
+libguile/guile-procedures.txt: libguile/guile-procedures.texi
+ $(AM_V_GEN) \
+ $(top_builddir)/meta/guile --no-auto-compile \
+ "$(srcdir)/libguile/texi-fragments-to-docstrings" \
+ "$(builddir)/libguile/guile-procedures.texi" \
+ > address@hidden
+ @mv address@hidden $@
+
EXTRA_DIST = LICENSE HACKING GUILE-VERSION \
m4/ChangeLog-2008 \
m4/gnulib-cache.m4 \
@@ -50,13 +63,15 @@ EXTRA_DIST = LICENSE HACKING GUILE-VERSION
\
gnulib-local/lib/localcharset.h.diff \
gnulib-local/lib/localcharset.c.diff \
gnulib-local/m4/clock_time.m4.diff \
- gnulib-local/build-aux/git-version-gen.diff
+ gnulib-local/build-aux/git-version-gen.diff \
+ libguile/texi-fragments-to-docstrings
TESTS = check-guile
TESTS_ENVIRONMENT = @LOCALCHARSET_TESTS_ENVIRONMENT@
ACLOCAL_AMFLAGS = -I m4
+CLEANFILES = libguile/guile-procedures.txt
DISTCLEANFILES = check-guile.log
DISTCHECK_CONFIGURE_FLAGS = --enable-error-on-warning
diff --git a/NEWS b/NEWS
index ebf5d61..80b06fd 100644
--- a/NEWS
+++ b/NEWS
@@ -1,10 +1,325 @@
Guile NEWS --- history of user-visible changes.
-Copyright (C) 1996-2012 Free Software Foundation, Inc.
+Copyright (C) 1996-2013 Free Software Foundation, Inc.
See the end for copying conditions.
Please send Guile bug reports to address@hidden
+Changes in 2.0.8 (since 2.0.7):
+
+* TODO
+
+Reorder points in order of importance and make comprehensible
+
+Assemble thanks
+
+file name docs
+
+gnulib version
+
+--language docs
+
+* Notable changes
+
+** New guile.m4.
+
+The `guile.m4' autoconf macros have been rewritten to use `guild' and
+`pkg-config' instead of the deprecated `guile-config' (which itself
+calls pkg-config).
+
+There is also a new macro, `GUILE_PKG', which allows packages to select
+the version of Guile that they want to compile against. See "Autoconf
+Macros" in the manual, for more information.
+
+** Better Windows support.
+
+Guile now correctly identifies absolute paths on Windows (MinGW), and
+creates files on that platform according to its path conventions. See
+XXX in the manual, for all details.
+
+In addition, the new Gnulib imports provide `select' and `poll' on
+Windows builds.
+
+As an incompatible change, systems that are missing <sys/select.h> were
+previously provided a public `scm_std_select' C function that defined a
+version of `select', but unhappily it also provided its own incompatible
+definitions for FD_SET, FD_ZERO, and other system interface. Guile
+should not be setting these macros in public API, so this interface was
+removed on those plaforms (basically only MinGW).
+
+** Gnulib update.
+
+Guile's copy of Gnulib was updated to XXX. The following modules were
+imported from Gnulib: select, times, pipe-posix, fstat, getlogin, and
+poll.
+
+** New optimizations.
+
+There were a number of improvements to the partial evaluator, allowing
+complete reduction of forms such as:
+
+ ((let ((_ 10)) (lambda () _)))
+
+ ((lambda _ _))
+
+ (apply (lambda _) 1 2 3 4)
+
+ (call-with-values (lambda () (values 1 2)) (lambda _ _))
+
+A number (ahem) of numeric operations on have been made faster, among
+them GCD and logarithms.
+
+Finally, `array-ref' and `array-set!' on arrays of rank 1 or 2 is now
+faster, because it avoids building a rest list.
+
+** `include' resolves relative file names relative to including file.
+
+Given a relative file name, `include' will look for it relative to the
+directory of the including file. This harmonizes the behavior of
+`include' with that of `load'.
+
+** SLIB compatibility restored.
+
+Guile 2.0.8 is now compatible with SLIB. You will have to use a
+development version of SLIB, however, until a new version of SLIB is
+released.
+
+** Better ,trace REPL command.
+
+Sometimes the ,trace output for nested function calls could overflow the
+terminal width, which wasn't useful. Now there is a limit to the amount
+of space the prefix will take. See the documentation for ",trace" for
+more information.
+
+** Update predefined character sets to Unicode 6.2.
+
+* Manual updates
+
+** Better SXML documentation.
+
+The documentation for SXML modules was much improved, though there is
+still far to go. See "SXML" in manual.
+
+** Style updates.
+
+Use of "iff" was replaced with standard English. Keyword arguments are
+now documented consistently, along with their default values.
+
+** An end to the generated-documentation experiment.
+
+When Guile 2.0 imported some modules from Guile-Lib, they came with a
+system that generated documentation from docstrings and module
+commentaries. This produced terrible documentation. We finally bit the
+bullet and incorporated these modules into the main text, and will be
+improving them manually over time, as is the case with SXML. Help is
+appreciated.
+
+** New documentation.
+
+There is now documentation for `scm_array_type', and `scm_array_ref', as
+well as for the new `array-length' / 'scm_c_array_length' /
+`scm_array_length' functions. `array-in-bounds?' has better
+documentation as well. The `program-arguments-alist' and
+`program-lambda-list' functions are now documented. Finally, the GOOPS
+class hierarchy diagram has been regenerated for the web and print
+output formats.
+
+* New deprecations
+
+** Deprecate generalized vector interface.
+
+The generalized vector interface, introduced in 1.8.0, is simply a
+redundant, verbose interface to arrays of rank 1. `array-ref' and
+similar functions are entirely sufficient. Thus,
+`scm_generalized_vector_p', `scm_generalized_vector_length',
+`scm_generalized_vector_ref', `scm_generalized_vector_set_x', and
+`scm_generalized_vector_to_list' are now deprecated.
+
+** Deprecate SCM_CHAR_CODE_LIMIT and char-code-limit.
+
+These constants were defined to 256, which is not the highest codepoint
+supported by Guile. Given that they were useless and incorrect, they
+have been deprecated.
+
+** Deprecate `http-get*'.
+
+The new `#:streaming?' argument to `http-get' subsumes the functionality
+of `http-get*' (introduced in 2.0.7). Also, the `#:extra-headers'
+argument is deprecated in favor of `#:headers'.
+
+** Deprecate (ice-9 mapping).
+
+This module, present in Guile since 1996 but never used or documented,
+has never worked in Guile 2.0. It has now been deprecated and will be
+removed in Guile 2.2.
+
+* New interfaces
+
+** `round-ash', a bit-shifting operator that rounds on right-shift.
+
+See "Bitwise Operations".
+
+** New environment variables: `GUILE_STACK_SIZE', `GUILE_INSTALL_LOCALE'.
+
+See "Environment Variables".
+
+** New procedure `sendfile'.
+
+See "File System".
+
+** New procedures for dealing with file names.
+
+See XXX for documentation on `system-file-name-convention',
+`file-name-separator?', `absolute-file-name?', and
+`file-name-separator-string'.
+
+** `array-length', an array's first dimension.
+
+See "Array Procedures".
+
+** `hash-count', for hash tables.
+
+See "Hash Tables".
+
+** New foreign types: `ssize_t', `ptrdiff_t'.
+
+See "Foreign Types".
+
+** New C helpers: `scm_from_ptrdiff_t', `scm_to_ptrdiff_t'.
+
+See "Integers".
+
+** Much more capable `xml->sxml'
+
+See "Reading and Writing XML" for information on how the `xml->sxml'
+parser deals with namespaces, processed entities, doctypes, and literal
+strings. Incidentally, `current-ssax-error-port' is now a parameter
+object.
+
+** New command-line argument: `--language'
+
+See XXX in the manual.
+
+** `current-language' in default environment.
+
+Previously defined only in `(system base language)', `current-language'
+is now defined in the default environment, and is used to determine the
+language for the REPL, and for `compile-and-load'.
+
+** New procedure: `fluid->parameter'
+
+See "Parameters", for information on how to convert a fluid to a
+parameter.
+
+** New procedures to read all characters from a port
+
+See "Line/Delimited" in the manual for documentation on `read-string'
+ and `read-string!'.
+
+** New HTTP client procedures.
+
+See "Web Client" for documentation on the new `http-head', `http-post',
+`http-put', `http-delete', `http-trace', and `http-options' procedures,
+and also for more options to `http-get'.
+
+** New procedures for converting strings to and from bytevectors.
+
+See "Representing Strings as Bytes" for documention on the new `(ice-9
+iconv)' module and its `bytevector->string' and `string->bytevector'
+procedures.
+
+** New `print' REPL option.
+
+See "REPL Commands" in the manual for information on the new
+user-customizable REPL printer.
+
+** New variable: %site-ccache-dir.
+
+The "Installing Site Packages" and "Build Config" manual sections now
+refer to this variable to describe where users should install their
+`.go' files.
+
+* Build fixes
+
+** Fix compilation against libgc 7.3.
+** Fix cross-compilation of `c-tokenize.o'.
+** Fix warning when compiling against glibc 2.17.
+** Fix documentation build against Texinfo 5.0.
+** Fix building Guile from a directory with non-ASCII characters.
+** Fix native MinGW build.
+** Fix --disable-posix build.
+** Fix MinGW builds with networking, POSIX, and thread support.
+
+* Bug fixes
+
+** SRFI-37: Fix infinite loop when parsing optional-argument short options
+ (http://bugs.gnu.org/13176)
+** web: Support non-GMT date headers in the HTTP client
+ (http://bugs.gnu.org/13544)
+** Avoid stack overflows with `par-map' and nested futures in general
+ (http://bugs.gnu.org/13188)
+** A fork when multiple threads are running will now print a warning.
+** Allow for spurious wakeups from pthread_cond_wait.
+ (http://bugs.gnu.org/10641)
+** Warn and ignore module autoload failures.
+ (http://bugs.gnu.org/12202)
+** Use chmod portably in (system base compile).
+ (http://bugs.gnu.org/10474)
+** Fix response-body-port for responses without content-length.
+ (http://bugs.gnu.org/13857)
+** Allow case-lambda expressions with no clauses.
+ (http://bugs.gnu.org/9776)
+** Improve standards conformance of string->number.
+ (http://bugs.gnu.org/11887)
+** Support calls and tail-calls with more than 255 formals.
+** ,option evaluates its right-hand-side.
+ (http://bugs.gnu.org/13076)
+** Structs with tail arrays are not simple.
+ (http://bugs.gnu.org/12808)
+** Make `SCM_LONG_BIT' usable in preprocessor conditionals.
+ (http://bugs.gnu.org/13848)
+** Fix thread-unsafe lazy initializations.
+** Allow SMOB mark procedures to be called from parallel markers.
+ (http://bugs.gnu.org/13611)
+** Fix later-bindings-win logic in with-fluids.
+ (http://bugs.gnu.org/13843)
+** Fix duplicate removal of with-fluids.
+ (http://bugs.gnu.org/13838)
+** Support calling foreign functions of 10 arguments or more.
+ (http://bugs.gnu.org/13809)
+** Let reverse! accept arbitrary types as second argument.
+ (http://bugs.gnu.org/13835)
+** Recognize the `x86_64.*-gnux32' triplet.
+** Check whether a triplet's OS part specifies an ABI.
+** Recognize mips64* as having 32-bit pointers by default.
+** Remove language/glil/decompile-assembly.scm.
+ (http://bugs.gnu.org/10622)
+** Use O_BINARY in `copy-file', `load-objcode', `mkstemp'.
+** Fix compilation of functions with more than 255 local variables.
+** Fix `getgroups' for when zero supplementary group IDs exist.
+** Allow (define-macro name (lambda ...)).
+** Various fixes to the (texinfo) modules.
+** guild: Gracefully handle failures to install the locale.
+** Fix format string warnings for ~!, ~|, ~/, ~q, ~Q, and ~^.
+ (http://bugs.gnu.org/13485)
+** Fix source annotation bug in psyntax 'expand-body'.
+** Ecmascript: Fix conversion to boolean for non-numbers.
+** A failure to find a module's file does not prevent future loading.
+** Many (oop goops save) fixes.
+** `http-get': don't shutdown write end of socket.
+ (http://bugs.gnu.org/13095)
+** Avoid signed integer overflow in scm_product.
+** http: read-response-body always returns bytevector or #f (not EOF in one
case).
+** web: Correctly detect "No route to host" conditions.
+** `system*': failure to execvp no longer leaks dangling processes
+ (http://bugs.gnu.org/13166)
+** More sensible case-lambda* dispatch
+ (http://bugs.gnu.org/12929)
+** Do not defer expansion of internal define-syntax forms.
+ (http://bugs.gnu.org/13509)
+
+
+
Changes in 2.0.7 (since 2.0.6):
* Notable changes
diff --git a/THANKS b/THANKS
index fc2bf49..8209996 100644
--- a/THANKS
+++ b/THANKS
@@ -9,6 +9,7 @@ Contributors since the last release:
Daniel Hartwig
No Itisnt
Neil Jerram
+ Chris K Jester-Young
Daniel Kraft
Noah Lavine
Gregory Marton
@@ -21,7 +22,7 @@ Contributors since the last release:
Ken Raeburn
Andreas Rottmann
Kevin Ryde
- Brian Templeton
+ BT Templeton
Mark H Weaver
Göran Weinholt
Ralf Wildenhues
@@ -94,6 +95,7 @@ For fixes or providing information which led to a fix:
David Jaquay
Paul Jarc
Steve Juranich
+ David Kastrup
Richard Kim
Bruce Korb
René Köcher
diff --git a/build-aux/announce-gen b/build-aux/announce-gen
index ec7c22a..3a64ec6 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 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 1a07018..c38b914 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-2012 Free Software Foundation, Inc.
+# Copyright 1996-2013 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
old mode 100755
new mode 100644
index 0c0bc4b..e4bfc9f
--- a/build-aux/gendocs.sh
+++ b/build-aux/gendocs.sh
@@ -2,9 +2,9 @@
# 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=2012-10-27.11
+scriptversion=2013-02-03.15
-# Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
+# Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
# Free Software Foundation, Inc.
#
# This program is free software: you can redistribute it and/or modify
@@ -56,7 +56,7 @@ unset use_texi2html
version="gendocs.sh $scriptversion
-Copyright 2012 Free Software Foundation, Inc.
+Copyright 2013 Free Software Foundation, Inc.
There is NO warranty. You may redistribute this software
under the terms of the GNU General Public License.
For more information about these matters, see the files named COPYING."
@@ -69,16 +69,23 @@ discussion:
http://www.gnu.org/prep/maintain_toc.html
Options:
- -s SRCFILE read Texinfo from SRCFILE, instead of PACKAGE.{texinfo|texi|txi}
- -o OUTDIR write files into OUTDIR, instead of manual/.
- -I DIR append DIR to the Texinfo search path.
- --email ADR use ADR as contact in generated web pages.
- --docbook convert through DocBook too (xml, txt, html, pdf).
- --html ARG pass indicated ARG to makeinfo or texi2html for HTML targets.
- --info ARG pass indicated ARG to makeinfo for Info, instead of --no-split.
- --texi2html use texi2html to generate HTML targets.
- --help display this help and exit successfully.
- --version display version information and exit successfully.
+ --email ADR use ADR as contact in generated web pages; always give this.
+
+ -s SRCFILE read Texinfo from SRCFILE, instead of PACKAGE.{texinfo|texi|txi}
+ -o OUTDIR write files into OUTDIR, instead of manual/.
+ -I DIR append DIR to the Texinfo search path.
+ --common ARG pass ARG in all invocations.
+ --html ARG pass ARG to makeinfo or texi2html for HTML targets.
+ --info ARG pass ARG to makeinfo for Info, instead of --no-split.
+ --no-ascii skip generating the plain text output.
+ --source ARG include ARG in tar archive of sources.
+ --split HOW make split HTML by node, section, chapter; default node.
+
+ --texi2html use texi2html to make HTML target, with all split versions.
+ --docbook convert through DocBook too (xml, txt, html, pdf).
+
+ --help display this help and exit successfully.
+ --version display version information and exit successfully.
Simple example: $prog --email address@hidden emacs \"GNU Emacs Manual\"
@@ -92,8 +99,8 @@ Output will be in a new subdirectory \"manual\" (by default;
use -o OUTDIR to override). Move all the new files into your web CVS
tree, as explained in the Web Pages node of maintain.texi.
-Please do use the --email ADDRESS option to specify your bug-reporting
-address in the generated HTML pages.
+Please use the --email ADDRESS option so your own bug-reporting
+address will be used in the generated HTML pages.
MANUAL-TITLE is included as part of the HTML <title> of the overall
manual/index.html file. It should include the name of the package being
@@ -117,7 +124,7 @@ You can set the environment variables MAKEINFO, TEXI2DVI,
TEXI2HTML,
and PERL to control the programs that get executed, and
GENDOCS_TEMPLATE_DIR to control where the gendocs_template file is
looked for. With --docbook, the environment variables DOCBOOK2HTML,
-DOCBOOK2PDF, and DOCBOOK2TXT are also respected.
+DOCBOOK2PDF, and DOCBOOK2TXT are also consulted.
By default, makeinfo and texi2dvi are run in the default (English)
locale, since that's the language of most Texinfo manuals. If you
@@ -130,25 +137,34 @@ Email bug reports or enhancement requests to
address@hidden
MANUAL_TITLE=
PACKAGE=
address@hidden # please override with --email
-commonarg= # Options passed to all the tools (-I dir).
+commonarg= # passed to all makeinfo/texi2html invcations.
+dirargs= # passed to all tools (-I dir).
dirs= # -I's directories.
htmlarg=
infoarg=--no-split
+generate_ascii=true
outdir=manual
+source_extra=
+split=node
srcfile=
while test $# -gt 0; do
case $1 in
- --email) shift; EMAIL=$1;;
- --help) echo "$usage"; exit 0;;
- --version) echo "$version"; exit 0;;
- -s) shift; srcfile=$1;;
- -o) shift; outdir=$1;;
- -I) shift; commonarg="$commonarg -I '$1'"; dirs="$dirs $1";;
- --docbook) docbook=yes;;
- --html) shift; htmlarg=$1;;
- --info) shift; infoarg=$1;;
+ -s) shift; srcfile=$1;;
+ -o) shift; outdir=$1;;
+ -I) shift; dirargs="$dirargs -I '$1'"; dirs="$dirs $1";;
+ --common) shift; commonarg=$1;;
+ --docbook) docbook=yes;;
+ --email) shift; EMAIL=$1;;
+ --html) shift; htmlarg=$1;;
+ --info) shift; infoarg=$1;;
+ --no-ascii) generate_ascii=false;;
+ --source) shift; source_extra=$1;;
+ --split) shift; split=$1;;
--texi2html) use_texi2html=1;;
+
+ --help) echo "$usage"; exit 0;;
+ --version) echo "$version"; exit 0;;
-*)
echo "$0: Unknown option \`$1'." >&2
echo "$0: Try \`--help' for more information." >&2
@@ -166,6 +182,9 @@ while test $# -gt 0; do
shift
done
+# makeinfo uses the dirargs, but texi2dvi doesn't.
+commonarg=" $dirargs $commonarg"
+
# For most of the following, the base name is just $PACKAGE
base=$PACKAGE
@@ -247,46 +266,52 @@ case $outdir in
*) abs_outdir=$srcdir/$outdir;;
esac
-echo "Generating output formats for $srcfile"
+echo "Making output for $srcfile"
+echo " in `pwd`"
+mkdir -p "$outdir/"
cmd="$SETLANG $MAKEINFO -o $PACKAGE.info $commonarg $infoarg \"$srcfile\""
-echo "Generating info file(s)... ($cmd)"
+echo "Generating info... ($cmd)"
eval "$cmd"
-mkdir -p "$outdir/"
tar czf "$outdir/$PACKAGE.info.tar.gz" $PACKAGE.info*
+ls -l "$outdir/$PACKAGE.info.tar.gz"
info_tgz_size=`calcsize "$outdir/$PACKAGE.info.tar.gz"`
# do not mv the info files, there's no point in having them available
# separately on the web.
-cmd="$SETLANG $TEXI2DVI $commonarg \"$srcfile\""
-echo "Generating dvi ... ($cmd)"
+cmd="$SETLANG $TEXI2DVI $dirargs \"$srcfile\""
+printf "\nGenerating dvi... ($cmd)\n"
eval "$cmd"
-
# compress/finish dvi:
gzip -f -9 $PACKAGE.dvi
dvi_gz_size=`calcsize $PACKAGE.dvi.gz`
mv $PACKAGE.dvi.gz "$outdir/"
+ls -l "$outdir/$PACKAGE.dvi.gz"
-cmd="$SETLANG $TEXI2DVI --pdf $commonarg \"$srcfile\""
-echo "Generating pdf ... ($cmd)"
+cmd="$SETLANG $TEXI2DVI --pdf $dirargs \"$srcfile\""
+printf "\nGenerating pdf... ($cmd)\n"
eval "$cmd"
pdf_size=`calcsize $PACKAGE.pdf`
mv $PACKAGE.pdf "$outdir/"
+ls -l "$outdir/$PACKAGE.pdf"
-opt="-o $PACKAGE.txt --no-split --no-headers $commonarg"
-cmd="$SETLANG $MAKEINFO $opt \"$srcfile\""
-echo "Generating ASCII... ($cmd)"
-eval "$cmd"
-ascii_size=`calcsize $PACKAGE.txt`
-gzip -f -9 -c $PACKAGE.txt >"$outdir/$PACKAGE.txt.gz"
-ascii_gz_size=`calcsize "$outdir/$PACKAGE.txt.gz"`
-mv $PACKAGE.txt "$outdir/"
+if $generate_ascii; then
+ opt="-o $PACKAGE.txt --no-split --no-headers $commonarg"
+ cmd="$SETLANG $MAKEINFO $opt \"$srcfile\""
+ printf "\nGenerating ascii... ($cmd)\n"
+ eval "$cmd"
+ ascii_size=`calcsize $PACKAGE.txt`
+ gzip -f -9 -c $PACKAGE.txt >"$outdir/$PACKAGE.txt.gz"
+ ascii_gz_size=`calcsize "$outdir/$PACKAGE.txt.gz"`
+ mv $PACKAGE.txt "$outdir/"
+ ls -l "$outdir/$PACKAGE.txt" "$outdir/$PACKAGE.txt.gz"
+fi
html_split()
{
- opt="--split=$1 $commonarg $htmlarg --node-files"
+ opt="--split=$1 --node-files $commonarg $htmlarg"
cmd="$SETLANG $TEXI2HTML --output $PACKAGE.html $opt \"$srcfile\""
- echo "Generating html by $1... ($cmd)"
+ printf "\nGenerating html by $1... ($cmd)\n"
eval "$cmd"
split_html_dir=$PACKAGE.html
(
@@ -304,7 +329,7 @@ html_split()
if test -z "$use_texi2html"; then
opt="--no-split --html -o $PACKAGE.html $commonarg $htmlarg"
cmd="$SETLANG $MAKEINFO $opt \"$srcfile\""
- echo "Generating monolithic html... ($cmd)"
+ printf "\nGenerating monolithic html... ($cmd)\n"
rm -rf $PACKAGE.html # in case a directory is left over
eval "$cmd"
html_mono_size=`calcsize $PACKAGE.html`
@@ -312,24 +337,29 @@ if test -z "$use_texi2html"; then
html_mono_gz_size=`calcsize "$outdir/$PACKAGE.html.gz"`
copy_images "$outdir/" $PACKAGE.html
mv $PACKAGE.html "$outdir/"
+ ls -l "$outdir/$PACKAGE.html" "$outdir/$PACKAGE.html.gz"
- opt="--html -o $PACKAGE.html $commonarg $htmlarg"
+ opt="--html -o $PACKAGE.html --split=$split $commonarg $htmlarg"
cmd="$SETLANG $MAKEINFO $opt \"$srcfile\""
- echo "Generating html by node... ($cmd)"
+ printf "\nGenerating html by $split... ($cmd)\n"
eval "$cmd"
split_html_dir=$PACKAGE.html
copy_images $split_html_dir/ $split_html_dir/*.html
(
cd $split_html_dir || exit 1
- tar -czf "$abs_outdir/$PACKAGE.html_node.tar.gz" -- *
+ tar -czf "$abs_outdir/$PACKAGE.html_$split.tar.gz" -- *
)
- html_node_tgz_size=`calcsize "$outdir/$PACKAGE.html_node.tar.gz"`
- rm -rf "$outdir/html_node/"
- mv $split_html_dir "$outdir/html_node/"
-else
+ eval \
+ html_${split}_tgz_size=`calcsize "$outdir/$PACKAGE.html_$split.tar.gz"`
+ rm -rf "$outdir/html_$split/"
+ mv $split_html_dir "$outdir/html_$split/"
+ du -s "$outdir/html_$split/"
+ ls -l "$outdir/$PACKAGE.html_$split.tar.gz"
+
+else # use texi2html:
opt="--output $PACKAGE.html $commonarg $htmlarg"
cmd="$SETLANG $TEXI2HTML $opt \"$srcfile\""
- echo "Generating monolithic html... ($cmd)"
+ printf "\nGenerating monolithic html with texi2html... ($cmd)\n"
rm -rf $PACKAGE.html # in case a directory is left over
eval "$cmd"
html_mono_size=`calcsize $PACKAGE.html`
@@ -342,19 +372,20 @@ else
html_split section
fi
-echo Making .tar.gz for sources...
+printf "\nMaking .tar.gz for sources...\n"
d=`dirname $srcfile`
(
cd "$d"
- srcfiles=`ls *.texinfo *.texi *.txi *.eps 2>/dev/null` || true
- tar cvzfh "$abs_outdir/$PACKAGE.texi.tar.gz" $srcfiles
+ srcfiles=`ls -d *.texinfo *.texi *.txi *.eps $source_extra 2>/dev/null` ||
true
+ tar czfh "$abs_outdir/$PACKAGE.texi.tar.gz" $srcfiles
+ ls -l "$abs_outdir/$PACKAGE.texi.tar.gz"
)
texi_tgz_size=`calcsize "$outdir/$PACKAGE.texi.tar.gz"`
if test -n "$docbook"; then
opt="-o - --docbook $commonarg"
cmd="$SETLANG $MAKEINFO $opt \"$srcfile\" >${srcdir}/$PACKAGE-db.xml"
- echo "Generating docbook XML... ($cmd)"
+ printf "\nGenerating docbook XML... ($cmd)\n"
eval "$cmd"
docbook_xml_size=`calcsize $PACKAGE-db.xml`
gzip -f -9 -c $PACKAGE-db.xml >"$outdir/$PACKAGE-db.xml.gz"
@@ -364,7 +395,7 @@ if test -n "$docbook"; then
split_html_db_dir=html_node_db
opt="$commonarg -o $split_html_db_dir"
cmd="$DOCBOOK2HTML $opt \"${outdir}/$PACKAGE-db.xml\""
- echo "Generating docbook HTML... ($cmd)"
+ printf "\nGenerating docbook HTML... ($cmd)\n"
eval "$cmd"
(
cd ${split_html_db_dir} || exit 1
@@ -377,24 +408,25 @@ if test -n "$docbook"; then
rmdir ${split_html_db_dir}
cmd="$DOCBOOK2TXT \"${outdir}/$PACKAGE-db.xml\""
- echo "Generating docbook ASCII... ($cmd)"
+ printf "\nGenerating docbook ASCII... ($cmd)\n"
eval "$cmd"
docbook_ascii_size=`calcsize $PACKAGE-db.txt`
mv $PACKAGE-db.txt "$outdir/"
cmd="$DOCBOOK2PDF \"${outdir}/$PACKAGE-db.xml\""
- echo "Generating docbook PDF... ($cmd)"
+ printf "\nGenerating docbook PDF... ($cmd)\n"
eval "$cmd"
docbook_pdf_size=`calcsize $PACKAGE-db.pdf`
mv $PACKAGE-db.pdf "$outdir/"
fi
-echo "Writing index file..."
+printf "\nMaking index file...\n"
if test -z "$use_texi2html"; then
- CONDS="/%%IF *HTML_SECTION%%/,/%%ENDIF *HTML_SECTION%%/d;\
- /%%IF *HTML_CHAPTER%%/,/%%ENDIF *HTML_CHAPTER%%/d"
+ CONDS="/%%IF *HTML_SECTION%%/,/%%ENDIF *HTML_SECTION%%/d;\
+ /%%IF *HTML_CHAPTER%%/,/%%ENDIF *HTML_CHAPTER%%/d"
else
- CONDS="/%%ENDIF.*%%/d;/%%IF *HTML_SECTION%%/d;/%%IF *HTML_CHAPTER%%/d"
+ # should take account of --split here.
+ CONDS="/%%ENDIF.*%%/d;/%%IF *HTML_SECTION%%/d;/%%IF *HTML_CHAPTER%%/d"
fi
curdate=`$SETLANG date '+%B %d, %Y'`
diff --git a/build-aux/git-version-gen b/build-aux/git-version-gen
index 0b51154..223a61e 100755
--- a/build-aux/git-version-gen
+++ b/build-aux/git-version-gen
@@ -1,8 +1,8 @@
#!/bin/sh
# Print a version string.
-scriptversion=2012-07-06.14; # UTC
+scriptversion=2012-12-31.23; # UTC
-# Copyright (C) 2007-2012 Free Software Foundation, Inc.
+# Copyright (C) 2007-2013 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
@@ -85,16 +85,18 @@ Print a version string.
Options:
- --prefix prefix of git tags to strip from version (default 'v')
- --match pattern for git tags to match (default: '\$prefix*')
+ --prefix prefix of git tags (default 'v')
+ --match pattern for git tags to match (default: '\$prefix*')
+ --fallback fallback version to use if \"git --version\" fails
- --help display this help and exit
- --version output version information and exit
+ --help display this help and exit
+ --version output version information and exit
-Running without arguments will suffice in most cases. If no --match
-argument is given, only match tags that begin with the --prefix."
+Running without arguments will suffice in most cases."
prefix=v
+fallback=
+
unset match
unset tag_sed_script
@@ -104,14 +106,15 @@ while test $# -gt 0; do
--version) echo "$version"; exit 0;;
--prefix) shift; prefix="$1";;
--match) shift; match="$1";;
+ --fallback) shift; fallback="$1";;
-*)
echo "$0: Unknown option '$1'." >&2
echo "$0: Try '--help' for more information." >&2
exit 1;;
*)
- if test -z "$tarball_version_file"; then
+ if test "x$tarball_version_file" = x; then
tarball_version_file="$1"
- elif test -z "$tag_sed_script"; then
+ elif test "x$tag_sed_script" = x; then
tag_sed_script="$1"
else
echo "$0: extra non-option argument '$1'." >&2
@@ -121,7 +124,7 @@ while test $# -gt 0; do
shift
done
-if test -z "$tarball_version_file"; then
+if test "x$tarball_version_file" = x; then
echo "$usage"
exit 1
fi
@@ -146,18 +149,19 @@ then
[0-9]*) ;;
*) v= ;;
esac
- test -z "$v" \
+ test "x$v" = x \
&& echo "$0: WARNING: $tarball_version_file is missing or damaged" 1>&2
fi
-if test -n "$v"
+if test "x$v" != x
then
: # use $v
# Otherwise, if there is at least one git commit involving the working
# directory, and "git describe" output looks sensible, use that to
# derive a version string.
elif test "`git log -1 --pretty=format:x . 2>&1`" = x \
- && v=`git describe --abbrev=4 --match="$match" HEAD 2>/dev/null` \
+ && v=`git describe --abbrev=4 --match="$match" HEAD 2>/dev/null \
+ || git describe --abbrev=4 HEAD 2>/dev/null` \
&& v=`printf '%s\n' "$v" | sed "$tag_sed_script"` \
&& case $v in
$prefix[0-9]*) ;;
@@ -189,8 +193,10 @@ then
# Remove the "g" in git describe's output string, to save a byte.
v=`echo "$v" | sed 's/-/./;s/\(.*\)-g/\1-/'`;
v_from_git=1
-else
+elif test "x$fallback" = x || git --version >/dev/null 2>&1; then
v=UNKNOWN
+else
+ v=$fallback
fi
v=`echo "$v" |sed "s/^$prefix//"`
@@ -198,7 +204,7 @@ v=`echo "$v" |sed "s/^$prefix//"`
# Test whether to append the "-dirty" suffix only if the version
# string we're using came from git. I.e., skip the test if it's "UNKNOWN"
# or if it came from .tarball-version.
-if test -n "$v_from_git"; then
+if test "x$v_from_git" != x; then
# Don't declare a version "dirty" merely because a time stamp has changed.
git update-index --refresh > /dev/null 2>&1
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index 5184edc..e02d34c 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2008-2013 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 4acd69d..268ecc0 100755
--- a/build-aux/gnu-web-doc-update
+++ b/build-aux/gnu-web-doc-update
@@ -1,15 +1,10 @@
#!/bin/sh
# Run this after each non-alpha release, to update the web documentation at
# http://www.gnu.org/software/$pkg/manual/
-# This script must be run from the top-level directory,
-# assumes you're using git for revision control,
-# and requires a .prev-version file as well as a Makefile,
-# from which it extracts the version number and package name, respectively.
-# Also, it assumes all documentation is in the doc/ sub-directory.
-VERSION=2009-07-21.16; # UTC
+VERSION=2012-12-16.14; # UTC
-# Copyright (C) 2009-2012 Free Software Foundation, Inc.
+# Copyright (C) 2009-2013 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
@@ -37,8 +32,14 @@ Run this script from top_srcdir (no arguments) after each
non-alpha
release, to update the web documentation at
http://www.gnu.org/software/\$pkg/manual/
+This script assumes you're using git for revision control, and
+requires a .prev-version file as well as a Makefile, from which it
+extracts the version number and package name, respectively. Also, it
+assumes all documentation is in the doc/ sub-directory.
+
Options:
-C, --builddir=DIR location of (configured) Makefile (default: .)
+ -n, --dry-run don't actually commit anything
--help print this help, then exit
--version print version number, then exit
@@ -100,12 +101,12 @@ find_tool ()
# Requirements: everything required to bootstrap your package, plus
# these.
find_tool CVS cvs
-find_tool CVSU cvsu
find_tool GIT git
find_tool RSYNC rsync
find_tool XARGS gxargs xargs
builddir=.
+dryrun=
while test $# != 0
do
# Handle --option=value by splitting apart and putting back on argv.
@@ -121,6 +122,7 @@ do
case $1 in
--help|--version) ${1#--};;
-C|--builddir) shift; builddir=$1; shift ;;
+ -n|--dry-run) dryrun=echo; shift;;
--*) die "unrecognized option: $1";;
*) break;;
esac
@@ -139,7 +141,7 @@ current_branch=$($GIT branch | sed -ne '/^\* /{s///;p;q;}')
cleanup()
{
__st=$?
- rm -rf "$tmp"
+ $dryrun rm -rf "$tmp"
$GIT checkout "$current_branch"
$GIT submodule update --recursive
$GIT branch -d $tmp_branch
@@ -172,12 +174,15 @@ $RSYNC -avP "$builddir"/doc/manual/ $tmp/$pkg/manual
(
cd $tmp/$pkg/manual
- # Add any new files:
- $CVSU --types='?' \
- | sed s/..// \
- | $XARGS --no-run-if-empty -- $CVS add -ko
+ # Add all the files. This is simpler than trying to add only the
+ # new ones because of new directories: it would require iterating on
+ # adding the outer directories, and then their contents.
+ #
+ # find guarantees that we add outer directories first.
+ find . -name CVS -prune -o -print \
+ | $XARGS --no-run-if-empty -- $dryrun $CVS add -ko
- $CVS ci -m $version
+ $dryrun $CVS ci -m $version
)
# Local variables:
diff --git a/build-aux/gnupload b/build-aux/gnupload
index a0e5c7b..782dd6f 100755
--- a/build-aux/gnupload
+++ b/build-aux/gnupload
@@ -1,9 +1,9 @@
#!/bin/sh
# Sign files and upload them.
-scriptversion=2012-06-11.00; # UTC
+scriptversion=2012-12-11.16; # UTC
-# Copyright (C) 2004-2012 Free Software Foundation, Inc.
+# Copyright (C) 2004-2013 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
@@ -242,6 +242,8 @@ fi
# Make sure passphrase is not exported in the environment.
unset passphrase
+unset passphrase_fd_0
+GNUPGHOME=${GNUPGHOME:-$HOME/.gnupg}
# Reset PATH to be sure that echo is a built-in. We will later use
# 'echo $passphrase' to output the passphrase, so it is important that
@@ -249,12 +251,13 @@ unset passphrase
# listings with their arguments...).
# Remember this script runs with 'set -e', so if echo is not built-in
# it will exit now.
-if $dry_run; then :; else
+if $dry_run || grep -q "^use-agent" $GNUPGHOME/gpg.conf; then :; else
PATH=/empty echo -n "Enter GPG passphrase: "
stty -echo
read -r passphrase
stty echo
echo
+ passphrase_fd_0="--passphrase-fd 0"
fi
if test $# -ne 0; then
@@ -262,7 +265,7 @@ if test $# -ne 0; then
do
echo "Signing $file ..."
rm -f $file.sig
- echo "$passphrase" | $dbg $GPG --passphrase-fd 0 -ba -o $file.sig $file
+ echo "$passphrase" | $dbg $GPG $passphrase_fd_0 -ba -o $file.sig $file
done
fi
@@ -320,12 +323,12 @@ upload ()
case $dest in
alpha.gnu.org:*)
mkdirective "$destdir" "$base" "$file" "$stmt"
- echo "$passphrase" | $dbg $GPG --passphrase-fd 0 --clearsign
$base.directive
+ echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign
$base.directive
$dbg ncftpput ftp-upload.gnu.org /incoming/alpha $files
$base.directive.asc
;;
ftp.gnu.org:*)
mkdirective "$destdir" "$base" "$file" "$stmt"
- echo "$passphrase" | $dbg $GPG --passphrase-fd 0 --clearsign
$base.directive
+ echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign
$base.directive
$dbg ncftpput ftp-upload.gnu.org /incoming/ftp $files $base.directive.asc
;;
savannah.gnu.org:*)
@@ -344,7 +347,7 @@ upload ()
destdir_p1=`echo "$destdir" | sed 's,^[^/]*/,,'`
destdir_topdir=`echo "$destdir" | sed 's,/.*,,'`
mkdirective "$destdir_p1" "$base" "$file" "$stmt"
- echo "$passphrase" | $dbg $GPG --passphrase-fd 0 --clearsign
$base.directive
+ echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign
$base.directive
for f in $files $base.directive.asc
do
echo put $f
@@ -353,7 +356,7 @@ upload ()
/*)
dest_host=`echo "$dest" | sed 's,:.*,,'`
mkdirective "$destdir" "$base" "$file" "$stmt"
- echo "$passphrase" | $dbg $GPG --passphrase-fd 0 --clearsign
$base.directive
+ echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign
$base.directive
$dbg cp $files $base.directive.asc $dest_host
;;
*)
diff --git a/build-aux/snippet/arg-nonnull.h b/build-aux/snippet/arg-nonnull.h
index 3a9dd26..8ea2a47 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 96da94b..b35b933 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2010-2013 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 1c8d61f..1347c27 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 d4cb94f..1736a1b 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2010-2013 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
@@ -55,7 +55,7 @@
rather than issue the nice warning, but the end result of informing
the developer about their portability problem is still achieved):
#if HAVE_RAW_DECL_ENVIRON
- static inline char ***rpl_environ (void) { return &environ; }
+ static char ***rpl_environ (void) { return &environ; }
_GL_WARN_ON_USE (rpl_environ, "environ is not always properly declared");
# undef environ
# define environ (*rpl_environ ())
diff --git a/build-aux/useless-if-before-free b/build-aux/useless-if-before-free
index 2b64630..663347a 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2008-2013 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 d477da8..7ec335f 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2006-2013 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/configure.ac b/configure.ac
index 3b532a0..85e3170 100644
--- a/configure.ac
+++ b/configure.ac
@@ -647,12 +647,13 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
# this file instead of <fenv.h>
# process.h - mingw specific
# sched.h - missing on MinGW
+# sys/sendfile.h - non-POSIX, found in glibc
#
AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h memory.h process.h
string.h \
sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h machine/fpu.h poll.h sched.h])
+direct.h machine/fpu.h sched.h sys/sendfile.h])
# "complex double" is new in C99, and "complex" is only a keyword if
# <complex.h> is included
@@ -705,9 +706,6 @@ case $host in
[Define if you have the <winsock2.h> header file.])])
AC_CHECK_LIB(ws2_32, main)
AC_LIBOBJ([win32-uname])
- if test "$enable_networking" = yes ; then
- AC_LIBOBJ([win32-socket])
- fi
if test "$enable_shared" = yes ; then
EXTRA_DEFS="-DSCM_IMPORT"
AC_DEFINE([USE_DLL_IMPORT], 1,
@@ -738,7 +736,6 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# gmtime_r - recent posix, not on old systems
# pipe - not in mingw
# _pipe - specific to mingw, taking 3 args
-# poll - since posix 2001
# readdir_r - recent posix, not on old systems
# readdir64_r - not available on HP-UX 11.11
# stat64 - SuS largefile stuff, not on old systems
@@ -748,10 +745,21 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# _NSGetEnviron - Darwin specific
# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
# fork - unavailable on Windows
-# utimensat: posix.1-2008
-# sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
+# utimensat - posix.1-2008
+# sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
+# sendfile - non-POSIX, found in glibc
#
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround
ftime ftruncate fchown fchmod getcwd geteuid getsid gettimeofday gmtime_r ioctl
lstat mkdir mknod nice pipe _pipe poll readdir_r readdir64_r readlink rename
rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt
stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname
waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent
getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index
bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l
newlocale utimensat sched_getaffinity sched_setaffinity])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid
\
+ fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \
+ gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe
\
+ readdir_r readdir64_r readlink rename rmdir select setegid seteuid \
+ setlocale setpgid setsid sigaction siginterrupt stat64 strftime \
+ strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid
\
+ strdup system usleep atexit on_exit chown link fcntl ttyname getpwent
\
+ getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \
+ index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron \
+ strcoll strcoll_l newlocale utimensat sched_getaffinity \
+ sched_setaffinity sendfile])
AM_CONDITIONAL([HAVE_FORK], [test "x$ac_cv_func_fork" = "xyes"])
@@ -920,6 +928,8 @@ AC_DEFUN([GUILE_FUNC_DECLARED], [
GUILE_FUNC_DECLARED(sleep, unistd.h)
GUILE_FUNC_DECLARED(usleep, unistd.h)
+AC_CHECK_DECLS([getlogin, alarm])
+
AC_CHECK_DECLS([strptime],,,
[#define _GNU_SOURCE /* ask glibc to give strptime prototype */
#include <time.h>])
@@ -1229,7 +1239,13 @@ save_LIBS="$LIBS"
LIBS="$BDW_GC_LIBS $LIBS"
CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
-AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit
GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask
GC_set_start_callback GC_get_suspend_signal GC_move_disappearing_link
GC_get_heap_usage_safe GC_get_free_space_divisor GC_gcollect_and_unmap
GC_get_unmapped_bytes GC_set_finalizer_notifier GC_set_finalize_on_demand])
+AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit \
+ GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask \
+ GC_set_start_callback GC_get_suspend_signal GC_move_disappearing_link
\
+ GC_get_heap_usage_safe GC_get_free_space_divisor \
+ GC_gcollect_and_unmap GC_get_unmapped_bytes GC_set_finalizer_notifier
\
+ GC_set_finalize_on_demand GC_set_all_interior_pointers GC_get_gc_no \
+ GC_set_java_finalization])
# Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not
# declared, and has a different type (returning void instead of
@@ -1632,7 +1648,6 @@ AC_CONFIG_FILES([
AC_CONFIG_FILES([meta/guile-2.2.pc])
AC_CONFIG_FILES([meta/guile-2.2-uninstalled.pc])
-AC_CONFIG_FILES([doc/ref/effective-version.texi])
GUILE_CONFIG_SCRIPT([check-guile])
GUILE_CONFIG_SCRIPT([benchmark-guile])
diff --git a/doc/gendocs_template b/doc/gendocs_template
index a62ad61..63fbe53 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 © 2012 Free Software Foundation, Inc.</p>
+<p>Copyright © 2013 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/r5rs/r5rs.texi b/doc/r5rs/r5rs.texi
index b7722c1..775c930 100644
--- a/doc/r5rs/r5rs.texi
+++ b/doc/r5rs/r5rs.texi
@@ -106,7 +106,6 @@
@author C. address@hidden
@author K. M. address@hidden
@author M. address@hidden
address@hidden
@c {\it Dedicated to the Memory of ALGOL 60}
@@ -116,7 +115,7 @@
address@hidden Summary
address@hidden Summary
The report gives a defining description of the programming language
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 53cc7ce..75b1745 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -123,6 +123,13 @@ autoconf-macros.texi: $(top_srcdir)/meta/guile.m4
snarf-guile-m4-docs $(top_srcdir)/meta/guile.m4 \
> $(srcdir)/$@
+# Build that file from here rather than at the user's site to avoid
+# triggering a rebuild of `guile.info'. Note that `GUILE-VERSION' is
+# among $(CONFIG_STATUS_DEPENDENCIES); thus, when it's updated, this
+# Makefile is rebuilt, and $(GUILE_EFFECTIVE_VERSION) is up-to-date.
+$(srcdir)/effective-version.texi: $(top_srcdir)/GUILE-VERSION
+ echo "@set EFFECTIVE-VERSION $(GUILE_EFFECTIVE_VERSION)" > $@
+
MAINTAINERCLEANFILES = autoconf-macros.texi
www-commit: html
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 6dfc5fd..641245a 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -300,7 +300,7 @@ depending on the datatype of their arguments.
@rnindex list?
@deffn {Scheme Procedure} list? x
@deffnx {C Function} scm_list_p (x)
-Return @code{#t} iff @var{x} is a proper list, else @code{#f}.
+Return @code{#t} if @var{x} is a proper list, else @code{#f}.
@end deffn
The predicate @code{null?} is often used in list-processing code to
@@ -311,7 +311,7 @@ somehow deals with the elements of a list until the list
satisfies
@rnindex null?
@deffn {Scheme Procedure} null? x
@deffnx {C Function} scm_null_p (x)
-Return @code{#t} iff @var{x} is the empty list, else @code{#f}.
+Return @code{#t} if @var{x} is the empty list, else @code{#f}.
@end deffn
@deftypefn {C Function} int scm_is_null (SCM x)
@@ -2248,7 +2248,7 @@ Overview}). It can be used with:
(use-modules (srfi srfi-9))
@end example
address@hidden {library syntax} define-record-type type @* (constructor
fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
address@hidden {Scheme Syntax} define-record-type type @* (constructor
fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
@sp 1
Create a new record type, and make various @code{define}s for using
it. This syntax can only occur at the top-level, not nested within
@@ -2283,12 +2283,12 @@ field in a @var{record}.
An example will illustrate typical usage,
@example
-(define-record-type employee-type
+(define-record-type <employee>
(make-employee name age salary)
employee?
- (name get-employee-name)
- (age get-employee-age set-employee-age)
- (salary get-employee-salary set-employee-salary))
+ (name employee-name)
+ (age employee-age set-employee-age!)
+ (salary employee-salary set-employee-salary!))
@end example
This creates a new employee data type, with name, age and salary
@@ -2298,13 +2298,13 @@ that it's established only when an employee object is
created). These
can all then be used as for example,
@example
-employee-type @result{} #<record-type employee-type>
+<employee> @result{} #<record-type <employee>>
(define fred (make-employee "Fred" 45 20000.00))
(employee? fred) @result{} #t
-(get-employee-age fred) @result{} 45
-(set-employee-salary fred 25000.00) ;; pay rise
+(employee-age fred) @result{} 45
+(set-employee-salary! fred 25000.00) ;; pay rise
@end example
The functions created by @code{define-record-type} are ordinary
@@ -2334,10 +2334,10 @@ an output port.
This example prints the employee's name in brackets, for instance
@code{[Fred]}.
@example
-(set-record-type-printer! employee-type
+(set-record-type-printer! <employee>
(lambda (record port)
(write-char #\[ port)
- (display (get-employee-name record) port)
+ (display (employee-name record) port)
(write-char #\] port)))
@end example
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index d8b6a45..4dede72 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.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, 2012
address@hidden Free Software Foundation, Inc.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010,
address@hidden 2011, 2012, 2013 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node Control Mechanisms
@@ -200,7 +200,7 @@ For this clause type, @var{test} may return multiple
values, and
@code{cond} ignores its boolean state; instead, @code{cond} evaluates
@var{guard} and applies the resulting procedure to the value(s) of
@var{test}, as if @var{guard} were the @var{consumer} argument of
address@hidden Iff the result of that procedure call is a
address@hidden If the result of that procedure call is a
true value, it evaluates @var{expression} and applies the resulting
procedure to the value(s) of @var{test}, in the same manner as the
@var{guard} was called.
@@ -1735,8 +1735,8 @@ and the call to these routines doesn't change
@code{errno}.
@deftypefnx {C Function} void scm_wrong_type_arg (char address@hidden, int
@var{argnum}, SCM @var{bad_value})
@deftypefnx {C Function} void scm_wrong_type_arg_msg (char address@hidden, int
@var{argnum}, SCM @var{bad_value}, const char address@hidden)
@deftypefnx {C Function} void scm_memory_error (char address@hidden)
-Throw an error with the various keys described above.
@deftypefnx {C Function} void scm_misc_error (const char address@hidden, const
char address@hidden, SCM @var{args})
+Throw an error with the various keys described above.
In @code{scm_wrong_num_args}, @var{proc} should be a Scheme symbol
which is the name of the procedure incorrectly invoked. The other
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 9bb674a..ac778b9 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1686,19 +1686,15 @@ starts from 0 for the least significant bit.
@end lisp
@end deffn
address@hidden {Scheme Procedure} ash n cnt
address@hidden {C Function} scm_ash (n, cnt)
-Return @var{n} shifted left by @var{cnt} bits, or shifted right if
address@hidden is negative. This is an ``arithmetic'' shift.
address@hidden {Scheme Procedure} ash n count
address@hidden {C Function} scm_ash (n, count)
+Return @math{floor(n * 2^count)}.
address@hidden and @var{count} must be exact integers.
-This is effectively a multiplication by @m{2^{cnt}, address@hidden, and
-when @var{cnt} is negative it's a division, rounded towards negative
-infinity. (Note that this is not the same rounding as @code{quotient}
-does.)
-
-With @var{n} viewed as an infinite precision twos complement,
address@hidden means a left shift introducing zero bits, or a right shift
-dropping bits.
+With @var{n} viewed as an infinite-precision twos-complement
+integer, @code{ash} means a left shift introducing zero bits
+when @var{count} is positive, or a right shift dropping bits
+when @var{count} is negative. This is an ``arithmetic'' shift.
@lisp
(number->string (ash #b1 3) 2) @result{} "1000"
@@ -1709,6 +1705,28 @@ dropping bits.
@end lisp
@end deffn
address@hidden {Scheme Procedure} round-ash n count
address@hidden {C Function} scm_round_ash (n, count)
+Return @math{round(n * 2^count)}.
address@hidden and @var{count} must be exact integers.
+
+With @var{n} viewed as an infinite-precision twos-complement
+integer, @code{round-ash} means a left shift introducing zero
+bits when @var{count} is positive, or a right shift rounding
+to the nearest integer (with ties going to the nearest even
+integer) when @var{count} is negative. This is a rounded
+``arithmetic'' shift.
+
address@hidden
+(number->string (round-ash #b1 3) 2) @result{} \"1000\"
+(number->string (round-ash #b1010 -1) 2) @result{} \"101\"
+(number->string (round-ash #b1010 -2) 2) @result{} \"10\"
+(number->string (round-ash #b1011 -2) 2) @result{} \"11\"
+(number->string (round-ash #b1101 -2) 2) @result{} \"11\"
+(number->string (round-ash #b1110 -2) 2) @result{} \"100\"
address@hidden lisp
address@hidden deffn
+
@deffn {Scheme Procedure} logcount n
@deffnx {C Function} scm_logcount (n)
Return the number of bits in integer @var{n}. If @var{n} is
@@ -2049,7 +2067,7 @@ number of one to eight digits.
@rnindex char?
@deffn {Scheme Procedure} char? x
@deffnx {C Function} scm_char_p (x)
-Return @code{#t} iff @var{x} is a character, else @code{#f}.
+Return @code{#t} if @var{x} is a character, else @code{#f}.
@end deffn
Fundamentally, the character comparison operations below are
@@ -2057,31 +2075,31 @@ numeric comparisons of the character's code points.
@rnindex char=?
@deffn {Scheme Procedure} char=? x y
-Return @code{#t} iff code point of @var{x} is equal to the code point
+Return @code{#t} if code point of @var{x} is equal to the code point
of @var{y}, else @code{#f}.
@end deffn
@rnindex char<?
@deffn {Scheme Procedure} char<? x y
-Return @code{#t} iff the code point of @var{x} is less than the code
+Return @code{#t} if the code point of @var{x} is less than the code
point of @var{y}, else @code{#f}.
@end deffn
@rnindex char<=?
@deffn {Scheme Procedure} char<=? x y
-Return @code{#t} iff the code point of @var{x} is less than or equal
+Return @code{#t} if the code point of @var{x} is less than or equal
to the code point of @var{y}, else @code{#f}.
@end deffn
@rnindex char>?
@deffn {Scheme Procedure} char>? x y
-Return @code{#t} iff the code point of @var{x} is greater than the
+Return @code{#t} if the code point of @var{x} is greater than the
code point of @var{y}, else @code{#f}.
@end deffn
@rnindex char>=?
@deffn {Scheme Procedure} char>=? x y
-Return @code{#t} iff the code point of @var{x} is greater than or
+Return @code{#t} if the code point of @var{x} is greater than or
equal to the code point of @var{y}, else @code{#f}.
@end deffn
@@ -2099,32 +2117,32 @@ it cannot cover all cases for all languages.
@rnindex char-ci=?
@deffn {Scheme Procedure} char-ci=? x y
-Return @code{#t} iff the case-folded code point of @var{x} is the same
+Return @code{#t} if the case-folded code point of @var{x} is the same
as the case-folded code point of @var{y}, else @code{#f}.
@end deffn
@rnindex char-ci<?
@deffn {Scheme Procedure} char-ci<? x y
-Return @code{#t} iff the case-folded code point of @var{x} is less
+Return @code{#t} if the case-folded code point of @var{x} is less
than the case-folded code point of @var{y}, else @code{#f}.
@end deffn
@rnindex char-ci<=?
@deffn {Scheme Procedure} char-ci<=? x y
-Return @code{#t} iff the case-folded code point of @var{x} is less
+Return @code{#t} if the case-folded code point of @var{x} is less
than or equal to the case-folded code point of @var{y}, else
@code{#f}.
@end deffn
@rnindex char-ci>?
@deffn {Scheme Procedure} char-ci>? x y
-Return @code{#t} iff the case-folded code point of @var{x} is greater
+Return @code{#t} if the case-folded code point of @var{x} is greater
than the case-folded code point of @var{y}, else @code{#f}.
@end deffn
@rnindex char-ci>=?
@deffn {Scheme Procedure} char-ci>=? x y
-Return @code{#t} iff the case-folded code point of @var{x} is greater
+Return @code{#t} if the case-folded code point of @var{x} is greater
than or equal to the case-folded code point of @var{y}, else
@code{#f}.
@end deffn
@@ -2132,36 +2150,36 @@ than or equal to the case-folded code point of @var{y},
else
@rnindex char-alphabetic?
@deffn {Scheme Procedure} char-alphabetic? chr
@deffnx {C Function} scm_char_alphabetic_p (chr)
-Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}.
+Return @code{#t} if @var{chr} is alphabetic, else @code{#f}.
@end deffn
@rnindex char-numeric?
@deffn {Scheme Procedure} char-numeric? chr
@deffnx {C Function} scm_char_numeric_p (chr)
-Return @code{#t} iff @var{chr} is numeric, else @code{#f}.
+Return @code{#t} if @var{chr} is numeric, else @code{#f}.
@end deffn
@rnindex char-whitespace?
@deffn {Scheme Procedure} char-whitespace? chr
@deffnx {C Function} scm_char_whitespace_p (chr)
-Return @code{#t} iff @var{chr} is whitespace, else @code{#f}.
+Return @code{#t} if @var{chr} is whitespace, else @code{#f}.
@end deffn
@rnindex char-upper-case?
@deffn {Scheme Procedure} char-upper-case? chr
@deffnx {C Function} scm_char_upper_case_p (chr)
-Return @code{#t} iff @var{chr} is uppercase, else @code{#f}.
+Return @code{#t} if @var{chr} is uppercase, else @code{#f}.
@end deffn
@rnindex char-lower-case?
@deffn {Scheme Procedure} char-lower-case? chr
@deffnx {C Function} scm_char_lower_case_p (chr)
-Return @code{#t} iff @var{chr} is lowercase, else @code{#f}.
+Return @code{#t} if @var{chr} is lowercase, else @code{#f}.
@end deffn
@deffn {Scheme Procedure} char-is-both? chr
@deffnx {C Function} scm_char_is_both_p (chr)
-Return @code{#t} iff @var{chr} is either uppercase or lowercase, else
+Return @code{#t} if @var{chr} is either uppercase or lowercase, else
@code{#f}.
@end deffn
@@ -2583,8 +2601,8 @@ string is not defined.
@deffn {Scheme Procedure} char-set-contains? cs ch
@deffnx {C Function} scm_char_set_contains_p (cs, ch)
-Return @code{#t} iff the character @var{ch} is contained in the
-character set @var{cs}.
+Return @code{#t} if the character @var{ch} is contained in the
+character set @var{cs}, or @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} char-set-every pred cs
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index dd2a3d1..f6c706c 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.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, 2007,
2010, 2011, 2012
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -1175,7 +1175,9 @@ calls to @var{proc}.
In addition, Guile defines a procedure to call a thunk, tracing all
procedure calls and returns within the thunk.
address@hidden {Scheme Procedure} call-with-trace thunk #:key (calls? #t)
(instructions? #f) (width 80) (vm (the-vm))
address@hidden {Scheme Procedure} call-with-trace thunk [#:calls?=#t] @
+ [#:instructions?=#f] @
+ [#:width=80] [#:vm=(the-vm)]
Call @var{thunk}, tracing all execution within its dynamic extent.
If @var{calls?} is true, Guile will print a brief report at each
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 0ffb501..c4e77a9 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -488,7 +488,10 @@ procedure in the default environment, but you really want
the one from
(use-modules (ice-9 eval-string))
@end example
address@hidden {Scheme Procedure} eval-string string [module=#f] [file=#f]
[line=#f] [column=#f] [lang=(current-language)] [compile?=#f]
address@hidden {Scheme Procedure} eval-string string [#:module=#f] [#:file=#f] @
+ [#:line=#f] [#:column=#f] @
+ [#:lang=(current-language)] @
+ [#:compile?=#f]
Parse @var{string} according to the current language, normally Scheme.
Evaluate or compile the expressions it contains, in order, returning the
last expression.
@@ -691,7 +694,9 @@ coding declaration as recognized by @code{file-encoding}
The compiler can also be invoked directly by Scheme code using the procedures
below:
address@hidden {Scheme Procedure} compile exp [env=#f]
[from=(current-language)] [to=value] [opts=()]
address@hidden {Scheme Procedure} compile exp [#:env=#f] @
+ [#:from=(current-language)] @
+ [#:to=value] [#:opts=()]
Compile the expression @var{exp} in the environment @var{env}. If
@var{exp} is a procedure, the result will be a compiled procedure;
otherwise @code{compile} is mostly equivalent to @code{eval}.
@@ -700,10 +705,11 @@ For a discussion of languages and compiler options,
@xref{Compiling to
the Virtual Machine}.
@end deffn
address@hidden {Scheme Procedure} compile-file file [output-file=#f] @
- [from=(current-language)] [to='objcode] @
- [env=(default-environment from)] [opts='()] @
- [canonicalization 'relative]
address@hidden {Scheme Procedure} compile-file file [#:output-file=#f] @
+ [#:from=(current-language)] [#:to='objcode] @
+ [#:env=(default-environment from)] @
+ [#:opts='()] @
+ [#:canonicalization='relative]
Compile the file named @var{file}.
Output will be written to a @var{output-file}. If you do not supply an
@@ -1061,7 +1067,8 @@ was found, or @code{#f} otherwise. The port is rewound.
@cindex promises
Promises are a convenient way to defer a calculation until its result
-is actually needed, and to run such a calculation only once.
+is actually needed, and to run such a calculation only once. Also
address@hidden
@deffn syntax delay expr
@rnindex delay
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index b08c103..09ffee6 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -215,7 +215,7 @@ including ellipsizing and tail patterns.
((_ #((var val) ...) exp exp* ...)
(let ((var val) ...) exp exp* ...))))
(letv #((foo 'bar)) foo)
address@hidden foo
address@hidden bar
@end example
Literals are used to match specific datums in an expression, like the use of
@@ -520,7 +520,8 @@ is impossible with @code{syntax-rules}, given the datum
matching forms. But with
@code{syntax-case} it is easy:
@deffn {Scheme Procedure} identifier? syntax-object
-Returns @code{#t} iff @var{syntax-object} is an identifier.
+Returns @code{#t} if @var{syntax-object} is an identifier, or @code{#f}
+otherwise.
@end deffn
@example
@@ -690,13 +691,13 @@ macros can use to compare, generate, and query objects of
this data
type.
@deffn {Scheme Procedure} bound-identifier=? a b
-Return @code{#t} iff the syntax objects @var{a} and @var{b} refer to the
-same lexically-bound identifier.
+Return @code{#t} if the syntax objects @var{a} and @var{b} refer to the
+same lexically-bound identifier, or @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} free-identifier=? a b
-Return @code{#t} iff the syntax objects @var{a} and @var{b} refer to the
-same free identifier.
+Return @code{#t} if the syntax objects @var{a} and @var{b} refer to the
+same free identifier, or @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} generate-temporaries ls
@@ -941,7 +942,7 @@ left-hand side of a @code{set!} expression, as in the
following:
(set! foo @var{val})
;; expands via
(foo-transformer #'(set! foo @var{val}))
-;; iff foo-transformer is a "variable transformer"
+;; if foo-transformer is a "variable transformer"
@end example
As the example notes, the transformer procedure must be explicitly
@@ -1131,7 +1132,8 @@ for syntax-case.
@deffn {Scheme Procedure} macro? obj
@deffnx {C Function} scm_macro_p (obj)
-Return @code{#t} iff @var{obj} is a syntax transformer.
+Return @code{#t} if @var{obj} is a syntax transformer, or @code{#f}
+otherwise.
Note that it's a bit difficult to actually get a macro as a first-class object;
simply naming it (like @code{case}) will produce a syntax error. But it is
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 17ab462..4a4011d 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.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, 2007,
2008, 2009, 2010, 2011, 2012
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2008, 2009, 2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -759,8 +759,8 @@ Return a variable initialized to value @var{init}.
@deffn {Scheme Procedure} variable-bound? var
@deffnx {C Function} scm_variable_bound_p (var)
-Return @code{#t} iff @var{var} is bound to a value.
-Throws an error if @var{var} is not a variable object.
+Return @code{#t} if @var{var} is bound to a value, or @code{#f}
+otherwise. Throws an error if @var{var} is not a variable object.
@end deffn
@deffn {Scheme Procedure} variable-ref var
@@ -784,8 +784,8 @@ Unset the value of the variable @var{var}, leaving
@var{var} unbound.
@deffn {Scheme Procedure} variable? obj
@deffnx {C Function} scm_variable_p (obj)
-Return @code{#t} iff @var{obj} is a variable object, else
-return @code{#f}.
+Return @code{#t} if @var{obj} is a variable object, else return
address@hidden
@end deffn
@@ -827,7 +827,8 @@ the time @var{thunk}'s dynamic extent was last entered) is
restored. If
saved, and the previously saved inner module is set current again.
@end deffn
address@hidden {Scheme Procedure} resolve-module name [autoload=#t]
[version=#f] [#:ensure=#t]
address@hidden {Scheme Procedure} resolve-module name [autoload=#t]
[version=#f] @
+ [#:ensure=#t]
@deffnx {C Function} scm_resolve_module (name)
Find the module named @var{name} and return it. When it has not already
been defined and @var{autoload} is true, try to auto-load it. When it
@@ -837,7 +838,9 @@ that the resulting module is compatible with the given
version reference
(@pxref{R6RS Version References}). The name is a list of symbols.
@end deffn
address@hidden {Scheme Procedure} resolve-interface name [#:select=#f]
[#:hide='()] [#:select=()] [#:prefix=#f] [#:renamer] [#:version=#f]
address@hidden {Scheme Procedure} resolve-interface name [#:select=#f] @
+ [#:hide='()] [#:prefix=#f] @
+ [#:renamer=#f] [#:version=#f]
Find the module named @var{name} as with @code{resolve-module} and
return its interface. The interface of a module is also a module
object, but it contains only the exported bindings.
@@ -942,14 +945,18 @@ the @var{name} is not bound in the module, signals an
error. Returns a
variable, always.
@example
-SCM my_eval_string (SCM str)
address@hidden
- static SCM eval_string_var = SCM_BOOL_F;
+static SCM eval_string_var;
- if (scm_is_false (eval_string_var))
- eval_string_var =
- scm_c_public_lookup ("ice-9 eval-string", "eval-string");
+/* NOTE: It is important that the call to 'my_init'
+ happens-before all calls to 'my_eval_string'. */
+void my_init (void)
address@hidden
+ eval_string_var = scm_c_public_lookup ("ice-9 eval-string",
+ "eval-string");
address@hidden
+SCM my_eval_string (SCM str)
address@hidden
return scm_call_1 (scm_variable_ref (eval_string_var), str);
@}
@end example
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index 1734318..a1575c5 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -96,6 +96,13 @@ your site should be installed. On Unix-like systems, this
is usually
@file{/usr/local/share/guile/site} or @file{/usr/share/guile/site}.
@end deffn
address@hidden {Scheme Procedure} %site-ccache-dir
address@hidden {C Function} scm_sys_site_ccache_dir ()
+Return the directory where users should install compiled @code{.go}
+files for use with this version of Guile. Might look something like
address@hidden/usr/lib/guile/@value{EFFECTIVE-VERSION}/site-ccache}.
address@hidden deffn
+
@defvar %guile-build-info
Alist of information collected during the building of a particular
Guile. Entries can be grouped into one of several categories:
diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi
index bef3386..8ff240a 100644
--- a/doc/ref/api-procedures.texi
+++ b/doc/ref/api-procedures.texi
@@ -157,7 +157,8 @@ appropriate module first, though:
@deffn {Scheme Procedure} program? obj
@deffnx {C Function} scm_program_p (obj)
-Returns @code{#t} iff @var{obj} is a compiled procedure.
+Returns @code{#t} if @var{obj} is a compiled procedure, or @code{#f}
+otherwise.
@end deffn
@deffn {Scheme Procedure} program-objcode program
@@ -333,7 +334,11 @@ cheaply, without allocating a rest list.
@code{lambda*} is like @code{lambda}, except with some extensions to
allow optional and keyword arguments.
address@hidden {library syntax} lambda* (address@hidden @* [#:optional
address@hidden @* [#:key address@hidden [#:allow-other-keys]] @* [#:rest var |
. var]) @* body
address@hidden {library syntax} lambda* (address@hidden @* @
+ [#:optional address@hidden @* @
+ [#:key address@hidden [#:allow-other-keys]] @* @
+ [#:rest var | . var]) @* @
+ body1 body2 @dots{}
@sp 1
Create a procedure which takes optional and/or keyword arguments
specified with @code{#:optional} and @code{#:key}. For example,
@@ -712,6 +717,11 @@ compatible arity.
Return X.
@end deffn
address@hidden {Scheme Procedure} and=> value proc
+When @var{value} is @code{#f}, return @code{#f}. Otherwise, return
address@hidden(@var{proc} @var{value})}.
address@hidden deffn
+
@node Procedure Properties
@subsection Procedure Properties and Meta-information
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index 749583a..b230821 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -247,7 +247,7 @@ Once @var{body} or @var{handler} returns, the return value
is made the
@deffn {Scheme Procedure} thread? obj
@deffnx {C Function} scm_thread_p (obj)
-Return @code{#t} iff @var{obj} is a thread; otherwise, return
+Return @code{#t} ff @var{obj} is a thread; otherwise, return
@code{#f}.
@end deffn
@@ -267,7 +267,7 @@ specified; @code{#f} is returned otherwise).
@deffn {Scheme Procedure} thread-exited? thread
@deffnx {C Function} scm_thread_exited_p (thread)
-Return @code{#t} iff @var{thread} has exited.
+Return @code{#t} if @var{thread} has exited, or @code{#f} otherwise.
@end deffn
@c begin (texi-doc-string "guile" "yield")
@@ -376,7 +376,7 @@ The returned mutex will be recursive.
@deffn {Scheme Procedure} mutex? obj
@deffnx {C Function} scm_mutex_p (obj)
-Return @code{#t} iff @var{obj} is a mutex; otherwise, return
+Return @code{#t} if @var{obj} is a mutex; otherwise, return
@code{#f}.
@end deffn
@@ -481,7 +481,7 @@ Return a new condition variable.
@deffn {Scheme Procedure} condition-variable? obj
@deffnx {C Function} scm_condition_variable_p (obj)
-Return @code{#t} iff @var{obj} is a condition variable; otherwise,
+Return @code{#t} if @var{obj} is a condition variable; otherwise,
return @code{#f}.
@end deffn
@@ -702,7 +702,7 @@ implicitly bound to some definite value).
@deffn {Scheme Procedure} fluid? obj
@deffnx {C Function} scm_fluid_p (obj)
-Return @code{#t} iff @var{obj} is a fluid; otherwise, return
+Return @code{#t} if @var{obj} is a fluid; otherwise, return
@code{#f}.
@end deffn
@@ -726,7 +726,7 @@ Disassociate the given fluid from any value, making it
unbound.
@deffn {Scheme Procedure} fluid-bound? fluid
@deffnx {C Function} scm_fluid_bound_p (fluid)
-Returns @code{#t} iff the given fluid is bound to a value, otherwise
+Returns @code{#t} if the given fluid is bound to a value, otherwise
@code{#f}.
@end deffn
@@ -1037,6 +1037,13 @@ future has completed. This suspend/resume is achieved
by capturing the
calling future's continuation, and later reinstating it (@pxref{Prompts,
delimited continuations}).
+Note that @code{par-map} above is not tail-recursive. This could lead
+to stack overflows when @var{lst} is large compared to
address@hidden(current-processor-count)}. To address that, @code{touch} uses
+the suspend mechanism described above to limit the number of nested
+futures executing on the same stack. Thus, the above code should never
+run into stack overflows.
+
@deffn {Scheme Syntax} future exp
Return a future for expression @var{exp}. This is equivalent to:
diff --git a/doc/ref/api-smobs.texi b/doc/ref/api-smobs.texi
index cb2034c..345bf7c 100644
--- a/doc/ref/api-smobs.texi
+++ b/doc/ref/api-smobs.texi
@@ -124,9 +124,9 @@ Else, signal an error.
@end deftypefn
@deftypefn {C Macro} int SCM_SMOB_PREDICATE (scm_t_bits tag, SCM exp)
-Return true iff @var{exp} is a smob instance of the type indicated by
address@hidden The expression @var{exp} can be evaluated more than once,
-so it shouldn't contain any side effects.
+Return true if @var{exp} is a smob instance of the type indicated by
address@hidden, or false otherwise. The expression @var{exp} can be
+evaluated more than once, so it shouldn't contain any side effects.
@end deftypefn
@deftypefn {C Function} SCM scm_new_smob (scm_t_bits tag, void *data)
diff --git a/doc/ref/api-undocumented.texi b/doc/ref/api-undocumented.texi
index 1ffb3a9..4e478f4 100644
--- a/doc/ref/api-undocumented.texi
+++ b/doc/ref/api-undocumented.texi
@@ -188,8 +188,8 @@ would modify regular hash tables. (@pxref{Hash Tables})
@end deffn
@deffn {Scheme Procedure} include-deprecated-features
-Return @code{#t} iff deprecated features should be included
-in public interfaces.
+Return @code{#t} if deprecated features should be included in public
+interfaces, or @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} issue-deprecation-warning . msgs
@@ -202,7 +202,7 @@ they are printed in turn, each one followed by a newline.
@deffn {Scheme Procedure} valid-object-procedure? proc
@deffnx {C Function} scm_valid_object_procedure_p (proc)
-Return @code{#t} iff @var{proc} is a procedure that can be used with
@code{set-object-procedure}. It is always valid to use a closure constructed
by @code{lambda}.
+Return @code{#t} ff @var{proc} is a procedure that can be used with
@code{set-object-procedure}. It is always valid to use a closure constructed
by @code{lambda}.
@end deffn
@deffn {Scheme Procedure} %get-pre-modules-obarray
diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi
index 17694ec..76c50b2 100644
--- a/doc/ref/api-utility.texi
+++ b/doc/ref/api-utility.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, 2011,
2012
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011,
2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -308,10 +308,10 @@ input.
@deffn {Scheme Procedure} sorted? items less
@deffnx {C Function} scm_sorted_p (items, less)
-Return @code{#t} iff @var{items} is a list or vector such that,
+Return @code{#t} if @var{items} is a list or vector such that,
for each element @var{x} and the next element @var{y} of
@var{items}, @code{(@var{less} @var{y} @var{x})} returns
address@hidden
address@hidden Otherwise return @code{#f}.
@end deffn
@deffn {Scheme Procedure} sort items less
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index 1d730b7..0615ef7 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -53,10 +53,11 @@ Languages are registered in the module, @code{(system base
language)}:
They are registered with the @code{define-language} form.
@deffn {Scheme Syntax} define-language @
-name title reader printer @
-[parser=#f] [compilers='()] [decompilers='()] [evaluator=#f] @
-[joiner=#f] [for-humans?=#t] @
-[make-default-environment=make-fresh-user-module]
+ [#:name] [#:title] [#:reader] [#:printer] @
+ [#:parser=#f] [#:compilers='()] @
+ [#:decompilers='()] [#:evaluator=#f] @
+ [#:joiner=#f] [#:for-humans?=#t] @
+ [#:make-default-environment=make-fresh-user-module]
Define a language.
This syntax defines a @code{#<language>} object, bound to @var{name}
@@ -590,9 +591,9 @@ variables. @var{vars} is a list of @code{(@var{name}
@var{type}
program's metadata and do not form part of a program's code path.
@end deftp
@deftp {Scheme Variable} <glil-mv-bind> vars rest
-A multiple-value binding of the values on the stack to @var{vars}. Iff
address@hidden is true, the last element of @var{vars} will be treated as
-a rest argument.
+A multiple-value binding of the values on the stack to @var{vars}. If
address@hidden is true, the last element of @var{vars} will be treated as a
+rest argument.
In addition to pushing a binding annotation on the stack, like
@code{<glil-bind>}, an expression is emitted at compilation time to
@@ -799,7 +800,7 @@ objcode)} module.
@deffn {Scheme Procedure} objcode? obj
@deffnx {C Function} scm_objcode_p (obj)
-Returns @code{#f} iff @var{obj} is object code, @code{#f} otherwise.
+Returns @code{#f} if @var{obj} is object code, @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} bytecode->objcode bytecode [endianness]
diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi
index 5a9a3f7..15ca625 100644
--- a/doc/ref/guile-invoke.texi
+++ b/doc/ref/guile-invoke.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, 2005,
2010, 2011
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2010, 2011, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -291,6 +291,32 @@ This variable names the file that holds the Guile REPL
command history.
You can specify a different history file by setting this environment
variable. By default, the history file is @file{$HOME/.guile_history}.
address@hidden GUILE_INSTALL_LOCALE
address@hidden GUILE_INSTALL_LOCALE
+This is a flag that can be used to tell Guile whether or not to install
+the current locale at startup, via a call to @code{(setlocale LC_ALL
+"")}. @xref{Locales}, for more information on locales.
+
+You may explicitly indicate that you do not want to install
+the locale by setting @env{GUILE_INSTALL_LOCALE} to @code{0}, or
+explicitly enable it by setting the variable to @code{1}.
+
+Usually, installing the current locale is the right thing to do. It
+allows Guile to correctly parse and print strings with non-ASCII
+characters. Therefore, this option is on by default.
+
address@hidden GUILE_STACK_SIZE
address@hidden GUILE_STACK_SIZE
+Guile currently has a limited stack size for Scheme computations.
+Attempting to call too many nested functions will signal an error. This
+is good to detect infinite recursion, but sometimes the limit is reached
+for normal computations. This environment variable, if set to a
+positive integer, specifies the number of Scheme value slots to allocate
+for the stack.
+
+In the future we will implement stacks that can grow and shrink, but for
+now this hack will have to do.
+
@item GUILE_LOAD_COMPILED_PATH
@vindex GUILE_LOAD_COMPILED_PATH
This variable may be used to augment the path that is searched for
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 262cd64..c3170ce 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -374,7 +374,7 @@ available through both Scheme and C interfaces.
* Curried Definitions:: Extended @code{define} syntax.
* Statprof:: An easy-to-use statistical profiler.
* SXML:: Parsing, transforming, and serializing XML.
-* Texinfo:: Munging documents written in Texinfo.
+* Texinfo Processing:: Munging documents written in Texinfo.
@end menu
@include slib.texi
diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi
index e94948f..28da4ac 100644
--- a/doc/ref/intro.texi
+++ b/doc/ref/intro.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, 2006,
2010, 2011
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006,
2010, 2011, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -288,21 +288,6 @@ classes, multiple inheritance and generic functions.
@node Typographical Conventions
@section Typographical Conventions
-We use some conventions in this manual.
-
address@hidden @bullet
-
address@hidden
-For some procedures, notably type predicates, we use ``iff'' to mean
-``if and only if''. The construct is usually something like: `Return
address@hidden iff @var{condition}', where @var{val} is usually
address@hidden'' or address@hidden''. This typically means that
address@hidden is returned if @var{condition} holds, and that @samp{#f} is
-returned otherwise. To clarify: @var{val} will @strong{only} be
-returned when @var{condition} is true.
address@hidden iff
-
address@hidden
In examples and procedure descriptions and all other places where the
evaluation of Scheme expression is shown, we use some notation for
denoting the output and evaluation results of expressions.
@@ -328,10 +313,6 @@ As you can see, this code prints @samp{1} (denoted by
@address@hidden), and returns @code{hooray} (denoted by
@address@hidden).
address@hidden Add other conventions here.
-
address@hidden itemize
-
@c Local Variables:
@c TeX-master: "guile.texi"
diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..c1e65d7 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1573,6 +1573,9 @@ modifies the queue @var{list} then it must either maintain
@section Streams
@cindex streams
+This section documents Guile's legacy stream module. For a more
+complete and portable stream library, @pxref{SRFI-41}.
+
A stream represents a sequence of values, each of which is calculated
only when required. This allows large or even infinite sequences to
be represented and manipulated with familiar operations like ``car'',
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index a019f4e..950c351 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -803,6 +803,29 @@ Copy the file specified by @var{oldfile} to @var{newfile}.
The return value is unspecified.
@end deffn
address@hidden {Scheme Procedure} sendfile out in count [offset]
address@hidden {C Function} scm_sendfile (out, in, count, offset)
+Send @var{count} bytes from @var{in} to @var{out}, both of which
+are either open file ports or file descriptors. When
address@hidden is omitted, start reading from @var{in}'s current
+position; otherwise, start reading at @var{offset}.
+
+When @var{in} is a port, it is often preferable to specify @var{offset},
+because @var{in}'s offset as a port may be different from the offset of
+its underlying file descriptor.
+
+On systems that support it, such as GNU/Linux, this procedure uses the
address@hidden libc function, which usually corresponds to a system
+call. This is faster than doing a series of @code{read} and
address@hidden system calls. A typical application is to send a file over
+a socket.
+
+In some cases, the @code{sendfile} libc function may return
address@hidden or @code{ENOSYS}. In that case, Guile's @code{sendfile}
+procedure automatically falls back to doing a series of @code{read} and
address@hidden calls.
address@hidden deffn
+
@findex rename
@deffn {Scheme Procedure} rename-file oldname newname
@deffnx {C Function} scm_rename (oldname, newname)
@@ -1718,6 +1741,18 @@ interpretation is not required.
Example: (system* "echo" "foo" "bar")
@end deffn
address@hidden {Scheme Procedure} quit [status]
address@hidden {Scheme Procedure} exit [status]
+Terminate the current process with proper unwinding of the Scheme stack.
+The exit status zero if @var{status} is not supplied. If @var{status}
+is supplied, and it is an integer, that integer is used as the exit
+status. If @var{status} is @code{#t} or @code{#f}, the exit status is 0
+or 1, respectively.
+
+The procedure @code{exit} is an alias of @code{quit}. They have the
+same functionality.
address@hidden deffn
+
@deffn {Scheme Procedure} primitive-exit [status]
@deffnx {Scheme Procedure} primitive-_exit [status]
@deffnx {C Function} scm_primitive_exit (status)
@@ -2528,8 +2563,11 @@ code should be prepared to handle it when it is defined.
@var{hint_socktype} was not recognized.
@item EAI_SYSTEM
-A system error occurred; the error code can be found in
address@hidden
+A system error occurred. In C, the error code can be found in
address@hidden; this value is not accessible from Scheme, but in
+practice it provides little information about the actual error
+cause.
address@hidden See <http://bugs.gnu.org/13958>.
@end table
Users are encouraged to read the
@@ -3052,6 +3090,7 @@ Manual}, or @command{man 7 socket}.
@defvarx SO_OOBINLINE
@defvarx SO_NO_CHECK
@defvarx SO_PRIORITY
address@hidden SO_REUSEPORT
The @var{value} taken or returned is an integer.
@end defvar
diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index 2028ada..b183771 100644
--- a/doc/ref/r6rs.texi
+++ b/doc/ref/r6rs.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 2010, 2011, 2012
address@hidden Copyright (C) 2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -273,10 +273,8 @@ grouped below by the existing manual sections to which
they correspond.
@end deffn
@deffn {Scheme Syntax} define-syntax keyword expression
address@hidden {Scheme Syntax} let-syntax ((keyword transformer) @dots{})
- exp1 exp2 @dots{}
address@hidden {Scheme Syntax} letrec-syntax ((keyword transformer) @dots{})
- exp1 exp2 @dots{}
address@hidden {Scheme Syntax} let-syntax ((keyword transformer) @dots{}) exp1
exp2 @dots{}
address@hidden {Scheme Syntax} letrec-syntax ((keyword transformer) @dots{})
exp1 exp2 @dots{}
@xref{Defining Macros}, for documentation.
@end deffn
@@ -1523,9 +1521,9 @@ This procedure is identical to the one provided by
Guile's core library.
@xref{Runtime Environment}, for documentation.
@end deffn
address@hidden {Scheme Procedure} exit
address@hidden {Scheme Procedure} exit obj
-This procedure is identical to the one provided by Guile's core library.
address@hidden {Scheme Procedure} exit [status]
+This procedure is identical to the one provided by Guile's core
+library. @xref{Processes}, for documentation.
@end deffn
@node rnrs arithmetic fixnums
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..4422c18 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -125,7 +125,7 @@ The programmatic interface to value history is in a module:
@end lisp
@deffn {Scheme Procedure} value-history-enabled?
-Return true iff value history is enabled.
+Return true if value history is enabled, or false otherwise.
@end deffn
@deffn {Scheme Procedure} enable-value-history!
@@ -430,8 +430,11 @@ Garbage collection.
Display statistics.
@end deffn
address@hidden {REPL Command} option [key value]
-List/show/set options.
address@hidden {REPL Command} option [name] [exp]
+With no arguments, lists all options. With one argument, shows the
+current value of the @var{name} option. With two arguments, sets the
address@hidden option to the result of evaluating the Scheme expression
address@hidden
@end deffn
@deffn {REPL Command} quit
@@ -749,6 +752,7 @@ list}, or simply @code{guild}.
@cindex site path
@cindex load path
@findex %site-dir
address@hidden %site-ccache-dir
At some point, you will probably want to share your code with other
people. To do so effectively, it is important to follow a set of common
@@ -780,11 +784,11 @@ find them.
As with Scheme files, Guile searches a path to find compiled @code{.go}
files, the @code{%load-compiled-path}. By default, this path has two
entries: a path for Guile's files, and a path for site packages. You
-should install your @code{.go} files into the latter. Currently there
-is no procedure to get at this path, which is probably a bug. As in the
-previous example, if Guile @value{EFFECTIVE-VERSION} is installed on
-your system in @code{/usr/}, then the place to put compiled files for
-site packages will be
+should install your @code{.go} files into the latter directory, whose
+value is returned by invoking the @code{%site-ccache-dir} procedure. As
+in the previous example, if Guile @value{EFFECTIVE-VERSION} is installed
+on your system in @code{/usr/}, then @code{(%site-ccache-dir)} site
+packages will be
@code{/usr/lib/guile/@value{EFFECTIVE-VERSION}/site-ccache}.
Note that a @code{.go} file will only be loaded in preference to a
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 17b1918..8bf7c41 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -45,6 +45,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-37:: args-fold program argument processor
* SRFI-38:: External Representation for Data With Shared
Structure
* SRFI-39:: Parameter objects
+* SRFI-41:: Streams.
* SRFI-42:: Eager comprehensions
* SRFI-45:: Primitives for expressing iterative lazy
algorithms
* SRFI-55:: Requiring Features.
@@ -76,13 +77,13 @@ check for the Scheme implementation, that is, before she
can know that
it is safe to use @code{use-modules} to load SRFI support modules. The
second reason is that some features defined in SRFIs had been
implemented in Guile before the developers started to add SRFI
-implementations as modules (for example SRFI-6 (@pxref{SRFI-6})). In
+implementations as modules (for example SRFI-13 (@pxref{SRFI-13})). In
the future, it is possible that SRFIs in the core library might be
factored out into separate modules, requiring explicit module loading
when they are needed. So you should be prepared to have to use
address@hidden someday in the future to access SRFI-6 bindings. If
address@hidden someday in the future to access SRFI-13 bindings. If
you want, you can do that already. We have included the module
address@hidden(srfi srfi-6)} in the distribution, which currently does nothing,
address@hidden(srfi srfi-13)} in the distribution, which currently does nothing,
but ensures that you can write future-safe code.
Generally, support for a specific SRFI is made available by using
@@ -145,9 +146,13 @@ guile-2 ;; starting from Guile 2.x
r5rs
srfi-0
srfi-4
-srfi-6
srfi-13
srfi-14
+srfi-23
+srfi-39
+srfi-55
+srfi-61
+srfi-105
@end example
Other SRFI feature symbols are defined once their code has been loaded
@@ -1846,11 +1851,19 @@ uniform numeric vector, it is returned unchanged.
@cindex SRFI-6
SRFI-6 defines the procedures @code{open-input-string},
address@hidden and @code{get-output-string}. These
-procedures are included in the Guile core, so using this module does not
-make any difference at the moment. But it is possible that support for
-SRFI-6 will be factored out of the core library in the future, so using
-this module does not hurt, after all.
address@hidden and @code{get-output-string}.
+
+Note that although versions of these procedures are included in the
+Guile core, the core versions are not fully conformant with SRFI-6:
+attempts to read or write characters that are not supported by the
+current @code{%default-port-encoding} will fail.
+
+We therefore recommend that you import this module, which supports all
+characters:
+
address@hidden
+(use-modules (srfi srfi-6))
address@hidden example
@node SRFI-8
@subsection SRFI-8 - receive
@@ -3429,9 +3442,10 @@ Note that all fields of @var{type} and its supertypes
must be specified.
@end deffn
@deffn {Scheme Procedure} make-compound-condition condition1 condition2 @dots{}
-Return a new compound condition composed of @var{conditions}. The
-returned condition has the type of each condition of @var{conditions}
-(per @code{condition-has-type?}).
+Return a new compound condition composed of @var{condition1}
address@hidden @enddots{}. The returned condition has the type of
+each condition of condition1 condition2 @dots{} (per
address@hidden).
@end deffn
@deffn {Scheme Procedure} condition-has-type? c type
@@ -3775,6 +3789,712 @@ scope and the result from that @var{thunk} is the
return from
@code{with-parameters*}.
@end defun
address@hidden SRFI-41
address@hidden SRFI-41 - Streams
address@hidden SRFI-41
+
+This subsection is based on the
address@hidden://srfi.schemers.org/srfi-41/srfi-41.html, specification of
+SRFI-41} by Philip L.@: Bewig.
+
address@hidden The copyright notice and license text of the SRFI-41
specification is
address@hidden reproduced below:
+
address@hidden Copyright (C) Philip L. Bewig (2007). 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
+This SRFI implements streams, sometimes called lazy lists, a sequential
+data structure containing elements computed only on demand. A stream is
+either null or is a pair with a stream in its cdr. Since elements of a
+stream are computed only when accessed, streams can be infinite. Once
+computed, the value of a stream element is cached in case it is needed
+again. SRFI-41 can be made available with:
+
address@hidden
+(use-modules (srfi srfi-41))
address@hidden example
+
address@hidden
+* SRFI-41 Stream Fundamentals::
+* SRFI-41 Stream Primitives::
+* SRFI-41 Stream Library::
address@hidden menu
+
address@hidden SRFI-41 Stream Fundamentals
address@hidden SRFI-41 Stream Fundamentals
+
+SRFI-41 Streams are based on two mutually-recursive abstract data types:
+An object of the @code{stream} abstract data type is a promise that,
+when forced, is either @code{stream-null} or is an object of type
address@hidden An object of the @code{stream-pair} abstract data
+type contains a @code{stream-car} and a @code{stream-cdr}, which must be
+a @code{stream}. The essential feature of streams is the systematic
+suspensions of the recursive promises between the two data types.
+
+The object stored in the @code{stream-car} of a @code{stream-pair} is a
+promise that is forced the first time the @code{stream-car} is accessed;
+its value is cached in case it is needed again. The object may have any
+type, and different stream elements may have different types. If the
address@hidden is never accessed, the object stored there is never
+evaluated. Likewise, the @code{stream-cdr} is a promise to return a
+stream, and is only forced on demand.
+
address@hidden SRFI-41 Stream Primitives
address@hidden SRFI-41 Stream Primitives
+
+This library provides eight operators: constructors for
address@hidden and @code{stream-pair}s, type predicates for streams
+and the two kinds of streams, accessors for both fields of a
address@hidden, and a lambda that creates procedures that return
+streams.
+
address@hidden {Scheme Variable} stream-null
+A promise that, when forced, is a single object, distinguishable from
+all other objects, that represents the null stream. @code{stream-null}
+is immutable and unique.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-cons object-expr stream-expr
+Creates a newly-allocated stream containing a promise that, when forced,
+is a @code{stream-pair} with @var{object-expr} in its @code{stream-car}
+and @var{stream-expr} in its @code{stream-cdr}. Neither
address@hidden nor @var{stream-expr} is evaluated when
address@hidden is called.
+
+Once created, a @code{stream-pair} is immutable; there is no
address@hidden or @code{stream-set-cdr!} that modifies an
+existing stream-pair. There is no dotted-pair or improper stream as
+with lists.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream? object
+Returns true if @var{object} is a stream, otherwise returns false. If
address@hidden is a stream, its promise will not be forced. If
address@hidden(stream? obj)} returns true, then one of @code{(stream-null? obj)}
+or @code{(stream-pair? obj)} will return true and the other will return
+false.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-null? object
+Returns true if @var{object} is the distinguished null stream, otherwise
+returns false. If @var{object} is a stream, its promise will be forced.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-pair? object
+Returns true if @var{object} is a @code{stream-pair} constructed by
address@hidden, otherwise returns false. If @var{object} is a
+stream, its promise will be forced.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-car stream
+Returns the object stored in the @code{stream-car} of @var{stream}. An
+error is signalled if the argument is not a @code{stream-pair}. This
+causes the @var{object-expr} passed to @code{stream-cons} to be
+evaluated if it had not yet been; the value is cached in case it is
+needed again.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-cdr stream
+Returns the stream stored in the @code{stream-cdr} of @var{stream}. An
+error is signalled if the argument is not a @code{stream-pair}.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-lambda formals body @dots{}
+Creates a procedure that returns a promise to evaluate the @var{body} of
+the procedure. The last @var{body} expression to be evaluated must
+yield a stream. As with normal @code{lambda}, @var{formals} may be a
+single variable name, in which case all the formal arguments are
+collected into a single list, or a list of variable names, which may be
+null if there are no arguments, proper if there are an exact number of
+arguments, or dotted if a fixed number of arguments is to be followed by
+zero or more arguments collected into a list. @var{Body} must contain
+at least one expression, and may contain internal definitions preceding
+any expressions to be evaluated.
address@hidden deffn
+
address@hidden
+(define strm123
+ (stream-cons 1
+ (stream-cons 2
+ (stream-cons 3
+ stream-null))))
+
+(stream-car strm123) @result{} 1
+(stream-car (stream-cdr strm123) @result{} 2
+
+(stream-pair?
+ (stream-cdr
+ (stream-cons (/ 1 0) stream-null))) @result{} #f
+
+(stream? (list 1 2 3)) @result{} #f
+
+(define iter
+ (stream-lambda (f x)
+ (stream-cons x (iter f (f x)))))
+
+(define nats (iter (lambda (x) (+ x 1)) 0))
+
+(stream-car (stream-cdr nats)) @result{} 1
+
+(define stream-add
+ (stream-lambda (s1 s2)
+ (stream-cons
+ (+ (stream-car s1) (stream-car s2))
+ (stream-add (stream-cdr s1)
+ (stream-cdr s2)))))
+
+(define evens (stream-add nats nats))
+
+(stream-car evens) @result{} 0
+(stream-car (stream-cdr evens)) @result{} 2
+(stream-car (stream-cdr (stream-cdr evens))) @result{} 4
address@hidden example
+
address@hidden SRFI-41 Stream Library
address@hidden SRFI-41 Stream Library
+
address@hidden {Scheme Syntax} define-stream (name args @dots{}) body @dots{}
+Creates a procedure that returns a stream, and may appear anywhere a
+normal @code{define} may appear, including as an internal definition.
+It may contain internal definitions of its own. The defined procedure
+takes arguments in the same way as @code{stream-lambda}.
address@hidden is syntactic sugar on @code{stream-lambda}; see
+also @code{stream-let}, which is also a sugaring of
address@hidden
+
+A simple version of @code{stream-map} that takes only a single input
+stream calls itself recursively:
+
address@hidden
+(define-stream (stream-map proc strm)
+ (if (stream-null? strm)
+ stream-null
+ (stream-cons
+ (proc (stream-car strm))
+ (stream-map proc (stream-cdr strm))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} list->stream list
+Returns a newly-allocated stream containing the elements from
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} port->stream [port]
+Returns a newly-allocated stream containing in its elements the
+characters on the port. If @var{port} is not given it defaults to the
+current input port. The returned stream has finite length and is
+terminated by @code{stream-null}.
+
+It looks like one use of @code{port->stream} would be this:
+
address@hidden
+(define s ;wrong!
+ (with-input-from-file filename
+ (lambda () (port->stream))))
address@hidden example
+
+But that fails, because @code{with-input-from-file} is eager, and closes
+the input port prematurely, before the first character is read. To read
+a file into a stream, say:
+
address@hidden
+(define-stream (file->stream filename)
+ (let ((p (open-input-file filename)))
+ (stream-let loop ((c (read-char p)))
+ (if (eof-object? c)
+ (begin (close-input-port p)
+ stream-null)
+ (stream-cons c
+ (loop (read-char p)))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Syntax} stream object-expr @dots{}
+Creates a newly-allocated stream containing in its elements the objects,
+in order. The @var{object-expr}s are evaluated when they are accessed,
+not when the stream is created. If no objects are given, as in
+(stream), the null stream is returned. See also @code{list->stream}.
+
address@hidden
+(define strm123 (stream 1 2 3))
+
+; (/ 1 0) not evaluated when stream is created
+(define s (stream 1 (/ 1 0) -1))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream->list [n] stream
+Returns a newly-allocated list containing in its elements the first
address@hidden items in @var{stream}. If @var{stream} has less than @var{n}
+items, all the items in the stream will be included in the returned
+list. If @var{n} is not given it defaults to infinity, which means that
+unless @var{stream} is finite @code{stream->list} will never return.
+
address@hidden
+(stream->list 10
+ (stream-map (lambda (x) (* x x))
+ (stream-from 0)))
+ @result{} (0 1 4 9 16 25 36 49 64 81)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-append stream @dots{}
+Returns a newly-allocated stream containing in its elements those
+elements contained in its input @var{stream}s, in order of input. If
+any of the input streams is infinite, no elements of any of the
+succeeding input streams will appear in the output stream. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-concat stream
+Takes a @var{stream} consisting of one or more streams and returns a
+newly-allocated stream containing all the elements of the input streams.
+If any of the streams in the input @var{stream} is infinite, any
+remaining streams in the input stream will never appear in the output
+stream. See also @code{stream-append}.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-constant object @dots{}
+Returns a newly-allocated stream containing in its elements the
address@hidden, repeating in succession forever.
+
address@hidden
+(stream-constant 1) @result{} 1 1 1 @dots{}
+(stream-constant #t #f) @result{} #t #f #t #f #t #f @dots{}
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-drop n stream
+Returns the suffix of the input @var{stream} that starts at the next
+element after the first @var{n} elements. The output stream shares
+structure with the input @var{stream}; thus, promises forced in one
+instance of the stream are also forced in the other instance of the
+stream. If the input @var{stream} has less than @var{n} elements,
address@hidden returns the null stream. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-drop-while pred stream
+Returns the suffix of the input @var{stream} that starts at the first
+element @var{x} for which @code{(pred x)} returns false. The output
+stream shares structure with the input @var{stream}. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-filter pred stream
+Returns a newly-allocated stream that contains only those elements
address@hidden of the input @var{stream} which satisfy the predicate
address@hidden
+
address@hidden
+(stream-filter odd? (stream-from 0))
+ @result{} 1 3 5 7 9 @dots{}
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-fold proc base stream
+Applies a binary procedure @var{proc} to @var{base} and the first
+element of @var{stream} to compute a new @var{base}, then applies the
+procedure to the new @var{base} and the next element of @var{stream} to
+compute a succeeding @var{base}, and so on, accumulating a value that is
+finally returned as the value of @code{stream-fold} when the end of the
+stream is reached. @var{stream} must be finite, or @code{stream-fold}
+will enter an infinite loop. See also @code{stream-scan}, which is
+similar to @code{stream-fold}, but useful for infinite streams. For
+readers familiar with other functional languages, this is a left-fold;
+there is no corresponding right-fold, since right-fold relies on finite
+streams that are fully-evaluated, in which case they may as well be
+converted to a list.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-for-each proc stream @dots{}
+Applies @var{proc} element-wise to corresponding elements of the input
address@hidden for side-effects; it returns nothing.
address@hidden stops as soon as any of its input streams is
+exhausted.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-from first [step]
+Creates a newly-allocated stream that contains @var{first} as its first
+element and increments each succeeding element by @var{step}. If
address@hidden is not given it defaults to 1. @var{first} and @var{step}
+may be of any numeric type. @code{stream-from} is frequently useful as
+a generator in @code{stream-of} expressions. See also
address@hidden for a similar procedure that creates finite streams.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-iterate proc base
+Creates a newly-allocated stream containing @var{base} in its first
+element and applies @var{proc} to each element in turn to determine the
+succeeding element. See also @code{stream-unfold} and
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-length stream
+Returns the number of elements in the @var{stream}; it does not evaluate
+its elements. @code{stream-length} may only be used on finite streams;
+it enters an infinite loop with infinite streams.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-let tag ((var expr) @dots{}) body @dots{}
+Creates a local scope that binds each variable to the value of its
+corresponding expression. It additionally binds @var{tag} to a
+procedure which takes the bound variables as arguments and @var{body} as
+its defining expressions, binding the @var{tag} with
address@hidden @var{tag} is in scope within body, and may be
+called recursively. When the expanded expression defined by the
address@hidden is evaluated, @code{stream-let} evaluates the
+expressions in its @var{body} in an environment containing the
+newly-bound variables, returning the value of the last expression
+evaluated, which must yield a stream.
+
address@hidden provides syntactic sugar on @code{stream-lambda}, in
+the same manner as normal @code{let} provides syntactic sugar on normal
address@hidden However, unlike normal @code{let}, the @var{tag} is
+required, not optional, because unnamed @code{stream-let} is
+meaningless.
+
+For example, @code{stream-member} returns the first @code{stream-pair}
+of the input @var{strm} with a @code{stream-car} @var{x} that satisfies
address@hidden(eql? obj x)}, or the null stream if @var{x} is not present in
address@hidden
+
address@hidden
+(define-stream (stream-member eql? obj strm)
+ (stream-let loop ((strm strm))
+ (cond ((stream-null? strm) strm)
+ ((eql? obj (stream-car strm)) strm)
+ (else (loop (stream-cdr strm))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-map proc stream @dots{}
+Applies @var{proc} element-wise to corresponding elements of the input
address@hidden, returning a newly-allocated stream containing elements
+that are the results of those procedure applications. The output stream
+has as many elements as the minimum-length input stream, and may be
+infinite.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-match stream clause @dots{}
+Provides pattern-matching for streams. The input @var{stream} is an
+expression that evaluates to a stream. Clauses are of the form
address@hidden(pattern [fender] expression)}, consisting of a @var{pattern} that
+matches a stream of a particular shape, an optional @var{fender} that
+must succeed if the pattern is to match, and an @var{expression} that is
+evaluated if the pattern matches. There are four types of patterns:
+
address@hidden @bullet
address@hidden
+() matches the null stream.
+
address@hidden
+(@var{pat0} @var{pat1} @dots{}) matches a finite stream with length
+exactly equal to the number of pattern elements.
+
address@hidden
+(@var{pat0} @var{pat1} @dots{} @code{.} @var{pat-rest}) matches an
+infinite stream, or a finite stream with length at least as great as the
+number of pattern elements before the literal dot.
+
address@hidden
address@hidden matches an entire stream. Should always appear last in the
+list of clauses; it's not an error to appear elsewhere, but subsequent
+clauses could never match.
address@hidden itemize
+
+Each pattern element may be either:
+
address@hidden @bullet
address@hidden
+An identifier, which matches any stream element. Additionally, the
+value of the stream element is bound to the variable named by the
+identifier, which is in scope in the @var{fender} and @var{expression}
+of the corresponding @var{clause}. Each identifier in a single pattern
+must be unique.
+
address@hidden
+A literal underscore (@code{_}), which matches any stream element but
+creates no bindings.
address@hidden itemize
+
+The @var{pattern}s are tested in order, left-to-right, until a matching
+pattern is found; if @var{fender} is present, it must evaluate to a true
+value for the match to be successful. Pattern variables are bound in
+the corresponding @var{fender} and @var{expression}. Once the matching
address@hidden is found, the corresponding @var{expression} is evaluated
+and returned as the result of the match. An error is signaled if no
+pattern matches the input @var{stream}.
+
address@hidden is often used to distinguish null streams from
+non-null streams, binding @var{head} and @var{tail}:
+
address@hidden
+(define (len strm)
+ (stream-match strm
+ (() 0)
+ ((head . tail) (+ 1 (len tail)))))
address@hidden example
+
+Fenders can test the common case where two stream elements must be
+identical; the @code{else} pattern is an identifier bound to the entire
+stream, not a keyword as in @code{cond}.
+
address@hidden
+(stream-match strm
+ ((x y . _) (equal? x y) 'ok)
+ (else 'error))
address@hidden example
+
+A more complex example uses two nested matchers to match two different
+stream arguments; @code{(stream-merge lt? . strms)} stably merges two or
+more streams ordered by the @code{lt?} predicate:
+
address@hidden
+(define-stream (stream-merge lt? . strms)
+ (define-stream (merge xx yy)
+ (stream-match xx (() yy) ((x . xs)
+ (stream-match yy (() xx) ((y . ys)
+ (if (lt? y x)
+ (stream-cons y (merge xx ys))
+ (stream-cons x (merge xs yy))))))))
+ (stream-let loop ((strms strms))
+ (cond ((null? strms) stream-null)
+ ((null? (cdr strms)) (car strms))
+ (else (merge (car strms)
+ (apply stream-merge lt?
+ (cdr strms)))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-of expr clause @dots{}
+Provides the syntax of stream comprehensions, which generate streams by
+means of looping expressions. The result is a stream of objects of the
+type returned by @var{expr}. There are four types of clauses:
+
address@hidden @bullet
address@hidden
+(@var{var} @code{in} @var{stream-expr}) loops over the elements of
address@hidden, in order from the start of the stream, binding each
+element of the stream in turn to @var{var}. @code{stream-from} and
address@hidden are frequently useful as generators for
address@hidden
+
address@hidden
+(@var{var} @code{is} @var{expr}) binds @var{var} to the value obtained
+by evaluating @var{expr}.
+
address@hidden
+(@var{pred} @var{expr}) includes in the output stream only those
+elements @var{x} which satisfy the predicate @var{pred}.
address@hidden itemize
+
+The scope of variables bound in the stream comprehension is the clauses
+to the right of the binding clause (but not the binding clause itself)
+plus the result expression.
+
+When two or more generators are present, the loops are processed as if
+they are nested from left to right; that is, the rightmost generator
+varies fastest. A consequence of this is that only the first generator
+may be infinite and all subsequent generators must be finite. If no
+generators are present, the result of a stream comprehension is a stream
+containing the result expression; thus, @samp{(stream-of 1)} produces a
+finite stream containing only the element 1.
+
address@hidden
+(stream-of (* x x)
+ (x in (stream-range 0 10))
+ (even? x))
+ @result{} 0 4 16 36 64
+
+(stream-of (list a b)
+ (a in (stream-range 1 4))
+ (b in (stream-range 1 3)))
+ @result{} (1 1) (1 2) (2 1) (2 2) (3 1) (3 2)
+
+(stream-of (list i j)
+ (i in (stream-range 1 5))
+ (j in (stream-range (+ i 1) 5)))
+ @result{} (1 2) (1 3) (1 4) (2 3) (2 4) (3 4)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-range first past [step]
+Creates a newly-allocated stream that contains @var{first} as its first
+element and increments each succeeding element by @var{step}. The
+stream is finite and ends before @var{past}, which is not an element of
+the stream. If @var{step} is not given it defaults to 1 if @var{first}
+is less than past and -1 otherwise. @var{first}, @var{past} and
address@hidden may be of any real numeric type. @code{stream-range} is
+frequently useful as a generator in @code{stream-of} expressions. See
+also @code{stream-from} for a similar procedure that creates infinite
+streams.
+
address@hidden
+(stream-range 0 10) @result{} 0 1 2 3 4 5 6 7 8 9
+(stream-range 0 10 2) @result{} 0 2 4 6 8
address@hidden example
+
+Successive elements of the stream are calculated by adding @var{step} to
address@hidden, so if any of @var{first}, @var{past} or @var{step} are
+inexact, the length of the output stream may differ from
address@hidden(ceiling (- (/ (- past first) step) 1)}.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-ref stream n
+Returns the @var{n}th element of stream, counting from zero. An error
+is signaled if @var{n} is greater than or equal to the length of stream.
+
address@hidden
+(define (fact n)
+ (stream-ref
+ (stream-scan * 1 (stream-from 1))
+ n))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-reverse stream
+Returns a newly-allocated stream containing the elements of the input
address@hidden but in reverse order. @code{stream-reverse} may only be
+used with finite streams; it enters an infinite loop with infinite
+streams. @code{stream-reverse} does not force evaluation of the
+elements of the stream.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-scan proc base stream
+Accumulates the partial folds of an input @var{stream} into a
+newly-allocated output stream. The output stream is the @var{base}
+followed by @code{(stream-fold proc base (stream-take i stream))} for
+each of the first @var{i} elements of @var{stream}.
+
address@hidden
+(stream-scan + 0 (stream-from 1))
+ @result{} (stream 0 1 3 6 10 15 @dots{})
+
+(stream-scan * 1 (stream-from 1))
+ @result{} (stream 1 1 2 6 24 120 @dots{})
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-take n stream
+Returns a newly-allocated stream containing the first @var{n} elements
+of the input @var{stream}. If the input @var{stream} has less than
address@hidden elements, so does the output stream. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-take-while pred stream
+Takes a predicate and a @code{stream} and returns a newly-allocated
+stream containing those elements @code{x} that form the maximal prefix
+of the input stream which satisfy @var{pred}. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-unfold map pred gen base
+The fundamental recursive stream constructor. It constructs a stream by
+repeatedly applying @var{gen} to successive values of @var{base}, in the
+manner of @code{stream-iterate}, then applying @var{map} to each of the
+values so generated, appending each of the mapped values to the output
+stream as long as @code{(pred? base)} returns a true value. See also
address@hidden and @code{stream-unfolds}.
+
+The expression below creates the finite stream @samp{0 1 4 9 16 25 36 49
+64 81}. Initially the @var{base} is 0, which is less than 10, so
address@hidden squares the @var{base} and the mapped value becomes the first
+element of the output stream. Then @var{gen} increments the @var{base}
+by 1, so it becomes 1; this is less than 10, so @var{map} squares the
+new @var{base} and 1 becomes the second element of the output stream.
+And so on, until the base becomes 10, when @var{pred} stops the
+recursion and stream-null ends the output stream.
+
address@hidden
+(stream-unfold
+ (lambda (x) (expt x 2)) ; map
+ (lambda (x) (< x 10)) ; pred?
+ (lambda (x) (+ x 1)) ; gen
+ 0) ; base
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-unfolds proc seed
+Returns @var{n} newly-allocated streams containing those elements
+produced by successive calls to the generator @var{proc}, which takes
+the current @var{seed} as its argument and returns @var{n}+1 values
+
+(@var{proc} @var{seed}) @result{} @var{seed} @var{result_0} @dots{}
@var{result_n-1}
+
+where the returned @var{seed} is the input @var{seed} to the next call
+to the generator and @var{result_i} indicates how to produce the next
+element of the @var{i}th result stream:
+
address@hidden @bullet
address@hidden
+(@var{value}): @var{value} is the next car of the result stream.
+
address@hidden
address@hidden: no value produced by this iteration of the generator
address@hidden for the result stream.
+
address@hidden
+(): the end of the result stream.
address@hidden itemize
+
+It may require multiple calls of @var{proc} to produce the next element
+of any particular result stream. See also @code{stream-iterate} and
address@hidden
+
address@hidden
+(define (stream-partition pred? strm)
+ (stream-unfolds
+ (lambda (s)
+ (if (stream-null? s)
+ (values s '() '())
+ (let ((a (stream-car s))
+ (d (stream-cdr s)))
+ (if (pred? a)
+ (values d (list a) #f)
+ (values d #f (list a))))))
+ strm))
+
+(call-with-values
+ (lambda ()
+ (stream-partition odd?
+ (stream-range 1 6)))
+ (lambda (odds evens)
+ (list (stream->list odds)
+ (stream->list evens))))
+ @result{} ((1 3 5) (2 4))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-zip stream @dots{}
+Returns a newly-allocated stream in which each element is a list (not a
+stream) of the corresponding elements of the input @var{stream}s. The
+output stream is as long as the shortest input @var{stream}, if any of
+the input @var{stream}s is finite, or is infinite if all the input
address@hidden are infinite.
address@hidden deffn
+
@node SRFI-42
@subsection SRFI-42 - Eager Comprehensions
@cindex SRFI-42
@@ -3832,6 +4552,13 @@ words, no program that uses the R5RS definitions of
delay and force will
break if those definition are replaced by the SRFI-45 definitions of
delay and force.
+Guile also adds @code{promise?} to the list of exports, which is not
+part of the official SRFI-45.
+
address@hidden {Scheme Procedure} promise? obj
+Return true if @var{obj} is an SRFI-45 promise, otherwise return false.
address@hidden deffn
+
@deffn {Scheme Syntax} delay expression
Takes an expression of arbitrary type @var{a} and returns a promise of
type @code{(Promise @var{a})} which at some point in the future may be
diff --git a/doc/ref/sxml.texi b/doc/ref/sxml.texi
index 6dc261f..75867f3 100644
--- a/doc/ref/sxml.texi
+++ b/doc/ref/sxml.texi
@@ -381,13 +381,8 @@ Pearl. Proc ICFP'00, pp. 186-197.
@deffn {Scheme Procedure} attlist-add attlist name-value
@end deffn
address@hidden {Scheme Procedure} attlist-null? _
address@hidden
- -- Scheme Procedure: null? x
- Return `#t' iff X is the empty list, else `#f'.
-
-
address@hidden verbatim
address@hidden {Scheme Procedure} attlist-null? x
+Return @code{#t} if @var{x} is the empty list, else @code{#f}.
@end deffn
@deffn {Scheme Procedure} attlist-remove-top attlist
diff --git a/doc/ref/texinfo.texi b/doc/ref/texinfo.texi
index b5ef393..ec06863 100644
--- a/doc/ref/texinfo.texi
+++ b/doc/ref/texinfo.texi
@@ -3,8 +3,12 @@
@c Copyright (C) 2013 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
address@hidden Texinfo
address@hidden Texinfo
address@hidden Note: Don't use "Texinfo" as the node name here because this
leads to
address@hidden a clash in the HTML output between texinfo.html (from the
"texinfo"
address@hidden node) and Texinfo.html on case-insensitive file systems such as
address@hidden HFS+ (MacOS X).
address@hidden Texinfo Processing
address@hidden Texinfo Processing
@menu
* texinfo:: Parse texinfo files or fragments into @code{stexi}, a
scheme representation
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 6c33f32..0d41f9f 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -10,7 +10,7 @@
@cindex HTTP
It has always been possible to connect computers together and share
-information between them, but the rise of the World-Wide Web over the
+information between them, but the rise of the World Wide Web over the
last couple of decades has made it much easier to do so. The result is
a richly connected network of computation, in which Guile forms a part.
@@ -206,9 +206,10 @@ The following procedures can be found in the @code{(web
uri)}
module. Load it into your Guile, using a form like the above, to have
access to them.
address@hidden {Scheme Procedure} build-uri scheme [#:address@hidden
[#:address@hidden @
- [#:address@hidden [#:address@hidden""}] [#:address@hidden @
- [#:address@hidden [#:address@hidden
address@hidden {Scheme Procedure} build-uri scheme @
+ [#:address@hidden [#:address@hidden [#:address@hidden @
+ [#:address@hidden""}] [#:address@hidden [#:address@hidden @
+ [#:address@hidden
Construct a URI object. @var{scheme} should be a symbol, @var{port}
either a positive, exact integer or @code{#f}, and the rest of the
fields are either strings or @code{#f}. If @var{validate?} is true,
@@ -216,7 +217,7 @@ also run some consistency checks to make sure that the
constructed URI
is valid.
@end deffn
address@hidden {Scheme Procedure} uri? x
address@hidden {Scheme Procedure} uri? obj
@deffnx {Scheme Procedure} uri-scheme uri
@deffnx {Scheme Procedure} uri-userinfo uri
@deffnx {Scheme Procedure} uri-host uri
@@ -249,9 +250,9 @@ Percent-decode the given @var{str}, according to
@var{encoding}, which
should be the name of a character encoding.
Note that this function should not generally be applied to a full URI
-string. For paths, use split-and-decode-uri-path instead. For query
-strings, split the query on @code{&} and @code{=} boundaries, and decode
-the components separately.
+string. For paths, use @code{split-and-decode-uri-path} instead. For
+query strings, split the query on @code{&} and @code{=} boundaries, and
+decode the components separately.
Note also that percent-encoded strings encode @emph{bytes}, not
characters. There is no guarantee that a given byte sequence is a valid
@@ -351,8 +352,8 @@ parsing and serialization procedures. If a header is
unknown, its
string name is simply its symbol name in title-case.
@deffn {Scheme Procedure} known-header? sym
-Return @code{#t} iff @var{sym} is a known header, with associated
-parsers and serialization procedures.
+Return @code{#t} if @var{sym} is a known header, with associated
+parsers and serialization procedures, or @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} header-parser sym
@@ -378,7 +379,8 @@ For more on the set of headers that Guile knows about out
of the box,
@pxref{HTTP Headers}. To add your own, use the @code{declare-header!}
procedure:
address@hidden {Scheme Procedure} declare-header! name parser validator writer
[#:address@hidden
address@hidden {Scheme Procedure} declare-header! name parser validator writer @
+ [#:address@hidden
Declare a parser, validator, and writer for a given header.
@end deffn
@@ -405,8 +407,8 @@ you want a header's value to be returned/written ``as-is''.
@end deffn
@deffn {Scheme Procedure} valid-header? sym val
-Return a true value iff @var{val} is a valid Scheme value for the header
-with name @var{sym}.
+Return a true value if @var{val} is a valid Scheme value for the header
+with name @var{sym}, or @code{#f} otherwise.
@end deffn
Now that we have a generic interface for reading and writing headers, we
@@ -450,7 +452,7 @@ like @code{GET}.
@end deffn
@deffn {Scheme Procedure} parse-http-version str [start] [end]
-Parse an HTTP version from @var{str}, returning it as a major-minor
+Parse an HTTP version from @var{str}, returning it as a major--minor
pair. For example, @code{HTTP/1.1} parses as the pair of integers,
@code{(1 . 1)}.
@end deffn
@@ -471,7 +473,7 @@ Write the first line of an HTTP request to @var{port}.
@deffn {Scheme Procedure} read-response-line port
Read the first line of an HTTP response from @var{port}, returning three
-values: the HTTP version, the response code, and the "reason phrase".
+values: the HTTP version, the response code, and the ``reason phrase''.
@end deffn
@deffn {Scheme Procedure} write-response-line version code reason-phrase port
@@ -1130,13 +1132,13 @@ any loss of generality.
@subsubsection Request API
address@hidden {Scheme Procedure} request?
address@hidden {Scheme Procedure} request-method
address@hidden {Scheme Procedure} request-uri
address@hidden {Scheme Procedure} request-version
address@hidden {Scheme Procedure} request-headers
address@hidden {Scheme Procedure} request-meta
address@hidden {Scheme Procedure} request-port
address@hidden {Scheme Procedure} request? obj
address@hidden {Scheme Procedure} request-method request
address@hidden {Scheme Procedure} request-uri request
address@hidden {Scheme Procedure} request-version request
address@hidden {Scheme Procedure} request-headers request
address@hidden {Scheme Procedure} request-meta request
address@hidden {Scheme Procedure} request-port request
A predicate and field accessors for the request type. The fields are as
follows:
@table @code
@@ -1170,7 +1172,9 @@ request, you may read the body separately, and likewise
for writing
requests.
@end deffn
address@hidden {Scheme Procedure} build-request uri [#:method='GET]
[#:version='(1 . 1)] [#:headers='()] [#:port=#f] [#:meta='()]
[#:validate-headers?=#t]
address@hidden {Scheme Procedure} build-request uri [#:method='GET] @
+ [#:version='(1 . 1)] [#:headers='()] [#:port=#f] [#:meta='()] @
+ [#:validate-headers?=#t]
Construct an HTTP request object. If @var{validate-headers?} is true,
the headers are each run through their respective validators.
@end deffn
@@ -1253,12 +1257,12 @@ A helper routine to determine the absolute URI of a
request, using the
As with requests (@pxref{Requests}), Guile offers a data type for HTTP
responses. Again, the body is represented separately from the request.
address@hidden {Scheme Procedure} response?
address@hidden {Scheme Procedure} response-version
address@hidden {Scheme Procedure} response-code
address@hidden {Scheme Procedure} response? obj
address@hidden {Scheme Procedure} response-version response
address@hidden {Scheme Procedure} response-code response
@deffnx {Scheme Procedure} response-reason-phrase response
address@hidden {Scheme Procedure} response-headers
address@hidden {Scheme Procedure} response-port
address@hidden {Scheme Procedure} response-headers response
address@hidden {Scheme Procedure} response-port response
A predicate and field accessors for the response type. The fields are as
follows:
@table @code
@@ -1384,6 +1388,10 @@ Return @code{#t} if @var{type}, a symbol as returned by
@code{(web client)} provides a simple, synchronous HTTP client, built on
the lower-level HTTP, request, and response modules.
address@hidden
+(use-modules (web client))
address@hidden example
+
@deffn {Scheme Procedure} open-socket-for-uri uri
Return an open input/output port for a connection to URI.
@end deffn
@@ -1419,9 +1427,9 @@ If you already have a port open, pass it as @var{port}.
Otherwise, a
connection will be opened to the server corresponding to @var{uri}. Any
extra headers in the alist @var{headers} will be added to the request.
-If @var{body} is not #f, a message body will also be sent with the HTTP
-request. If @var{body} is a string, it is encoded according to the
-content-type in @var{headers}, defaulting to UTF-8. Otherwise
+If @var{body} is not @code{#f}, a message body will also be sent with
+the HTTP request. If @var{body} is a string, it is encoded according to
+the content-type in @var{headers}, defaulting to UTF-8. Otherwise
@var{body} should be a bytevector, or @code{#f} for no body. Although a
message body may be sent with any request, usually only @code{POST} and
@code{PUT} requests have bodies.
@@ -1480,8 +1488,8 @@ The life cycle of a server goes as follows:
@enumerate
@item
-The @code{open} hook is called, to open the server. @code{open} takes 0 or
-more arguments, depending on the backend, and returns an opaque
+The @code{open} hook is called, to open the server. @code{open} takes
+zero or more arguments, depending on the backend, and returns an opaque
server socket object, or signals an error.
@item
@@ -1578,8 +1586,8 @@ in, allowing the user's handler to explicitly manage its
state.
@end deffn
@deffn {Scheme Procedure} sanitize-response request response body
-"Sanitize" the given response and body, making them appropriate for the
-given request.
+``Sanitize'' the given response and body, making them appropriate for
+the given request.
As a convenience to web handler authors, @var{response} may be given as
an alist of headers, in which case it is used to construct a default
@@ -1615,7 +1623,9 @@ and body, and write the response to the client. Return
the new state
produced by the handler procedure.
@end deffn
address@hidden {Scheme Procedure} run-server handler [impl='http]
[open-params='()] . state
address@hidden {Scheme Procedure} run-server handler @
+ [impl='http] [open-params='()] @
+ arg @dots{}
Run Guile's built-in web server.
@var{handler} should be a procedure that takes two or more arguments,
@@ -1627,16 +1637,20 @@ For examples, skip ahead to the next section, @ref{Web
Examples}.
The response and body will be run through @code{sanitize-response}
before sending back to the client.
-Additional arguments to @var{handler} are taken from @var{state}.
-Additional return values are accumulated into a new @var{state}, which
-will be used for subsequent requests. In this way a handler can
-explicitly manage its state.
+Additional arguments to @var{handler} are taken from @var{arg}
address@hidden These arguments comprise a @dfn{state}. Additional return
+values are accumulated into a new state, which will be used for
+subsequent requests. In this way a handler can explicitly manage its
+state.
@end deffn
The default web server implementation is @code{http}, which binds to a
socket, listening for request on that port.
address@hidden {HTTP Implementation} http [#:host=#f] [#:family=AF_INET]
[#:addr=INADDR_LOOPBACK] [#:port 8080] [#:socket]
address@hidden {HTTP Implementation} http [#:host=#f] @
+ [#:family=AF_INET] @
+ [#:addr=INADDR_LOOPBACK] @
+ [#:port 8080] [#:socket]
The default HTTP implementation. We document it as a function with
keyword arguments, because that is precisely the way that it is -- all
of the @var{open-params} to @code{run-server} get passed to the
diff --git a/gnulib-local/build-aux/git-version-gen.diff
b/gnulib-local/build-aux/git-version-gen.diff
index c222a99..f875f49 100644
--- a/gnulib-local/build-aux/git-version-gen.diff
+++ b/gnulib-local/build-aux/git-version-gen.diff
@@ -2,47 +2,33 @@ This patch is being discussed
at <http://lists.gnu.org/archive/html/bug-gnulib/2012-07/msg00079.html>.
Remove when integrated in Gnulib.
---- a/build-aux/git-version-gen 2012-06-12 21:25:48.000000000 +0200
-+++ b/build-aux/git-version-gen 2012-07-07 01:52:08.000000000 +0200
-@@ -1,6 +1,6 @@
- #!/bin/sh
- # Print a version string.
--scriptversion=2012-03-18.17; # UTC
-+scriptversion=2012-07-06.14; # UTC
-
- # Copyright (C) 2007-2012 Free Software Foundation, Inc.
- #
-@@ -85,20 +85,25 @@
-
+--- a/build-aux/git-version-gen
++++ b/build-aux/git-version-gen
+@@ -86,6 +86,7 @@ Print a version string.
Options:
-- --prefix prefix of git tags (default 'v')
-+ --prefix prefix of git tags to strip from version (default 'v')
-+ --match pattern for git tags to match (default: '\$prefix*')
-
-- --help display this help and exit
-- --version output version information and exit
-+ --help display this help and exit
-+ --version output version information and exit
-
--Running without arguments will suffice in most cases."
-+Running without arguments will suffice in most cases. If no --match
-+argument is given, only match tags that begin with the --prefix."
+ --prefix prefix of git tags (default 'v')
++ --match pattern for git tags to match (default: '\$prefix*')
+ --fallback fallback version to use if \"git --version\" fails
+ --help display this help and exit
+@@ -96,11 +97,15 @@ Running without arguments will suffice in most cases."
prefix=v
+ fallback=
+
+unset match
+unset tag_sed_script
-
++
while test $# -gt 0; do
case $1 in
--help) echo "$usage"; exit 0;;
--version) echo "$version"; exit 0;;
--prefix) shift; prefix="$1";;
+ --match) shift; match="$1";;
+ --fallback) shift; fallback="$1";;
-*)
echo "$0: Unknown option '$1'." >&2
- echo "$0: Try '--help' for more information." >&2
-@@ -121,6 +126,7 @@
+@@ -124,6 +129,7 @@ if test "x$tarball_version_file" = x; then
exit 1
fi
@@ -50,13 +36,12 @@ Remove when integrated in Gnulib.
tag_sed_script="${tag_sed_script:-s/x/x/}"
nl='
-@@ -151,8 +157,7 @@
+@@ -154,7 +160,7 @@ then
# directory, and "git describe" output looks sensible, use that to
# derive a version string.
elif test "`git log -1 --pretty=format:x . 2>&1`" = x \
- && v=`git describe --abbrev=4 --match="$prefix*" HEAD 2>/dev/null \
-- || git describe --abbrev=4 HEAD 2>/dev/null` \
-+ && v=`git describe --abbrev=4 --match="$match" HEAD 2>/dev/null` \
++ && v=`git describe --abbrev=4 --match="$match" HEAD 2>/dev/null \
+ || git describe --abbrev=4 HEAD 2>/dev/null` \
&& v=`printf '%s\n' "$v" | sed "$tag_sed_script"` \
&& case $v in
- $prefix[0-9]*) ;;
diff --git a/guile-readline/readline.c b/guile-readline/readline.c
index 1e697eb..aac6e18 100644
--- a/guile-readline/readline.c
+++ b/guile-readline/readline.c
@@ -1,6 +1,7 @@
/* readline.c --- line editing support for Guile */
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009,
2010, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008,
+ * 2009, 2010, 2013 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
@@ -27,19 +28,13 @@
#ifdef HAVE_RL_GETC_FUNCTION
#include "libguile.h"
-#include "libguile/iselect.h"
#include <stdio.h>
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif
#include <readline/readline.h>
#include <readline/history.h>
-#ifndef __MINGW32__
#include <sys/time.h>
-#else
-#include <io.h>
-#endif
+#include <sys/select.h>
#include <signal.h>
#include "libguile/validate.h"
@@ -207,10 +202,8 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
scm_dynwind_end ();
-#ifndef __MINGW32__
fclose (rl_instream);
fclose (rl_outstream);
-#endif
--in_readline;
return ans;
@@ -240,10 +233,8 @@ unwind_readline (void *unused)
rl_free_line_state ();
rl_cleanup_after_signal ();
fputc ('\n', rl_outstream); /* We don't want next output on this line */
-#ifndef __MINGW32__
fclose (rl_instream);
fclose (rl_outstream);
-#endif
--in_readline;
}
@@ -314,10 +305,8 @@ scm_readline_init_ports (SCM inp, SCM outp)
input_port = inp;
output_port = outp;
-#ifndef __MINGW32__
rl_instream = stream_from_fport (inp, "r", s_scm_readline);
rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
-#endif
}
@@ -489,11 +478,9 @@ static int
match_paren (int x, int k)
{
int tmp;
-#ifndef __MINGW32__
int fno;
- SELECT_TYPE readset;
+ fd_set readset;
struct timeval timeout;
-#endif
rl_insert (x, k);
if (!SCM_READLINE_BOUNCE_PARENS)
@@ -504,14 +491,12 @@ match_paren (int x, int k)
&& rl_line_buffer[rl_point - 2] == '\\')
return 0;
-#ifndef __MINGW32__
tmp = 1000 * SCM_READLINE_BOUNCE_PARENS;
timeout.tv_sec = tmp / 1000000;
timeout.tv_usec = tmp % 1000000;
FD_ZERO (&readset);
fno = fileno (rl_instream);
FD_SET (fno, &readset);
-#endif
if (rl_point > 1)
{
@@ -520,12 +505,7 @@ match_paren (int x, int k)
if (rl_point > -1)
{
rl_redisplay ();
-#ifndef __MINGW32__
- scm_std_select (fno + 1, &readset, NULL, NULL, &timeout);
-#else
- WaitForSingleObject (GetStdHandle(STD_INPUT_HANDLE),
- SCM_READLINE_BOUNCE_PARENS);
-#endif
+ select (fno + 1, &readset, NULL, NULL, &timeout);
}
rl_point = tmp;
}
@@ -542,9 +522,7 @@ scm_init_readline ()
#include "guile-readline/readline.x"
scm_readline_completion_function_var
= scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
-#ifndef __MINGW32__
rl_getc_function = current_input_getc;
-#endif
#if defined (_RL_FUNCTION_TYPEDEF)
rl_completion_entry_function = (rl_compentry_func_t*) completion_function;
#else
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 49c5140..c92a8ac 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 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
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# 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 canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp full-read full-write func
gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nl_langinfo nproc open pipe2 putenv recv recvfrom regex rename send
sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh
string sys_stat trunc verify vsnprintf warnings wchar
+# 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 canonicalize-lgpl ceil clock-time close connect 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 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 times
trunc verify vsnprintf warnings wchar
AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
@@ -62,6 +62,8 @@ libgnu_la_LDFLAGS += $(ISNANL_LIBM)
libgnu_la_LDFLAGS += $(LDEXP_LIBM)
libgnu_la_LDFLAGS += $(LIBSOCKET)
libgnu_la_LDFLAGS += $(LIB_CLOCK_GETTIME)
+libgnu_la_LDFLAGS += $(LIB_POLL)
+libgnu_la_LDFLAGS += $(LIB_SELECT)
libgnu_la_LDFLAGS += $(LOG1P_LIBM)
libgnu_la_LDFLAGS += $(LOG_LIBM)
libgnu_la_LDFLAGS += $(LTLIBICONV)
@@ -87,6 +89,17 @@ EXTRA_DIST += alignof.h
## end gnulib module alignof
+## begin gnulib module alloca
+
+
+libgnu_la_LIBADD += @LTALLOCA@
+libgnu_la_DEPENDENCIES += @LTALLOCA@
+EXTRA_DIST += alloca.c
+
+EXTRA_libgnu_la_SOURCES += alloca.c
+
+## end gnulib module alloca
+
## begin gnulib module alloca-opt
BUILT_SOURCES += $(ALLOCA_H)
@@ -371,6 +384,15 @@ EXTRA_DIST += dosname.h
## end gnulib module dosname
+## begin gnulib module dup2
+
+
+EXTRA_DIST += dup2.c
+
+EXTRA_libgnu_la_SOURCES += dup2.c
+
+## end gnulib module dup2
+
## begin gnulib module duplocale
@@ -556,6 +578,15 @@ EXTRA_libgnu_la_SOURCES += gai_strerror.c getaddrinfo.c
## end gnulib module getaddrinfo
+## begin gnulib module getlogin
+
+
+EXTRA_DIST += getlogin.c
+
+EXTRA_libgnu_la_SOURCES += getlogin.c
+
+## end gnulib module getlogin
+
## begin gnulib module getpeername
@@ -1006,6 +1037,7 @@ EXTRA_DIST += malloca.h malloca.valgrind
## begin gnulib module math
BUILT_SOURCES += math.h
+libgnu_la_SOURCES += math.c
# We need the following in order to create <math.h> when the system
# doesn't have one that works with the given compiler.
@@ -1438,12 +1470,59 @@ EXTRA_DIST += pathmax.h
## end gnulib module pathmax
+## begin gnulib module pipe-posix
+
+
+EXTRA_DIST += pipe.c
+
+EXTRA_libgnu_la_SOURCES += pipe.c
+
+## end gnulib module pipe-posix
+
## begin gnulib module pipe2
libgnu_la_SOURCES += pipe2.c
## end gnulib module pipe2
+## begin gnulib module poll
+
+
+EXTRA_DIST += poll.c
+
+EXTRA_libgnu_la_SOURCES += poll.c
+
+## end gnulib module poll
+
+## begin gnulib module poll-h
+
+BUILT_SOURCES += poll.h
+
+# We need the following in order to create <poll.h> when the system
+# doesn't have one.
+poll.h: poll.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H)
+ $(AM_V_GEN)rm -f address@hidden $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''HAVE_POLL_H''@|$(HAVE_POLL_H)|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_POLL_H''@|$(NEXT_POLL_H)|g' \
+ -e 's/@''GNULIB_POLL''@/$(GNULIB_POLL)/g' \
+ -e 's|@''HAVE_POLL''@|$(HAVE_POLL)|g' \
+ -e 's|@''REPLACE_POLL''@|$(REPLACE_POLL)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/poll.in.h; \
+ } > address@hidden && \
+ mv -f address@hidden $@
+MOSTLYCLEANFILES += poll.h poll.h-t
+
+EXTRA_DIST += poll.in.h
+
+## end gnulib module poll-h
+
## begin gnulib module putenv
@@ -1559,6 +1638,15 @@ EXTRA_DIST += same-inode.h
## end gnulib module same-inode
+## begin gnulib module select
+
+
+EXTRA_DIST += select.c
+
+EXTRA_libgnu_la_SOURCES += select.c
+
+## end gnulib module select
+
## begin gnulib module send
@@ -2093,6 +2181,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
-e 's/@''GNULIB_RPMATCH''@/$(GNULIB_RPMATCH)/g' \
+ -e 's/@''GNULIB_SECURE_GETENV''@/$(GNULIB_SECURE_GETENV)/g' \
-e 's/@''GNULIB_SETENV''@/$(GNULIB_SETENV)/g' \
-e 's/@''GNULIB_STRTOD''@/$(GNULIB_STRTOD)/g' \
-e 's/@''GNULIB_STRTOLL''@/$(GNULIB_STRTOLL)/g' \
@@ -2121,6 +2210,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
-e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \
+ -e 's|@''HAVE_SECURE_GETENV''@|$(HAVE_SECURE_GETENV)|g' \
-e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \
-e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \
-e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \
@@ -2311,9 +2401,44 @@ EXTRA_DIST += sys_file.in.h
## end gnulib module sys_file
+## begin gnulib module sys_select
+
+BUILT_SOURCES += sys/select.h
+
+# We need the following in order to create <sys/select.h> when the system
+# doesn't have one that works with the given compiler.
+sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H)
$(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f address@hidden $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \
+ -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \
+ -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \
+ -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \
+ -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \
+ -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_select.in.h; \
+ } > address@hidden && \
+ mv address@hidden $@
+MOSTLYCLEANFILES += sys/select.h sys/select.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_select.in.h
+
+## end gnulib module sys_select
+
## begin gnulib module sys_socket
BUILT_SOURCES += sys/socket.h
+libgnu_la_SOURCES += sys_socket.c
# We need the following in order to create <sys/socket.h> when the system
# doesn't have one that works with the given compiler.
@@ -2458,6 +2583,37 @@ EXTRA_DIST += sys_time.in.h
## end gnulib module sys_time
+## begin gnulib module sys_times
+
+BUILT_SOURCES += sys/times.h
+
+# We need the following in order to create <sys/times.h> when the system
+# doesn't have one that works with the given compiler.
+sys/times.h: sys_times.in.h $(top_builddir)/config.status $(WARN_ON_USE_H)
$(ARG_NONNULL_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f address@hidden $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_SYS_TIMES_H''@/$(HAVE_SYS_TIMES_H)/g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_TIMES_H''@|$(NEXT_SYS_TIMES_H)|g' \
+ -e 's/@''GNULIB_TIMES''@/$(GNULIB_TIMES)/g' \
+ -e 's|@''HAVE_STRUCT_TMS''@|$(HAVE_STRUCT_TMS)|g' \
+ -e 's|@''HAVE_TIMES''@|$(HAVE_TIMES)|g' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_times.in.h; \
+ } > address@hidden && \
+ mv address@hidden $@
+MOSTLYCLEANFILES += sys/times.h sys/times.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_times.in.h
+
+## end gnulib module sys_times
+
## begin gnulib module sys_types
BUILT_SOURCES += sys/types.h
@@ -2560,6 +2716,15 @@ EXTRA_libgnu_la_SOURCES += time_r.c
## end gnulib module time_r
+## begin gnulib module times
+
+
+EXTRA_DIST += times.c
+
+EXTRA_libgnu_la_SOURCES += times.c
+
+## end gnulib module times
+
## begin gnulib module trunc
@@ -2572,6 +2737,7 @@ EXTRA_libgnu_la_SOURCES += trunc.c
## begin gnulib module unistd
BUILT_SOURCES += unistd.h
+libgnu_la_SOURCES += unistd.c
# We need the following in order to create an empty placeholder for
# <unistd.h> when the system doesn't have one.
@@ -2963,6 +3129,7 @@ EXTRA_libgnu_la_SOURCES += wcrtomb.c
## begin gnulib module wctype-h
BUILT_SOURCES += wctype.h
+libgnu_la_SOURCES += wctype-h.c
# We need the following in order to create <wctype.h> when the system
# doesn't have one that works with the given compiler.
diff --git a/lib/accept.c b/lib/accept.c
index 78bb822..0c8e52e 100644
--- a/lib/accept.c
+++ b/lib/accept.c
@@ -1,6 +1,6 @@
/* accept.c --- wrappers for Windows accept function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 b6d8666..2bf3820 100644
--- a/lib/alignof.h
+++ b/lib/alignof.h
@@ -1,5 +1,5 @@
/* Determine alignment of types.
- Copyright (C) 2003-2004, 2006, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003-2004, 2006, 2009-2013 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/alloca.c b/lib/alloca.c
new file mode 100644
index 0000000..ee0f018
--- /dev/null
+++ b/lib/alloca.c
@@ -0,0 +1,478 @@
+/* alloca.c -- allocate automatically reclaimed memory
+ (Mostly) portable public-domain implementation -- D A Gwyn
+
+ This implementation of the PWB library alloca function,
+ which is used to allocate space off the run-time stack so
+ that it is automatically reclaimed upon procedure exit,
+ was inspired by discussions with J. Q. Johnson of Cornell.
+ J.Otto Tennant <address@hidden> contributed the Cray support.
+
+ There are some preprocessor constants that can
+ be defined when compiling for your specific system, for
+ improved efficiency; however, the defaults should be okay.
+
+ The general concept of this implementation is to keep
+ track of all alloca-allocated blocks, and reclaim any
+ that are found to be deeper in the stack than the current
+ invocation. This heuristic does not reclaim storage as
+ soon as it becomes invalid, but it will do so eventually.
+
+ As a special case, alloca(0) reclaims storage without
+ allocating any. It is a good idea to use alloca(0) in
+ your main control loop, etc. to force garbage collection. */
+
+#include <config.h>
+
+#include <alloca.h>
+
+#include <string.h>
+#include <stdlib.h>
+
+#ifdef emacs
+# include "lisp.h"
+# include "blockinput.h"
+# ifdef EMACS_FREE
+# undef free
+# define free EMACS_FREE
+# endif
+#else
+# define memory_full() abort ()
+#endif
+
+/* If compiling with GCC 2, this file's not needed. */
+#if !defined (__GNUC__) || __GNUC__ < 2
+
+/* If someone has defined alloca as a macro,
+ there must be some other way alloca is supposed to work. */
+# ifndef alloca
+
+# ifdef emacs
+# ifdef static
+/* actually, only want this if static is defined as ""
+ -- this is for usg, in which emacs must undefine static
+ in order to make unexec workable
+ */
+# ifndef STACK_DIRECTION
+you
+lose
+-- must know STACK_DIRECTION at compile-time
+/* Using #error here is not wise since this file should work for
+ old and obscure compilers. */
+# endif /* STACK_DIRECTION undefined */
+# endif /* static */
+# endif /* emacs */
+
+/* If your stack is a linked list of frames, you have to
+ provide an "address metric" ADDRESS_FUNCTION macro. */
+
+# if defined (CRAY) && defined (CRAY_STACKSEG_END)
+long i00afunc ();
+# define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+# else
+# define ADDRESS_FUNCTION(arg) &(arg)
+# endif
+
+/* Define STACK_DIRECTION if you know the direction of stack
+ growth for your system; otherwise it will be automatically
+ deduced at run-time.
+
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+
+# ifndef STACK_DIRECTION
+# define STACK_DIRECTION 0 /* Direction unknown. */
+# endif
+
+# if STACK_DIRECTION != 0
+
+# define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
+
+# else /* STACK_DIRECTION == 0; need run-time code. */
+
+static int stack_dir; /* 1 or -1 once known. */
+# define STACK_DIR stack_dir
+
+static int
+find_stack_direction (int *addr, int depth)
+{
+ int dir, dummy = 0;
+ if (! addr)
+ addr = &dummy;
+ *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1;
+ dir = depth ? find_stack_direction (addr, depth - 1) : 0;
+ return dir + dummy;
+}
+
+# endif /* STACK_DIRECTION == 0 */
+
+/* An "alloca header" is used to:
+ (a) chain together all alloca'ed blocks;
+ (b) keep track of stack depth.
+
+ It is very important that sizeof(header) agree with malloc
+ alignment chunk size. The following default should work okay. */
+
+# ifndef ALIGN_SIZE
+# define ALIGN_SIZE sizeof(double)
+# endif
+
+typedef union hdr
+{
+ char align[ALIGN_SIZE]; /* To force sizeof(header). */
+ struct
+ {
+ union hdr *next; /* For chaining headers. */
+ char *deep; /* For stack depth measure. */
+ } h;
+} header;
+
+static header *last_alloca_header = NULL; /* -> last alloca header. */
+
+/* Return a pointer to at least SIZE bytes of storage,
+ which will be automatically reclaimed upon exit from
+ the procedure that called alloca. Originally, this space
+ was supposed to be taken from the current stack frame of the
+ caller, but that method cannot be made to work for some
+ implementations of C, for example under Gould's UTX/32. */
+
+void *
+alloca (size_t size)
+{
+ auto char probe; /* Probes stack depth: */
+ register char *depth = ADDRESS_FUNCTION (probe);
+
+# if STACK_DIRECTION == 0
+ if (STACK_DIR == 0) /* Unknown growth direction. */
+ STACK_DIR = find_stack_direction (NULL, (size & 1) + 20);
+# endif
+
+ /* Reclaim garbage, defined as all alloca'd storage that
+ was allocated from deeper in the stack than currently. */
+
+ {
+ register header *hp; /* Traverses linked list. */
+
+# ifdef emacs
+ BLOCK_INPUT;
+# endif
+
+ for (hp = last_alloca_header; hp != NULL;)
+ if ((STACK_DIR > 0 && hp->h.deep > depth)
+ || (STACK_DIR < 0 && hp->h.deep < depth))
+ {
+ register header *np = hp->h.next;
+
+ free (hp); /* Collect garbage. */
+
+ hp = np; /* -> next header. */
+ }
+ else
+ break; /* Rest are not deeper. */
+
+ last_alloca_header = hp; /* -> last valid storage. */
+
+# ifdef emacs
+ UNBLOCK_INPUT;
+# endif
+ }
+
+ if (size == 0)
+ return NULL; /* No allocation required. */
+
+ /* Allocate combined header + user data storage. */
+
+ {
+ /* Address of header. */
+ register header *new;
+
+ size_t combined_size = sizeof (header) + size;
+ if (combined_size < sizeof (header))
+ memory_full ();
+
+ new = malloc (combined_size);
+
+ if (! new)
+ memory_full ();
+
+ new->h.next = last_alloca_header;
+ new->h.deep = depth;
+
+ last_alloca_header = new;
+
+ /* User storage begins just after header. */
+
+ return (void *) (new + 1);
+ }
+}
+
+# if defined (CRAY) && defined (CRAY_STACKSEG_END)
+
+# ifdef DEBUG_I00AFUNC
+# include <stdio.h>
+# endif
+
+# ifndef CRAY_STACK
+# define CRAY_STACK
+# ifndef CRAY2
+/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+struct stack_control_header
+ {
+ long shgrow:32; /* Number of times stack has grown. */
+ long shaseg:32; /* Size of increments to stack. */
+ long shhwm:32; /* High water mark of stack. */
+ long shsize:32; /* Current size of stack (all segments). */
+ };
+
+/* The stack segment linkage control information occurs at
+ the high-address end of a stack segment. (The stack
+ grows from low addresses to high addresses.) The initial
+ part of the stack segment linkage control information is
+ 0200 (octal) words. This provides for register storage
+ for the routine which overflows the stack. */
+
+struct stack_segment_linkage
+ {
+ long ss[0200]; /* 0200 overflow words. */
+ long sssize:32; /* Number of words in this segment. */
+ long ssbase:32; /* Offset to stack base. */
+ long:32;
+ long sspseg:32; /* Offset to linkage control of previous
+ segment of stack. */
+ long:32;
+ long sstcpt:32; /* Pointer to task common address block. */
+ long sscsnm; /* Private control structure number for
+ microtasking. */
+ long ssusr1; /* Reserved for user. */
+ long ssusr2; /* Reserved for user. */
+ long sstpid; /* Process ID for pid based multi-tasking. */
+ long ssgvup; /* Pointer to multitasking thread giveup. */
+ long sscray[7]; /* Reserved for Cray Research. */
+ long ssa0;
+ long ssa1;
+ long ssa2;
+ long ssa3;
+ long ssa4;
+ long ssa5;
+ long ssa6;
+ long ssa7;
+ long sss0;
+ long sss1;
+ long sss2;
+ long sss3;
+ long sss4;
+ long sss5;
+ long sss6;
+ long sss7;
+ };
+
+# else /* CRAY2 */
+/* The following structure defines the vector of words
+ returned by the STKSTAT library routine. */
+struct stk_stat
+ {
+ long now; /* Current total stack size. */
+ long maxc; /* Amount of contiguous space which would
+ be required to satisfy the maximum
+ stack demand to date. */
+ long high_water; /* Stack high-water mark. */
+ long overflows; /* Number of stack overflow ($STKOFEN) calls.
*/
+ long hits; /* Number of internal buffer hits. */
+ long extends; /* Number of block extensions. */
+ long stko_mallocs; /* Block allocations by $STKOFEN. */
+ long underflows; /* Number of stack underflow calls ($STKRETN).
*/
+ long stko_free; /* Number of deallocations by $STKRETN. */
+ long stkm_free; /* Number of deallocations by $STKMRET. */
+ long segments; /* Current number of stack segments. */
+ long maxs; /* Maximum number of stack segments so far. */
+ long pad_size; /* Stack pad size. */
+ long current_address; /* Current stack segment address. */
+ long current_size; /* Current stack segment size. This
+ number is actually corrupted by STKSTAT to
+ include the fifteen word trailer area. */
+ long initial_address; /* Address of initial segment. */
+ long initial_size; /* Size of initial segment. */
+ };
+
+/* The following structure describes the data structure which trails
+ any stack segment. I think that the description in 'asdef' is
+ out of date. I only describe the parts that I am sure about. */
+
+struct stk_trailer
+ {
+ long this_address; /* Address of this block. */
+ long this_size; /* Size of this block (does not include
+ this trailer). */
+ long unknown2;
+ long unknown3;
+ long link; /* Address of trailer block of previous
+ segment. */
+ long unknown5;
+ long unknown6;
+ long unknown7;
+ long unknown8;
+ long unknown9;
+ long unknown10;
+ long unknown11;
+ long unknown12;
+ long unknown13;
+ long unknown14;
+ };
+
+# endif /* CRAY2 */
+# endif /* not CRAY_STACK */
+
+# ifdef CRAY2
+/* Determine a "stack measure" for an arbitrary ADDRESS.
+ I doubt that "lint" will like this much. */
+
+static long
+i00afunc (long *address)
+{
+ struct stk_stat status;
+ struct stk_trailer *trailer;
+ long *block, size;
+ long result = 0;
+
+ /* We want to iterate through all of the segments. The first
+ step is to get the stack status structure. We could do this
+ more quickly and more directly, perhaps, by referencing the
+ $LM00 common block, but I know that this works. */
+
+ STKSTAT (&status);
+
+ /* Set up the iteration. */
+
+ trailer = (struct stk_trailer *) (status.current_address
+ + status.current_size
+ - 15);
+
+ /* There must be at least one stack segment. Therefore it is
+ a fatal error if "trailer" is null. */
+
+ if (trailer == 0)
+ abort ();
+
+ /* Discard segments that do not contain our argument address. */
+
+ while (trailer != 0)
+ {
+ block = (long *) trailer->this_address;
+ size = trailer->this_size;
+ if (block == 0 || size == 0)
+ abort ();
+ trailer = (struct stk_trailer *) trailer->link;
+ if ((block <= address) && (address < (block + size)))
+ break;
+ }
+
+ /* Set the result to the offset in this segment and add the sizes
+ of all predecessor segments. */
+
+ result = address - block;
+
+ if (trailer == 0)
+ {
+ return result;
+ }
+
+ do
+ {
+ if (trailer->this_size <= 0)
+ abort ();
+ result += trailer->this_size;
+ trailer = (struct stk_trailer *) trailer->link;
+ }
+ while (trailer != 0);
+
+ /* We are done. Note that if you present a bogus address (one
+ not in any segment), you will get a different number back, formed
+ from subtracting the address of the first block. This is probably
+ not what you want. */
+
+ return (result);
+}
+
+# else /* not CRAY2 */
+/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+ Determine the number of the cell within the stack,
+ given the address of the cell. The purpose of this
+ routine is to linearize, in some sense, stack addresses
+ for alloca. */
+
+static long
+i00afunc (long address)
+{
+ long stkl = 0;
+
+ long size, pseg, this_segment, stack;
+ long result = 0;
+
+ struct stack_segment_linkage *ssptr;
+
+ /* Register B67 contains the address of the end of the
+ current stack segment. If you (as a subprogram) store
+ your registers on the stack and find that you are past
+ the contents of B67, you have overflowed the segment.
+
+ B67 also points to the stack segment linkage control
+ area, which is what we are really interested in. */
+
+ stkl = CRAY_STACKSEG_END ();
+ ssptr = (struct stack_segment_linkage *) stkl;
+
+ /* If one subtracts 'size' from the end of the segment,
+ one has the address of the first word of the segment.
+
+ If this is not the first segment, 'pseg' will be
+ nonzero. */
+
+ pseg = ssptr->sspseg;
+ size = ssptr->sssize;
+
+ this_segment = stkl - size;
+
+ /* It is possible that calling this routine itself caused
+ a stack overflow. Discard stack segments which do not
+ contain the target address. */
+
+ while (!(this_segment <= address && address <= stkl))
+ {
+# ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+# endif
+ if (pseg == 0)
+ break;
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ this_segment = stkl - size;
+ }
+
+ result = address - this_segment;
+
+ /* If you subtract pseg from the current end of the stack,
+ you get the address of the previous stack segment's end.
+ This seems a little convoluted to me, but I'll bet you save
+ a cycle somewhere. */
+
+ while (pseg != 0)
+ {
+# ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o\n", pseg, size);
+# endif
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ result += size;
+ }
+ return (result);
+}
+
+# endif /* not CRAY2 */
+# endif /* CRAY */
+
+# endif /* no alloca */
+#endif /* not GCC 2 */
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index c36bdf9..19aea41 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-2012 Free Software Foundation,
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2013 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 e580723..5344a92 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2013 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 778068f..8c399b2 100644
--- a/lib/asnprintf.c
+++ b/lib/asnprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 1999, 2002, 2006, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2002, 2006, 2009-2013 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 8ddbfc3..5e89d26 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-2012 Free Software
+ Copyright (C) 1990, 1998-2001, 2003-2006, 2009-2013 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 30315e1..b2095a2 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2003, 2005, 2008-2013 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/bind.c b/lib/bind.c
index 1a2a3b6..e26f88e 100644
--- a/lib/bind.c
+++ b/lib/bind.c
@@ -1,6 +1,6 @@
/* bind.c --- wrappers for Windows bind function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 485e995..aca5742 100644
--- a/lib/btowc.c
+++ b/lib/btowc.c
@@ -1,5 +1,5 @@
/* Convert unibyte character to wide character.
- Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008, 2010-2013 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 a9baa68..6c7ab6d 100644
--- a/lib/byteswap.in.h
+++ b/lib/byteswap.in.h
@@ -1,5 +1,5 @@
/* byteswap.h - Byte swapping
- Copyright (C) 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-2013 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 6b388fa..ccd8d94 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-2012 Free Software Foundation, Inc.
+ Copyright 2000-2003, 2006, 2009-2013 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 6ef0550..64bae06 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2000-2003, 2006, 2008-2013 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-strcase.h b/lib/c-strcase.h
index 4d8b60c..e484aa8 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-2012 Free Software
+ Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2013 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 6983195..765b25a 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2013 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 25e6e07..53ce1e1 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2007, 2009-2013 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 dbec89e..ad5f4f6 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2013 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 16550cf..5451791 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1996-2013 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
@@ -16,16 +16,16 @@
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#ifndef _LIBC
+/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
+ optimizes away the name == NULL test below. */
+# define _GL_ARG_NONNULL(params)
+
# define _GL_USE_STDLIB_ALLOC 1
# include <config.h>
#endif
#if !HAVE_CANONICALIZE_FILE_NAME || !FUNC_REALPATH_WORKS || defined _LIBC
-/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
- optimizes away the name == NULL test below. */
-#define _GL_ARG_NONNULL(params)
-
/* Specification. */
#include <stdlib.h>
@@ -51,6 +51,7 @@
# define __realpath realpath
# include "pathmax.h"
# include "malloca.h"
+# include "dosname.h"
# if HAVE_GETCWD
# if IN_RELOCWRAPPER
/* When building the relocatable program wrapper, use the system's getcwd
@@ -101,6 +102,7 @@ __realpath (const char *name, char *resolved)
const char *start, *end, *rpath_limit;
long int path_max;
int num_links = 0;
+ size_t prefix_len;
if (name == NULL)
{
@@ -143,7 +145,11 @@ __realpath (const char *name, char *resolved)
rpath = resolved;
rpath_limit = rpath + path_max;
- if (name[0] != '/')
+ /* This is always zero for Posix hosts, but can be 2 for MS-Windows
+ and MS-DOS X:/foo/bar file names. */
+ prefix_len = FILE_SYSTEM_PREFIX_LEN (name);
+
+ if (!IS_ABSOLUTE_FILE_NAME (name))
{
if (!__getcwd (rpath, path_max))
{
@@ -151,20 +157,28 @@ __realpath (const char *name, char *resolved)
goto error;
}
dest = strchr (rpath, '\0');
+ start = name;
+ prefix_len = FILE_SYSTEM_PREFIX_LEN (rpath);
}
else
{
- rpath[0] = '/';
- dest = rpath + 1;
+ dest = rpath;
+ if (prefix_len)
+ {
+ memcpy (rpath, name, prefix_len);
+ dest += prefix_len;
+ }
+ *dest++ = '/';
if (DOUBLE_SLASH_IS_DISTINCT_ROOT)
{
- if (name[1] == '/' && name[2] != '/')
+ if (ISSLASH (name[1]) && !ISSLASH (name[2]) && !prefix_len)
*dest++ = '/';
*dest = '\0';
}
+ start = name + prefix_len;
}
- for (start = end = name; *start; start = end)
+ for (end = start; *start; start = end)
{
#ifdef _LIBC
struct stat64 st;
@@ -174,11 +188,11 @@ __realpath (const char *name, char *resolved)
int n;
/* Skip sequence of multiple path-separators. */
- while (*start == '/')
+ while (ISSLASH (*start))
++start;
/* Find end of path component. */
- for (end = start; *end && *end != '/'; ++end)
+ for (end = start; *end && !ISSLASH (*end); ++end)
/* Nothing. */;
if (end - start == 0)
@@ -188,17 +202,19 @@ __realpath (const char *name, char *resolved)
else if (end - start == 2 && start[0] == '.' && start[1] == '.')
{
/* Back up to previous component, ignore if at root already. */
- if (dest > rpath + 1)
- while ((--dest)[-1] != '/');
- if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1
- && *dest == '/' && dest[1] != '/')
+ if (dest > rpath + prefix_len + 1)
+ for (--dest; dest > rpath && !ISSLASH (dest[-1]); --dest)
+ continue;
+ if (DOUBLE_SLASH_IS_DISTINCT_ROOT
+ && dest == rpath + 1 && !prefix_len
+ && ISSLASH (*dest) && !ISSLASH (dest[1]))
dest++;
}
else
{
size_t new_size;
- if (dest[-1] != '/')
+ if (!ISSLASH (dest[-1]))
*dest++ = '/';
if (dest + (end - start) >= rpath_limit)
@@ -209,7 +225,7 @@ __realpath (const char *name, char *resolved)
if (resolved)
{
__set_errno (ENAMETOOLONG);
- if (dest > rpath + 1)
+ if (dest > rpath + prefix_len + 1)
dest--;
*dest = '\0';
goto error;
@@ -299,24 +315,32 @@ __realpath (const char *name, char *resolved)
memmove (&extra_buf[n], end, len + 1);
name = end = memcpy (extra_buf, buf, n);
- if (buf[0] == '/')
+ if (IS_ABSOLUTE_FILE_NAME (buf))
{
- dest = rpath + 1; /* It's an absolute symlink */
+ size_t pfxlen = FILE_SYSTEM_PREFIX_LEN (buf);
+
+ if (pfxlen)
+ memcpy (rpath, buf, pfxlen);
+ dest = rpath + pfxlen;
+ *dest++ = '/'; /* It's an absolute symlink */
if (DOUBLE_SLASH_IS_DISTINCT_ROOT)
{
- if (buf[1] == '/' && buf[2] != '/')
+ if (ISSLASH (buf[1]) && !ISSLASH (buf[2]) && !pfxlen)
*dest++ = '/';
*dest = '\0';
}
+ /* Install the new prefix to be in effect hereafter. */
+ prefix_len = pfxlen;
}
else
{
/* Back up to previous component, ignore if at root
already: */
- if (dest > rpath + 1)
- while ((--dest)[-1] != '/');
+ if (dest > rpath + prefix_len + 1)
+ for (--dest; dest > rpath && !ISSLASH (dest[-1]); --dest)
+ continue;
if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1
- && *dest == '/' && dest[1] != '/')
+ && ISSLASH (*dest) && !ISSLASH (dest[1]) && !prefix_len)
dest++;
}
}
@@ -327,10 +351,10 @@ __realpath (const char *name, char *resolved)
}
}
}
- if (dest > rpath + 1 && dest[-1] == '/')
+ if (dest > rpath + prefix_len + 1 && ISSLASH (dest[-1]))
--dest;
- if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1
- && *dest == '/' && dest[1] != '/')
+ if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1 && !prefix_len
+ && ISSLASH (*dest) && !ISSLASH (dest[1]))
dest++;
*dest = '\0';
diff --git a/lib/ceil.c b/lib/ceil.c
index 810179c..3a264ae 100644
--- a/lib/ceil.c
+++ b/lib/ceil.c
@@ -1,5 +1,5 @@
/* Round towards positive infinity.
- Copyright (C) 2007, 2010-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2013 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 2b6f598..02ff0b1 100644
--- a/lib/close.c
+++ b/lib/close.c
@@ -1,5 +1,5 @@
/* close replacement.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 58ac759..f15f5bb 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2000-2004, 2006-2013 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 303cd0b..03746f8 100644
--- a/lib/connect.c
+++ b/lib/connect.c
@@ -1,6 +1,6 @@
/* connect.c --- wrappers for Windows connect function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 8882415..aff6af3 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -1,5 +1,5 @@
/* A GNU-like <dirent.h>.
- Copyright (C) 2006-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006-2013 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 7013010..c535b17 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2006, 2008-2013 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 5d0cc07..90597ac 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-2012 Free Software
+ Copyright (C) 1990, 1998, 2000-2001, 2003-2006, 2009-2013 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 ce77baf..4b5acd9 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-2012 Free Software Foundation,
+ Copyright (C) 1998, 2001, 2003-2006, 2009-2013 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 f4b1439..82d62e5 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2004-2006, 2009-2013 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
new file mode 100644
index 0000000..89b40c4
--- /dev/null
+++ b/lib/dup2.c
@@ -0,0 +1,160 @@
+/* Duplicate an open file descriptor to a specified file descriptor.
+
+ Copyright (C) 1999, 2004-2007, 2009-2013 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 3 of the License, 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 Paul Eggert */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+#include <errno.h>
+#include <fcntl.h>
+
+#if HAVE_DUP2
+
+# undef dup2
+
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+/* Get declarations of the native Windows API functions. */
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+
+# include "msvc-inval.h"
+
+/* Get _get_osfhandle. */
+# include "msvc-nothrow.h"
+
+static int
+ms_windows_dup2 (int fd, int desired_fd)
+{
+ int result;
+
+ /* If fd is closed, mingw hangs on dup2 (fd, fd). If fd is open,
+ dup2 (fd, fd) returns 0, but all further attempts to use fd in
+ future dup2 calls will hang. */
+ if (fd == desired_fd)
+ {
+ if ((HANDLE) _get_osfhandle (fd) == INVALID_HANDLE_VALUE)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ return fd;
+ }
+
+ /* Wine 1.0.1 return 0 when desired_fd is negative but not -1:
+ http://bugs.winehq.org/show_bug.cgi?id=21289 */
+ if (desired_fd < 0)
+ {
+ errno = EBADF;
+ return -1;
+ }
+
+ TRY_MSVC_INVAL
+ {
+ result = dup2 (fd, desired_fd);
+ }
+ CATCH_MSVC_INVAL
+ {
+ errno = EBADF;
+ result = -1;
+ }
+ DONE_MSVC_INVAL;
+
+ if (result == 0)
+ result = desired_fd;
+
+ return result;
+}
+
+# define dup2 ms_windows_dup2
+
+# endif
+
+int
+rpl_dup2 (int fd, int desired_fd)
+{
+ int result;
+
+# ifdef F_GETFL
+ /* 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 Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */
+ if (desired_fd < 0)
+ fd = desired_fd;
+ if (fd == desired_fd)
+ return fcntl (fd, F_GETFL) == -1 ? -1 : fd;
+# endif
+
+ result = dup2 (fd, desired_fd);
+
+ /* Correct an errno value on FreeBSD 6.1 and Cygwin 1.5.x. */
+ if (result == -1 && errno == EMFILE)
+ errno = EBADF;
+# if REPLACE_FCHDIR
+ if (fd != desired_fd && result != -1)
+ result = _gl_register_dup (fd, result);
+# endif
+ return result;
+}
+
+#else /* !HAVE_DUP2 */
+
+/* On older platforms, dup2 did not exist. */
+
+# ifndef F_DUPFD
+static int
+dupfd (int fd, int desired_fd)
+{
+ int duplicated_fd = dup (fd);
+ if (duplicated_fd < 0 || duplicated_fd == desired_fd)
+ return duplicated_fd;
+ else
+ {
+ int r = dupfd (fd, desired_fd);
+ int e = errno;
+ close (duplicated_fd);
+ errno = e;
+ return r;
+ }
+}
+# endif
+
+int
+dup2 (int fd, int desired_fd)
+{
+ int result = fcntl (fd, F_GETFL) < 0 ? -1 : fd;
+ if (result == -1 || fd == desired_fd)
+ return result;
+ close (desired_fd);
+# ifdef F_DUPFD
+ result = fcntl (fd, F_DUPFD, desired_fd);
+# if REPLACE_FCHDIR
+ if (0 <= result)
+ result = _gl_register_dup (fd, result);
+# endif
+# else
+ result = dupfd (fd, desired_fd);
+# endif
+ if (result == -1 && (errno == EMFILE || errno == EINVAL))
+ errno = EBADF;
+ return result;
+}
+#endif /* !HAVE_DUP2 */
diff --git a/lib/duplocale.c b/lib/duplocale.c
index dd85efe..5a291b9 100644
--- a/lib/duplocale.c
+++ b/lib/duplocale.c
@@ -1,5 +1,5 @@
/* Duplicate a locale object.
- Copyright (C) 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 774c786..f2295cd 100644
--- a/lib/errno.in.h
+++ b/lib/errno.in.h
@@ -1,6 +1,6 @@
/* A POSIX-like <errno.h>.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 5c934c0..f71ce2f 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006-2013 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 39e25ea..cafd91c 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 b3b200d..397dbb0 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 fd4a9ed..1bd368c 100644
--- a/lib/float+.h
+++ b/lib/float+.h
@@ -1,5 +1,5 @@
/* Supplemental information about the floating-point formats.
- Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2013 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 94c6cfd..37b0b49 100644
--- a/lib/float.c
+++ b/lib/float.c
@@ -1,5 +1,5 @@
/* Auxiliary definitions for <float.h>.
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 b3740b8..40875a2 100644
--- a/lib/float.in.h
+++ b/lib/float.in.h
@@ -1,6 +1,6 @@
/* A correct <float.h>.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 3eb9abb..f15fe12 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 Free Software Foundation, Inc.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
diff --git a/lib/floor.c b/lib/floor.c
index 7efbe9e..3dca6f5 100644
--- a/lib/floor.c
+++ b/lib/floor.c
@@ -1,5 +1,5 @@
/* Round towards negative infinity.
- Copyright (C) 2007, 2010-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2013 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 baeb462..eb2b379 100644
--- a/lib/frexp.c
+++ b/lib/frexp.c
@@ -1,5 +1,5 @@
/* Split a double into fraction and mantissa.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 3f49e9b..121f4bf 100644
--- a/lib/fstat.c
+++ b/lib/fstat.c
@@ -1,5 +1,5 @@
/* fstat() replacement.
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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
@@ -31,7 +31,7 @@
#endif
#undef __need_system_sys_stat_h
-static inline int
+static int
orig_fstat (int fd, struct stat *buf)
{
return fstat (fd, buf);
@@ -51,7 +51,7 @@ orig_fstat (int fd, struct stat *buf)
#endif
#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline int
+static int
fstat_nothrow (int fd, struct stat *buf)
{
int result;
diff --git a/lib/full-read.c b/lib/full-read.c
index 68b273d..f884bb6 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2009-2013 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 fdf2331..81f6edf 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2013 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 20d99b7..8f30798 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 1997-2006, 2009-2013 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 018b25c..cb05bff 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2009-2013 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 8b36694..0205a78 100644
--- a/lib/gai_strerror.c
+++ b/lib/gai_strerror.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1997, 2001-2002, 2004-2006, 2008-2012 Free Software
+/* Copyright (C) 1997, 2001-2002, 2004-2006, 2008-2013 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 e53a69b..9b0297c 100644
--- a/lib/getaddrinfo.c
+++ b/lib/getaddrinfo.c
@@ -1,5 +1,5 @@
/* Get address information (partial implementation).
- Copyright (C) 1997, 2001-2002, 2004-2012 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2002, 2004-2013 Free Software Foundation, Inc.
Contributed by Simon Josefsson <address@hidden>.
This program is free software; you can redistribute it and/or modify
@@ -15,12 +15,12 @@
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/>. */
-#include <config.h>
-
/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
optimizes away the sa == NULL test below. */
#define _GL_ARG_NONNULL(params)
+#include <config.h>
+
#include <netdb.h>
#if HAVE_NETINET_IN_H
@@ -109,7 +109,7 @@ use_win32_p (void)
}
#endif
-static inline bool
+static bool
validate_family (int family)
{
/* FIXME: Support more families. */
diff --git a/lib/getlogin.c b/lib/getlogin.c
new file mode 100644
index 0000000..ebe7c33
--- /dev/null
+++ b/lib/getlogin.c
@@ -0,0 +1,41 @@
+/* Provide a working getlogin for systems which lack it.
+
+ Copyright (C) 2010-2013 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 3 of the License, 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, 2010. */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
+char *
+getlogin (void)
+{
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ static char login_name[1024];
+ DWORD sz = sizeof (login_name);
+
+ if (GetUserName (login_name, &sz))
+ return login_name;
+#endif
+ return NULL;
+}
diff --git a/lib/getpeername.c b/lib/getpeername.c
index 02e3fad..307c9e2 100644
--- a/lib/getpeername.c
+++ b/lib/getpeername.c
@@ -1,6 +1,6 @@
/* getpeername.c --- wrappers for Windows getpeername function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 890c50e..daac0c0 100644
--- a/lib/getsockname.c
+++ b/lib/getsockname.c
@@ -1,6 +1,6 @@
/* getsockname.c --- wrappers for Windows getsockname function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 0bf74b0..c80487f 100644
--- a/lib/getsockopt.c
+++ b/lib/getsockopt.c
@@ -1,6 +1,6 @@
/* getsockopt.c --- wrappers for Windows getsockopt function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 d130faa..2cc0e05 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-2012 Free Software
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2013 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/iconv.c b/lib/iconv.c
index de2fb31..933730b 100644
--- a/lib/iconv.c
+++ b/lib/iconv.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 1999-2001, 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2001, 2007, 2009-2013 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 e150947..2e7efbe 100644
--- a/lib/iconv.in.h
+++ b/lib/iconv.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <iconv.h>.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 d8b027a..3492f28 100644
--- a/lib/iconv_close.c
+++ b/lib/iconv_close.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2013 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 c011241..eaf7c7d 100644
--- a/lib/iconv_open.c
+++ b/lib/iconv_open.c
@@ -1,5 +1,5 @@
/* Character set conversion.
- Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2013 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 4a4f506..8d792ac 100644
--- a/lib/iconveh.h
+++ b/lib/iconveh.h
@@ -1,5 +1,5 @@
/* Character set conversion handler type.
- Copyright (C) 2001-2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2007, 2009-2013 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 0ccd997..96202e2 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2013 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 36e981a..08f1b20 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2008-2013 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 5efaa9d..24c32d3 100644
--- a/lib/isinf.c
+++ b/lib/isinf.c
@@ -1,5 +1,5 @@
/* Test for positive or negative infinity.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 1faa28a..18fa5a2 100644
--- a/lib/isnan.c
+++ b/lib/isnan.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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-nolibm.h b/lib/isnand-nolibm.h
index e9e64db..3510202 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 308caac..9bd092b 100644
--- a/lib/isnand.c
+++ b/lib/isnand.c
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 6376ce0..503575f 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2013 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 cfe2545..967eaff 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2009-2013 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 0c41e2d..ff43bd0 100644
--- a/lib/itold.c
+++ b/lib/itold.c
@@ -1,5 +1,5 @@
/* Replacement for 'int' to 'long double' conversion routine.
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 63b92fd..d60a980 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 28f3aaf..ea6eddc 100644
--- a/lib/listen.c
+++ b/lib/listen.c
@@ -1,6 +1,6 @@
/* listen.c --- wrappers for Windows listen function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 c4a0596..e967ee5 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2000-2006, 2008-2013 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.h b/lib/localcharset.h
index b4467f6..4580edf 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2000-2003, 2009-2013 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 89b6745..ca67816 100644
--- a/lib/locale.in.h
+++ b/lib/locale.in.h
@@ -1,5 +1,5 @@
/* A POSIX <locale.h>.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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
@@ -14,16 +14,30 @@
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/>. */
-#ifndef address@hidden@_LOCALE_H
-
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
@PRAGMA_COLUMNS@
+#ifdef _GL_ALREADY_INCLUDING_LOCALE_H
+
+/* Special invocation conventions to handle Solaris header files
+ (through Solaris 10) when combined with gettext's libintl.h. */
+
address@hidden@ @NEXT_LOCALE_H@
+
+#else
+/* Normal invocation convention. */
+
+#ifndef address@hidden@_LOCALE_H
+
+#define _GL_ALREADY_INCLUDING_LOCALE_H
+
/* The include_next requires a split double-inclusion guard. */
address@hidden@ @NEXT_LOCALE_H@
+#undef _GL_ALREADY_INCLUDING_LOCALE_H
+
#ifndef address@hidden@_LOCALE_H
#define address@hidden@_LOCALE_H
@@ -198,4 +212,5 @@ _GL_WARN_ON_USE (duplocale, "duplocale is buggy on some
glibc systems - "
#endif
#endif /* address@hidden@_LOCALE_H */
+#endif /* ! _GL_ALREADY_INCLUDING_LOCALE_H */
#endif /* address@hidden@_LOCALE_H */
diff --git a/lib/localeconv.c b/lib/localeconv.c
index c22860c..41396a0 100644
--- a/lib/localeconv.c
+++ b/lib/localeconv.c
@@ -1,5 +1,5 @@
/* Query locale dependent information for formatting numbers.
- Copyright (C) 2012 Free Software Foundation, Inc.
+ Copyright (C) 2012-2013 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 9ec5eae..892721a 100644
--- a/lib/log.c
+++ b/lib/log.c
@@ -1,5 +1,5 @@
/* Logarithm.
- Copyright (C) 2012 Free Software Foundation, Inc.
+ Copyright (C) 2012-2013 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 397b140..8c0788a 100644
--- a/lib/log1p.c
+++ b/lib/log1p.c
@@ -1,5 +1,5 @@
/* Natural logarithm of 1 plus argument.
- Copyright (C) 2012 Free Software Foundation, Inc.
+ Copyright (C) 2012-2013 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 fe20e61..b0873d3 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1997-2006, 2008-2013 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
@@ -35,7 +35,7 @@ typedef int dummy;
# include <sys/stat.h>
# undef __need_system_sys_stat_h
-static inline int
+static int
orig_lstat (const char *filename, struct stat *buf)
{
return lstat (filename, buf);
diff --git a/lib/malloc.c b/lib/malloc.c
index 109c65c..8124cad 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1997-1998, 2006-2007, 2009-2013 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 2d4c479..04ddc23 100644
--- a/lib/malloca.c
+++ b/lib/malloca.c
@@ -1,5 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003, 2006-2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2009-2013 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2003.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/malloca.h b/lib/malloca.h
index deb9bda..7747679 100644
--- a/lib/malloca.h
+++ b/lib/malloca.h
@@ -1,5 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003-2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2013 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2003.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/math.c b/lib/math.c
new file mode 100644
index 0000000..ddb2ded
--- /dev/null
+++ b/lib/math.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_MATH_INLINE _GL_EXTERN_INLINE
+#include "math.h"
diff --git a/lib/math.in.h b/lib/math.in.h
index ee0fc95..46d0cf1 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2007-2013 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,10 @@
#ifndef address@hidden@_MATH_H
#define address@hidden@_MATH_H
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_MATH_INLINE
+# define _GL_MATH_INLINE _GL_INLINE
+#endif
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -78,17 +82,17 @@ func (long double l)
\
classification macros with an argument of real-floating (that is,
one of float, double, or long double). */
#define _GL_WARN_REAL_FLOATING_DECL(func) \
-static inline int \
+_GL_MATH_INLINE int \
rpl_ ## func ## f (float f) \
{ \
return func (f); \
} \
-static inline int \
+_GL_MATH_INLINE int \
rpl_ ## func ## d (double d) \
{ \
return func (d); \
} \
-static inline int \
+_GL_MATH_INLINE int \
rpl_ ## func ## l (long double l) \
{ \
return func (l); \
@@ -124,7 +128,7 @@ static void (*_gl_math_fix_itold) (long double *, int) =
_Qp_itoq;
/* The Compaq (ex-DEC) C 6.4 compiler and the Microsoft MSVC 9 compiler
choke on the expression 0.0 / 0.0. */
# if defined __DECC || defined _MSC_VER
-static float
+_GL_MATH_INLINE float
_NaN ()
{
static float zero = 0.0f;
@@ -2265,6 +2269,7 @@ _GL_WARN_REAL_FLOATING_DECL (signbit);
# endif
#endif
+_GL_INLINE_HEADER_END
#endif /* address@hidden@_MATH_H */
#endif /* address@hidden@_MATH_H */
diff --git a/lib/mbrtowc.c b/lib/mbrtowc.c
index 5f2ec07..75d10bc 100644
--- a/lib/mbrtowc.c
+++ b/lib/mbrtowc.c
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 1999-2002, 2005-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2005-2013 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 79278d4..98ae1e6 100644
--- a/lib/mbsinit.c
+++ b/lib/mbsinit.c
@@ -1,5 +1,5 @@
/* Test for initial conversion state.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 3183f91..35b3528 100644
--- a/lib/mbtowc-impl.h
+++ b/lib/mbtowc-impl.h
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 e48b2f2..7777f0a 100644
--- a/lib/mbtowc.c
+++ b/lib/mbtowc.c
@@ -1,5 +1,5 @@
/* Convert multibyte character to wide character.
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 7b6e258..6b28405 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-2012
+/* Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2004, 2006, 2008-2013
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 7da3541..5e59da7 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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-inval.h b/lib/msvc-inval.h
index ce6fcee..3ff7494 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 3e791c3..c17a9a2 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 573bc8e..80d4785 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 63ebd2d..dff665c 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 a93dcdf..97ec58d 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 4b9bdbe..2210b7f 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 c4b151a..86aefe5 100644
--- a/lib/nproc.c
+++ b/lib/nproc.c
@@ -1,6 +1,6 @@
/* Detect the number of processors.
- Copyright (C) 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 c5f6322..57689aa 100644
--- a/lib/nproc.h
+++ b/lib/nproc.h
@@ -1,6 +1,6 @@
/* Detect the number of processors.
- Copyright (C) 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 3a74813..b4d9c87 100644
--- a/lib/open.c
+++ b/lib/open.c
@@ -1,5 +1,5 @@
/* Open a descriptor to a file.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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,7 +27,7 @@
#include <sys/types.h>
#undef __need_system_fcntl_h
-static inline int
+static int
orig_open (const char *filename, int flags, mode_t mode)
{
return open (filename, flags, mode);
diff --git a/lib/pathmax.h b/lib/pathmax.h
index 2361321..105edae 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-2012 Free Software
+ Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2013 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
new file mode 100644
index 0000000..fc11967
--- /dev/null
+++ b/lib/pipe.c
@@ -0,0 +1,50 @@
+/* Create a pipe.
+ Copyright (C) 2009-2013 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/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+/* Native Windows API. */
+
+/* Get _pipe(). */
+# include <io.h>
+
+/* Get _O_BINARY. */
+# include <fcntl.h>
+
+int
+pipe (int fd[2])
+{
+ /* Mingw changes fd to {-1,-1} on failure, but this violates
+ http://austingroupbugs.net/view.php?id=467 */
+ int tmp[2];
+ int result = _pipe (tmp, 4096, _O_BINARY);
+ if (!result)
+ {
+ fd[0] = tmp[0];
+ fd[1] = tmp[1];
+ }
+ return result;
+}
+
+#else
+
+# error "This platform lacks a pipe function, and Gnulib doesn't provide a
replacement. This is a bug in Gnulib."
+
+#endif
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 2c018d5..09952eb 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -1,5 +1,5 @@
/* Create a pipe, with specific opening flags.
- Copyright (C) 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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/poll.c b/lib/poll.c
new file mode 100644
index 0000000..2767f5a
--- /dev/null
+++ b/lib/poll.c
@@ -0,0 +1,611 @@
+/* Emulation for poll(2)
+ Contributed by Paolo Bonzini.
+
+ Copyright 2001-2003, 2006-2013 Free Software Foundation, Inc.
+
+ This file is part of gnulib.
+
+ 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/>. */
+
+/* Tell gcc not to warn about the (nfd < 0) tests, below. */
+#if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wtype-limits"
+#endif
+
+#include <config.h>
+#include <alloca.h>
+
+#include <sys/types.h>
+
+/* Specification. */
+#include <poll.h>
+
+#include <errno.h>
+#include <limits.h>
+#include <assert.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# define WINDOWS_NATIVE
+# include <winsock2.h>
+# include <windows.h>
+# include <io.h>
+# include <stdio.h>
+# include <conio.h>
+# include "msvc-nothrow.h"
+#else
+# include <sys/time.h>
+# include <sys/socket.h>
+# include <sys/select.h>
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h>
+#endif
+#ifdef HAVE_SYS_FILIO_H
+# include <sys/filio.h>
+#endif
+
+#include <time.h>
+
+#ifndef INFTIM
+# define INFTIM (-1)
+#endif
+
+/* BeOS does not have MSG_PEEK. */
+#ifndef MSG_PEEK
+# define MSG_PEEK 0
+#endif
+
+#ifdef WINDOWS_NATIVE
+
+/* Optimized test whether a HANDLE refers to a console.
+ See <http://lists.gnu.org/archive/html/bug-gnulib/2009-08/msg00065.html>.
*/
+#define IsConsoleHandle(h) (((intptr_t) (h) & 3) == 3)
+
+static BOOL
+IsSocketHandle (HANDLE h)
+{
+ WSANETWORKEVENTS ev;
+
+ if (IsConsoleHandle (h))
+ return FALSE;
+
+ /* Under Wine, it seems that getsockopt returns 0 for pipes too.
+ WSAEnumNetworkEvents instead distinguishes the two correctly. */
+ ev.lNetworkEvents = 0xDEADBEEF;
+ WSAEnumNetworkEvents ((SOCKET) h, NULL, &ev);
+ return ev.lNetworkEvents != 0xDEADBEEF;
+}
+
+/* Declare data structures for ntdll functions. */
+typedef struct _FILE_PIPE_LOCAL_INFORMATION {
+ ULONG NamedPipeType;
+ ULONG NamedPipeConfiguration;
+ ULONG MaximumInstances;
+ ULONG CurrentInstances;
+ ULONG InboundQuota;
+ ULONG ReadDataAvailable;
+ ULONG OutboundQuota;
+ ULONG WriteQuotaAvailable;
+ ULONG NamedPipeState;
+ ULONG NamedPipeEnd;
+} FILE_PIPE_LOCAL_INFORMATION, *PFILE_PIPE_LOCAL_INFORMATION;
+
+typedef struct _IO_STATUS_BLOCK
+{
+ union {
+ DWORD Status;
+ PVOID Pointer;
+ } u;
+ ULONG_PTR Information;
+} IO_STATUS_BLOCK, *PIO_STATUS_BLOCK;
+
+typedef enum _FILE_INFORMATION_CLASS {
+ FilePipeLocalInformation = 24
+} FILE_INFORMATION_CLASS, *PFILE_INFORMATION_CLASS;
+
+typedef DWORD (WINAPI *PNtQueryInformationFile)
+ (HANDLE, IO_STATUS_BLOCK *, VOID *, ULONG, FILE_INFORMATION_CLASS);
+
+# ifndef PIPE_BUF
+# define PIPE_BUF 512
+# endif
+
+/* Compute revents values for file handle H. If some events cannot happen
+ for the handle, eliminate them from *P_SOUGHT. */
+
+static int
+windows_compute_revents (HANDLE h, int *p_sought)
+{
+ int i, ret, happened;
+ INPUT_RECORD *irbuffer;
+ DWORD avail, nbuffer;
+ BOOL bRet;
+ IO_STATUS_BLOCK iosb;
+ FILE_PIPE_LOCAL_INFORMATION fpli;
+ static PNtQueryInformationFile NtQueryInformationFile;
+ static BOOL once_only;
+
+ switch (GetFileType (h))
+ {
+ case FILE_TYPE_PIPE:
+ if (!once_only)
+ {
+ NtQueryInformationFile = (PNtQueryInformationFile)
+ GetProcAddress (GetModuleHandle ("ntdll.dll"),
+ "NtQueryInformationFile");
+ once_only = TRUE;
+ }
+
+ happened = 0;
+ if (PeekNamedPipe (h, NULL, 0, NULL, &avail, NULL) != 0)
+ {
+ if (avail)
+ happened |= *p_sought & (POLLIN | POLLRDNORM);
+ }
+ else if (GetLastError () == ERROR_BROKEN_PIPE)
+ happened |= POLLHUP;
+
+ else
+ {
+ /* It was the write-end of the pipe. Check if it is writable.
+ If NtQueryInformationFile fails, optimistically assume the pipe is
+ writable. This could happen on Windows 9x, where
+ NtQueryInformationFile is not available, or if we inherit a pipe
+ that doesn't permit FILE_READ_ATTRIBUTES access on the write end
+ (I think this should not happen since Windows XP SP2; WINE seems
+ fine too). Otherwise, ensure that enough space is available for
+ atomic writes. */
+ memset (&iosb, 0, sizeof (iosb));
+ memset (&fpli, 0, sizeof (fpli));
+
+ if (!NtQueryInformationFile
+ || NtQueryInformationFile (h, &iosb, &fpli, sizeof (fpli),
+ FilePipeLocalInformation)
+ || fpli.WriteQuotaAvailable >= PIPE_BUF
+ || (fpli.OutboundQuota < PIPE_BUF &&
+ fpli.WriteQuotaAvailable == fpli.OutboundQuota))
+ happened |= *p_sought & (POLLOUT | POLLWRNORM | POLLWRBAND);
+ }
+ return happened;
+
+ case FILE_TYPE_CHAR:
+ ret = WaitForSingleObject (h, 0);
+ if (!IsConsoleHandle (h))
+ return ret == WAIT_OBJECT_0 ? *p_sought & ~(POLLPRI | POLLRDBAND) : 0;
+
+ nbuffer = avail = 0;
+ bRet = GetNumberOfConsoleInputEvents (h, &nbuffer);
+ if (bRet)
+ {
+ /* Input buffer. */
+ *p_sought &= POLLIN | POLLRDNORM;
+ if (nbuffer == 0)
+ return POLLHUP;
+ if (!*p_sought)
+ return 0;
+
+ irbuffer = (INPUT_RECORD *) alloca (nbuffer * sizeof (INPUT_RECORD));
+ bRet = PeekConsoleInput (h, irbuffer, nbuffer, &avail);
+ if (!bRet || avail == 0)
+ return POLLHUP;
+
+ for (i = 0; i < avail; i++)
+ if (irbuffer[i].EventType == KEY_EVENT)
+ return *p_sought;
+ return 0;
+ }
+ else
+ {
+ /* Screen buffer. */
+ *p_sought &= POLLOUT | POLLWRNORM | POLLWRBAND;
+ return *p_sought;
+ }
+
+ default:
+ ret = WaitForSingleObject (h, 0);
+ if (ret == WAIT_OBJECT_0)
+ return *p_sought & ~(POLLPRI | POLLRDBAND);
+
+ return *p_sought & (POLLOUT | POLLWRNORM | POLLWRBAND);
+ }
+}
+
+/* Convert fd_sets returned by select into revents values. */
+
+static int
+windows_compute_revents_socket (SOCKET h, int sought, long lNetworkEvents)
+{
+ int happened = 0;
+
+ if ((lNetworkEvents & (FD_READ | FD_ACCEPT | FD_CLOSE)) == FD_ACCEPT)
+ happened |= (POLLIN | POLLRDNORM) & sought;
+
+ else if (lNetworkEvents & (FD_READ | FD_ACCEPT | FD_CLOSE))
+ {
+ int r, error;
+
+ char data[64];
+ WSASetLastError (0);
+ r = recv (h, data, sizeof (data), MSG_PEEK);
+ error = WSAGetLastError ();
+ WSASetLastError (0);
+
+ if (r > 0 || error == WSAENOTCONN)
+ happened |= (POLLIN | POLLRDNORM) & sought;
+
+ /* Distinguish hung-up sockets from other errors. */
+ else if (r == 0 || error == WSAESHUTDOWN || error == WSAECONNRESET
+ || error == WSAECONNABORTED || error == WSAENETRESET)
+ happened |= POLLHUP;
+
+ else
+ happened |= POLLERR;
+ }
+
+ if (lNetworkEvents & (FD_WRITE | FD_CONNECT))
+ happened |= (POLLOUT | POLLWRNORM | POLLWRBAND) & sought;
+
+ if (lNetworkEvents & FD_OOB)
+ happened |= (POLLPRI | POLLRDBAND) & sought;
+
+ return happened;
+}
+
+#else /* !MinGW */
+
+/* Convert select(2) returned fd_sets into poll(2) revents values. */
+static int
+compute_revents (int fd, int sought, fd_set *rfds, fd_set *wfds, fd_set *efds)
+{
+ int happened = 0;
+ if (FD_ISSET (fd, rfds))
+ {
+ int r;
+ int socket_errno;
+
+# if defined __MACH__ && defined __APPLE__
+ /* There is a bug in Mac OS X that causes it to ignore MSG_PEEK
+ for some kinds of descriptors. Detect if this descriptor is a
+ connected socket, a server socket, or something else using a
+ 0-byte recv, and use ioctl(2) to detect POLLHUP. */
+ r = recv (fd, NULL, 0, MSG_PEEK);
+ socket_errno = (r < 0) ? errno : 0;
+ if (r == 0 || socket_errno == ENOTSOCK)
+ ioctl (fd, FIONREAD, &r);
+# else
+ char data[64];
+ r = recv (fd, data, sizeof (data), MSG_PEEK);
+ socket_errno = (r < 0) ? errno : 0;
+# endif
+ if (r == 0)
+ happened |= POLLHUP;
+
+ /* If the event happened on an unconnected server socket,
+ that's fine. */
+ else if (r > 0 || ( /* (r == -1) && */ socket_errno == ENOTCONN))
+ happened |= (POLLIN | POLLRDNORM) & sought;
+
+ /* Distinguish hung-up sockets from other errors. */
+ else if (socket_errno == ESHUTDOWN || socket_errno == ECONNRESET
+ || socket_errno == ECONNABORTED || socket_errno == ENETRESET)
+ happened |= POLLHUP;
+
+ /* some systems can't use recv() on non-socket, including HP NonStop */
+ else if (socket_errno == ENOTSOCK)
+ happened |= (POLLIN | POLLRDNORM) & sought;
+
+ else
+ happened |= POLLERR;
+ }
+
+ if (FD_ISSET (fd, wfds))
+ happened |= (POLLOUT | POLLWRNORM | POLLWRBAND) & sought;
+
+ if (FD_ISSET (fd, efds))
+ happened |= (POLLPRI | POLLRDBAND) & sought;
+
+ return happened;
+}
+#endif /* !MinGW */
+
+int
+poll (struct pollfd *pfd, nfds_t nfd, int timeout)
+{
+#ifndef WINDOWS_NATIVE
+ fd_set rfds, wfds, efds;
+ struct timeval tv;
+ struct timeval *ptv;
+ int maxfd, rc;
+ nfds_t i;
+
+# ifdef _SC_OPEN_MAX
+ static int sc_open_max = -1;
+
+ if (nfd < 0
+ || (nfd > sc_open_max
+ && (sc_open_max != -1
+ || nfd > (sc_open_max = sysconf (_SC_OPEN_MAX)))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+# else /* !_SC_OPEN_MAX */
+# ifdef OPEN_MAX
+ if (nfd < 0 || nfd > OPEN_MAX)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+# endif /* OPEN_MAX -- else, no check is needed */
+# endif /* !_SC_OPEN_MAX */
+
+ /* EFAULT is not necessary to implement, but let's do it in the
+ simplest case. */
+ if (!pfd && nfd)
+ {
+ errno = EFAULT;
+ return -1;
+ }
+
+ /* convert timeout number into a timeval structure */
+ if (timeout == 0)
+ {
+ ptv = &tv;
+ ptv->tv_sec = 0;
+ ptv->tv_usec = 0;
+ }
+ else if (timeout > 0)
+ {
+ ptv = &tv;
+ ptv->tv_sec = timeout / 1000;
+ ptv->tv_usec = (timeout % 1000) * 1000;
+ }
+ else if (timeout == INFTIM)
+ /* wait forever */
+ ptv = NULL;
+ else
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ /* create fd sets and determine max fd */
+ maxfd = -1;
+ FD_ZERO (&rfds);
+ FD_ZERO (&wfds);
+ FD_ZERO (&efds);
+ for (i = 0; i < nfd; i++)
+ {
+ if (pfd[i].fd < 0)
+ continue;
+
+ if (pfd[i].events & (POLLIN | POLLRDNORM))
+ FD_SET (pfd[i].fd, &rfds);
+
+ /* see select(2): "the only exceptional condition detectable
+ is out-of-band data received on a socket", hence we push
+ POLLWRBAND events onto wfds instead of efds. */
+ if (pfd[i].events & (POLLOUT | POLLWRNORM | POLLWRBAND))
+ FD_SET (pfd[i].fd, &wfds);
+ if (pfd[i].events & (POLLPRI | POLLRDBAND))
+ FD_SET (pfd[i].fd, &efds);
+ if (pfd[i].fd >= maxfd
+ && (pfd[i].events & (POLLIN | POLLOUT | POLLPRI
+ | POLLRDNORM | POLLRDBAND
+ | POLLWRNORM | POLLWRBAND)))
+ {
+ maxfd = pfd[i].fd;
+ if (maxfd > FD_SETSIZE)
+ {
+ errno = EOVERFLOW;
+ return -1;
+ }
+ }
+ }
+
+ /* examine fd sets */
+ rc = select (maxfd + 1, &rfds, &wfds, &efds, ptv);
+ if (rc < 0)
+ return rc;
+
+ /* establish results */
+ rc = 0;
+ for (i = 0; i < nfd; i++)
+ if (pfd[i].fd < 0)
+ pfd[i].revents = 0;
+ else
+ {
+ int happened = compute_revents (pfd[i].fd, pfd[i].events,
+ &rfds, &wfds, &efds);
+ if (happened)
+ {
+ pfd[i].revents = happened;
+ rc++;
+ }
+ }
+
+ return rc;
+#else
+ static struct timeval tv0;
+ static HANDLE hEvent;
+ WSANETWORKEVENTS ev;
+ HANDLE h, handle_array[FD_SETSIZE + 2];
+ DWORD ret, wait_timeout, nhandles;
+ fd_set rfds, wfds, xfds;
+ BOOL poll_again;
+ MSG msg;
+ int rc = 0;
+ nfds_t i;
+
+ if (nfd < 0 || timeout < -1)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (!hEvent)
+ hEvent = CreateEvent (NULL, FALSE, FALSE, NULL);
+
+restart:
+ handle_array[0] = hEvent;
+ nhandles = 1;
+ FD_ZERO (&rfds);
+ FD_ZERO (&wfds);
+ FD_ZERO (&xfds);
+
+ /* Classify socket handles and create fd sets. */
+ for (i = 0; i < nfd; i++)
+ {
+ int sought = pfd[i].events;
+ pfd[i].revents = 0;
+ if (pfd[i].fd < 0)
+ continue;
+ if (!(sought & (POLLIN | POLLRDNORM | POLLOUT | POLLWRNORM | POLLWRBAND
+ | POLLPRI | POLLRDBAND)))
+ continue;
+
+ h = (HANDLE) _get_osfhandle (pfd[i].fd);
+ assert (h != NULL);
+ if (IsSocketHandle (h))
+ {
+ int requested = FD_CLOSE;
+
+ /* see above; socket handles are mapped onto select. */
+ if (sought & (POLLIN | POLLRDNORM))
+ {
+ requested |= FD_READ | FD_ACCEPT;
+ FD_SET ((SOCKET) h, &rfds);
+ }
+ if (sought & (POLLOUT | POLLWRNORM | POLLWRBAND))
+ {
+ requested |= FD_WRITE | FD_CONNECT;
+ FD_SET ((SOCKET) h, &wfds);
+ }
+ if (sought & (POLLPRI | POLLRDBAND))
+ {
+ requested |= FD_OOB;
+ FD_SET ((SOCKET) h, &xfds);
+ }
+
+ if (requested)
+ WSAEventSelect ((SOCKET) h, hEvent, requested);
+ }
+ else
+ {
+ /* Poll now. If we get an event, do not poll again. Also,
+ screen buffer handles are waitable, and they'll block until
+ a character is available. windows_compute_revents eliminates
+ bits for the "wrong" direction. */
+ pfd[i].revents = windows_compute_revents (h, &sought);
+ if (sought)
+ handle_array[nhandles++] = h;
+ if (pfd[i].revents)
+ timeout = 0;
+ }
+ }
+
+ if (select (0, &rfds, &wfds, &xfds, &tv0) > 0)
+ {
+ /* Do MsgWaitForMultipleObjects anyway to dispatch messages, but
+ no need to call select again. */
+ poll_again = FALSE;
+ wait_timeout = 0;
+ }
+ else
+ {
+ poll_again = TRUE;
+ if (timeout == INFTIM)
+ wait_timeout = INFINITE;
+ else
+ wait_timeout = timeout;
+ }
+
+ for (;;)
+ {
+ ret = MsgWaitForMultipleObjects (nhandles, handle_array, FALSE,
+ wait_timeout, QS_ALLINPUT);
+
+ if (ret == WAIT_OBJECT_0 + nhandles)
+ {
+ /* new input of some other kind */
+ BOOL bRet;
+ while ((bRet = PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) != 0)
+ {
+ TranslateMessage (&msg);
+ DispatchMessage (&msg);
+ }
+ }
+ else
+ break;
+ }
+
+ if (poll_again)
+ select (0, &rfds, &wfds, &xfds, &tv0);
+
+ /* Place a sentinel at the end of the array. */
+ handle_array[nhandles] = NULL;
+ nhandles = 1;
+ for (i = 0; i < nfd; i++)
+ {
+ int happened;
+
+ if (pfd[i].fd < 0)
+ continue;
+ if (!(pfd[i].events & (POLLIN | POLLRDNORM |
+ POLLOUT | POLLWRNORM | POLLWRBAND)))
+ continue;
+
+ h = (HANDLE) _get_osfhandle (pfd[i].fd);
+ if (h != handle_array[nhandles])
+ {
+ /* It's a socket. */
+ WSAEnumNetworkEvents ((SOCKET) h, NULL, &ev);
+ WSAEventSelect ((SOCKET) h, 0, 0);
+
+ /* If we're lucky, WSAEnumNetworkEvents already provided a way
+ to distinguish FD_READ and FD_ACCEPT; this saves a recv later. */
+ if (FD_ISSET ((SOCKET) h, &rfds)
+ && !(ev.lNetworkEvents & (FD_READ | FD_ACCEPT)))
+ ev.lNetworkEvents |= FD_READ | FD_ACCEPT;
+ if (FD_ISSET ((SOCKET) h, &wfds))
+ ev.lNetworkEvents |= FD_WRITE | FD_CONNECT;
+ if (FD_ISSET ((SOCKET) h, &xfds))
+ ev.lNetworkEvents |= FD_OOB;
+
+ happened = windows_compute_revents_socket ((SOCKET) h, pfd[i].events,
+ ev.lNetworkEvents);
+ }
+ else
+ {
+ /* Not a socket. */
+ int sought = pfd[i].events;
+ happened = windows_compute_revents (h, &sought);
+ nhandles++;
+ }
+
+ if ((pfd[i].revents |= happened) != 0)
+ rc++;
+ }
+
+ if (!rc && timeout == INFTIM)
+ {
+ SleepEx (1, TRUE);
+ goto restart;
+ }
+
+ return rc;
+#endif
+}
diff --git a/lib/poll.in.h b/lib/poll.in.h
new file mode 100644
index 0000000..3c0b48f
--- /dev/null
+++ b/lib/poll.in.h
@@ -0,0 +1,103 @@
+/* Header for poll(2) emulation
+ Contributed by Paolo Bonzini.
+
+ Copyright 2001-2003, 2007, 2009-2013 Free Software Foundation, Inc.
+
+ This file is part of gnulib.
+
+ 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/>. */
+
+#ifndef address@hidden@_POLL_H
+
+#if __GNUC__ >= 3
address@hidden@
+#endif
address@hidden@
+
+/* The include_next requires a split double-inclusion guard. */
+#if @HAVE_POLL_H@
+# @INCLUDE_NEXT@ @NEXT_POLL_H@
+#endif
+
+#ifndef address@hidden@_POLL_H
+#define address@hidden@_POLL_H
+
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+#if address@hidden@
+
+/* fake a poll(2) environment */
+# define POLLIN 0x0001 /* any readable data available */
+# define POLLPRI 0x0002 /* OOB/Urgent readable data */
+# define POLLOUT 0x0004 /* file descriptor is writable */
+# define POLLERR 0x0008 /* some poll error occurred */
+# define POLLHUP 0x0010 /* file descriptor was "hung up" */
+# define POLLNVAL 0x0020 /* requested events "invalid" */
+# define POLLRDNORM 0x0040
+# define POLLRDBAND 0x0080
+# define POLLWRNORM 0x0100
+# define POLLWRBAND 0x0200
+
+# if !GNULIB_defined_poll_types
+
+struct pollfd
+{
+ int fd; /* which file descriptor to poll */
+ short events; /* events we are interested in */
+ short revents; /* events found on return */
+};
+
+typedef unsigned long nfds_t;
+
+# define GNULIB_defined_poll_types 1
+# endif
+
+/* Define INFTIM only if doing so conforms to POSIX. */
+# if !defined (_POSIX_C_SOURCE) && !defined (_XOPEN_SOURCE)
+# define INFTIM (-1)
+# endif
+
+#endif
+
+
+#if @GNULIB_POLL@
+# if @REPLACE_POLL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef poll
+# define poll rpl_poll
+# endif
+_GL_FUNCDECL_RPL (poll, int, (struct pollfd *pfd, nfds_t nfd, int timeout));
+_GL_CXXALIAS_RPL (poll, int, (struct pollfd *pfd, nfds_t nfd, int timeout));
+# else
+# if address@hidden@
+_GL_FUNCDECL_SYS (poll, int, (struct pollfd *pfd, nfds_t nfd, int timeout));
+# endif
+_GL_CXXALIAS_SYS (poll, int, (struct pollfd *pfd, nfds_t nfd, int timeout));
+# endif
+_GL_CXXALIASWARN (poll);
+#elif defined GNULIB_POSIXCHECK
+# undef poll
+# if HAVE_RAW_DECL_POLL
+_GL_WARN_ON_USE (poll, "poll is unportable - "
+ "use gnulib module poll for portability");
+# endif
+#endif
+
+
+#endif /* address@hidden@_POLL_H */
+#endif /* address@hidden@_POLL_H */
diff --git a/lib/printf-args.c b/lib/printf-args.c
index c768883..73fa7a4 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-2012 Free Software
+ Copyright (C) 1999, 2002-2003, 2005-2007, 2009-2013 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 0bc75ca..af7e72d 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-2012 Free Software
+ Copyright (C) 1999, 2002-2003, 2006-2007, 2011-2013 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 fcc302f..9a266df 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2000, 2002-2003, 2006-2013 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 94883c6..0d535fa 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-2012 Free Software
+ Copyright (C) 1999, 2002-2003, 2005, 2007, 2010-2013 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 eb3fae3..2abc6ac 100644
--- a/lib/putenv.c
+++ b/lib/putenv.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2012 Free Software
+/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2013 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
@@ -115,6 +115,37 @@ putenv (char *string)
if (*ep == NULL)
{
+#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=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;
+ }
+#else
static char **last_environ = NULL;
char **new_environ = (char **) malloc ((size + 2) * sizeof (char *));
if (new_environ == NULL)
@@ -126,6 +157,7 @@ putenv (char *string)
free (last_environ);
last_environ = new_environ;
environ = new_environ;
+#endif
}
else
*ep = string;
diff --git a/lib/raise.c b/lib/raise.c
index 0c3acbb..3720dfa 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-2006, 2009-2013 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
@@ -32,7 +32,7 @@
# undef raise
# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline int
+static int
raise_nothrow (int sig)
{
int result;
diff --git a/lib/read.c b/lib/read.c
index 9018bb5..155e6d1 100644
--- a/lib/read.c
+++ b/lib/read.c
@@ -1,5 +1,5 @@
/* POSIX compatible read() function.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2011.
This program is free software: you can redistribute it and/or modify
@@ -34,7 +34,7 @@
# undef read
# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline ssize_t
+static ssize_t
read_nothrow (int fd, void *buf, size_t count)
{
ssize_t result;
diff --git a/lib/readlink.c b/lib/readlink.c
index c75d794..ce8a0e8 100644
--- a/lib/readlink.c
+++ b/lib/readlink.c
@@ -1,5 +1,5 @@
/* Stub for readlink().
- Copyright (C) 2003-2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2013 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 7a5946a..aaa7d00 100644
--- a/lib/recv.c
+++ b/lib/recv.c
@@ -1,6 +1,6 @@
/* recv.c --- wrappers for Windows recv function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 bfd97ac..3155071 100644
--- a/lib/recvfrom.c
+++ b/lib/recvfrom.c
@@ -1,6 +1,6 @@
/* recvfrom.c --- wrappers for Windows recvfrom function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 8c1a7d0..7cbdec5 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2000, 2009-2013 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 fd87588..cf7b492 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2000, 2009-2013 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 76947c2..b236f36 100644
--- a/lib/regcomp.c
+++ b/lib/regcomp.c
@@ -1,20 +1,21 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2013 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern,
size_t length, reg_syntax_t syntax);
@@ -93,20 +94,20 @@ static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE
trans,
bitset_t sbcset,
re_charset_t *mbcset,
Idx *char_class_alloc,
- const unsigned char *class_name,
+ const char *class_name,
reg_syntax_t syntax);
#else /* not RE_ENABLE_I18N */
static reg_errcode_t build_equiv_class (bitset_t sbcset,
const unsigned char *name);
static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans,
bitset_t sbcset,
- const unsigned char *class_name,
+ const char *class_name,
reg_syntax_t syntax);
#endif /* not RE_ENABLE_I18N */
static bin_tree_t *build_charclass_op (re_dfa_t *dfa,
RE_TRANSLATE_TYPE trans,
- const unsigned char *class_name,
- const unsigned char *extra,
+ const char *class_name,
+ const char *extra,
bool non_match, reg_errcode_t *err);
static bin_tree_t *create_tree (re_dfa_t *dfa,
bin_tree_t *left, bin_tree_t *right,
@@ -952,10 +953,10 @@ static void
internal_function
init_word_char (re_dfa_t *dfa)
{
- dfa->word_ops_used = 1;
int i = 0;
int j;
int ch = 0;
+ dfa->word_ops_used = 1;
if (BE (dfa->map_notascii == 0, 1))
{
bitset_word_t bits0 = 0x00000000;
@@ -2421,8 +2422,8 @@ parse_expression (re_string_t *regexp, regex_t *preg,
re_token_t *token,
case OP_WORD:
case OP_NOTWORD:
tree = build_charclass_op (dfa, regexp->trans,
- (const unsigned char *) "alnum",
- (const unsigned char *) "_",
+ "alnum",
+ "_",
token->type == OP_NOTWORD, err);
if (BE (*err != REG_NOERROR && tree == NULL, 0))
return NULL;
@@ -2430,8 +2431,8 @@ parse_expression (re_string_t *regexp, regex_t *preg,
re_token_t *token,
case OP_SPACE:
case OP_NOTSPACE:
tree = build_charclass_op (dfa, regexp->trans,
- (const unsigned char *) "space",
- (const unsigned char *) "",
+ "space",
+ "",
token->type == OP_NOTSPACE, err);
if (BE (*err != REG_NOERROR && tree == NULL, 0))
return NULL;
@@ -2711,7 +2712,6 @@ build_range_exp (const reg_syntax_t syntax,
wchar_t wc;
wint_t start_wc;
wint_t end_wc;
- wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch
: ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0]
@@ -2725,11 +2725,7 @@ build_range_exp (const reg_syntax_t syntax,
? __btowc (end_ch) : end_elem->opr.wch);
if (start_wc == WEOF || end_wc == WEOF)
return REG_ECOLLATE;
- cmp_buf[0] = start_wc;
- cmp_buf[4] = end_wc;
-
- if (BE ((syntax & RE_NO_EMPTY_RANGES)
- && wcscoll (cmp_buf, cmp_buf + 4) > 0, 0))
+ else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0))
return REG_ERANGE;
/* Got valid collation sequence values, add them as a new entry.
@@ -2770,9 +2766,7 @@ build_range_exp (const reg_syntax_t syntax,
/* Build the table for single byte characters. */
for (wc = 0; wc < SBC_MAX; ++wc)
{
- cmp_buf[2] = wc;
- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
+ if (start_wc <= wc && wc <= end_wc)
bitset_set (sbcset, wc);
}
}
@@ -2969,6 +2963,7 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
0))
return REG_ERANGE;
+ /* FIXME: Implement rational ranges here, too. */
start_collseq = lookup_collation_sequence_value (start_elem);
end_collseq = lookup_collation_sequence_value (end_elem);
/* Check start/end collation sequence values. */
@@ -3296,7 +3291,8 @@ parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
re_token_t *token,
#ifdef RE_ENABLE_I18N
mbcset, &char_class_alloc,
#endif /* RE_ENABLE_I18N */
- start_elem.opr.name, syntax);
+ (const char *) start_elem.opr.name,
+ syntax);
if (BE (*err != REG_NOERROR, 0))
goto parse_bracket_exp_free_return;
break;
@@ -3576,14 +3572,14 @@ static reg_errcode_t
#ifdef RE_ENABLE_I18N
build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
re_charset_t *mbcset, Idx *char_class_alloc,
- const unsigned char *class_name, reg_syntax_t syntax)
+ const char *class_name, reg_syntax_t syntax)
#else /* not RE_ENABLE_I18N */
build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
- const unsigned char *class_name, reg_syntax_t syntax)
+ const char *class_name, reg_syntax_t syntax)
#endif /* not RE_ENABLE_I18N */
{
int i;
- const char *name = (const char *) class_name;
+ const char *name = class_name;
/* In case of REG_ICASE "upper" and "lower" match the both of
upper and lower cases. */
@@ -3657,8 +3653,8 @@ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
static bin_tree_t *
build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans,
- const unsigned char *class_name,
- const unsigned char *extra, bool non_match,
+ const char *class_name,
+ const char *extra, bool non_match,
reg_errcode_t *err)
{
re_bitset_ptr_t sbcset;
diff --git a/lib/regex.c b/lib/regex.c
index c578852..ca40e6e 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -1,20 +1,21 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2013 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
#ifndef _LIBC
# include <config.h>
diff --git a/lib/regex.h b/lib/regex.h
index 07c1b3d..74645ca 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -1,21 +1,22 @@
/* Definitions for data structures and routines for the regular
expression library.
- Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2012
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 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
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
#ifndef _REGEX_H
#define _REGEX_H 1
diff --git a/lib/regex_internal.c b/lib/regex_internal.c
index 71ee41e..e11ad3d 100644
--- a/lib/regex_internal.c
+++ b/lib/regex_internal.c
@@ -1,20 +1,21 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2013 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
static void re_string_construct_common (const char *str, Idx len,
re_string_t *pstr,
@@ -973,7 +974,7 @@ re_node_set_alloc (re_node_set *set, Idx size)
set->alloc = size;
set->nelem = 0;
set->elems = re_malloc (Idx, size);
- if (BE (set->elems == NULL, 0))
+ if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0))
return REG_ESPACE;
return REG_NOERROR;
}
@@ -1442,11 +1443,9 @@ re_dfa_add_node (re_dfa_t *dfa, re_token_t token)
dfa->nodes[dfa->nodes_len] = token;
dfa->nodes[dfa->nodes_len].constraint = 0;
#ifdef RE_ENABLE_I18N
- {
- int type = token.type;
dfa->nodes[dfa->nodes_len].accept_mb =
- (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET;
- }
+ ((token.type == OP_PERIOD && dfa->mb_cur_max > 1)
+ || token.type == COMPLEX_BRACKET);
#endif
dfa->nexts[dfa->nodes_len] = REG_MISSING;
re_node_set_init_empty (dfa->edests + dfa->nodes_len);
@@ -1454,7 +1453,7 @@ re_dfa_add_node (re_dfa_t *dfa, re_token_t token)
return dfa->nodes_len++;
}
-static inline re_hashval_t
+static re_hashval_t
internal_function
calc_state_hash (const re_node_set *nodes, unsigned int context)
{
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index fd331b1..fa93382 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -1,20 +1,21 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2013 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
#ifndef _REGEX_INTERNAL_H
#define _REGEX_INTERNAL_H 1
@@ -26,9 +27,6 @@
#include <string.h>
#include <langinfo.h>
-#ifndef _LIBC
-# include "localcharset.h"
-#endif
#include <locale.h>
#include <wchar.h>
#include <wctype.h>
@@ -37,7 +35,6 @@
#if defined _LIBC
# include <bits/libc-lock.h>
#else
-# define __libc_lock_define(CLASS,NAME)
# define __libc_lock_init(NAME) do { } while (0)
# define __libc_lock_lock(NAME) do { } while (0)
# define __libc_lock_unlock(NAME) do { } while (0)
@@ -63,7 +60,7 @@
# ifdef _LIBC
# undef gettext
# define gettext(msgid) \
- INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES)
+ __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES)
# endif
#else
# define gettext(msgid) (msgid)
@@ -83,9 +80,6 @@
# define BE(expr, val) __builtin_expect (expr, val)
#else
# define BE(expr, val) (expr)
-# ifdef _LIBC
-# define inline
-# endif
#endif
/* Number of ASCII characters. */
@@ -102,6 +96,8 @@
/* Rename to standard API for using out of glibc. */
#ifndef _LIBC
+# undef __wctype
+# undef __iswctype
# define __wctype wctype
# define __iswctype iswctype
# define __btowc btowc
@@ -449,7 +445,9 @@ static unsigned int re_string_context_at (const re_string_t
*input, Idx idx,
#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
-#include <alloca.h>
+#if defined _LIBC || HAVE_ALLOCA
+# include <alloca.h>
+#endif
#ifndef _LIBC
# if HAVE_ALLOCA
@@ -466,6 +464,12 @@ static unsigned int re_string_context_at (const
re_string_t *input, Idx idx,
# endif
#endif
+#ifdef _LIBC
+# define MALLOC_0_IS_NONNULL 1
+#elif !defined MALLOC_0_IS_NONNULL
+# define MALLOC_0_IS_NONNULL 0
+#endif
+
#ifndef MAX
# define MAX(a,b) ((a) < (b) ? (b) : (a))
#endif
@@ -696,7 +700,9 @@ struct re_dfa_t
#ifdef DEBUG
char* re_str;
#endif
+#ifdef _LIBC
__libc_lock_define (, lock)
+#endif
};
#define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
@@ -727,33 +733,33 @@ typedef struct
} bracket_elem_t;
-/* Inline functions for bitset_t operation. */
+/* Functions for bitset_t operation. */
-static inline void
+static void
bitset_set (bitset_t set, Idx i)
{
set[i / BITSET_WORD_BITS] |= (bitset_word_t) 1 << i % BITSET_WORD_BITS;
}
-static inline void
+static void
bitset_clear (bitset_t set, Idx i)
{
set[i / BITSET_WORD_BITS] &= ~ ((bitset_word_t) 1 << i % BITSET_WORD_BITS);
}
-static inline bool
+static bool
bitset_contain (const bitset_t set, Idx i)
{
return (set[i / BITSET_WORD_BITS] >> i % BITSET_WORD_BITS) & 1;
}
-static inline void
+static void
bitset_empty (bitset_t set)
{
memset (set, '\0', sizeof (bitset_t));
}
-static inline void
+static void
bitset_set_all (bitset_t set)
{
memset (set, -1, sizeof (bitset_word_t) * (SBC_MAX / BITSET_WORD_BITS));
@@ -762,13 +768,13 @@ bitset_set_all (bitset_t set)
((bitset_word_t) 1 << SBC_MAX % BITSET_WORD_BITS) - 1;
}
-static inline void
+static void
bitset_copy (bitset_t dest, const bitset_t src)
{
memcpy (dest, src, sizeof (bitset_t));
}
-static inline void
+static void
bitset_not (bitset_t set)
{
int bitset_i;
@@ -780,7 +786,7 @@ bitset_not (bitset_t set)
& ~set[BITSET_WORDS - 1]);
}
-static inline void
+static void
bitset_merge (bitset_t dest, const bitset_t src)
{
int bitset_i;
@@ -788,7 +794,7 @@ bitset_merge (bitset_t dest, const bitset_t src)
dest[bitset_i] |= src[bitset_i];
}
-static inline void
+static void
bitset_mask (bitset_t dest, const bitset_t src)
{
int bitset_i;
@@ -797,8 +803,8 @@ bitset_mask (bitset_t dest, const bitset_t src)
}
#ifdef RE_ENABLE_I18N
-/* Inline functions for re_string. */
-static inline int
+/* Functions for re_string. */
+static int
internal_function __attribute ((pure))
re_string_char_size_at (const re_string_t *pstr, Idx idx)
{
@@ -811,7 +817,7 @@ re_string_char_size_at (const re_string_t *pstr, Idx idx)
return byte_idx;
}
-static inline wint_t
+static wint_t
internal_function __attribute ((pure))
re_string_wchar_at (const re_string_t *pstr, Idx idx)
{
diff --git a/lib/regexec.c b/lib/regexec.c
index 13c3f15..1bd1640 100644
--- a/lib/regexec.c
+++ b/lib/regexec.c
@@ -1,20 +1,21 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2013 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <address@hidden>.
- 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.
+ The GNU C 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 2.1 of the License, or (at your option) any later version.
- This program is distributed in the hope that it will be useful,
+ The GNU C 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.
+ 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/>. */
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags,
Idx n) internal_function;
@@ -198,7 +199,7 @@ static Idx group_nodes_into_DFAstates (const re_dfa_t *dfa,
static bool check_node_accept (const re_match_context_t *mctx,
const re_token_t *node, Idx idx)
internal_function;
-static reg_errcode_t extend_buffers (re_match_context_t *mctx)
+static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len)
internal_function;
/* Entry point for POSIX code. */
@@ -1175,7 +1176,7 @@ check_matching (re_match_context_t *mctx, bool
fl_longest_match,
|| (BE (next_char_idx >= mctx->input.valid_len, 0)
&& mctx->input.valid_len < mctx->input.len))
{
- err = extend_buffers (mctx);
+ err = extend_buffers (mctx, next_char_idx + 1);
if (BE (err != REG_NOERROR, 0))
{
assert (err == REG_ESPACE);
@@ -1755,7 +1756,7 @@ clean_state_log_if_needed (re_match_context_t *mctx, Idx
next_state_log_idx)
&& mctx->input.valid_len < mctx->input.len))
{
reg_errcode_t err;
- err = extend_buffers (mctx);
+ err = extend_buffers (mctx, next_state_log_idx + 1);
if (BE (err != REG_NOERROR, 0))
return err;
}
@@ -2812,7 +2813,7 @@ get_subexp (re_match_context_t *mctx, Idx bkref_node, Idx
bkref_str_idx)
if (bkref_str_off >= mctx->input.len)
break;
- err = extend_buffers (mctx);
+ err = extend_buffers (mctx, bkref_str_off + 1);
if (BE (err != REG_NOERROR, 0))
return err;
@@ -3935,6 +3936,7 @@ check_node_accept_bytes (const re_dfa_t *dfa, Idx
node_idx,
in_collseq = find_collation_sequence_value (pin, elem_len);
}
/* match with range expression? */
+ /* FIXME: Implement rational ranges here, too. */
for (i = 0; i < cset->nranges; ++i)
if (cset->range_starts[i] <= in_collseq
&& in_collseq <= cset->range_ends[i])
@@ -3986,18 +3988,9 @@ check_node_accept_bytes (const re_dfa_t *dfa, Idx
node_idx,
# endif /* _LIBC */
{
/* match with range expression? */
-#if __GNUC__ >= 2 && ! (__STDC_VERSION__ < 199901L && defined __STRICT_ANSI__)
- wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'};
-#else
- wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
- cmp_buf[2] = wc;
-#endif
for (i = 0; i < cset->nranges; ++i)
{
- cmp_buf[0] = cset->range_starts[i];
- cmp_buf[4] = cset->range_ends[i];
- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
+ if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i])
{
match_len = char_len;
goto check_node_accept_bytes_match;
@@ -4135,7 +4128,7 @@ check_node_accept (const re_match_context_t *mctx, const
re_token_t *node,
static reg_errcode_t
internal_function __attribute_warn_unused_result__
-extend_buffers (re_match_context_t *mctx)
+extend_buffers (re_match_context_t *mctx, int min_len)
{
reg_errcode_t ret;
re_string_t *pstr = &mctx->input;
@@ -4145,8 +4138,10 @@ extend_buffers (re_match_context_t *mctx)
<= pstr->bufs_len, 0))
return REG_ESPACE;
- /* Double the lengths of the buffers. */
- ret = re_string_realloc_buffers (pstr, MIN (pstr->len, pstr->bufs_len * 2));
+ /* Double the lengths of the buffers, but allocate at least MIN_LEN. */
+ ret = re_string_realloc_buffers (pstr,
+ MAX (min_len,
+ MIN (pstr->len, pstr->bufs_len * 2)));
if (BE (ret != REG_NOERROR, 0))
return ret;
diff --git a/lib/rename.c b/lib/rename.c
index 547a6a2..eceadec 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2003, 2005-2006, 2009-2013 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 0b53626..f18acbe 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-2012 Free Software
+ Copyright (C) 1988, 1990, 1999, 2003-2006, 2009-2013 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 53dfe84..4d4e69b 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2013 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 d2d85c7..39490ab 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-2012 Free Software
+ Copyright (C) 1993-1994, 1998, 2002-2006, 2009-2013 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 dc73922..91a86c6 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006, 2009-2013 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 cd42722..71f2f3d 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2013 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 3a7f509..779f5d5 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2009-2013 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 7ce286d..94fe3e2 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-2013 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
new file mode 100644
index 0000000..13ca150
--- /dev/null
+++ b/lib/select.c
@@ -0,0 +1,547 @@
+/* Emulation for select(2)
+ Contributed by Paolo Bonzini.
+
+ Copyright 2008-2013 Free Software Foundation, Inc.
+
+ This file is part of gnulib.
+
+ 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/>. */
+
+#include <config.h>
+#include <alloca.h>
+#include <assert.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+/* Native Windows. */
+
+#include <sys/types.h>
+#include <errno.h>
+#include <limits.h>
+
+#include <winsock2.h>
+#include <windows.h>
+#include <io.h>
+#include <stdio.h>
+#include <conio.h>
+#include <time.h>
+
+/* Get the overridden 'struct timeval'. */
+#include <sys/time.h>
+
+#include "msvc-nothrow.h"
+
+#undef select
+
+struct bitset {
+ unsigned char in[FD_SETSIZE / CHAR_BIT];
+ unsigned char out[FD_SETSIZE / CHAR_BIT];
+};
+
+/* Declare data structures for ntdll functions. */
+typedef struct _FILE_PIPE_LOCAL_INFORMATION {
+ ULONG NamedPipeType;
+ ULONG NamedPipeConfiguration;
+ ULONG MaximumInstances;
+ ULONG CurrentInstances;
+ ULONG InboundQuota;
+ ULONG ReadDataAvailable;
+ ULONG OutboundQuota;
+ ULONG WriteQuotaAvailable;
+ ULONG NamedPipeState;
+ ULONG NamedPipeEnd;
+} FILE_PIPE_LOCAL_INFORMATION, *PFILE_PIPE_LOCAL_INFORMATION;
+
+typedef struct _IO_STATUS_BLOCK
+{
+ union {
+ DWORD Status;
+ PVOID Pointer;
+ } u;
+ ULONG_PTR Information;
+} IO_STATUS_BLOCK, *PIO_STATUS_BLOCK;
+
+typedef enum _FILE_INFORMATION_CLASS {
+ FilePipeLocalInformation = 24
+} FILE_INFORMATION_CLASS, *PFILE_INFORMATION_CLASS;
+
+typedef DWORD (WINAPI *PNtQueryInformationFile)
+ (HANDLE, IO_STATUS_BLOCK *, VOID *, ULONG, FILE_INFORMATION_CLASS);
+
+#ifndef PIPE_BUF
+#define PIPE_BUF 512
+#endif
+
+/* Optimized test whether a HANDLE refers to a console.
+ See <http://lists.gnu.org/archive/html/bug-gnulib/2009-08/msg00065.html>.
*/
+#define IsConsoleHandle(h) (((intptr_t) (h) & 3) == 3)
+
+static BOOL
+IsSocketHandle (HANDLE h)
+{
+ WSANETWORKEVENTS ev;
+
+ if (IsConsoleHandle (h))
+ return FALSE;
+
+ /* Under Wine, it seems that getsockopt returns 0 for pipes too.
+ WSAEnumNetworkEvents instead distinguishes the two correctly. */
+ ev.lNetworkEvents = 0xDEADBEEF;
+ WSAEnumNetworkEvents ((SOCKET) h, NULL, &ev);
+ return ev.lNetworkEvents != 0xDEADBEEF;
+}
+
+/* Compute output fd_sets for libc descriptor FD (whose Windows handle is
+ H). */
+
+static int
+windows_poll_handle (HANDLE h, int fd,
+ struct bitset *rbits,
+ struct bitset *wbits,
+ struct bitset *xbits)
+{
+ BOOL read, write, except;
+ int i, ret;
+ INPUT_RECORD *irbuffer;
+ DWORD avail, nbuffer;
+ BOOL bRet;
+ IO_STATUS_BLOCK iosb;
+ FILE_PIPE_LOCAL_INFORMATION fpli;
+ static PNtQueryInformationFile NtQueryInformationFile;
+ static BOOL once_only;
+
+ read = write = except = FALSE;
+ switch (GetFileType (h))
+ {
+ case FILE_TYPE_DISK:
+ read = TRUE;
+ write = TRUE;
+ break;
+
+ case FILE_TYPE_PIPE:
+ if (!once_only)
+ {
+ NtQueryInformationFile = (PNtQueryInformationFile)
+ GetProcAddress (GetModuleHandle ("ntdll.dll"),
+ "NtQueryInformationFile");
+ once_only = TRUE;
+ }
+
+ if (PeekNamedPipe (h, NULL, 0, NULL, &avail, NULL) != 0)
+ {
+ if (avail)
+ read = TRUE;
+ }
+ else if (GetLastError () == ERROR_BROKEN_PIPE)
+ ;
+
+ else
+ {
+ /* It was the write-end of the pipe. Check if it is writable.
+ If NtQueryInformationFile fails, optimistically assume the pipe is
+ writable. This could happen on Windows 9x, where
+ NtQueryInformationFile is not available, or if we inherit a pipe
+ that doesn't permit FILE_READ_ATTRIBUTES access on the write end
+ (I think this should not happen since Windows XP SP2; WINE seems
+ fine too). Otherwise, ensure that enough space is available for
+ atomic writes. */
+ memset (&iosb, 0, sizeof (iosb));
+ memset (&fpli, 0, sizeof (fpli));
+
+ if (!NtQueryInformationFile
+ || NtQueryInformationFile (h, &iosb, &fpli, sizeof (fpli),
+ FilePipeLocalInformation)
+ || fpli.WriteQuotaAvailable >= PIPE_BUF
+ || (fpli.OutboundQuota < PIPE_BUF &&
+ fpli.WriteQuotaAvailable == fpli.OutboundQuota))
+ write = TRUE;
+ }
+ break;
+
+ case FILE_TYPE_CHAR:
+ write = TRUE;
+ if (!(rbits->in[fd / CHAR_BIT] & (1 << (fd & (CHAR_BIT - 1)))))
+ break;
+
+ ret = WaitForSingleObject (h, 0);
+ if (ret == WAIT_OBJECT_0)
+ {
+ if (!IsConsoleHandle (h))
+ {
+ read = TRUE;
+ break;
+ }
+
+ nbuffer = avail = 0;
+ bRet = GetNumberOfConsoleInputEvents (h, &nbuffer);
+
+ /* Screen buffers handles are filtered earlier. */
+ assert (bRet);
+ if (nbuffer == 0)
+ {
+ except = TRUE;
+ break;
+ }
+
+ irbuffer = (INPUT_RECORD *) alloca (nbuffer * sizeof (INPUT_RECORD));
+ bRet = PeekConsoleInput (h, irbuffer, nbuffer, &avail);
+ if (!bRet || avail == 0)
+ {
+ except = TRUE;
+ break;
+ }
+
+ for (i = 0; i < avail; i++)
+ if (irbuffer[i].EventType == KEY_EVENT)
+ read = TRUE;
+ }
+ break;
+
+ default:
+ ret = WaitForSingleObject (h, 0);
+ write = TRUE;
+ if (ret == WAIT_OBJECT_0)
+ read = TRUE;
+
+ break;
+ }
+
+ ret = 0;
+ if (read && (rbits->in[fd / CHAR_BIT] & (1 << (fd & (CHAR_BIT - 1)))))
+ {
+ rbits->out[fd / CHAR_BIT] |= (1 << (fd & (CHAR_BIT - 1)));
+ ret++;
+ }
+
+ if (write && (wbits->in[fd / CHAR_BIT] & (1 << (fd & (CHAR_BIT - 1)))))
+ {
+ wbits->out[fd / CHAR_BIT] |= (1 << (fd & (CHAR_BIT - 1)));
+ ret++;
+ }
+
+ if (except && (xbits->in[fd / CHAR_BIT] & (1 << (fd & (CHAR_BIT - 1)))))
+ {
+ xbits->out[fd / CHAR_BIT] |= (1 << (fd & (CHAR_BIT - 1)));
+ ret++;
+ }
+
+ return ret;
+}
+
+int
+rpl_select (int nfds, fd_set *rfds, fd_set *wfds, fd_set *xfds,
+ struct timeval *timeout)
+#undef timeval
+{
+ static struct timeval tv0;
+ static HANDLE hEvent;
+ HANDLE h, handle_array[FD_SETSIZE + 2];
+ fd_set handle_rfds, handle_wfds, handle_xfds;
+ struct bitset rbits, wbits, xbits;
+ unsigned char anyfds_in[FD_SETSIZE / CHAR_BIT];
+ DWORD ret, wait_timeout, nhandles, nsock, nbuffer;
+ MSG msg;
+ int i, fd, rc;
+
+ if (nfds > FD_SETSIZE)
+ nfds = FD_SETSIZE;
+
+ if (!timeout)
+ wait_timeout = INFINITE;
+ else
+ {
+ wait_timeout = timeout->tv_sec * 1000 + timeout->tv_usec / 1000;
+
+ /* select is also used as a portable usleep. */
+ if (!rfds && !wfds && !xfds)
+ {
+ Sleep (wait_timeout);
+ return 0;
+ }
+ }
+
+ if (!hEvent)
+ hEvent = CreateEvent (NULL, FALSE, FALSE, NULL);
+
+ handle_array[0] = hEvent;
+ nhandles = 1;
+ nsock = 0;
+
+ /* Copy descriptors to bitsets. At the same time, eliminate
+ bits in the "wrong" direction for console input buffers
+ and screen buffers, because screen buffers are waitable
+ and they will block until a character is available. */
+ memset (&rbits, 0, sizeof (rbits));
+ memset (&wbits, 0, sizeof (wbits));
+ memset (&xbits, 0, sizeof (xbits));
+ memset (anyfds_in, 0, sizeof (anyfds_in));
+ if (rfds)
+ for (i = 0; i < rfds->fd_count; i++)
+ {
+ fd = rfds->fd_array[i];
+ h = (HANDLE) _get_osfhandle (fd);
+ if (IsConsoleHandle (h)
+ && !GetNumberOfConsoleInputEvents (h, &nbuffer))
+ continue;
+
+ rbits.in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ anyfds_in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ }
+ else
+ rfds = (fd_set *) alloca (sizeof (fd_set));
+
+ if (wfds)
+ for (i = 0; i < wfds->fd_count; i++)
+ {
+ fd = wfds->fd_array[i];
+ h = (HANDLE) _get_osfhandle (fd);
+ if (IsConsoleHandle (h)
+ && GetNumberOfConsoleInputEvents (h, &nbuffer))
+ continue;
+
+ wbits.in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ anyfds_in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ }
+ else
+ wfds = (fd_set *) alloca (sizeof (fd_set));
+
+ if (xfds)
+ for (i = 0; i < xfds->fd_count; i++)
+ {
+ fd = xfds->fd_array[i];
+ xbits.in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ anyfds_in[fd / CHAR_BIT] |= 1 << (fd & (CHAR_BIT - 1));
+ }
+ else
+ xfds = (fd_set *) alloca (sizeof (fd_set));
+
+ /* Zero all the fd_sets, including the application's. */
+ FD_ZERO (rfds);
+ FD_ZERO (wfds);
+ FD_ZERO (xfds);
+ FD_ZERO (&handle_rfds);
+ FD_ZERO (&handle_wfds);
+ FD_ZERO (&handle_xfds);
+
+ /* Classify handles. Create fd sets for sockets, poll the others. */
+ for (i = 0; i < nfds; i++)
+ {
+ if ((anyfds_in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1)))) == 0)
+ continue;
+
+ h = (HANDLE) _get_osfhandle (i);
+ if (!h)
+ {
+ errno = EBADF;
+ return -1;
+ }
+
+ if (IsSocketHandle (h))
+ {
+ int requested = FD_CLOSE;
+
+ /* See above; socket handles are mapped onto select, but we
+ need to map descriptors to handles. */
+ if (rbits.in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ {
+ requested |= FD_READ | FD_ACCEPT;
+ FD_SET ((SOCKET) h, rfds);
+ FD_SET ((SOCKET) h, &handle_rfds);
+ }
+ if (wbits.in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ {
+ requested |= FD_WRITE | FD_CONNECT;
+ FD_SET ((SOCKET) h, wfds);
+ FD_SET ((SOCKET) h, &handle_wfds);
+ }
+ if (xbits.in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ {
+ requested |= FD_OOB;
+ FD_SET ((SOCKET) h, xfds);
+ FD_SET ((SOCKET) h, &handle_xfds);
+ }
+
+ WSAEventSelect ((SOCKET) h, hEvent, requested);
+ nsock++;
+ }
+ else
+ {
+ handle_array[nhandles++] = h;
+
+ /* Poll now. If we get an event, do not wait below. */
+ if (wait_timeout != 0
+ && windows_poll_handle (h, i, &rbits, &wbits, &xbits))
+ wait_timeout = 0;
+ }
+ }
+
+ /* Place a sentinel at the end of the array. */
+ handle_array[nhandles] = NULL;
+
+restart:
+ if (wait_timeout == 0 || nsock == 0)
+ rc = 0;
+ else
+ {
+ /* See if we need to wait in the loop below. If any select is ready,
+ do MsgWaitForMultipleObjects anyway to dispatch messages, but
+ no need to call select again. */
+ rc = select (0, &handle_rfds, &handle_wfds, &handle_xfds, &tv0);
+ if (rc == 0)
+ {
+ /* Restore the fd_sets for the other select we do below. */
+ memcpy (&handle_rfds, rfds, sizeof (fd_set));
+ memcpy (&handle_wfds, wfds, sizeof (fd_set));
+ memcpy (&handle_xfds, xfds, sizeof (fd_set));
+ }
+ else
+ wait_timeout = 0;
+ }
+
+ for (;;)
+ {
+ ret = MsgWaitForMultipleObjects (nhandles, handle_array, FALSE,
+ wait_timeout, QS_ALLINPUT);
+
+ if (ret == WAIT_OBJECT_0 + nhandles)
+ {
+ /* new input of some other kind */
+ BOOL bRet;
+ while ((bRet = PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) != 0)
+ {
+ TranslateMessage (&msg);
+ DispatchMessage (&msg);
+ }
+ }
+ else
+ break;
+ }
+
+ /* If we haven't done it yet, check the status of the sockets. */
+ if (rc == 0 && nsock > 0)
+ rc = select (0, &handle_rfds, &handle_wfds, &handle_xfds, &tv0);
+
+ if (nhandles > 1)
+ {
+ /* Count results that are not counted in the return value of select. */
+ nhandles = 1;
+ for (i = 0; i < nfds; i++)
+ {
+ if ((anyfds_in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1)))) == 0)
+ continue;
+
+ h = (HANDLE) _get_osfhandle (i);
+ if (h == handle_array[nhandles])
+ {
+ /* Not a socket. */
+ nhandles++;
+ windows_poll_handle (h, i, &rbits, &wbits, &xbits);
+ if (rbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1)))
+ || wbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1)))
+ || xbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ rc++;
+ }
+ }
+
+ if (rc == 0 && wait_timeout == INFINITE)
+ {
+ /* Sleep 1 millisecond to avoid busy wait and retry with the
+ original fd_sets. */
+ memcpy (&handle_rfds, rfds, sizeof (fd_set));
+ memcpy (&handle_wfds, wfds, sizeof (fd_set));
+ memcpy (&handle_xfds, xfds, sizeof (fd_set));
+ SleepEx (1, TRUE);
+ goto restart;
+ }
+ }
+
+ /* Now fill in the results. */
+ FD_ZERO (rfds);
+ FD_ZERO (wfds);
+ FD_ZERO (xfds);
+ nhandles = 1;
+ for (i = 0; i < nfds; i++)
+ {
+ if ((anyfds_in[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1)))) == 0)
+ continue;
+
+ h = (HANDLE) _get_osfhandle (i);
+ if (h != handle_array[nhandles])
+ {
+ /* Perform handle->descriptor mapping. */
+ WSAEventSelect ((SOCKET) h, NULL, 0);
+ if (FD_ISSET (h, &handle_rfds))
+ FD_SET (i, rfds);
+ if (FD_ISSET (h, &handle_wfds))
+ FD_SET (i, wfds);
+ if (FD_ISSET (h, &handle_xfds))
+ FD_SET (i, xfds);
+ }
+ else
+ {
+ /* Not a socket. */
+ nhandles++;
+ if (rbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ FD_SET (i, rfds);
+ if (wbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ FD_SET (i, wfds);
+ if (xbits.out[i / CHAR_BIT] & (1 << (i & (CHAR_BIT - 1))))
+ FD_SET (i, xfds);
+ }
+ }
+
+ return rc;
+}
+
+#else /* ! Native Windows. */
+
+#include <sys/select.h>
+#include <stddef.h> /* NULL */
+#include <errno.h>
+#include <unistd.h>
+
+#undef select
+
+int
+rpl_select (int nfds, fd_set *rfds, fd_set *wfds, fd_set *xfds,
+ struct timeval *timeout)
+{
+ int i;
+
+ /* FreeBSD 8.2 has a bug: it does not always detect invalid fds. */
+ if (nfds < 0 || nfds > FD_SETSIZE)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ for (i = 0; i < nfds; i++)
+ {
+ if (((rfds && FD_ISSET (i, rfds))
+ || (wfds && FD_ISSET (i, wfds))
+ || (xfds && FD_ISSET (i, xfds)))
+ && dup2 (i, i) != i)
+ return -1;
+ }
+
+ /* Interix 3.5 has a bug: it does not support nfds == 0. */
+ if (nfds == 0)
+ {
+ nfds = 1;
+ rfds = NULL;
+ wfds = NULL;
+ xfds = NULL;
+ }
+ return select (nfds, rfds, wfds, xfds, timeout);
+}
+
+#endif
diff --git a/lib/send.c b/lib/send.c
index 64d0e8d..3e76ce1 100644
--- a/lib/send.c
+++ b/lib/send.c
@@ -1,6 +1,6 @@
/* send.c --- wrappers for Windows send function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 7a8e994..2154582 100644
--- a/lib/sendto.c
+++ b/lib/sendto.c
@@ -1,6 +1,6 @@
/* sendto.c --- wrappers for Windows sendto function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 75f423f..8076c54 100644
--- a/lib/setenv.c
+++ b/lib/setenv.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1992, 1995-2003, 2005-2012 Free Software Foundation, Inc.
+/* Copyright (C) 1992, 1995-2003, 2005-2013 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
@@ -15,14 +15,14 @@
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#if !_LIBC
+/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
+ optimizes away the name == NULL test below. */
+# define _GL_ARG_NONNULL(params)
+
# define _GL_USE_STDLIB_ALLOC 1
# include <config.h>
#endif
-/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
- optimizes away the name == NULL test below. */
-#define _GL_ARG_NONNULL(params)
-
#include <alloca.h>
/* Specification. */
diff --git a/lib/setsockopt.c b/lib/setsockopt.c
index 07e9023..7a50835 100644
--- a/lib/setsockopt.c
+++ b/lib/setsockopt.c
@@ -1,6 +1,6 @@
/* setsockopt.c --- wrappers for Windows setsockopt function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 1e646a9..2f5fc54 100644
--- a/lib/shutdown.c
+++ b/lib/shutdown.c
@@ -1,6 +1,6 @@
/* shutdown.c --- wrappers for Windows shutdown function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 627ae17..6f96f0d 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <signal.h>.
- Copyright (C) 2006-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006-2013 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 60d50f1..20fb1b7 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-2013 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 eb27f5d..3cccf48 100644
--- a/lib/snprintf.c
+++ b/lib/snprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 2004, 2006-2012 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2006-2013 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 24f16c9..17fecc4 100644
--- a/lib/socket.c
+++ b/lib/socket.c
@@ -1,6 +1,6 @@
/* socket.c --- wrappers for Windows socket function
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 635479a..d4652a2 100644
--- a/lib/sockets.c
+++ b/lib/sockets.c
@@ -1,6 +1,6 @@
/* sockets.c --- wrappers for Windows socket functions
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 35d6923..4eb4dcb 100644
--- a/lib/sockets.h
+++ b/lib/sockets.h
@@ -1,6 +1,6 @@
/* sockets.h - wrappers for Windows socket functions
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 daf2ca6..a3dff54 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -1,6 +1,6 @@
/* stat-related time functions.
- Copyright (C) 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-2013 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.c b/lib/stat.c
index f46e31d..c42962b 100644
--- a/lib/stat.c
+++ b/lib/stat.c
@@ -1,5 +1,5 @@
/* Work around platform bugs in stat.
- Copyright (C) 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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
@@ -42,7 +42,7 @@
# endif
#endif
-static inline int
+static int
orig_stat (const char *filename, struct stat *buf)
{
return stat (filename, buf);
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index e043871..d9b2eec 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -1,6 +1,6 @@
/* A substitute for ISO C11 <stdalign.h>.
- Copyright 2011-2012 Free Software Foundation, Inc.
+ Copyright 2011-2013 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/stdbool.in.h b/lib/stdbool.in.h
index 4193429..bd629ed 100644
--- a/lib/stdbool.in.h
+++ b/lib/stdbool.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2003, 2006-2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2003, 2006-2013 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 e17ef24..614c9bc 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2009-2013 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 3a73abf..889bca7 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2002, 2004-2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2002, 2004-2013 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
This file is part of gnulib.
@@ -39,7 +39,7 @@
Ideally we should test __BIONIC__ here, but it is only defined after
<sys/cdefs.h> has been included; hence test __ANDROID__ instead. */
#if defined __ANDROID__ \
- && defined _SYS_TYPES_H_ && !defined _SSIZE_T_DEFINED_
+ && defined _SYS_TYPES_H_ && !defined __need_size_t
# @INCLUDE_NEXT@ @NEXT_STDINT_H@
#else
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index f7e06ad..bc3fccb 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdio.h>.
- Copyright (C) 2004, 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2007-2013 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
@@ -575,21 +575,17 @@ _GL_CXXALIAS_RPL (fwrite, size_t,
_GL_CXXALIAS_SYS (fwrite, size_t,
(const void *ptr, size_t s, size_t n, FILE *stream));
-/* Work around glibc bug 11959
+/* Work around bug 11959 when fortifying glibc 2.4 through 2.15
<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, so it's not
- needed for C++. */
-# if !defined __cplusplus && 0 < __USE_FORTIFY_LEVEL
-static inline size_t _GL_ARG_NONNULL ((1, 4))
-rpl_fwrite (const void *ptr, size_t s, size_t n, FILE *stream)
-{
- size_t r = fwrite (ptr, s, n, stream);
- (void) r;
- return r;
-}
+ This affects only function declaration attributes under certain
+ versions of gcc, 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 rpl_fwrite
+# define fwrite(a, b, c, d) ({size_t __r = fwrite (a, b, c, d); __r; })
# endif
# endif
_GL_CXXALIASWARN (fwrite);
@@ -1333,7 +1329,6 @@ _GL_WARN_ON_USE (vsprintf, "vsprintf is not always POSIX
compliant - "
"POSIX compliance");
#endif
-
#endif /* address@hidden@_STDIO_H */
#endif /* address@hidden@_STDIO_H */
#endif
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index b67a348..552fdf0 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2004, 2006-2013 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
@@ -20,8 +20,9 @@
#endif
@PRAGMA_COLUMNS@
-#if defined __need_malloc_and_calloc
-/* Special invocation convention inside glibc header files. */
+#if defined __need_system_stdlib_h || defined __need_malloc_and_calloc
+/* Special invocation conventions inside some gnulib header files,
+ and inside some glibc header files, respectively. */
address@hidden@ @NEXT_STDLIB_H@
@@ -766,6 +767,22 @@ _GL_WARN_ON_USE (rpmatch, "rpmatch is unportable - "
# endif
#endif
+#if @GNULIB_SECURE_GETENV@
+/* Look up NAME in the environment, returning 0 in insecure situations. */
+# if address@hidden@
+_GL_FUNCDECL_SYS (secure_getenv, char *,
+ (char const *name) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (secure_getenv, char *, (char const *name));
+_GL_CXXALIASWARN (secure_getenv);
+#elif defined GNULIB_POSIXCHECK
+# undef secure_getenv
+# if HAVE_RAW_DECL_SECURE_GETENV
+_GL_WARN_ON_USE (secure_getenv, "secure_getenv is unportable - "
+ "use gnulib module secure_getenv for portability");
+# endif
+#endif
+
#if @GNULIB_SETENV@
/* Set NAME to VALUE in the environment.
If REPLACE is nonzero, overwrite an existing value. */
diff --git a/lib/streq.h b/lib/streq.h
index 7fd07c8..03ede61 100644
--- a/lib/streq.h
+++ b/lib/streq.h
@@ -1,5 +1,5 @@
/* Optimized string comparison.
- Copyright (C) 2001-2002, 2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2007, 2009-2013 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 f5fc3c9..058ba11 100644
--- a/lib/strftime.c
+++ b/lib/strftime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+/* Copyright (C) 1991-2001, 2003-2007, 2009-2013 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
@@ -26,7 +26,6 @@
#else
# include <config.h>
# if FPRINTFTIME
-# include "ignore-value.h"
# include "fprintftime.h"
# else
# include "strftime.h"
@@ -210,13 +209,12 @@ extern char *tzname[];
fwrite_uppcase (p, (s), _n); \
else \
{ \
- /* We are ignoring the value of fwrite here, in spite of the \
- fact that technically, that may not be valid: the fwrite \
- specification in POSIX 2008 defers to that of fputc, which \
- is intended to be consistent with the one from ISO C, \
- which permits failure due to ENOMEM *without* setting the \
- stream's error indicator. */ \
- ignore_value (fwrite ((s), _n, 1, p)); \
+ /* Ignore the value of fwrite. The caller can determine whether \
+ an error occurred by inspecting ferror (P). All known fwrite \
+ implementations set the stream's error indicator when they \
+ fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \
+ not require this. */ \
+ fwrite (s, _n, 1, p); \
} \
} \
while (0) \
diff --git a/lib/strftime.h b/lib/strftime.h
index 596b0b8..a521875 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -1,6 +1,6 @@
/* declarations for strftime.c
- Copyright (C) 2002, 2004, 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2008-2013 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 8a38236..bc841eb 100644
--- a/lib/striconveh.c
+++ b/lib/striconveh.c
@@ -1,5 +1,5 @@
/* Character set conversion with error handling.
- Copyright (C) 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2013 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 77730a0..ea6a6dc 100644
--- a/lib/striconveh.h
+++ b/lib/striconveh.h
@@ -1,5 +1,5 @@
/* Character set conversion with error handling.
- Copyright (C) 2001-2007, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2007, 2009-2013 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 0c23526..5dcf8de 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2013 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 63b77cd..16d4339 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-2012 Free Software Foundation,
+ Copyright (C) 1990, 2001, 2003-2006, 2009-2013 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 476f2f6..152311c 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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
new file mode 100644
index 0000000..0e3e32d
--- /dev/null
+++ b/lib/sys_select.in.h
@@ -0,0 +1,309 @@
+/* Substitute for <sys/select.h>.
+ Copyright (C) 2007-2013 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/>. */
+
+# if __GNUC__ >= 3
address@hidden@
+# endif
address@hidden@
+
+/* On OSF/1 and Solaris 2.6, <sys/types.h> and <sys/time.h>
+ both include <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 __sun && defined _SYS_TYPES_H \
+ && (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \
+ || defined __EXTENSIONS__))) \
+ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H)
+
+# 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 __sun && defined _SYS_TIME_H \
+ && (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \
+ || defined __EXTENSIONS__))) \
+ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H)
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On IRIX 6.5, <sys/timespec.h> includes <sys/types.h>, which includes
+ <sys/bsd_types.h>, which includes <sys/select.h>. At this point we cannot
+ include <signal.h>, because that includes <internal/signal_core.h>, which
+ gives a syntax error because <sys/timespec.h> has not been completely
+ processed. Simply delegate to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __sgi && (defined _SYS_BSD_TYPES_H &&
!defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H)
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On OpenBSD 5.0, <pthread.h> includes <sys/types.h>, which includes
+ <sys/select.h>. At this point we cannot include <signal.h>, because that
+ includes gnulib's pthread.h override, which gives a syntax error because
+ /usr/include/pthread.h has not been completely processed. Simply delegate
+ to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __OpenBSD__ && (defined _PTHREAD_H_ &&
!defined PTHREAD_MUTEX_INITIALIZER)
+
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#else
+
+#ifndef address@hidden@_SYS_SELECT_H
+
+/* On many platforms, <sys/select.h> assumes prior inclusion of
+ <sys/types.h>. Also, mingw defines sigset_t there, instead of
+ in <signal.h> where it belongs. */
+#include <sys/types.h>
+
+#if @HAVE_SYS_SELECT_H@
+
+/* On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ of 'struct timeval', and no definition of this type.
+ Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select()
+ in <sys/time.h>.
+ But avoid namespace pollution on glibc systems. */
+# ifndef __GLIBC__
+# include <sys/time.h>
+# endif
+
+/* On AIX 7 and Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>.
+ But in any case avoid namespace pollution on glibc systems. */
+# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __osf__
|| defined __BEOS__) \
+ && ! defined __GLIBC__
+# include <string.h>
+# endif
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#endif
+
+/* Get definition of 'sigset_t'.
+ But avoid namespace pollution on glibc systems.
+ Do this after the include_next (for the sake of OpenBSD 5.0) but before
+ the split double-inclusion guard (for the sake of Solaris). */
+#if !(defined __GLIBC__ && !defined __UCLIBC__)
+# include <signal.h>
+#endif
+
+#ifndef address@hidden@_SYS_SELECT_H
+#define address@hidden@_SYS_SELECT_H
+
+#if address@hidden@
+/* A platform that lacks <sys/select.h>. */
+/* Get the 'struct timeval' and 'fd_set' types and the FD_* macros
+ on most platforms. */
+# include <sys/time.h>
+/* On HP-UX 11, <sys/time.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>. */
+# if defined __hpux
+# include <string.h>
+# endif
+/* On native Windows platforms:
+ Get the 'fd_set' type.
+ Get the close() declaration before we override it. */
+# if @HAVE_WINSOCK2_H@
+# if !defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+# endif
+# include <io.h>
+# endif
+#endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Fix some definitions from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+
+# if !GNULIB_defined_rpl_fd_isset
+
+/* Re-define FD_ISSET to avoid a WSA call while we are not using
+ network sockets. */
+static int
+rpl_fd_isset (SOCKET fd, fd_set * set)
+{
+ u_int i;
+ if (set == NULL)
+ return 0;
+
+ for (i = 0; i < set->fd_count; i++)
+ if (set->fd_array[i] == fd)
+ return 1;
+
+ return 0;
+}
+
+# define GNULIB_defined_rpl_fd_isset 1
+# endif
+
+# undef FD_ISSET
+# define FD_ISSET(fd, set) rpl_fd_isset(fd, set)
+
+#endif
+
+/* Hide some function declarations from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+# if !defined address@hidden@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (close,
+ "close() used without including <unistd.h>");
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (gethostname,
+ "gethostname() used without including <unistd.h>");
+# endif
+# endif
+# if !defined address@hidden@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
+ _GL_WARN_ON_USE (socket,
+ "socket() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (connect,
+ "connect() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (accept,
+ "accept() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (bind,
+ "bind() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getpeername,
+ "getpeername() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockname,
+ "getsockname() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockopt,
+ "getsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (listen,
+ "listen() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recv,
+ "recv() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (send,
+ "send() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recvfrom,
+ "recvfrom() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (sendto,
+ "sendto() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (setsockopt,
+ "setsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (shutdown,
+ "shutdown() used without including <sys/socket.h>");
+# endif
+# endif
+#endif
+
+
+#if @GNULIB_PSELECT@
+# if @REPLACE_PSELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pselect
+# define pselect rpl_pselect
+# endif
+_GL_FUNCDECL_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+_GL_CXXALIAS_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# else
+# if address@hidden@
+_GL_FUNCDECL_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIAS_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIASWARN (pselect);
+#elif defined GNULIB_POSIXCHECK
+# undef pselect
+# if HAVE_RAW_DECL_PSELECT
+_GL_WARN_ON_USE (pselect, "pselect is not portable - "
+ "use gnulib module pselect for portability");
+# endif
+#endif
+
+#if @GNULIB_SELECT@
+# if @REPLACE_SELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select rpl_select
+# endif
+_GL_FUNCDECL_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+_GL_CXXALIAS_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# else
+_GL_CXXALIAS_SYS (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# endif
+_GL_CXXALIASWARN (select);
+#elif @HAVE_WINSOCK2_H@
+# undef select
+# define select select_used_without_requesting_gnulib_module_select
+#elif defined GNULIB_POSIXCHECK
+# undef select
+# if HAVE_RAW_DECL_SELECT
+_GL_WARN_ON_USE (select, "select is not always POSIX compliant - "
+ "use gnulib module select for portability");
+# endif
+#endif
+
+
+#endif /* address@hidden@_SYS_SELECT_H */
+#endif /* address@hidden@_SYS_SELECT_H */
+#endif /* OSF/1 */
diff --git a/lib/sys_socket.c b/lib/sys_socket.c
new file mode 100644
index 0000000..3f017f8
--- /dev/null
+++ b/lib/sys_socket.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_SYS_SOCKET_INLINE _GL_EXTERN_INLINE
+#include "sys/socket.h"
diff --git a/lib/sys_socket.in.h b/lib/sys_socket.in.h
index a0bcffb..31ed042 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2013 Free Software Foundation, Inc.
Written by Simon Josefsson.
This program is free software; you can redistribute it and/or modify
@@ -63,6 +63,11 @@
#ifndef address@hidden@_SYS_SOCKET_H
#define address@hidden@_SYS_SOCKET_H
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_SYS_SOCKET_INLINE
+# define _GL_SYS_SOCKET_INLINE _GL_INLINE
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_ARG_NONNULL is copied here. */
@@ -201,7 +206,7 @@ struct msghdr {
/* Re-define FD_ISSET to avoid a WSA call while we are not using
network sockets. */
-static inline int
+_GL_SYS_SOCKET_INLINE int
rpl_fd_isset (SOCKET fd, fd_set * set)
{
u_int i;
@@ -677,6 +682,8 @@ _GL_WARN_ON_USE (accept4, "accept4 is unportable - "
# endif
#endif
+_GL_INLINE_HEADER_END
+
#endif /* address@hidden@_SYS_SOCKET_H */
#endif /* address@hidden@_SYS_SOCKET_H */
#endif
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 97fb3c4..12f99da 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2013 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
@@ -150,6 +150,10 @@
# endif
#endif
+#ifndef S_ISMPX /* AIX */
+# define S_ISMPX(m) 0
+#endif
+
#ifndef S_ISNAM /* Xenix */
# ifdef S_IFNAM
# define S_ISNAM(m) (((m) & S_IFMT) == S_IFNAM)
@@ -497,7 +501,7 @@ _GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t
mode));
# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
# if !GNULIB_defined_rpl_mkdir
-static inline int
+static int
rpl_mkdir (char const *name, mode_t mode)
{
return _mkdir (name);
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
index 3dbbf91..f2398c5 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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
@@ -17,37 +17,34 @@
/* Written by Paul Eggert. */
+#ifndef address@hidden@_SYS_TIME_H
+
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
@PRAGMA_COLUMNS@
-#if defined address@hidden@_SYS_TIME_H
-
-/* Simply delegate to the system's header, without adding anything. */
-# if @HAVE_SYS_TIME_H@
-# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
-# endif
-
-#else
+/* The include_next requires a split double-inclusion guard. */
+#if @HAVE_SYS_TIME_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+#endif
-# define address@hidden@_SYS_TIME_H
+#ifndef address@hidden@_SYS_TIME_H
+#define address@hidden@_SYS_TIME_H
-# if @HAVE_SYS_TIME_H@
-# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
-# else
-# include <time.h>
-# endif
+#if ! @HAVE_SYS_TIME_H@
+# include <time.h>
+#endif
/* On native Windows with MSVC, get the 'struct timeval' type.
Also, on native Windows with a 64-bit time_t, where we are overriding the
'struct timeval' type, get all declarations of system functions whose
signature contains 'struct timeval'. */
-# if (defined _MSC_VER || @REPLACE_STRUCT_TIMEVAL@) && @HAVE_WINSOCK2_H@ &&
!defined _GL_INCLUDING_WINSOCK2_H
-# define _GL_INCLUDING_WINSOCK2_H
-# include <winsock2.h>
-# undef _GL_INCLUDING_WINSOCK2_H
-# endif
+#if (defined _MSC_VER || @REPLACE_STRUCT_TIMEVAL@) && @HAVE_WINSOCK2_H@ &&
!defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+#endif
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -55,112 +52,112 @@
/* The definition of _GL_WARN_ON_USE is copied here. */
-# ifdef __cplusplus
+#ifdef __cplusplus
extern "C" {
-# endif
+#endif
-# if address@hidden@ || @REPLACE_STRUCT_TIMEVAL@
+#if address@hidden@ || @REPLACE_STRUCT_TIMEVAL@
-# if @REPLACE_STRUCT_TIMEVAL@
-# define timeval rpl_timeval
-# endif
+# if @REPLACE_STRUCT_TIMEVAL@
+# define timeval rpl_timeval
+# endif
-# if !GNULIB_defined_struct_timeval
+# if !GNULIB_defined_struct_timeval
struct timeval
{
time_t tv_sec;
long int tv_usec;
};
-# define GNULIB_defined_struct_timeval 1
-# endif
-
+# define GNULIB_defined_struct_timeval 1
# endif
-# ifdef __cplusplus
+#endif
+
+#ifdef __cplusplus
}
-# endif
+#endif
-# if @GNULIB_GETTIMEOFDAY@
-# if @REPLACE_GETTIMEOFDAY@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef gettimeofday
-# define gettimeofday rpl_gettimeofday
-# endif
+#if @GNULIB_GETTIMEOFDAY@
+# if @REPLACE_GETTIMEOFDAY@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gettimeofday
+# define gettimeofday rpl_gettimeofday
+# endif
_GL_FUNCDECL_RPL (gettimeofday, int,
(struct timeval *restrict, void *restrict)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (gettimeofday, int,
(struct timeval *restrict, void *restrict));
-# else
-# if address@hidden@
+# else
+# if address@hidden@
_GL_FUNCDECL_SYS (gettimeofday, int,
(struct timeval *restrict, void *restrict)
_GL_ARG_NONNULL ((1)));
-# endif
+# endif
/* Need to cast, because on glibc systems, by default, the second argument is
struct timezone *. */
_GL_CXXALIAS_SYS_CAST (gettimeofday, int,
(struct timeval *restrict, void *restrict));
-# endif
+# endif
_GL_CXXALIASWARN (gettimeofday);
-# elif defined GNULIB_POSIXCHECK
-# undef gettimeofday
-# if HAVE_RAW_DECL_GETTIMEOFDAY
+#elif defined GNULIB_POSIXCHECK
+# undef gettimeofday
+# if HAVE_RAW_DECL_GETTIMEOFDAY
_GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - "
"use gnulib module gettimeofday for portability");
-# endif
# endif
+#endif
/* Hide some function declarations from <winsock2.h>. */
-# if defined _MSC_VER && @HAVE_WINSOCK2_H@
-# if !defined address@hidden@_UNISTD_H
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef close
-# define close close_used_without_including_unistd_h
-# else
+#if defined _MSC_VER && @HAVE_WINSOCK2_H@
+# if !defined address@hidden@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
_GL_WARN_ON_USE (close,
"close() used without including <unistd.h>");
-# endif
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef gethostname
-# define gethostname gethostname_used_without_including_unistd_h
-# else
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
_GL_WARN_ON_USE (gethostname,
"gethostname() used without including <unistd.h>");
-# endif
# endif
-# if !defined address@hidden@_SYS_SOCKET_H
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef socket
-# define socket socket_used_without_including_sys_socket_h
-# undef connect
-# define connect connect_used_without_including_sys_socket_h
-# undef accept
-# define accept accept_used_without_including_sys_socket_h
-# undef bind
-# define bind bind_used_without_including_sys_socket_h
-# undef getpeername
-# define getpeername getpeername_used_without_including_sys_socket_h
-# undef getsockname
-# define getsockname getsockname_used_without_including_sys_socket_h
-# undef getsockopt
-# define getsockopt getsockopt_used_without_including_sys_socket_h
-# undef listen
-# define listen listen_used_without_including_sys_socket_h
-# undef recv
-# define recv recv_used_without_including_sys_socket_h
-# undef send
-# define send send_used_without_including_sys_socket_h
-# undef recvfrom
-# define recvfrom recvfrom_used_without_including_sys_socket_h
-# undef sendto
-# define sendto sendto_used_without_including_sys_socket_h
-# undef setsockopt
-# define setsockopt setsockopt_used_without_including_sys_socket_h
-# undef shutdown
-# define shutdown shutdown_used_without_including_sys_socket_h
-# else
+# endif
+# if !defined address@hidden@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
_GL_WARN_ON_USE (socket,
"socket() used without including <sys/socket.h>");
_GL_WARN_ON_USE (connect,
@@ -189,17 +186,18 @@ _GL_WARN_ON_USE (gettimeofday, "gettimeofday is
unportable - "
"setsockopt() used without including <sys/socket.h>");
_GL_WARN_ON_USE (shutdown,
"shutdown() used without including <sys/socket.h>");
-# endif
# endif
-# if !defined address@hidden@_SYS_SELECT_H
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef select
-# define select select_used_without_including_sys_select_h
-# else
+# endif
+# if !defined address@hidden@_SYS_SELECT_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select select_used_without_including_sys_select_h
+# else
_GL_WARN_ON_USE (select,
"select() used without including <sys/select.h>");
-# endif
# endif
# endif
+#endif
#endif /* address@hidden@_SYS_TIME_H */
+#endif /* address@hidden@_SYS_TIME_H */
diff --git a/lib/sys_times.in.h b/lib/sys_times.in.h
new file mode 100644
index 0000000..8ea8088
--- /dev/null
+++ b/lib/sys_times.in.h
@@ -0,0 +1,80 @@
+/* Provide a sys/times.h header file.
+ Copyright (C) 2008-2013 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 Simon Josefsson <address@hidden>, 2008. */
+
+/* This file is supposed to be used on platforms where <sys/times.h>
+ is missing. */
+
+#ifndef address@hidden@_SYS_TIMES_H
+
+# if __GNUC__ >= 3
address@hidden@
+# endif
address@hidden@
+
+# if @HAVE_SYS_TIMES_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIMES_H@
+# endif
+
+# define address@hidden@_SYS_TIMES_H
+
+/* Get clock_t.
+ But avoid namespace pollution on glibc systems. */
+# ifndef __GLIBC__
+# include <time.h>
+# endif
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if address@hidden@
+# if !GNULIB_defined_struct_tms
+ /* Structure describing CPU time used by a process and its children. */
+ struct tms
+ {
+ clock_t tms_utime; /* User CPU time. */
+ clock_t tms_stime; /* System CPU time. */
+
+ clock_t tms_cutime; /* User CPU time of dead children. */
+ clock_t tms_cstime; /* System CPU time of dead children. */
+ };
+# define GNULIB_defined_struct_tms 1
+# endif
+# endif
+
+# if @GNULIB_TIMES@
+# if address@hidden@
+ extern clock_t times (struct tms *buffer) _GL_ARG_NONNULL ((1));
+# endif
+# elif defined GNULIB_POSIXCHECK
+# undef times
+# if HAVE_RAW_DECL_TIMES
+_GL_WARN_ON_USE (times, "times is unportable - "
+ "use gnulib module times for portability");
+# endif
+# endif
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif /* address@hidden@_SYS_TIMES_H */
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
index 6eedaeb..520f6c8 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 73c34be..6f605df 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2013 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 11c6ca1..71dcc36 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -1,6 +1,6 @@
/* A more-standard <time.h>.
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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_r.c b/lib/time_r.c
index 267c18d..9a61794 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2010-2013 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
new file mode 100644
index 0000000..cf2fa1d
--- /dev/null
+++ b/lib/times.c
@@ -0,0 +1,66 @@
+/* Get process times
+
+ Copyright (C) 2008-2013 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 Simon Josefsson <address@hidden>, 2008. */
+
+#include <config.h>
+
+/* Get times prototype. */
+#include <sys/times.h>
+
+/* Get round. */
+#include <math.h>
+
+/* Get GetProcessTimes etc. */
+#include <windows.h>
+
+static clock_t
+filetime2clock (FILETIME time)
+{
+ float f;
+
+ /* We have a 64-bit value, in the form of two DWORDS aka unsigned
+ int, counting the number of 100-nanosecond intervals. We need to
+ convert these to clock ticks. Older POSIX uses CLK_TCK to
+ indicate the number of clock ticks per second while modern POSIX
+ uses sysconf(_SC_CLK_TCK). Mingw32 does not appear to have
+ sysconf(_SC_CLK_TCK), but appears to have CLK_TCK = 1000 so we
+ use it. Note that CLOCKS_PER_SEC constant does not apply here,
+ it is for use with the clock function. */
+
+ f = (unsigned long long) time.dwHighDateTime << 32;
+ f += time.dwLowDateTime;
+ f = f * CLK_TCK / 10000000;
+ return (clock_t) round (f);
+}
+
+clock_t
+times (struct tms * buffer)
+{
+ FILETIME creation_time, exit_time, kernel_time, user_time;
+
+ if (GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time,
+ &kernel_time, &user_time) == 0)
+ return (clock_t) -1;
+
+ buffer->tms_utime = filetime2clock (user_time);
+ buffer->tms_stime = filetime2clock (kernel_time);
+ buffer->tms_cutime = 0;
+ buffer->tms_cstime = 0;
+
+ return filetime2clock (creation_time);
+}
diff --git a/lib/trunc.c b/lib/trunc.c
index 3b86ef0..26a784b 100644
--- a/lib/trunc.c
+++ b/lib/trunc.c
@@ -1,5 +1,5 @@
/* Round towards zero.
- Copyright (C) 2007, 2010-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2010-2013 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.c b/lib/unistd.c
new file mode 100644
index 0000000..6c6a8e2
--- /dev/null
+++ b/lib/unistd.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_UNISTD_INLINE _GL_EXTERN_INLINE
+#include "unistd.h"
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index e96a39c..84bed4a 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003-2013 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
@@ -14,29 +14,13 @@
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/>. */
+#ifndef address@hidden@_UNISTD_H
+
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
@PRAGMA_COLUMNS@
-/* Special invocation convention:
- - On mingw, several headers, including <winsock2.h>, include <unistd.h>,
- but we need to ensure that both the system <unistd.h> and <winsock2.h>
- are completely included before we replace gethostname. */
-#if @GNULIB_GETHOSTNAME@ && @UNISTD_H_HAVE_WINSOCK2_H@ \
- && !defined _GL_WINSOCK2_H_WITNESS && defined _WINSOCK2_H
-/* <unistd.h> is being indirectly included for the first time from
- <winsock2.h>; avoid declaring any overrides. */
-# if @HAVE_UNISTD_H@
-# @INCLUDE_NEXT@ @NEXT_UNISTD_H@
-# else
-# error unexpected; report this to address@hidden
-# endif
-# define _GL_WINSOCK2_H_WITNESS
-
-/* Normal invocation. */
-#elif !defined address@hidden@_UNISTD_H
-
/* The include_next requires a split double-inclusion guard. */
#if @HAVE_UNISTD_H@
# @INCLUDE_NEXT@ @NEXT_UNISTD_H@
@@ -79,7 +63,9 @@
/* Solaris declares getcwd not only in <unistd.h> but also in <stdlib.h>. */
/* But avoid namespace pollution on glibc systems. */
#ifndef __GLIBC__
+# define __need_system_stdlib_h
# include <stdlib.h>
+# undef __need_system_stdlib_h
#endif
/* Native Windows platforms declare chdir, getcwd, rmdir in
@@ -124,9 +110,15 @@
/* Get getopt(), optarg, optind, opterr, optopt.
But avoid namespace pollution on glibc systems. */
#if @GNULIB_UNISTD_H_GETOPT@ && !defined __GLIBC__ && !defined
_GL_SYSTEM_GETOPT
+# define __need_getopt
# include <getopt.h>
#endif
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_UNISTD_INLINE
+# define _GL_UNISTD_INLINE _GL_INLINE
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_ARG_NONNULL is copied here. */
@@ -404,7 +396,7 @@ extern char **environ;
# endif
#elif defined GNULIB_POSIXCHECK
# if HAVE_RAW_DECL_ENVIRON
-static inline char ***
+_GL_UNISTD_INLINE char ***
rpl_environ (void)
{
return &environ;
@@ -862,7 +854,7 @@ _GL_CXXALIAS_RPL (getpagesize, int, (void));
# define getpagesize() _gl_getpagesize ()
# else
# if !GNULIB_defined_getpagesize_function
-static inline int
+_GL_UNISTD_INLINE int
getpagesize ()
{
return _gl_getpagesize ();
@@ -1530,6 +1522,7 @@ _GL_CXXALIAS_SYS_CAST (write, ssize_t, (int fd, const
void *buf, size_t count));
_GL_CXXALIASWARN (write);
#endif
+_GL_INLINE_HEADER_END
#endif /* address@hidden@_UNISTD_H */
#endif /* address@hidden@_UNISTD_H */
diff --git a/lib/unistr.in.h b/lib/unistr.in.h
index 2706789..2d28b1f 100644
--- a/lib/unistr.in.h
+++ b/lib/unistr.in.h
@@ -1,5 +1,5 @@
/* Elementary Unicode string functions.
- Copyright (C) 2001-2002, 2005-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2005-2013 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 e68a8e2..0179498 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2006-2007, 2009-2013 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 38db03d..65f792c 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2002, 2006-2007, 2009-2013 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 6fbde71..8aecdd4 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2013 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 d286c27..2e644bb 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2013 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 f01cfe9..7b9d8a7 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999-2002, 2006-2007, 2009-2013 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 04def87..5e97909 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006-2007, 2009-2013 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 1a44ddb..a6d21a4 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006-2007, 2009-2013 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 4bfe261..5e6a825 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2005-2006, 2009-2013 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 c588589..50a59f1 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2005-2006, 2009-2013 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 1da25f5..2e6bc80 100644
--- a/lib/vasnprintf.c
+++ b/lib/vasnprintf.c
@@ -1,5 +1,5 @@
/* vsprintf with automatic memory allocation.
- Copyright (C) 1999, 2002-2012 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2002-2013 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
@@ -1530,7 +1530,7 @@ is_borderline (const char *digits, size_t precision)
/* Returns the number of TCHAR_T units needed as temporary space for the result
of sprintf or SNPRINTF of a single conversion directive. */
-static inline size_t
+static size_t
MAX_ROOM_NEEDED (const arguments *ap, size_t arg_index, FCHAR_T conversion,
arg_type type, int flags, size_t width, int has_precision,
size_t precision, int pad_ourselves)
diff --git a/lib/vasnprintf.h b/lib/vasnprintf.h
index 277f270..8571eb7 100644
--- a/lib/vasnprintf.h
+++ b/lib/vasnprintf.h
@@ -1,5 +1,5 @@
/* vsprintf with automatic memory allocation.
- Copyright (C) 2002-2004, 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2002-2004, 2007-2013 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 780b55e..40b8ef5 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -1,6 +1,6 @@
/* Compile-time assert-like macros.
- Copyright (C) 2005-2006, 2009-2012 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-2013 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/vsnprintf.c b/lib/vsnprintf.c
index 1d8db4e..4dd428c 100644
--- a/lib/vsnprintf.c
+++ b/lib/vsnprintf.c
@@ -1,5 +1,5 @@
/* Formatted output to strings.
- Copyright (C) 2004, 2006-2012 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2006-2013 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 b397115..76c6f9f 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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 5c93616..97f7dc8 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 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 a4d6bcd..0aab985 100644
--- a/lib/wcrtomb.c
+++ b/lib/wcrtomb.c
@@ -1,5 +1,5 @@
/* Convert wide character to multibyte character.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 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-h.c b/lib/wctype-h.c
new file mode 100644
index 0000000..bb5f847
--- /dev/null
+++ b/lib/wctype-h.c
@@ -0,0 +1,4 @@
+/* Normally this would be wctype.c, but that name's already taken. */
+#include <config.h>
+#define _GL_WCTYPE_INLINE _GL_EXTERN_INLINE
+#include "wctype.h"
diff --git a/lib/wctype.in.h b/lib/wctype.in.h
index e819d44..246ce9d 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-2012 Free Software Foundation, Inc.
+ Copyright (C) 2006-2013 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
@@ -54,6 +54,11 @@
#ifndef address@hidden@_WCTYPE_H
#define address@hidden@_WCTYPE_H
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_WCTYPE_INLINE
+# define _GL_WCTYPE_INLINE _GL_INLINE
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_WARN_ON_USE is copied here. */
@@ -148,7 +153,7 @@ typedef unsigned int rpl_wint_t;
# endif
# endif
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswalnum
# else
@@ -160,7 +165,7 @@ iswalnum
|| ((wc & ~0x20) >= 'A' && (wc & ~0x20) <= 'Z'));
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswalpha
# else
@@ -171,7 +176,7 @@ iswalpha
return (wc & ~0x20) >= 'A' && (wc & ~0x20) <= 'Z';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswblank
# else
@@ -182,7 +187,7 @@ iswblank
return wc == ' ' || wc == '\t';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswcntrl
# else
@@ -193,7 +198,7 @@ iswcntrl
return (wc & ~0x1f) == 0 || wc == 0x7f;
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswdigit
# else
@@ -204,7 +209,7 @@ iswdigit
return wc >= '0' && wc <= '9';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswgraph
# else
@@ -215,7 +220,7 @@ iswgraph
return wc >= '!' && wc <= '~';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswlower
# else
@@ -226,7 +231,7 @@ iswlower
return wc >= 'a' && wc <= 'z';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswprint
# else
@@ -237,7 +242,7 @@ iswprint
return wc >= ' ' && wc <= '~';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswpunct
# else
@@ -250,7 +255,7 @@ iswpunct
|| ((wc & ~0x20) >= 'A' && (wc & ~0x20) <= 'Z')));
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswspace
# else
@@ -262,7 +267,7 @@ iswspace
|| wc == '\n' || wc == '\v' || wc == '\f' || wc == '\r');
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswupper
# else
@@ -273,7 +278,7 @@ iswupper
return wc >= 'A' && wc <= 'Z';
}
-static inline int
+_GL_WCTYPE_INLINE int
# if @REPLACE_ISWCNTRL@
rpl_iswxdigit
# else
@@ -285,7 +290,7 @@ iswxdigit
|| ((wc & ~0x20) >= 'A' && (wc & ~0x20) <= 'F'));
}
-static inline wint_t
+_GL_WCTYPE_INLINE wint_t
# if @REPLACE_TOWLOWER@
rpl_towlower
# else
@@ -296,7 +301,7 @@ towlower
return (wc >= 'A' && wc <= 'Z' ? wc - 'A' + 'a' : wc);
}
-static inline wint_t
+_GL_WCTYPE_INLINE wint_t
# if @REPLACE_TOWLOWER@
rpl_towupper
# else
@@ -336,7 +341,7 @@ _GL_FUNCDECL_SYS (iswblank, int, (wint_t wc));
result register. We need to fix this by adding a zero-extend from
wchar_t to wint_t after the call. */
-static inline wint_t
+_GL_WCTYPE_INLINE wint_t
rpl_towlower (wint_t wc)
{
return (wint_t) (wchar_t) towlower (wc);
@@ -345,7 +350,7 @@ rpl_towlower (wint_t wc)
# define towlower rpl_towlower
# endif
-static inline wint_t
+_GL_WCTYPE_INLINE wint_t
rpl_towupper (wint_t wc)
{
return (wint_t) (wchar_t) towupper (wc);
@@ -493,6 +498,7 @@ _GL_WARN_ON_USE (towctrans, "towctrans is unportable - "
# endif
#endif
+_GL_INLINE_HEADER_END
#endif /* address@hidden@_WCTYPE_H */
#endif /* address@hidden@_WCTYPE_H */
diff --git a/lib/write.c b/lib/write.c
index 2473cdb..d7d00de 100644
--- a/lib/write.c
+++ b/lib/write.c
@@ -1,5 +1,5 @@
/* POSIX compatible write() function.
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2013 Free Software Foundation, Inc.
Written by Bruno Haible <address@hidden>, 2008.
This program is free software: you can redistribute it and/or modify
@@ -40,7 +40,7 @@
# undef write
# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline ssize_t
+static ssize_t
write_nothrow (int fd, const void *buf, size_t count)
{
ssize_t result;
diff --git a/lib/xsize.h b/lib/xsize.h
index 8312243..a7a34c5 100644
--- a/lib/xsize.h
+++ b/lib/xsize.h
@@ -1,6 +1,6 @@
/* xsize.h -- Checked size_t computations.
- Copyright (C) 2003, 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2008-2013 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/libguile/Makefile.am b/libguile/Makefile.am
index d42c650..6f914e0 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -93,7 +93,7 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c
c-tokenize.$(OBJEXT): c-tokenize.c
$(AM_V_GEN) \
if [ "$(cross_compiling)" = "yes" ]; then \
- $(CC_FOR_BUILD) -c -o $@ $<; \
+ $(CC_FOR_BUILD) -I$(top_builddir) -c -o $@ $<; \
else \
$(COMPILE) -c -o $@ $<; \
fi
@@ -436,12 +436,16 @@ BUILT_SOURCES = cpp-E.c cpp-SIG.c libpath.h \
scmconfig.h \
$(DOT_I_FILES) $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
+# Force the generation of `guile-procedures.texi' because the top-level
+# Makefile expects it to be built.
+all-local: guile-procedures.texi
+
address@hidden@_la_SOURCES = _scm.h \
memmove.c strerror.c \
dynl.c regex-posix.c \
posix.c net_db.c socket.c \
debug-malloc.c mkstemp.c \
- win32-uname.c win32-socket.c \
+ win32-uname.c \
locale-categories.h
## delete guile-snarf.awk from the installation bindir, in case it's
@@ -458,7 +462,7 @@ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c
\
elf.h \
srfi-14.i.c \
quicksort.i.c \
- win32-uname.h win32-socket.h \
+ win32-uname.h \
private-gc.h private-options.h
# vm instructions
@@ -723,25 +727,9 @@ guile.texi: $(alldotdocfiles) guile$(EXEEXT)
guile-procedures.texi: $(alldotdocfiles) guile$(EXEEXT)
$(AM_V_GEN)$(dotdoc2texi) > $@ || { rm $@; false; }
-if HAVE_MAKEINFO
-
-guile-procedures.txt: guile-procedures.texi
- rm -f $@
- makeinfo --force -o $@ guile-procedures.texi || test -f $@
-
-else
-
-guile-procedures.txt: guile-procedures.texi
- cp guile-procedures.texi $@
-
-endif
-
c-tokenize.c: c-tokenize.lex
flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; }
-schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
-schemelib_DATA = guile-procedures.txt
-
## Add -MG to make the .x magic work with auto-dep code.
MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
diff --git a/libguile/__scm.h b/libguile/__scm.h
index b42b823..0a749be 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -371,7 +371,7 @@
#ifdef LONG_BIT
# define SCM_LONG_BIT LONG_BIT
#else
-# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
+# define SCM_LONG_BIT (SCM_SIZEOF_LONG * 8)
#endif
#define SCM_I_UTYPE_MAX(type) ((type)-1)
diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h
index 2e1fce2..7aa757f 100644
--- a/libguile/bdw-gc.h
+++ b/libguile/bdw-gc.h
@@ -1,7 +1,7 @@
#ifndef SCM_BDW_GC_H
#define SCM_BDW_GC_H
-/* Copyright (C) 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2006, 2008, 2009, 2011, 2012, 2013 Free Software Foundation,
Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -37,6 +37,11 @@
routines. */
# define GC_NO_THREAD_REDIRECTS 1
+#ifdef __MINGW32__
+/* Rely on pthreads-w32. */
+#define GC_WIN32_PTHREADS
+#endif
+
#endif
#include <gc/gc.h>
diff --git a/libguile/c-tokenize.lex b/libguile/c-tokenize.lex
index dc72257..856224e 100644
--- a/libguile/c-tokenize.lex
+++ b/libguile/c-tokenize.lex
@@ -14,7 +14,8 @@ FLOQUAL (f|F|l|L)
INTQUAL (l|L|ll|LL|lL|Ll|u|U)
%{
-
+#include <config.h>
+
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
diff --git a/libguile/debug.c b/libguile/debug.c
index 87513bf..b01864f 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -202,10 +202,14 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
SCM
scm_local_eval (SCM exp, SCM env)
{
- static SCM local_eval_var = SCM_BOOL_F;
+ static SCM local_eval_var = SCM_UNDEFINED;
+ static scm_i_pthread_mutex_t local_eval_var_mutex
+ = SCM_I_PTHREAD_MUTEX_INITIALIZER;
- if (scm_is_false (local_eval_var))
+ 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);
return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
}
diff --git a/libguile/error.c b/libguile/error.c
index 790ed05..0df4c73 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2004, 2006, 2010,
- * 2012 Free Software Foundation, Inc.
+ * 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -100,17 +100,6 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
}
#undef FUNC_NAME
-#if defined __MINGW32__ && defined HAVE_NETWORKING
-# include "win32-socket.h"
-# define SCM_I_STRERROR(err) \
- ((err >= WSABASEERR) ? scm_i_socket_strerror (err) : strerror (err))
-# define SCM_I_ERRNO() \
- (errno ? errno : scm_i_socket_errno ())
-#else
-# define SCM_I_STRERROR(err) strerror (err)
-# define SCM_I_ERRNO() errno
-#endif /* __MINGW32__ */
-
/* strerror may not be thread safe, for instance in glibc (version 2.3.2) an
error number not among the known values results in a string like "Unknown
error 9999" formed in a static buffer, which will be overwritten by a
@@ -136,7 +125,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
scm_dynwind_begin (0);
scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
- ret = scm_from_locale_string (SCM_I_STRERROR (scm_to_int (err)));
+ ret = scm_from_locale_string (strerror (scm_to_int (err)));
scm_dynwind_end ();
return ret;
@@ -147,7 +136,7 @@ SCM_GLOBAL_SYMBOL (scm_system_error_key, "system-error");
void
scm_syserror (const char *subr)
{
- SCM err = scm_from_int (SCM_I_ERRNO ());
+ SCM err = scm_from_int (errno);
/* It could be that we're getting here because the syscall was
interrupted by a signal. In that case a signal handler might have
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 3d5b1fb..09a0de0 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
- * 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -45,7 +45,6 @@
#include "libguile/feature.h"
#include "libguile/fports.h"
#include "libguile/private-gc.h" /* for SCM_MAX */
-#include "libguile/iselect.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/dynwind.h"
@@ -81,9 +80,7 @@
#include <libc.h>
#endif
-#ifdef HAVE_SYS_SELECT_H
#include <sys/select.h>
-#endif
#ifdef HAVE_STRING_H
#include <string.h>
@@ -101,6 +98,18 @@
#define NAMLEN(dirent) strlen ((dirent)->d_name)
+#ifdef HAVE_SYS_SENDFILE_H
+# include <sys/sendfile.h>
+#endif
+
+/* Glibc's `sendfile' function. */
+#define sendfile_or_sendfile64 \
+ CHOOSE_LARGEFILE (sendfile, sendfile64)
+
+#include <full-read.h>
+#include <full-write.h>
+
+
/* Some more definitions for the native Windows port. */
#ifdef __MINGW32__
# define fsync(fd) _commit (fd)
@@ -435,30 +444,17 @@ scm_stat2scm (struct stat_or_stat64 *stat_temp)
return ans;
}
-#ifdef __MINGW32__
-/*
- * Try getting the appropiate stat buffer for a given file descriptor
- * under Windows. It differentiates between file, pipe and socket
- * descriptors.
- */
-static int fstat_Win32 (int fdes, struct stat *buf)
+static int
+is_file_name_separator (SCM c)
{
- int error, optlen = sizeof (int);
-
- memset (buf, 0, sizeof (struct stat));
-
- /* Is this a socket ? */
- if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0)
- {
- buf->st_mode = _S_IREAD | _S_IWRITE | _S_IEXEC;
- buf->st_nlink = 1;
- buf->st_atime = buf->st_ctime = buf->st_mtime = time (NULL);
- return 0;
- }
- /* Maybe a regular file or pipe ? */
- return fstat (fdes, buf);
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('/')))
+ return 1;
+#ifdef __MINGW32__
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('\\')))
+ return 1;
+#endif
+ return 0;
}
-#endif /* __MINGW32__ */
SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
(SCM object, SCM exception_on_error),
@@ -532,21 +528,11 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
if (scm_is_integer (object))
{
-#ifdef __MINGW32__
- SCM_SYSCALL (rv = fstat_Win32 (scm_to_int (object), &stat_temp));
-#else
SCM_SYSCALL (rv = fstat_or_fstat64 (scm_to_int (object), &stat_temp));
-#endif
}
else if (scm_is_string (object))
{
char *file = scm_to_locale_string (object);
-#ifdef __MINGW32__
- char *p;
- p = file + strlen (file) - 1;
- while (p > file && (*p == '/' || *p == '\\'))
- *p-- = '\0';
-#endif
SCM_SYSCALL (rv = stat_or_stat64 (file, &stat_temp));
free (file);
}
@@ -555,11 +541,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_OPFPORT (1, object);
fdes = SCM_FPORT_FDES (object);
-#ifdef __MINGW32__
- SCM_SYSCALL (rv = fstat_Win32 (fdes, &stat_temp));
-#else
SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
-#endif
}
if (rv == -1)
@@ -653,15 +635,13 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
-#ifdef HAVE_SELECT
-
/* check that element is a port or file descriptor. if it's a port
and its buffer is ready for use, add it to the ports_ready list.
otherwise add its file descriptor to *set. the type of list can be
determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes,
SCM_ARG3 for excepts. */
static int
-set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos)
+set_element (fd_set *set, SCM *ports_ready, SCM element, int pos)
{
int fd;
@@ -707,7 +687,7 @@ set_element (SELECT_TYPE *set, SCM *ports_ready, SCM
element, int pos)
determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes,
SCM_ARG3 for excepts. */
static int
-fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
+fill_select_type (fd_set *set, SCM *ports_ready, SCM list_or_vec, int pos)
{
int max_fd = 0;
@@ -742,7 +722,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM
list_or_vec, int pos)
/* if element (a file descriptor or port) appears in *set, cons it to
list. return list. */
static SCM
-get_element (SELECT_TYPE *set, SCM element, SCM list)
+get_element (fd_set *set, SCM element, SCM list)
{
int fd;
@@ -768,7 +748,7 @@ get_element (SELECT_TYPE *set, SCM element, SCM list)
*set and appending them to ports_ready. result is converted to a
vector if list_or_vec is a vector. */
static SCM
-retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
+retrieve_select_type (fd_set *set, SCM ports_ready, SCM list_or_vec)
{
SCM answer_list = ports_ready;
@@ -829,9 +809,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
{
struct timeval timeout;
struct timeval * time_ptr;
- SELECT_TYPE read_set;
- SELECT_TYPE write_set;
- SELECT_TYPE except_set;
+ fd_set read_set;
+ fd_set write_set;
+ fd_set except_set;
int read_count;
int write_count;
int except_count;
@@ -922,9 +902,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
}
{
- int rv = scm_std_select (max_fd + 1,
- &read_set, &write_set, &except_set,
- time_ptr);
+ int rv = select (max_fd + 1,
+ &read_set, &write_set, &except_set,
+ time_ptr);
if (rv < 0)
SCM_SYSERROR;
}
@@ -933,7 +913,6 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
retrieve_select_type (&except_set, SCM_EOL, excepts));
}
#undef FUNC_NAME
-#endif /* HAVE_SELECT */
@@ -1095,15 +1074,11 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
c_newfile = scm_to_locale_string (newfile);
scm_dynwind_free (c_newfile);
- oldfd = open_or_open64 (c_oldfile, O_RDONLY);
+ oldfd = open_or_open64 (c_oldfile, O_RDONLY | O_BINARY);
if (oldfd == -1)
SCM_SYSERROR;
-#ifdef __MINGW32__
- SCM_SYSCALL (rv = fstat_Win32 (oldfd, &oldstat));
-#else
SCM_SYSCALL (rv = fstat_or_fstat64 (oldfd, &oldstat));
-#endif
if (rv == -1)
goto err_close_oldfd;
@@ -1133,6 +1108,90 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
+ (SCM out, SCM in, SCM count, SCM offset),
+ "Send @var{count} bytes from @var{in} to @var{out}, both of which "
+ "are either open file ports or file descriptors. When "
+ "@var{offset} is omitted, start reading from @var{in}'s current "
+ "position; otherwise, start reading at @var{offset}.")
+#define FUNC_NAME s_scm_sendfile
+{
+#define VALIDATE_FD_OR_PORT(cvar, svar, pos) \
+ if (scm_is_integer (svar)) \
+ cvar = scm_to_int (svar); \
+ else \
+ { \
+ SCM_VALIDATE_OPFPORT (pos, svar); \
+ scm_flush (svar); \
+ cvar = SCM_FPORT_FDES (svar); \
+ }
+
+ size_t c_count;
+ scm_t_off c_offset;
+ ssize_t result;
+ int in_fd, out_fd;
+
+ VALIDATE_FD_OR_PORT (out_fd, out, 1);
+ VALIDATE_FD_OR_PORT (in_fd, in, 2);
+ c_count = scm_to_size_t (count);
+ c_offset = SCM_UNBNDP (offset) ? 0 : scm_to_off_t (offset);
+
+#if defined HAVE_SYS_SENDFILE_H && defined HAVE_SENDFILE
+ /* The Linux-style sendfile(2), which is different from the BSD-style. */
+
+ result = sendfile_or_sendfile64 (out_fd, in_fd,
+ SCM_UNBNDP (offset) ? NULL : &c_offset,
+ c_count);
+
+ /* Quoting the Linux man page: "In Linux kernels before 2.6.33, out_fd
+ must refer to a socket. Since Linux 2.6.33 it can be any file."
+ Fall back to read(2) and write(2) when such an error occurs. */
+ if (result < 0 && errno != EINVAL && errno != ENOSYS)
+ SCM_SYSERROR;
+ else if (result < 0)
+#endif
+ {
+ char buf[8192];
+ size_t result, left;
+
+ if (!SCM_UNBNDP (offset))
+ {
+ if (SCM_PORTP (in))
+ scm_seek (in, offset, scm_from_int (SEEK_SET));
+ else
+ {
+ if (lseek_or_lseek64 (in_fd, c_offset, SEEK_SET) < 0)
+ SCM_SYSERROR;
+ }
+ }
+
+ for (result = 0, left = c_count; result < c_count; )
+ {
+ size_t asked, obtained;
+
+ asked = SCM_MIN (sizeof buf, left);
+ obtained = full_read (in_fd, buf, asked);
+ if (obtained < asked)
+ SCM_SYSERROR;
+
+ left -= obtained;
+
+ obtained = full_write (out_fd, buf, asked);
+ if (obtained < asked)
+ SCM_SYSERROR;
+
+ result += obtained;
+ }
+
+ return scm_from_size_t (result);
+ }
+
+ return scm_from_ssize_t (result);
+
+#undef VALIDATE_FD_OR_PORT
+}
+#undef FUNC_NAME
+
#endif /* HAVE_POSIX */
@@ -1434,6 +1493,24 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
SCM scm_dot_string;
+#ifdef __MINGW32__
+SCM_SYMBOL (sym_file_name_convention, "windows");
+#else
+SCM_SYMBOL (sym_file_name_convention, "posix");
+#endif
+
+SCM_INTERNAL SCM scm_system_file_name_convention (void);
+
+SCM_DEFINE (scm_system_file_name_convention,
+ "system-file-name-convention", 0, 0, 0, (void),
+ "Return either @code{posix} or @code{windows}, depending on\n"
+ "what kind of system this Guile is running on.")
+#define FUNC_NAME s_scm_system_file_name_convention
+{
+ return sym_file_name_convention;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
(SCM filename),
"Return the directory name component of the file name\n"
@@ -1449,32 +1526,17 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
len = scm_i_string_length (filename);
i = len - 1;
-#ifdef __MINGW32__
- while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
- || scm_i_string_ref (filename, i) == '\\'))
- --i;
- while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
- && scm_i_string_ref (filename, i) != '\\'))
- --i;
- while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
- || scm_i_string_ref (filename, i) == '\\'))
- --i;
-#else
- while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+
+ while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i)))
--i;
- while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+ while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i)))
--i;
- while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+ while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i)))
--i;
-#endif /* ndef __MINGW32__ */
+
if (i < 0)
{
-#ifdef __MINGW32__
- if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
- || scm_i_string_ref (filename, 0) == '\\'))
-#else
- if (len > 0 && scm_i_string_ref (filename, 0) == '/')
-#endif /* ndef __MINGW32__ */
+ if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0)))
return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
@@ -1505,14 +1567,8 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
j = scm_i_string_length (suffix) - 1;
}
i = len - 1;
-#ifdef __MINGW32__
- while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
- || scm_i_string_ref (filename, i) == '\\'))
+ while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i)))
--i;
-#else
- while (i >= 0 && scm_i_string_ref (filename, i) == '/')
- --i;
-#endif /* ndef __MINGW32__ */
end = i;
while (i >= 0 && j >= 0
&& (scm_i_string_ref (filename, i)
@@ -1523,22 +1579,11 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
}
if (j == -1)
end = i;
-#ifdef __MINGW32__
- while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
- && scm_i_string_ref (filename, i) != '\\'))
- --i;
-#else
- while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+ while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i)))
--i;
-#endif /* ndef __MINGW32__ */
if (i == end)
{
-#ifdef __MINGW32__
- if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
- || scm_i_string_ref (filename, 0) == '\\'))
-#else
- if (len > 0 && scm_i_string_ref (filename, 0) == '/')
-#endif /* ndef __MINGW32__ */
+ if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0)))
return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
@@ -1605,14 +1650,7 @@ scm_i_relativize_path (SCM path, SCM in_path)
will be delimited by single delimiters. When DIR does not
have a trailing delimiter, add one to the length to strip
off the delimiter within SCANON. */
- if (
-#ifdef __MINGW32__
- (scm_i_string_ref (dir, len - 1) != '/'
- && scm_i_string_ref (dir, len - 1) != '\\')
-#else
- scm_i_string_ref (dir, len - 1) != '/'
-#endif
- )
+ if (!is_file_name_separator (scm_c_string_ref (dir, len - 1)))
len++;
if (scm_c_string_length (scanon) > len)
diff --git a/libguile/filesys.h b/libguile/filesys.h
index c420992..fc66e40 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -3,7 +3,8 @@
#ifndef SCM_FILESYS_H
#define SCM_FILESYS_H
-/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
+ * 2010, 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -66,6 +67,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
SCM_API SCM scm_dirname (SCM filename);
SCM_API SCM scm_basename (SCM filename, SCM suffix);
SCM_API SCM scm_canonicalize_path (SCM path);
+SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
SCM_INTERNAL void scm_init_filesys (void);
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 8e36acd..146854b 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010,
2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010,
+ * 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -304,22 +305,24 @@ apply_thunk (void *thunk)
size_t
scm_prepare_fluids (size_t n, SCM *fluids, SCM *values)
{
- size_t j = n;
+ size_t j;
/* Ensure that there are no duplicates in the fluids set -- an N^2 operation,
but N will usually be small, so perhaps that's OK. */
- while (j--)
+ for (j = n; j--;)
{
size_t i;
if (SCM_UNLIKELY (!IS_FLUID (fluids[j])))
scm_wrong_type_arg ("with-fluids", 0, fluids[j]);
- for (i = 0; i < j; i++)
+ for (i = j; i--;)
if (scm_is_eq (fluids[i], fluids[j]))
{
values[i] = values[j]; /* later bindings win */
n--;
+ fluids[j] = fluids[n];
+ values[j] = values[n];
break;
}
}
diff --git a/libguile/foreign.c b/libguile/foreign.c
index c81c5f4..4f5aa58 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -770,37 +770,40 @@ SCM_DEFINE (scm_pointer_to_procedure,
"pointer->procedure", 3, 0, 0,
/* Pre-generate trampolines for less than 10 arguments. */
#ifdef WORDS_BIGENDIAN
-#define OBJCODE_HEADER 0, 0, 0, 8, 0, 0, 0, 40
-#define META_HEADER 0, 0, 0, 32, 0, 0, 0, 0
+#define OBJCODE_HEADER(M) M (0), M (0), M (0), M (8), M (0), M (0), M (0), M
(40)
+#define META_HEADER(M) M (0), M (0), M (0), M (32), M (0), M (0), M (0), M
(0)
#else
-#define OBJCODE_HEADER 8, 0, 0, 0, 40, 0, 0, 0
-#define META_HEADER 32, 0, 0, 0, 0, 0, 0, 0
+#define OBJCODE_HEADER(M) M (8), M (0), M (0), M (0), M (40), M (0), M (0), M
(0)
+#define META_HEADER(M) M (32), M (0), M (0), M (0), M (0), M (0), M (0), M
(0)
#endif
-#define CODE(nreq) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_assert_nargs_ee, 0, nreq, /* assert number of args */ \
- /* 3 */ scm_op_object_ref, 0, /* push the pair with the cif and the function
pointer */ \
- /* 5 */ scm_op_foreign_call, nreq, /* and call (will return value as well)
*/ \
- /* 7 */ scm_op_nop, \
- /* 8 */ META (3, 7, nreq)
-
-#define META(start, end, nreq) \
- META_HEADER, \
- /* 0 */ scm_op_make_eol, /* bindings */ \
- /* 1 */ scm_op_make_eol, /* sources */ \
- /* 2 */ scm_op_make_int8, start, scm_op_make_int8, end, /* arity: from ip N
to ip N */ \
- /* 6 */ scm_op_make_int8, nreq, /* the arity is N required args */ \
- /* 8 */ scm_op_list, 0, 3, /* make a list of those 3 vals */ \
- /* 11 */ scm_op_list, 0, 1, /* and the arities will be a list of that one
list */ \
- /* 14 */ scm_op_load_symbol, 0, 0, 4, 'n', 'a', 'm', 'e', /* `name' */ \
- /* 22 */ scm_op_object_ref, 1, /* the name from the object table */ \
- /* 24 */ scm_op_cons, /* make a pair for the properties */ \
- /* 25 */ scm_op_list, 0, 4, /* pack bindings, sources, and arities into list
*/ \
- /* 28 */ scm_op_return, /* and return */ \
- /* 29 */ scm_op_nop, scm_op_nop, scm_op_nop \
+#define GEN_CODE(M, nreq) \
+ OBJCODE_HEADER (M), \
+ /* 0 */ M (scm_op_assert_nargs_ee), M (0), M (nreq), /* assert number of
args */ \
+ /* 3 */ M (scm_op_object_ref), M (0), /* push the pair with the cif and the
function pointer */ \
+ /* 5 */ M (scm_op_foreign_call), M (nreq), /* and call (will return value as
well) */ \
+ /* 7 */ M (scm_op_nop), \
+ /* 8 */ META (M, 3, 7, nreq)
+
+#define META(M, start, end, nreq) \
+ META_HEADER (M), \
+ /* 0 */ M (scm_op_make_eol), /* bindings */ \
+ /* 1 */ M (scm_op_make_eol), /* sources */ \
+ /* 2 */ M (scm_op_make_int8), M (start), M (scm_op_make_int8), M (end), /*
arity: from ip N to ip N */ \
+ /* 6 */ M (scm_op_make_int8), M (nreq), /* the arity is N required args */ \
+ /* 8 */ M (scm_op_list), M (0), M (3), /* make a list of those 3 vals */ \
+ /* 11 */ M (scm_op_list), M (0), M (1), /* and the arities will be a list of
that one list */ \
+ /* 14 */ M (scm_op_load_symbol), M (0), M (0), M (4), M ('n'), M ('a'), M
('M'), M ('e'), /* `name' */ \
+ /* 22 */ M (scm_op_object_ref), M (1), /* the name from the object table */ \
+ /* 24 */ M (scm_op_cons), /* make a pair for the properties */ \
+ /* 25 */ M (scm_op_list), M (0), M (4), /* pack bindings, sources, and
arities into list */ \
+ /* 28 */ M (scm_op_return), /* and return */ \
+ /* 29 */ M (scm_op_nop), M (scm_op_nop), M (scm_op_nop) \
/* 32 */
+#define M_STATIC(x) (x)
+#define CODE(nreq) GEN_CODE (M_STATIC, nreq)
+
static const struct
{
scm_t_uint64 dummy; /* ensure 8-byte alignment; perhaps there's a better way
*/
@@ -814,8 +817,28 @@ static const struct
}
};
-#undef CODE
+static SCM
+make_objcode_trampoline (unsigned int nargs)
+{
+ const int size = sizeof (struct scm_objcode) + 8
+ + sizeof (struct scm_objcode) + 32;
+ SCM bytecode = scm_c_make_bytevector (size);
+ scm_t_uint8 *bytes = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bytecode);
+ int i = 0;
+
+#define M_DYNAMIC(x) (bytes[i++] = (x))
+ GEN_CODE (M_DYNAMIC, nargs);
+#undef M_DYNAMIC
+
+ if (i != size)
+ scm_syserror ("make_objcode_trampoline");
+ return scm_bytecode_to_objcode (bytecode, SCM_UNDEFINED);
+}
+
+#undef GEN_CODE
#undef META
+#undef M_STATIC
+#undef CODE
#undef OBJCODE_HEADER
#undef META_HEADER
@@ -878,21 +901,43 @@ static const SCM objcode_trampolines[10] = {
SCM_PACK (objcode_cells.cells+18),
};
+static SCM large_objcode_trampolines = SCM_UNDEFINED;
+static scm_i_pthread_mutex_t large_objcode_trampolines_mutex =
+ SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
static SCM
-cif_to_procedure (SCM cif, SCM func_ptr)
+get_objcode_trampoline (unsigned int nargs)
{
- ffi_cif *c_cif;
- unsigned int nargs;
- SCM objcode, table, ret;
-
- c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
- nargs = c_cif->nargs;
+ SCM objcode;
if (nargs < 10)
objcode = objcode_trampolines[nargs];
+ else if (nargs < 128)
+ {
+ scm_i_scm_pthread_mutex_lock (&large_objcode_trampolines_mutex);
+ if (SCM_UNBNDP (large_objcode_trampolines))
+ large_objcode_trampolines = scm_c_make_vector (128, SCM_UNDEFINED);
+ objcode = scm_c_vector_ref (large_objcode_trampolines, nargs);
+ if (SCM_UNBNDP (objcode))
+ scm_c_vector_set_x (large_objcode_trampolines, nargs,
+ objcode = make_objcode_trampoline (nargs));
+ scm_i_pthread_mutex_unlock (&large_objcode_trampolines_mutex);
+ }
else
- scm_misc_error ("make-foreign-function", "args >= 10 currently
unimplemented",
+ scm_misc_error ("make-foreign-function", "args >= 128 currently
unimplemented",
SCM_EOL);
+
+ return objcode;
+}
+
+static SCM
+cif_to_procedure (SCM cif, SCM func_ptr)
+{
+ ffi_cif *c_cif;
+ SCM objcode, table, ret;
+
+ c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
+ objcode = get_objcode_trampoline (c_cif->nargs);
table = scm_c_make_vector (2, SCM_UNDEFINED);
SCM_SIMPLE_VECTOR_SET (table, 0, scm_cons (cif, func_ptr));
diff --git a/libguile/fports.c b/libguile/fports.c
index 94ce434..067c3e2 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation,
Inc.
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -28,15 +28,6 @@
#include <stdio.h>
#include <fcntl.h>
-#include "libguile/_scm.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/gc.h"
-#include "libguile/posix.h"
-#include "libguile/dynwind.h"
-#include "libguile/hashtab.h"
-
-#include "libguile/fports.h"
#ifdef HAVE_STRING_H
#include <string.h>
@@ -50,36 +41,23 @@
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
#include <sys/stat.h>
#endif
-#ifdef HAVE_POLL_H
#include <poll.h>
-#endif
#include <errno.h>
#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/select.h>
#include <full-write.h>
-#include "libguile/iselect.h"
-
-/* Some defines for Windows (native port, not Cygwin). */
-#ifdef __MINGW32__
-# include <sys/stat.h>
-# include <winsock2.h>
-#endif /* __MINGW32__ */
-
-#include <full-write.h>
-
-/* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
- already, but have this code here in case that wasn't so in past versions,
- or perhaps to help other minimal DOS environments.
-
- gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
- might be possibilities if we've got other systems without ftruncate. */
+#include "libguile/_scm.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/gc.h"
+#include "libguile/posix.h"
+#include "libguile/dynwind.h"
+#include "libguile/hashtab.h"
-#if defined HAVE_CHSIZE && ! defined HAVE_FTRUNCATE
-# define ftruncate(fd, size) chsize (fd, size)
-# undef HAVE_FTRUNCATE
-# define HAVE_FTRUNCATE 1
-#endif
+#include "libguile/fports.h"
#if SIZEOF_OFF_T == SIZEOF_INT
#define OFF_T_MAX INT_MAX
@@ -496,48 +474,6 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
#undef FUNC_NAME
-#ifdef __MINGW32__
-/*
- * Try getting the appropiate file flags for a given file descriptor
- * under Windows. This incorporates some fancy operations because Windows
- * differentiates between file, pipe and socket descriptors.
- */
-#ifndef O_ACCMODE
-# define O_ACCMODE 0x0003
-#endif
-
-static int getflags (int fdes)
-{
- int flags = 0;
- struct stat buf;
- int error, optlen = sizeof (int);
-
- /* Is this a socket ? */
- if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0)
- flags = O_RDWR;
- /* Maybe a regular file ? */
- else if (fstat (fdes, &buf) < 0)
- flags = -1;
- else
- {
- /* Or an anonymous pipe handle ? */
- if (buf.st_mode & _S_IFIFO)
- flags = PeekNamedPipe ((HANDLE) _get_osfhandle (fdes), NULL, 0,
- NULL, NULL, NULL) ? O_RDONLY : O_WRONLY;
- /* stdin ? */
- else if (fdes == fileno (stdin) && isatty (fdes))
- flags = O_RDONLY;
- /* stdout / stderr ? */
- else if ((fdes == fileno (stdout) || fdes == fileno (stderr)) &&
- isatty (fdes))
- flags = O_WRONLY;
- else
- flags = buf.st_mode;
- }
- return flags;
-}
-#endif /* __MINGW32__ */
-
/* Building Guile ports from a file descriptor. */
/* Build a Scheme port from an open file descriptor `fdes'.
@@ -551,14 +487,10 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
{
SCM port;
scm_t_fport *fp;
- int flags;
- /* test that fdes is valid. */
-#ifdef __MINGW32__
- flags = getflags (fdes);
-#else
- flags = fcntl (fdes, F_GETFL, 0);
-#endif
+ /* Test that fdes is valid. */
+#ifdef F_GETFL
+ int flags = fcntl (fdes, F_GETFL, 0);
if (flags == -1)
SCM_SYSERROR;
flags &= O_ACCMODE;
@@ -568,6 +500,13 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
{
SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
}
+#else
+ /* If we don't have F_GETFL, as on mingw, at least we can test that
+ it is a valid file descriptor. */
+ struct stat st;
+ if (fstat (fdes, &st) != 0)
+ SCM_SYSERROR;
+#endif
fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
"file port");
@@ -600,52 +539,12 @@ fport_input_waiting (SCM port)
{
int fdes = SCM_FSTREAM (port)->fdes;
- /* `FD_SETSIZE', which is 1024 on GNU systems, effectively limits the
- highest numerical value of file descriptors that can be monitored.
- Thus, use poll(2) whenever that is possible. */
-
-#ifdef HAVE_POLL
struct pollfd pollfd = { fdes, POLLIN, 0 };
if (poll (&pollfd, 1, 0) < 0)
scm_syserror ("fport_input_waiting");
return pollfd.revents & POLLIN ? 1 : 0;
-
-#elif defined(HAVE_SELECT)
- struct timeval timeout;
- SELECT_TYPE read_set;
- SELECT_TYPE write_set;
- SELECT_TYPE except_set;
-
- FD_ZERO (&read_set);
- FD_ZERO (&write_set);
- FD_ZERO (&except_set);
-
- FD_SET (fdes, &read_set);
-
- timeout.tv_sec = 0;
- timeout.tv_usec = 0;
-
- if (select (SELECT_SET_SIZE,
- &read_set, &write_set, &except_set, &timeout)
- < 0)
- scm_syserror ("fport_input_waiting");
- return FD_ISSET (fdes, &read_set) ? 1 : 0;
-
-#elif HAVE_IOCTL && defined (FIONREAD)
- /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
- (for use with winsock ioctlsocket()) but not ioctl(). */
- int fdes = SCM_FSTREAM (port)->fdes;
- int remir;
- ioctl(fdes, FIONREAD, &remir);
- return remir;
-
-#else
- scm_misc_error ("fport_input_waiting",
- "Not fully implemented on this platform",
- SCM_EOL);
-#endif
}
diff --git a/libguile/gc.c b/libguile/gc.c
index d580a65..581bbc5 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008,
2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006,
+ * 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -281,7 +282,13 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
&bytes_since_gc, &total_bytes);
+#ifdef HAVE_GC_GET_GC_NO
+ /* This function was added in 7.2alpha2 (June 2009). */
+ gc_times = GC_get_gc_no ();
+#else
+ /* This symbol is deprecated as of 7.3. */
gc_times = GC_gc_no;
+#endif
answer =
scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
@@ -582,7 +589,14 @@ scm_getenv_int (const char *var, int def)
void
scm_storage_prehistory ()
{
+#ifdef HAVE_GC_SET_ALL_INTERIOR_POINTERS
+ /* This function was added in 7.2alpha2 (June 2009). */
+ GC_set_all_interior_pointers (0);
+#else
+ /* This symbol is deprecated in 7.3. */
GC_all_interior_pointers = 0;
+#endif
+
free_space_divisor = scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3);
minimum_free_space_divisor = free_space_divisor;
target_free_space_divisor = free_space_divisor;
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 8a0d296..49d7cba 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009, 2011,
- * 2012 Free Software Foundation, Inc.
+ * 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -355,7 +355,13 @@ void
scm_init_guardians ()
{
/* We use unordered finalization `a la Java. */
+#ifdef HAVE_GC_SET_JAVA_FINALIZATION
+ /* This function was added in 7.2alpha2 (June 2009). */
+ GC_set_java_finalization (1);
+#else
+ /* This symbol is deprecated as of 7.3. */
GC_java_finalization = 1;
+#endif
tc16_guardian = scm_make_smob_type ("guardian", 0);
diff --git a/libguile/guile.c b/libguile/guile.c
index 133afc4..03b603e 100644
--- a/libguile/guile.c
+++ b/libguile/guile.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1997, 2000, 2001, 2006, 2008,
- * 2011 Free Software Foundation, Inc.
+ * 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -66,15 +66,41 @@ inner_main (void *closure SCM_UNUSED, int argc, char **argv)
#endif /* __MINGW32__ */
}
+static int
+get_integer_from_environment (const char *var, int def)
+{
+ char *end = 0;
+ char *val = getenv (var);
+ long res = def;
+ if (!val)
+ return def;
+ res = strtol (val, &end, 10);
+ if (end == val)
+ {
+ fprintf (stderr, "guile: warning: invalid %s: %s\n", var, val);
+ return def;
+ }
+ return res;
+}
+
+static int
+should_install_locale (void)
+{
+ /* If the GUILE_INSTALL_LOCALE environment variable is unset,
+ or set to a nonzero value, we should install the locale via
+ setlocale(). */
+ return get_integer_from_environment ("GUILE_INSTALL_LOCALE", 1);
+}
+
int
main (int argc, char **argv)
{
- /* Install the locale right at the beginning so that string conversion
- for command-line arguments, along with possible error messages, use
- the right locale. See
+ /* If we should install a locale, do it right at the beginning so that
+ string conversion for command-line arguments, along with possible
+ error messages, use the right locale. See
<https://lists.gnu.org/archive/html/guile-devel/2011-11/msg00041.html>
for the rationale. */
- if (setlocale (LC_ALL, "") == NULL)
+ if (should_install_locale () && setlocale (LC_ALL, "") == NULL)
fprintf (stderr, "guile: warning: failed to install locale\n");
scm_install_gmp_memory_functions = 1;
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 817c661..dc6d07d 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software
Foundation, Inc.
+/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -685,6 +685,8 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
}
}
+ /* silence gcc's unused variable warning */
+ (void) c_base_locale;
#endif
return locale;
diff --git a/libguile/init.c b/libguile/init.c
index 684f6eb..fb952f2 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -75,7 +75,6 @@
#include "libguile/gettext.h"
#include "libguile/i18n.h"
#include "libguile/instructions.h"
-#include "libguile/iselect.h"
#include "libguile/ioext.h"
#include "libguile/keywords.h"
#include "libguile/list.h"
diff --git a/libguile/iselect.h b/libguile/iselect.h
index 760d959..1c7b12d 100644
--- a/libguile/iselect.h
+++ b/libguile/iselect.h
@@ -3,7 +3,8 @@
#ifndef SCM_ISELECT_H
#define SCM_ISELECT_H
-/* Copyright (C) 1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1998,2000,2001, 2002, 2006,
+ * 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -29,35 +30,18 @@
#include <sys/types.h>
#if SCM_HAVE_SYS_SELECT_H
-# include <sys/select.h>
-#endif
-#if SCM_HAVE_WINSOCK2_H
-# include <winsock2.h>
-#endif
+#include <sys/select.h>
-#ifdef FD_SET
+SCM_API int scm_std_select (int fds,
+ fd_set *rfds,
+ fd_set *wfds,
+ fd_set *efds,
+ struct timeval *timeout);
#define SELECT_TYPE fd_set
-#define SELECT_SET_SIZE FD_SETSIZE
-
-#else /* no FD_SET */
-
-/* Define the macros to access a single-int bitmap of descriptors. */
-#define SELECT_SET_SIZE 32
-#define SELECT_TYPE int
-#define FD_SET(n, p) (*(p) |= (1 << (n)))
-#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
-#define FD_ISSET(n, p) (*(p) & (1 << (n)))
-#define FD_ZERO(p) (*(p) = 0)
-#endif /* no FD_SET */
-
-SCM_API int scm_std_select (int fds,
- SELECT_TYPE *rfds,
- SELECT_TYPE *wfds,
- SELECT_TYPE *efds,
- struct timeval *timeout);
+#endif /* SCM_HAVE_SYS_SELECT_H */
#endif /* SCM_ISELECT_H */
diff --git a/libguile/list.c b/libguile/list.c
index 6276403..1f44ad0 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -377,8 +377,6 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
SCM_VALIDATE_LIST (1, lst);
if (SCM_UNBNDP (new_tail))
new_tail = SCM_EOL;
- else
- SCM_VALIDATE_LIST (2, new_tail);
while (!SCM_NULL_OR_NIL_P (lst))
{
diff --git a/libguile/load.c b/libguile/load.c
index 081c364..ebf79a9 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -198,6 +198,19 @@ SCM_DEFINE (scm_sys_global_site_dir, "%global-site-dir",
0,0,0,
#undef FUNC_NAME
#endif /* SCM_GLOBAL_SITE_DIR */
+#ifdef SCM_SITE_CCACHE_DIR
+SCM_DEFINE (scm_sys_site_ccache_dir, "%site-ccache-dir", 0,0,0,
+ (),
+ "Return the directory where users should install compiled\n"
+ "@code{.go} files for use with this version of Guile.\n\n"
+ "E.g., may return \"/usr/lib/guile/" SCM_EFFECTIVE_VERSION
"/site-ccache\".")
+#define FUNC_NAME s_scm_sys_site_ccache_dir
+{
+ return scm_from_locale_string (SCM_SITE_CCACHE_DIR);
+}
+#undef FUNC_NAME
+#endif /* SCM_SITE_CCACHE_DIR */
+
/* Initializing the load path, and searching it. */
@@ -447,6 +460,60 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM
extensions)
return 0;
}
+#ifdef __MINGW32__
+#define FILE_NAME_SEPARATOR_STRING "\\"
+#else
+#define FILE_NAME_SEPARATOR_STRING "/"
+#endif
+
+static int
+is_file_name_separator (SCM c)
+{
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('/')))
+ return 1;
+#ifdef __MINGW32__
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('\\')))
+ return 1;
+#endif
+ return 0;
+}
+
+static int
+is_drive_letter (SCM c)
+{
+#ifdef __MINGW32__
+ if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z')
+ return 1;
+ else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z')
+ return 1;
+#endif
+ return 0;
+}
+
+static int
+is_absolute_file_name (SCM filename)
+{
+ size_t filename_len = scm_c_string_length (filename);
+
+ if (filename_len >= 1
+ && is_file_name_separator (scm_c_string_ref (filename, 0))
+#ifdef __MINGW32__
+ /* On Windows, one initial separator indicates a drive-relative
+ path. Two separators indicate a Universal Naming Convention
+ (UNC) path. UNC paths are always absolute. */
+ && filename_len >= 2
+ && is_file_name_separator (scm_c_string_ref (filename, 1))
+#endif
+ )
+ return 1;
+ if (filename_len >= 3
+ && is_drive_letter (scm_c_string_ref (filename, 0))
+ && scm_is_eq (scm_c_string_ref (filename, 1), SCM_MAKE_CHAR (':'))
+ && is_file_name_separator (scm_c_string_ref (filename, 2)))
+ return 1;
+ return 0;
+}
+
/* Search PATH for a directory containing a file named FILENAME.
The file must be readable, and not a directory.
If we find one, return its full pathname; otherwise, return #f.
@@ -477,16 +544,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM
require_exts,
scm_dynwind_free (filename_chars);
/* If FILENAME is absolute and is still valid, return it unchanged. */
-#ifdef __MINGW32__
- if (((filename_len >= 1) &&
- (filename_chars[0] == '/' || filename_chars[0] == '\\')) ||
- ((filename_len >= 3) && filename_chars[1] == ':' &&
- ((filename_chars[0] >= 'a' && filename_chars[0] <= 'z') ||
- (filename_chars[0] >= 'A' && filename_chars[0] <= 'Z')) &&
- (filename_chars[2] == '/' || filename_chars[2] == '\\')))
-#else
- if (filename_len >= 1 && filename_chars[0] == '/')
-#endif
+ if (is_absolute_file_name (filename))
{
if ((scm_is_false (require_exts) ||
scm_c_string_has_an_ext (filename_chars, filename_len,
@@ -520,11 +578,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM
require_exts,
extensions = SCM_EOL;
break;
}
-#ifdef __MINGW32__
- else if (*endp == '/' || *endp == '\\')
-#else
- else if (*endp == '/')
-#endif
+ else if (is_file_name_separator (SCM_MAKE_CHAR (*endp)))
/* This filename has no extension, so keep the current list
of extensions. */
break;
@@ -553,12 +607,9 @@ search_path (SCM path, SCM filename, SCM extensions, SCM
require_exts,
/* Concatenate the path name and the filename. */
-#ifdef __MINGW32__
- if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/') && (buf.ptr[-1] != '\\'))
-#else
- if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/'))
-#endif
- stringbuf_cat (&buf, "/");
+ if (buf.ptr > buf.buf
+ && !is_file_name_separator (SCM_MAKE_CHAR (buf.ptr[-1])))
+ stringbuf_cat (&buf, FILE_NAME_SEPARATOR_STRING);
stringbuf_cat (&buf, filename_chars);
sans_ext_len = buf.ptr - buf.buf;
@@ -823,24 +874,36 @@ scm_try_auto_compile (SCM source)
NULL, NULL);
}
-/* See also (system base compile):compiled-file-name. */
+/* The auto-compilation code will residualize a .go file in the cache
+ dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go. This
+ function determines the PATH to use as a key into the compilation
+ cache. See also (system base compile):compiled-file-name. */
static SCM
canonical_suffix (SCM fname)
{
SCM canon;
- size_t len;
+ /* CANON should be absolute. */
canon = scm_canonicalize_path (fname);
- len = scm_c_string_length (canon);
- if (len > 1 && scm_is_eq (scm_c_string_ref (canon, 0), SCM_MAKE_CHAR ('/')))
- return canon;
- else if (len > 2 && scm_is_eq (scm_c_string_ref (canon, 1), SCM_MAKE_CHAR
(':')))
- return scm_string_append (scm_list_3 (scm_from_latin1_string ("/"),
- scm_c_substring (canon, 0, 1),
- scm_c_substring (canon, 2, len)));
- else
- return canon;
+#ifdef __MINGW32__
+ {
+ size_t len = scm_c_string_length (canon);
+
+ /* On Windows, an absolute file name that doesn't start with a
+ separator starts with a drive component. Transform the drive
+ component to a file name element: c:\foo -> \c\foo. */
+ if (len >= 2
+ && is_absolute_file_name (canon)
+ && !is_file_name_separator (scm_c_string_ref (canon, 0)))
+ return scm_string_append
+ (scm_list_3 (scm_from_latin1_string (FILE_NAME_SEPARATOR_STRING),
+ scm_c_substring (canon, 0, 1),
+ scm_c_substring (canon, 2, len)));
+ }
+#endif
+
+ return canon;
}
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
diff --git a/libguile/load.h b/libguile/load.h
index 698bbaf..ab75ea3 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -3,7 +3,7 @@
#ifndef SCM_LOAD_H
#define SCM_LOAD_H
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011, 2013
Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -34,6 +34,7 @@ SCM_API SCM scm_sys_package_data_dir (void);
SCM_API SCM scm_sys_library_dir (void);
SCM_API SCM scm_sys_site_dir (void);
SCM_API SCM scm_sys_global_site_dir (void);
+SCM_API SCM scm_sys_site_ccache_dir (void);
SCM_API SCM scm_search_path (SCM path, SCM filename, SCM rest);
SCM_API SCM scm_sys_search_load_path (SCM filename);
SCM_API SCM scm_primitive_load_path (SCM filename_and_exception_on_not_found);
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 7431d3c..f20241c 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -284,14 +284,33 @@ memoize (SCM exp, SCM env)
memoize (REF (exp, SEQ, TAIL), env));
case SCM_EXPANDED_LAMBDA:
- /* The body will be a lambda-case. */
+ /* The body will be a lambda-case or #f. */
{
- SCM meta, docstring, proc;
+ SCM meta, docstring, body, proc;
meta = REF (exp, LAMBDA, META);
docstring = scm_assoc_ref (meta, scm_sym_documentation);
- proc = memoize (REF (exp, LAMBDA, BODY), env);
+ body = REF (exp, LAMBDA, BODY);
+ if (scm_is_false (body))
+ /* Give a body to case-lambda with no clauses. */
+ proc = MAKMEMO_LAMBDA
+ (MAKMEMO_CALL
+ (MAKMEMO_MOD_REF (list_of_guile,
+ scm_from_latin1_symbol ("throw"),
+ SCM_BOOL_F),
+ 5,
+ scm_list_5 (MAKMEMO_QUOTE (scm_args_number_key),
+ MAKMEMO_QUOTE (SCM_BOOL_F),
+ MAKMEMO_QUOTE (scm_from_latin1_string
+ ("Wrong number of arguments")),
+ MAKMEMO_QUOTE (SCM_EOL),
+ MAKMEMO_QUOTE (SCM_BOOL_F))),
+ FIXED_ARITY (0),
+ SCM_BOOL_F /* docstring */);
+ else
+ proc = memoize (body, env);
+
if (scm_is_string (docstring))
{
SCM args = SCM_MEMOIZED_ARGS (proc);
diff --git a/libguile/mkstemp.c b/libguile/mkstemp.c
index 6a573c6..a7eaf10 100644
--- a/libguile/mkstemp.c
+++ b/libguile/mkstemp.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 1992, 1996, 1998, 2001, 2006 Free Software Foundation,
Inc.
+/* Copyright (C) 1991, 1992, 1996, 1998, 2001, 2006, 2013 Free Software
Foundation, Inc.
This file is derived from mkstemps.c from the GNU Libiberty Library
which in turn is derived from the GNU C Library.
@@ -112,7 +112,7 @@ mkstemp (template)
v /= 62;
XXXXXX[5] = letters[v % 62];
- fd = open (template, O_RDWR|O_CREAT|O_EXCL, 0600);
+ fd = open (template, O_RDWR|O_CREAT|O_EXCL|O_BINARY, 0600);
if (fd >= 0)
/* The file does not exist. */
return fd;
diff --git a/libguile/net_db.c b/libguile/net_db.c
index 4d63aab..d7a12c5 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -1,6 +1,6 @@
/* "net_db.c" network database support
* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009,
- * 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -34,48 +34,36 @@
#include <verify.h>
#include <errno.h>
-#include "libguile/_scm.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/validate.h"
-#include "libguile/net_db.h"
-#include "libguile/socket.h"
-
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#include <sys/types.h>
-#ifdef HAVE_WINSOCK2_H
-#include <winsock2.h>
-#else
#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
-#endif
-#ifdef __MINGW32__
-#include "win32-socket.h"
-#endif
+#include "libguile/_scm.h"
+#include "libguile/feature.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+#include "libguile/dynwind.h"
-#if !defined (HAVE_H_ERRNO) && !defined (__MINGW32__) && !defined (__CYGWIN__)
-/* h_errno not found in netdb.h, maybe this will help. */
-extern int h_errno;
-#endif
+#include "libguile/validate.h"
+#include "libguile/net_db.h"
+#include "libguile/socket.h"
+
+
+#if defined (HAVE_H_ERRNO)
+/* Only wrap gethostbyname / gethostbyaddr if h_errno is available. */
-#if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR \
- && !defined __MINGW32__ && !defined __CYGWIN__
+#if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR
/* Some OSes, such as Tru64 5.1b, lack a declaration for hstrerror(3). */
extern const char *hstrerror (int);
#endif
-
-
SCM_SYMBOL (scm_host_not_found_key, "host-not-found");
SCM_SYMBOL (scm_try_again_key, "try-again");
SCM_SYMBOL (scm_no_recovery_key, "no-recovery");
@@ -204,6 +192,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
}
#undef FUNC_NAME
+#endif /* HAVE_H_ERRNO */
+
/* In all subsequent getMUMBLE functions, when we're called with no
arguments, we're supposed to traverse the tables entry by entry.
@@ -267,7 +257,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
#undef FUNC_NAME
#endif
-#if defined (HAVE_GETPROTOENT) || defined (__MINGW32__)
+#if defined (HAVE_GETPROTOENT)
SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
(SCM protocol),
"@deffnx {Scheme Procedure} getprotobyname name\n"
@@ -318,7 +308,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
#undef FUNC_NAME
#endif
-#if defined (HAVE_GETSERVENT) || defined (__MINGW32__)
+#if defined (HAVE_GETSERVENT)
static SCM
scm_return_entry (struct servent *entry)
{
@@ -420,7 +410,7 @@ SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0,
#undef FUNC_NAME
#endif
-#if defined (HAVE_SETPROTOENT) && defined (HAVE_ENDPROTOENT) || defined
(__MINGW32__)
+#if defined (HAVE_SETPROTOENT) && defined (HAVE_ENDPROTOENT)
SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
(SCM stayopen),
"If @var{stayopen} is omitted, this is equivalent to
@code{endprotoent}.\n"
@@ -436,7 +426,7 @@ SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
#undef FUNC_NAME
#endif
-#if defined (HAVE_SETSERVENT) && defined (HAVE_ENDSERVENT) || defined
(__MINGW32__)
+#if defined (HAVE_SETSERVENT) && defined (HAVE_ENDSERVENT)
SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0,
(SCM stayopen),
"If @var{stayopen} is omitted, this is equivalent to
@code{endservent}.\n"
@@ -605,8 +595,10 @@ SCM_DEFINE (scm_getaddrinfo, "getaddrinfo", 1, 5, 0,
"@item EAI_SOCKTYPE\n"
"@var{hint_socktype} was not recognized.\n\n"
"@item EAI_SYSTEM\n"
- "A system error occurred; the error code can be found in "
- "@code{errno}.\n"
+ "A system error occurred. In C, the error code can be found in "
+ "@code{errno}; this value is not accessible from Scheme, but in\n"
+ "practice it provides little information about the actual error "
+ "cause.\n\n" /* see <http://bugs.gnu.org/13958>. */
"@end table\n"
"\n"
"Users are encouraged to read the "
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 01f8e05..29d2669 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -81,6 +81,9 @@
#define M_PI 3.14159265358979323846
#endif
+/* FIXME: We assume that FLT_RADIX is 2 */
+verify (FLT_RADIX == 2);
+
typedef scm_t_signed_bits scm_t_inum;
#define scm_from_inum(x) (scm_from_signed_integer (x))
@@ -327,81 +330,52 @@ scm_i_dbl2num (double u)
return scm_i_dbl2big (u);
}
-/* scm_i_big2dbl() rounds to the closest representable double, in accordance
- with R5RS exact->inexact.
-
- The approach is to use mpz_get_d to pick out the high DBL_MANT_DIG bits
- (ie. truncate towards zero), then adjust to get the closest double by
- examining the next lower bit and adding 1 (to the absolute value) if
- necessary.
-
- Bignums exactly half way between representable doubles are rounded to the
- next higher absolute value (ie. away from zero). This seems like an
- adequate interpretation of R5RS "numerically closest", and it's easier
- and faster than a full "nearest-even" style.
-
- The bit test must be done on the absolute value of the mpz_t, which means
- we need to use mpz_getlimbn. mpz_tstbit is not right, it treats
- negatives as twos complement.
+static SCM round_right_shift_exact_integer (SCM n, long count);
- In GMP before 4.2, mpz_get_d rounding was unspecified. It ended up
- following the hardware rounding mode, but applied to the absolute
- value of the mpz_t operand. This is not what we want so we put the
- high DBL_MANT_DIG bits into a temporary. Starting with GMP 4.2
- (released in March 2006) mpz_get_d now always truncates towards zero.
+/* scm_i_big2dbl_2exp() is like frexp for bignums: it converts the
+ bignum b into a normalized significand and exponent such that
+ b = significand * 2^exponent and 1/2 <= abs(significand) < 1.
+ The return value is the significand rounded to the closest
+ representable double, and the exponent is placed into *expon_p.
+ If b is zero, then the returned exponent and significand are both
+ zero. */
- ENHANCE-ME: The temporary init+clear to force the rounding in GMP
- before 4.2 is a slowdown. It'd be faster to pick out the relevant
- high bits with mpz_getlimbn. */
-
-double
-scm_i_big2dbl (SCM b)
+static double
+scm_i_big2dbl_2exp (SCM b, long *expon_p)
{
- double result;
- size_t bits;
-
- bits = mpz_sizeinbase (SCM_I_BIG_MPZ (b), 2);
-
-#if 1
- {
- /* For GMP earlier than 4.2, force truncation towards zero */
-
- /* FIXME: DBL_MANT_DIG is the number of base-`FLT_RADIX' digits,
- _not_ the number of bits, so this code will break badly on a
- system with non-binary doubles. */
-
- mpz_t tmp;
- if (bits > DBL_MANT_DIG)
- {
- size_t shift = bits - DBL_MANT_DIG;
- mpz_init2 (tmp, DBL_MANT_DIG);
- mpz_tdiv_q_2exp (tmp, SCM_I_BIG_MPZ (b), shift);
- result = ldexp (mpz_get_d (tmp), shift);
- mpz_clear (tmp);
- }
- else
- {
- result = mpz_get_d (SCM_I_BIG_MPZ (b));
- }
- }
-#else
- /* GMP 4.2 or later */
- result = mpz_get_d (SCM_I_BIG_MPZ (b));
-#endif
+ size_t bits = mpz_sizeinbase (SCM_I_BIG_MPZ (b), 2);
+ size_t shift = 0;
if (bits > DBL_MANT_DIG)
{
- unsigned long pos = bits - DBL_MANT_DIG - 1;
- /* test bit number "pos" in absolute value */
- if (mpz_getlimbn (SCM_I_BIG_MPZ (b), pos / GMP_NUMB_BITS)
- & ((mp_limb_t) 1 << (pos % GMP_NUMB_BITS)))
+ shift = bits - DBL_MANT_DIG;
+ b = round_right_shift_exact_integer (b, shift);
+ if (SCM_I_INUMP (b))
{
- result += ldexp ((double) mpz_sgn (SCM_I_BIG_MPZ (b)), pos + 1);
+ int expon;
+ double signif = frexp (SCM_I_INUM (b), &expon);
+ *expon_p = expon + shift;
+ return signif;
}
}
- scm_remember_upto_here_1 (b);
- return result;
+ {
+ long expon;
+ double signif = mpz_get_d_2exp (&expon, SCM_I_BIG_MPZ (b));
+ scm_remember_upto_here_1 (b);
+ *expon_p = expon + shift;
+ return signif;
+ }
+}
+
+/* scm_i_big2dbl() rounds to the closest representable double,
+ in accordance with R5RS exact->inexact. */
+double
+scm_i_big2dbl (SCM b)
+{
+ long expon;
+ double signif = scm_i_big2dbl_2exp (b, &expon);
+ return ldexp (signif, expon);
}
SCM
@@ -436,107 +410,212 @@ scm_i_mpz2num (mpz_t b)
}
}
-/* this is needed when we want scm_divide to make a float, not a ratio, even
if passed two ints */
-static SCM scm_divide2real (SCM x, SCM y);
-
+/* Make the ratio NUMERATOR/DENOMINATOR, where:
+ 1. NUMERATOR and DENOMINATOR are exact integers
+ 2. NUMERATOR and DENOMINATOR are reduced to lowest terms: gcd(n,d) == 1 */
static SCM
-scm_i_make_ratio (SCM numerator, SCM denominator)
-#define FUNC_NAME "make-ratio"
+scm_i_make_ratio_already_reduced (SCM numerator, SCM denominator)
{
- /* First make sure the arguments are proper.
- */
- if (SCM_I_INUMP (denominator))
+ /* Flip signs so that the denominator is positive. */
+ if (scm_is_false (scm_positive_p (denominator)))
{
- if (scm_is_eq (denominator, SCM_INUM0))
+ if (SCM_UNLIKELY (scm_is_eq (denominator, SCM_INUM0)))
scm_num_overflow ("make-ratio");
- if (scm_is_eq (denominator, SCM_INUM1))
- return numerator;
- }
- else
- {
- if (!(SCM_BIGP(denominator)))
- SCM_WRONG_TYPE_ARG (2, denominator);
+ else
+ {
+ numerator = scm_difference (numerator, SCM_UNDEFINED);
+ denominator = scm_difference (denominator, SCM_UNDEFINED);
+ }
}
- if (!SCM_I_INUMP (numerator) && !SCM_BIGP (numerator))
- SCM_WRONG_TYPE_ARG (1, numerator);
- /* Then flip signs so that the denominator is positive.
- */
- if (scm_is_true (scm_negative_p (denominator)))
- {
- numerator = scm_difference (numerator, SCM_UNDEFINED);
- denominator = scm_difference (denominator, SCM_UNDEFINED);
- }
+ /* Check for the integer case */
+ if (scm_is_eq (denominator, SCM_INUM1))
+ return numerator;
- /* Now consider for each of the four fixnum/bignum combinations
- whether the rational number is really an integer.
- */
- if (SCM_I_INUMP (numerator))
+ return scm_double_cell (scm_tc16_fraction,
+ SCM_UNPACK (numerator),
+ SCM_UNPACK (denominator), 0);
+}
+
+static SCM scm_exact_integer_quotient (SCM x, SCM y);
+
+/* Make the ratio NUMERATOR/DENOMINATOR */
+static SCM
+scm_i_make_ratio (SCM numerator, SCM denominator)
+#define FUNC_NAME "make-ratio"
+{
+ /* Make sure the arguments are proper */
+ if (!SCM_LIKELY (SCM_I_INUMP (numerator) || SCM_BIGP (numerator)))
+ SCM_WRONG_TYPE_ARG (1, numerator);
+ else if (!SCM_LIKELY (SCM_I_INUMP (denominator) || SCM_BIGP (denominator)))
+ SCM_WRONG_TYPE_ARG (2, denominator);
+ else
{
- scm_t_inum x = SCM_I_INUM (numerator);
- if (scm_is_eq (numerator, SCM_INUM0))
- return SCM_INUM0;
- if (SCM_I_INUMP (denominator))
+ SCM the_gcd = scm_gcd (numerator, denominator);
+ if (!(scm_is_eq (the_gcd, SCM_INUM1)))
{
- scm_t_inum y;
- y = SCM_I_INUM (denominator);
- if (x == y)
- return SCM_INUM1;
- if ((x % y) == 0)
- return SCM_I_MAKINUM (x / y);
+ /* Reduce to lowest terms */
+ numerator = scm_exact_integer_quotient (numerator, the_gcd);
+ denominator = scm_exact_integer_quotient (denominator, the_gcd);
}
- else
- {
- /* When x == SCM_MOST_NEGATIVE_FIXNUM we could have the negative
- of that value for the denominator, as a bignum. Apart from
- that case, abs(bignum) > abs(inum) so inum/bignum is not an
- integer. */
- if (x == SCM_MOST_NEGATIVE_FIXNUM
- && mpz_cmp_ui (SCM_I_BIG_MPZ (denominator),
- - SCM_MOST_NEGATIVE_FIXNUM) == 0)
- return SCM_I_MAKINUM(-1);
- }
+ return scm_i_make_ratio_already_reduced (numerator, denominator);
}
- else if (SCM_BIGP (numerator))
+}
+#undef FUNC_NAME
+
+static mpz_t scm_i_divide2double_lo2b;
+
+/* Return the double that is closest to the exact rational N/D, with
+ ties rounded toward even mantissas. N and D must be exact
+ integers. */
+static double
+scm_i_divide2double (SCM n, SCM d)
+{
+ int neg;
+ mpz_t nn, dd, lo, hi, x;
+ ssize_t e;
+
+ if (SCM_LIKELY (SCM_I_INUMP (d)))
{
- if (SCM_I_INUMP (denominator))
- {
- scm_t_inum yy = SCM_I_INUM (denominator);
- if (mpz_divisible_ui_p (SCM_I_BIG_MPZ (numerator), yy))
- return scm_divide (numerator, denominator);
- }
- else
- {
- if (scm_is_eq (numerator, denominator))
- return SCM_INUM1;
- if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator),
- SCM_I_BIG_MPZ (denominator)))
- return scm_divide(numerator, denominator);
- }
+ if (SCM_LIKELY (SCM_I_INUMP (n)
+ && (SCM_I_FIXNUM_BIT-1 <= DBL_MANT_DIG
+ || (SCM_I_INUM (n) < (1L << DBL_MANT_DIG)
+ && SCM_I_INUM (d) < (1L << DBL_MANT_DIG)))))
+ /* If both N and D can be losslessly converted to doubles, then
+ we can rely on IEEE floating point to do proper rounding much
+ faster than we can. */
+ return ((double) SCM_I_INUM (n)) / ((double) SCM_I_INUM (d));
+
+ if (SCM_UNLIKELY (scm_is_eq (d, SCM_INUM0)))
+ {
+ if (scm_is_true (scm_positive_p (n)))
+ return 1.0 / 0.0;
+ else if (scm_is_true (scm_negative_p (n)))
+ return -1.0 / 0.0;
+ else
+ return 0.0 / 0.0;
+ }
+
+ mpz_init_set_si (dd, SCM_I_INUM (d));
}
+ else
+ mpz_init_set (dd, SCM_I_BIG_MPZ (d));
- /* No, it's a proper fraction.
- */
+ if (SCM_I_INUMP (n))
+ mpz_init_set_si (nn, SCM_I_INUM (n));
+ else
+ mpz_init_set (nn, SCM_I_BIG_MPZ (n));
+
+ neg = (mpz_sgn (nn) < 0) ^ (mpz_sgn (dd) < 0);
+ mpz_abs (nn, nn);
+ mpz_abs (dd, dd);
+
+ /* Now we need to find the value of e such that:
+
+ For e <= 0:
+ b^{p-1} - 1/2b <= b^-e n / d < b^p - 1/2 [1A]
+ (2 b^p - 1) <= 2 b b^-e n / d < (2 b^p - 1) b [2A]
+ (2 b^p - 1) d <= 2 b b^-e n < (2 b^p - 1) d b [3A]
+
+ For e >= 0:
+ b^{p-1} - 1/2b <= n / b^e d < b^p - 1/2 [1B]
+ (2 b^p - 1) <= 2 b n / b^e d < (2 b^p - 1) b [2B]
+ (2 b^p - 1) d b^e <= 2 b n < (2 b^p - 1) d b b^e [3B]
+
+ where: p = DBL_MANT_DIG
+ b = FLT_RADIX (here assumed to be 2)
+
+ After rounding, the mantissa must be an integer between b^{p-1} and
+ (b^p - 1), except for subnormal numbers. In the inequations [1A]
+ and [1B], the middle expression represents the mantissa *before*
+ rounding, and therefore is bounded by the range of values that will
+ round to a floating-point number with the exponent e. The upper
+ bound is (b^p - 1 + 1/2) = (b^p - 1/2), and is exclusive because
+ ties will round up to the next power of b. The lower bound is
+ (b^{p-1} - 1/2b), and is inclusive because ties will round toward
+ this power of b. Here we subtract 1/2b instead of 1/2 because it
+ is in the range of the next smaller exponent, where the
+ representable numbers are closer together by a factor of b.
+
+ Inequations [2A] and [2B] are derived from [1A] and [1B] by
+ multiplying by 2b, and in [3A] and [3B] we multiply by the
+ denominator of the middle value to obtain integer expressions.
+
+ In the code below, we refer to the three expressions in [3A] or
+ [3B] as lo, x, and hi. If the number is normalizable, we will
+ achieve the goal: lo <= x < hi */
+
+ /* Make an initial guess for e */
+ e = mpz_sizeinbase (nn, 2) - mpz_sizeinbase (dd, 2) - (DBL_MANT_DIG-1);
+ if (e < DBL_MIN_EXP - DBL_MANT_DIG)
+ e = DBL_MIN_EXP - DBL_MANT_DIG;
+
+ /* Compute the initial values of lo, x, and hi
+ based on the initial guess of e */
+ mpz_inits (lo, hi, x, NULL);
+ mpz_mul_2exp (x, nn, 2 + ((e < 0) ? -e : 0));
+ mpz_mul (lo, dd, scm_i_divide2double_lo2b);
+ if (e > 0)
+ mpz_mul_2exp (lo, lo, e);
+ mpz_mul_2exp (hi, lo, 1);
+
+ /* Adjust e as needed to satisfy the inequality lo <= x < hi,
+ (but without making e less then the minimum exponent) */
+ while (mpz_cmp (x, lo) < 0 && e > DBL_MIN_EXP - DBL_MANT_DIG)
+ {
+ mpz_mul_2exp (x, x, 1);
+ e--;
+ }
+ while (mpz_cmp (x, hi) >= 0)
+ {
+ /* If we ever used lo's value again,
+ we would need to double lo here. */
+ mpz_mul_2exp (hi, hi, 1);
+ e++;
+ }
+
+ /* Now compute the rounded mantissa:
+ n / b^e d (if e >= 0)
+ n b^-e / d (if e <= 0) */
{
- SCM divisor = scm_gcd (numerator, denominator);
- if (!(scm_is_eq (divisor, SCM_INUM1)))
- {
- numerator = scm_divide (numerator, divisor);
- denominator = scm_divide (denominator, divisor);
- }
-
- return scm_double_cell (scm_tc16_fraction,
- SCM_UNPACK (numerator),
- SCM_UNPACK (denominator), 0);
+ int cmp;
+ double result;
+
+ if (e < 0)
+ mpz_mul_2exp (nn, nn, -e);
+ else
+ mpz_mul_2exp (dd, dd, e);
+
+ /* mpz does not directly support rounded right
+ shifts, so we have to do it the hard way.
+ For efficiency, we reuse lo and hi.
+ hi == quotient, lo == remainder */
+ mpz_fdiv_qr (hi, lo, nn, dd);
+
+ /* The fractional part of the unrounded mantissa would be
+ remainder/dividend, i.e. lo/dd. So we have a tie if
+ lo/dd = 1/2. Multiplying both sides by 2*dd yields the
+ integer expression 2*lo = dd. Here we do that comparison
+ to decide whether to round up or down. */
+ mpz_mul_2exp (lo, lo, 1);
+ cmp = mpz_cmp (lo, dd);
+ if (cmp > 0 || (cmp == 0 && mpz_odd_p (hi)))
+ mpz_add_ui (hi, hi, 1);
+
+ result = ldexp (mpz_get_d (hi), e);
+ if (neg)
+ result = -result;
+
+ mpz_clears (nn, dd, lo, hi, x, NULL);
+ return result;
}
}
-#undef FUNC_NAME
double
scm_i_fraction2double (SCM z)
{
- return scm_to_double (scm_divide2real (SCM_FRACTION_NUMERATOR (z),
- SCM_FRACTION_DENOMINATOR (z)));
+ return scm_i_divide2double (SCM_FRACTION_NUMERATOR (z),
+ SCM_FRACTION_DENOMINATOR (z));
}
static int
@@ -820,8 +899,9 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
{
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (x))))
return x;
- return scm_i_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x),
SCM_UNDEFINED),
- SCM_FRACTION_DENOMINATOR (x));
+ return scm_i_make_ratio_already_reduced
+ (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED),
+ SCM_FRACTION_DENOMINATOR (x));
}
else
return scm_wta_dispatch_1 (g_scm_abs, x, 1, s_scm_abs);
@@ -889,6 +969,84 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0,
}
#undef FUNC_NAME
+/* Return the exact integer q such that n = q*d, for exact integers n
+ and d, where d is known in advance to divide n evenly (with zero
+ remainder). For large integers, this can be computed more
+ efficiently than when the remainder is unknown. */
+static SCM
+scm_exact_integer_quotient (SCM n, SCM d)
+#define FUNC_NAME "exact-integer-quotient"
+{
+ if (SCM_LIKELY (SCM_I_INUMP (n)))
+ {
+ scm_t_inum nn = SCM_I_INUM (n);
+ if (SCM_LIKELY (SCM_I_INUMP (d)))
+ {
+ scm_t_inum dd = SCM_I_INUM (d);
+ if (SCM_UNLIKELY (dd == 0))
+ scm_num_overflow ("exact-integer-quotient");
+ else
+ {
+ scm_t_inum qq = nn / dd;
+ if (SCM_LIKELY (SCM_FIXABLE (qq)))
+ return SCM_I_MAKINUM (qq);
+ else
+ return scm_i_inum2big (qq);
+ }
+ }
+ else if (SCM_LIKELY (SCM_BIGP (d)))
+ {
+ /* n is an inum and d is a bignum. Given that d is known to
+ divide n evenly, there are only two possibilities: n is 0,
+ or else n is fixnum-min and d is abs(fixnum-min). */
+ if (nn == 0)
+ return SCM_INUM0;
+ else
+ return SCM_I_MAKINUM (-1);
+ }
+ else
+ SCM_WRONG_TYPE_ARG (2, d);
+ }
+ else if (SCM_LIKELY (SCM_BIGP (n)))
+ {
+ if (SCM_LIKELY (SCM_I_INUMP (d)))
+ {
+ scm_t_inum dd = SCM_I_INUM (d);
+ if (SCM_UNLIKELY (dd == 0))
+ scm_num_overflow ("exact-integer-quotient");
+ else if (SCM_UNLIKELY (dd == 1))
+ return n;
+ else
+ {
+ SCM q = scm_i_mkbig ();
+ if (dd > 0)
+ mpz_divexact_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (n), dd);
+ else
+ {
+ mpz_divexact_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (n), -dd);
+ mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
+ }
+ scm_remember_upto_here_1 (n);
+ return scm_i_normbig (q);
+ }
+ }
+ else if (SCM_LIKELY (SCM_BIGP (d)))
+ {
+ SCM q = scm_i_mkbig ();
+ mpz_divexact (SCM_I_BIG_MPZ (q),
+ SCM_I_BIG_MPZ (n),
+ SCM_I_BIG_MPZ (d));
+ scm_remember_upto_here_2 (n, d);
+ return scm_i_normbig (q);
+ }
+ else
+ SCM_WRONG_TYPE_ARG (2, d);
+ }
+ else
+ SCM_WRONG_TYPE_ARG (1, n);
+}
+#undef FUNC_NAME
+
/* two_valued_wta_dispatch_2 is a version of SCM_WTA_DISPATCH_2 for
two-valued functions. It is called from primitive generics that take
two arguments and return two values, when the core procedure is
@@ -3888,52 +4046,58 @@ SCM_PRIMITIVE_GENERIC (scm_i_gcd, "gcd", 0, 2, 1,
SCM
scm_gcd (SCM x, SCM y)
{
- if (SCM_UNBNDP (y))
+ if (SCM_UNLIKELY (SCM_UNBNDP (y)))
return SCM_UNBNDP (x) ? SCM_INUM0 : scm_abs (x);
- if (SCM_I_INUMP (x))
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
{
- if (SCM_I_INUMP (y))
+ if (SCM_LIKELY (SCM_I_INUMP (y)))
{
scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum yy = SCM_I_INUM (y);
scm_t_inum u = xx < 0 ? -xx : xx;
scm_t_inum v = yy < 0 ? -yy : yy;
scm_t_inum result;
- if (xx == 0)
+ if (SCM_UNLIKELY (xx == 0))
result = v;
- else if (yy == 0)
+ else if (SCM_UNLIKELY (yy == 0))
result = u;
else
{
- scm_t_inum k = 1;
- scm_t_inum t;
+ int k = 0;
/* Determine a common factor 2^k */
- while (!(1 & (u | v)))
+ while (((u | v) & 1) == 0)
{
- k <<= 1;
+ k++;
u >>= 1;
v >>= 1;
}
/* Now, any factor 2^n can be eliminated */
- if (u & 1)
- t = -v;
+ if ((u & 1) == 0)
+ while ((u & 1) == 0)
+ u >>= 1;
else
+ while ((v & 1) == 0)
+ v >>= 1;
+ /* Both u and v are now odd. Subtract the smaller one
+ from the larger one to produce an even number, remove
+ more factors of two, and repeat. */
+ while (u != v)
{
- t = u;
- b3:
- t = SCM_SRS (t, 1);
+ if (u > v)
+ {
+ u -= v;
+ while ((u & 1) == 0)
+ u >>= 1;
+ }
+ else
+ {
+ v -= u;
+ while ((v & 1) == 0)
+ v >>= 1;
+ }
}
- if (!(1 & t))
- goto b3;
- if (t > 0)
- u = t;
- else
- v = -t;
- t = u - v;
- if (t != 0)
- goto b3;
- result = u * k;
+ result = u << k;
}
return (SCM_POSFIXABLE (result)
? SCM_I_MAKINUM (result)
@@ -4666,6 +4830,26 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
else /* return NaN for (0 ^ k) for negative k per R6RS */
return scm_nan ();
}
+ else if (SCM_FRACTIONP (n))
+ {
+ /* Optimize the fraction case by (a/b)^k ==> (a^k)/(b^k), to avoid
+ needless reduction of intermediate products to lowest terms.
+ If a and b have no common factors, then a^k and b^k have no
+ common factors. Use 'scm_i_make_ratio_already_reduced' to
+ construct the final result, so that no gcd computations are
+ needed to exponentiate a fraction. */
+ if (scm_is_true (scm_positive_p (k)))
+ return scm_i_make_ratio_already_reduced
+ (scm_integer_expt (SCM_FRACTION_NUMERATOR (n), k),
+ scm_integer_expt (SCM_FRACTION_DENOMINATOR (n), k));
+ else
+ {
+ k = scm_difference (k, SCM_UNDEFINED);
+ return scm_i_make_ratio_already_reduced
+ (scm_integer_expt (SCM_FRACTION_DENOMINATOR (n), k),
+ scm_integer_expt (SCM_FRACTION_NUMERATOR (n), k));
+ }
+ }
if (SCM_I_INUMP (k))
i2 = SCM_I_INUM (k);
@@ -4723,19 +4907,119 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
}
#undef FUNC_NAME
+/* Efficiently compute (N * 2^COUNT),
+ where N is an exact integer, and COUNT > 0. */
+static SCM
+left_shift_exact_integer (SCM n, long count)
+{
+ if (SCM_I_INUMP (n))
+ {
+ scm_t_inum nn = SCM_I_INUM (n);
+
+ /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will always
+ overflow a non-zero fixnum. For smaller shifts we check the
+ bits going into positions above SCM_I_FIXNUM_BIT-1. If they're
+ all 0s for nn>=0, or all 1s for nn<0 then there's no overflow.
+ Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)". */
+
+ if (nn == 0)
+ return n;
+ else if (count < SCM_I_FIXNUM_BIT-1 &&
+ ((scm_t_bits) (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - count)) + 1)
+ <= 1))
+ return SCM_I_MAKINUM (nn << count);
+ else
+ {
+ SCM result = scm_i_inum2big (nn);
+ mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
+ count);
+ return result;
+ }
+ }
+ else if (SCM_BIGP (n))
+ {
+ SCM result = scm_i_mkbig ();
+ mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n), count);
+ scm_remember_upto_here_1 (n);
+ return result;
+ }
+ else
+ scm_syserror ("left_shift_exact_integer");
+}
+
+/* Efficiently compute floor (N / 2^COUNT),
+ where N is an exact integer and COUNT > 0. */
+static SCM
+floor_right_shift_exact_integer (SCM n, long count)
+{
+ if (SCM_I_INUMP (n))
+ {
+ scm_t_inum nn = SCM_I_INUM (n);
+
+ if (count >= SCM_I_FIXNUM_BIT)
+ return (nn >= 0 ? SCM_INUM0 : SCM_I_MAKINUM (-1));
+ else
+ return SCM_I_MAKINUM (SCM_SRS (nn, count));
+ }
+ else if (SCM_BIGP (n))
+ {
+ SCM result = scm_i_mkbig ();
+ mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n),
+ count);
+ scm_remember_upto_here_1 (n);
+ return scm_i_normbig (result);
+ }
+ else
+ scm_syserror ("floor_right_shift_exact_integer");
+}
+
+/* Efficiently compute round (N / 2^COUNT),
+ where N is an exact integer and COUNT > 0. */
+static SCM
+round_right_shift_exact_integer (SCM n, long count)
+{
+ if (SCM_I_INUMP (n))
+ {
+ if (count >= SCM_I_FIXNUM_BIT)
+ return SCM_INUM0;
+ else
+ {
+ scm_t_inum nn = SCM_I_INUM (n);
+ scm_t_inum qq = SCM_SRS (nn, count);
+
+ if (0 == (nn & (1L << (count-1))))
+ return SCM_I_MAKINUM (qq); /* round down */
+ else if (nn & ((1L << (count-1)) - 1))
+ return SCM_I_MAKINUM (qq + 1); /* round up */
+ else
+ return SCM_I_MAKINUM ((~1L) & (qq + 1)); /* round to even */
+ }
+ }
+ else if (SCM_BIGP (n))
+ {
+ SCM q = scm_i_mkbig ();
+
+ mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (n), count);
+ if (mpz_tstbit (SCM_I_BIG_MPZ (n), count-1)
+ && (mpz_odd_p (SCM_I_BIG_MPZ (q))
+ || (mpz_scan1 (SCM_I_BIG_MPZ (n), 0) < count-1)))
+ mpz_add_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q), 1);
+ scm_remember_upto_here_1 (n);
+ return scm_i_normbig (q);
+ }
+ else
+ scm_syserror ("round_right_shift_exact_integer");
+}
+
SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
- (SCM n, SCM cnt),
- "Return @var{n} shifted left by @var{cnt} bits, or shifted right\n"
- "if @var{cnt} is negative. This is an ``arithmetic'' shift.\n"
+ (SCM n, SCM count),
+ "Return @math{floor(@var{n} * address@hidden)}.\n"
+ "@var{n} and @var{count} must be exact integers.\n"
"\n"
- "This is effectively a multiplication by address@hidden, and when\n"
- "@var{cnt} is negative it's a division, rounded towards negative\n"
- "infinity. (Note that this is not the same rounding as\n"
- "@code{quotient} does.)\n"
- "\n"
- "With @var{n} viewed as an infinite precision twos complement,\n"
- "@code{ash} means a left shift introducing zero bits, or a right\n"
- "shift dropping bits.\n"
+ "With @var{n} viewed as an infinite-precision twos-complement\n"
+ "integer, @code{ash} means a left shift introducing zero bits\n"
+ "when @var{count} is positive, or a right shift dropping bits\n"
+ "when @var{count} is negative. This is an ``arithmetic'' shift.\n"
"\n"
"@lisp\n"
"(number->string (ash #b1 3) 2) @result{} \"1000\"\n"
@@ -4746,79 +5030,57 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_ash
{
- long bits_to_shift;
- bits_to_shift = scm_to_long (cnt);
-
- if (SCM_I_INUMP (n))
+ if (SCM_I_INUMP (n) || SCM_BIGP (n))
{
- scm_t_inum nn = SCM_I_INUM (n);
+ long bits_to_shift = scm_to_long (count);
if (bits_to_shift > 0)
- {
- /* Left shift of bits_to_shift >= SCM_I_FIXNUM_BIT-1 will always
- overflow a non-zero fixnum. For smaller shifts we check the
- bits going into positions above SCM_I_FIXNUM_BIT-1. If they're
- all 0s for nn>=0, or all 1s for nn<0 then there's no overflow.
- Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 -
- bits_to_shift)". */
-
- if (nn == 0)
- return n;
-
- if (bits_to_shift < SCM_I_FIXNUM_BIT-1
- && ((scm_t_bits)
- (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
- <= 1))
- {
- return SCM_I_MAKINUM (nn << bits_to_shift);
- }
- else
- {
- SCM result = scm_i_inum2big (nn);
- mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
- bits_to_shift);
- return result;
- }
- }
+ return left_shift_exact_integer (n, bits_to_shift);
+ else if (SCM_LIKELY (bits_to_shift < 0))
+ return floor_right_shift_exact_integer (n, -bits_to_shift);
else
- {
- bits_to_shift = -bits_to_shift;
- if (bits_to_shift >= SCM_LONG_BIT)
- return (nn >= 0 ? SCM_INUM0 : SCM_I_MAKINUM(-1));
- else
- return SCM_I_MAKINUM (SCM_SRS (nn, bits_to_shift));
- }
-
+ return n;
}
- else if (SCM_BIGP (n))
- {
- SCM result;
+ else
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+}
+#undef FUNC_NAME
- if (bits_to_shift == 0)
- return n;
+SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
+ (SCM n, SCM count),
+ "Return @math{round(@var{n} * address@hidden)}.\n"
+ "@var{n} and @var{count} must be exact integers.\n"
+ "\n"
+ "With @var{n} viewed as an infinite-precision twos-complement\n"
+ "integer, @code{round-ash} means a left shift introducing zero\n"
+ "bits when @var{count} is positive, or a right shift rounding\n"
+ "to the nearest integer (with ties going to the nearest even\n"
+ "integer) when @var{count} is negative. This is a rounded\n"
+ "``arithmetic'' shift.\n"
+ "\n"
+ "@lisp\n"
+ "(number->string (round-ash #b1 3) 2) @result{} \"1000\"\n"
+ "(number->string (round-ash #b1010 -1) 2) @result{} \"101\"\n"
+ "(number->string (round-ash #b1010 -2) 2) @result{} \"10\"\n"
+ "(number->string (round-ash #b1011 -2) 2) @result{} \"11\"\n"
+ "(number->string (round-ash #b1101 -2) 2) @result{} \"11\"\n"
+ "(number->string (round-ash #b1110 -2) 2) @result{} \"100\"\n"
+ "@end lisp")
+#define FUNC_NAME s_scm_round_ash
+{
+ if (SCM_I_INUMP (n) || SCM_BIGP (n))
+ {
+ long bits_to_shift = scm_to_long (count);
- result = scm_i_mkbig ();
- if (bits_to_shift >= 0)
- {
- mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n),
- bits_to_shift);
- return result;
- }
+ if (bits_to_shift > 0)
+ return left_shift_exact_integer (n, bits_to_shift);
+ else if (SCM_LIKELY (bits_to_shift < 0))
+ return round_right_shift_exact_integer (n, -bits_to_shift);
else
- {
- /* GMP doesn't have an fdiv_q_2exp variant returning just a long, so
- we have to allocate a bignum even if the result is going to be a
- fixnum. */
- mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n),
- -bits_to_shift);
- return scm_i_normbig (result);
- }
-
+ return n;
}
else
- {
- SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
- }
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
}
#undef FUNC_NAME
@@ -4998,220 +5260,230 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1,
0, 0,
#undef FUNC_NAME
/*** NUMBERS -> STRINGS ***/
-#define SCM_MAX_DBL_PREC 60
#define SCM_MAX_DBL_RADIX 36
-/* this is an array starting with radix 2, and ending with radix
SCM_MAX_DBL_RADIX */
-static int scm_dblprec[SCM_MAX_DBL_RADIX - 1];
-static double fx_per_radix[SCM_MAX_DBL_RADIX - 1][SCM_MAX_DBL_PREC];
-
-static
-void init_dblprec(int *prec, int radix) {
- /* determine floating point precision by adding successively
- smaller increments to 1.0 until it is considered == 1.0 */
- double f = ((double)1.0)/radix;
- double fsum = 1.0 + f;
-
- *prec = 0;
- while (fsum != 1.0)
- {
- if (++(*prec) > SCM_MAX_DBL_PREC)
- fsum = 1.0;
- else
- {
- f /= radix;
- fsum = f + 1.0;
- }
- }
- (*prec) -= 1;
-}
-
-static
-void init_fx_radix(double *fx_list, int radix)
-{
- /* initialize a per-radix list of tolerances. When added
- to a number < 1.0, we can determine if we should raund
- up and quit converting a number to a string. */
- int i;
- fx_list[0] = 0.0;
- fx_list[1] = 0.5;
- for( i = 2 ; i < SCM_MAX_DBL_PREC; ++i )
- fx_list[i] = (fx_list[i-1] / radix);
-}
-
/* use this array as a way to generate a single digit */
static const char number_chars[] = "0123456789abcdefghijklmnopqrstuvwxyz";
+static mpz_t dbl_minimum_normal_mantissa;
+
static size_t
-idbl2str (double f, char *a, int radix)
+idbl2str (double dbl, char *a, int radix)
{
- int efmt, dpt, d, i, wp;
- double *fx;
-#ifdef DBL_MIN_10_EXP
- double f_cpy;
- int exp_cpy;
-#endif /* DBL_MIN_10_EXP */
- size_t ch = 0;
- int exp = 0;
-
- if(radix < 2 ||
- radix > SCM_MAX_DBL_RADIX)
- {
- /* revert to existing behavior */
- radix = 10;
- }
+ int ch = 0;
- wp = scm_dblprec[radix-2];
- fx = fx_per_radix[radix-2];
+ if (radix < 2 || radix > SCM_MAX_DBL_RADIX)
+ /* revert to existing behavior */
+ radix = 10;
- if (f == 0.0)
+ if (isinf (dbl))
{
-#ifdef HAVE_COPYSIGN
- double sgn = copysign (1.0, f);
-
- if (sgn < 0.0)
- a[ch++] = '-';
-#endif
- goto zero; /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;} */
+ strcpy (a, (dbl > 0.0) ? "+inf.0" : "-inf.0");
+ return 6;
}
-
- if (isinf (f))
+ else if (dbl > 0.0)
+ ;
+ else if (dbl < 0.0)
{
- if (f < 0)
- strcpy (a, "-inf.0");
- else
- strcpy (a, "+inf.0");
- return ch+6;
+ dbl = -dbl;
+ a[ch++] = '-';
}
- else if (isnan (f))
+ else if (dbl == 0.0)
{
- strcpy (a, "+nan.0");
- return ch+6;
+ if (!double_is_non_negative_zero (dbl))
+ a[ch++] = '-';
+ strcpy (a + ch, "0.0");
+ return ch + 3;
}
-
- if (f < 0.0)
+ else if (isnan (dbl))
{
- f = -f;
- a[ch++] = '-';
+ strcpy (a, "+nan.0");
+ return 6;
}
-#ifdef DBL_MIN_10_EXP /* Prevent unnormalized values, as from
- make-uniform-vector, from causing infinite loops. */
- /* just do the checking...if it passes, we do the conversion for our
- radix again below */
- f_cpy = f;
- exp_cpy = exp;
+ /* Algorithm taken from "Printing Floating-Point Numbers Quickly and
+ Accurately" by Robert G. Burger and R. Kent Dybvig */
+ {
+ int e, k;
+ mpz_t f, r, s, mplus, mminus, hi, digit;
+ int f_is_even, f_is_odd;
+ int expon;
+ int show_exp = 0;
+
+ mpz_inits (f, r, s, mplus, mminus, hi, digit, NULL);
+ mpz_set_d (f, ldexp (frexp (dbl, &e), DBL_MANT_DIG));
+ if (e < DBL_MIN_EXP)
+ {
+ mpz_tdiv_q_2exp (f, f, DBL_MIN_EXP - e);
+ e = DBL_MIN_EXP;
+ }
+ e -= DBL_MANT_DIG;
- while (f_cpy < 1.0)
- {
- f_cpy *= 10.0;
- if (exp_cpy-- < DBL_MIN_10_EXP)
- {
- a[ch++] = '#';
- a[ch++] = '.';
- a[ch++] = '#';
- return ch;
- }
- }
- while (f_cpy > 10.0)
- {
- f_cpy *= 0.10;
- if (exp_cpy++ > DBL_MAX_10_EXP)
- {
- a[ch++] = '#';
- a[ch++] = '.';
- a[ch++] = '#';
- return ch;
- }
- }
-#endif
+ f_is_even = !mpz_odd_p (f);
+ f_is_odd = !f_is_even;
- while (f < 1.0)
- {
- f *= radix;
- exp--;
- }
- while (f > radix)
- {
- f /= radix;
- exp++;
- }
+ /* Initialize r, s, mplus, and mminus according
+ to Table 1 from the paper. */
+ if (e < 0)
+ {
+ mpz_set_ui (mminus, 1);
+ if (mpz_cmp (f, dbl_minimum_normal_mantissa) != 0
+ || e == DBL_MIN_EXP - DBL_MANT_DIG)
+ {
+ mpz_set_ui (mplus, 1);
+ mpz_mul_2exp (r, f, 1);
+ mpz_mul_2exp (s, mminus, 1 - e);
+ }
+ else
+ {
+ mpz_set_ui (mplus, 2);
+ mpz_mul_2exp (r, f, 2);
+ mpz_mul_2exp (s, mminus, 2 - e);
+ }
+ }
+ else
+ {
+ mpz_set_ui (mminus, 1);
+ mpz_mul_2exp (mminus, mminus, e);
+ if (mpz_cmp (f, dbl_minimum_normal_mantissa) != 0)
+ {
+ mpz_set (mplus, mminus);
+ mpz_mul_2exp (r, f, 1 + e);
+ mpz_set_ui (s, 2);
+ }
+ else
+ {
+ mpz_mul_2exp (mplus, mminus, 1);
+ mpz_mul_2exp (r, f, 2 + e);
+ mpz_set_ui (s, 4);
+ }
+ }
- if (f + fx[wp] >= radix)
+ /* Find the smallest k such that:
+ (r + mplus) / s < radix^k (if f is even)
+ (r + mplus) / s <= radix^k (if f is odd) */
{
- f = 1.0;
- exp++;
- }
- zero:
- efmt = (exp < -3) || (exp > wp + 2);
- if (!efmt)
- {
- if (exp < 0)
- {
- a[ch++] = '0';
- a[ch++] = '.';
- dpt = exp;
- while (++dpt)
- a[ch++] = '0';
- }
- else
- dpt = exp + 1;
+ /* IMPROVE-ME: Make an initial guess to speed this up */
+ mpz_add (hi, r, mplus);
+ k = 0;
+ while (mpz_cmp (hi, s) >= f_is_odd)
+ {
+ mpz_mul_ui (s, s, radix);
+ k++;
+ }
+ if (k == 0)
+ {
+ mpz_mul_ui (hi, hi, radix);
+ while (mpz_cmp (hi, s) < f_is_odd)
+ {
+ mpz_mul_ui (r, r, radix);
+ mpz_mul_ui (mplus, mplus, radix);
+ mpz_mul_ui (mminus, mminus, radix);
+ mpz_mul_ui (hi, hi, radix);
+ k--;
+ }
+ }
}
- else
- dpt = 1;
- do
- {
- d = f;
- f -= d;
- a[ch++] = number_chars[d];
- if (f < fx[wp])
- break;
- if (f + fx[wp] >= 1.0)
- {
- a[ch - 1] = number_chars[d+1];
- break;
- }
- f *= radix;
- if (!(--dpt))
- a[ch++] = '.';
- }
- while (wp--);
+ expon = k - 1;
+ if (k <= 0)
+ {
+ if (k <= -3)
+ {
+ /* Use scientific notation */
+ show_exp = 1;
+ k = 1;
+ }
+ else
+ {
+ int i;
- if (dpt > 0)
- {
- if ((dpt > 4) && (exp > 6))
- {
- d = (a[0] == '-' ? 2 : 1);
- for (i = ch++; i > d; i--)
- a[i] = a[i - 1];
- a[d] = '.';
- efmt = 1;
- }
- else
- {
- while (--dpt)
- a[ch++] = '0';
- a[ch++] = '.';
- }
- }
- if (a[ch - 1] == '.')
- a[ch++] = '0'; /* trailing zero */
- if (efmt && exp)
- {
- a[ch++] = 'e';
- if (exp < 0)
- {
- exp = -exp;
- a[ch++] = '-';
- }
- for (i = radix; i <= exp; i *= radix);
- for (i /= radix; i; i /= radix)
- {
- a[ch++] = number_chars[exp / i];
- exp %= i;
- }
- }
+ /* Print leading zeroes */
+ a[ch++] = '0';
+ a[ch++] = '.';
+ for (i = 0; i > k; i--)
+ a[ch++] = '0';
+ }
+ }
+
+ for (;;)
+ {
+ int end_1_p, end_2_p;
+ int d;
+
+ mpz_mul_ui (mplus, mplus, radix);
+ mpz_mul_ui (mminus, mminus, radix);
+ mpz_mul_ui (r, r, radix);
+ mpz_fdiv_qr (digit, r, r, s);
+ d = mpz_get_ui (digit);
+
+ mpz_add (hi, r, mplus);
+ end_1_p = (mpz_cmp (r, mminus) < f_is_even);
+ end_2_p = (mpz_cmp (s, hi) < f_is_even);
+ if (end_1_p || end_2_p)
+ {
+ mpz_mul_2exp (r, r, 1);
+ if (!end_2_p)
+ ;
+ else if (!end_1_p)
+ d++;
+ else if (mpz_cmp (r, s) >= !(d & 1))
+ d++;
+ a[ch++] = number_chars[d];
+ if (--k == 0)
+ a[ch++] = '.';
+ break;
+ }
+ else
+ {
+ a[ch++] = number_chars[d];
+ if (--k == 0)
+ a[ch++] = '.';
+ }
+ }
+
+ if (k > 0)
+ {
+ if (expon >= 7 && k >= 4 && expon >= k)
+ {
+ /* Here we would have to print more than three zeroes
+ followed by a decimal point and another zero. It
+ makes more sense to use scientific notation. */
+
+ /* Adjust k to what it would have been if we had chosen
+ scientific notation from the beginning. */
+ k -= expon;
+
+ /* k will now be <= 0, with magnitude equal to the number of
+ digits that we printed which should now be put after the
+ decimal point. */
+
+ /* Insert a decimal point */
+ memmove (a + ch + k + 1, a + ch + k, -k);
+ a[ch + k] = '.';
+ ch++;
+
+ show_exp = 1;
+ }
+ else
+ {
+ for (; k > 0; k--)
+ a[ch++] = '0';
+ a[ch++] = '.';
+ }
+ }
+
+ if (k == 0)
+ a[ch++] = '0';
+
+ if (show_exp)
+ {
+ a[ch++] = 'e';
+ ch += scm_iint2str (expon, radix, a + ch);
+ }
+
+ mpz_clears (f, r, s, mplus, mminus, hi, digit, NULL);
+ }
return ch;
}
@@ -5695,7 +5967,7 @@ mem2decimal_from_point (SCM result, SCM mem,
break;
}
- if (exponent > SCM_MAXEXP)
+ if (exponent > ((sign == 1) ? SCM_MAXEXP : SCM_MAXEXP + DBL_DIG + 1))
{
size_t exp_len = idx - start;
SCM exp_string = scm_i_substring_copy (mem, start, start +
exp_len);
@@ -5731,7 +6003,8 @@ mem2decimal_from_point (SCM result, SCM mem,
static SCM
mem2ureal (SCM mem, unsigned int *p_idx,
- unsigned int radix, enum t_exactness forced_x)
+ unsigned int radix, enum t_exactness forced_x,
+ int allow_inf_or_nan)
{
unsigned int idx = *p_idx;
SCM result;
@@ -5744,30 +6017,53 @@ mem2ureal (SCM mem, unsigned int *p_idx,
if (idx == len)
return SCM_BOOL_F;
- if (idx+5 <= len && !scm_i_string_strcmp (mem, idx, "inf.0"))
- {
- *p_idx = idx+5;
- return scm_inf ();
- }
-
- if (idx+4 < len && !scm_i_string_strcmp (mem, idx, "nan."))
- {
- /* Cobble up the fractional part. We might want to set the
- NaN's mantissa from it. */
- idx += 4;
- if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x), SCM_INUM0))
- {
+ if (allow_inf_or_nan && forced_x != EXACT && idx+5 <= len)
+ switch (scm_i_string_ref (mem, idx))
+ {
+ case 'i': case 'I':
+ switch (scm_i_string_ref (mem, idx + 1))
+ {
+ case 'n': case 'N':
+ switch (scm_i_string_ref (mem, idx + 2))
+ {
+ case 'f': case 'F':
+ if (scm_i_string_ref (mem, idx + 3) == '.'
+ && scm_i_string_ref (mem, idx + 4) == '0')
+ {
+ *p_idx = idx+5;
+ return scm_inf ();
+ }
+ }
+ }
+ case 'n': case 'N':
+ switch (scm_i_string_ref (mem, idx + 1))
+ {
+ case 'a': case 'A':
+ switch (scm_i_string_ref (mem, idx + 2))
+ {
+ case 'n': case 'N':
+ if (scm_i_string_ref (mem, idx + 3) == '.')
+ {
+ /* Cobble up the fractional part. We might want to
+ set the NaN's mantissa from it. */
+ idx += 4;
+ if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x),
+ SCM_INUM0))
+ {
#if SCM_ENABLE_DEPRECATED == 1
- scm_c_issue_deprecation_warning
- ("Non-zero suffixes to `+nan.' are deprecated. Use `+nan.0'.");
+ scm_c_issue_deprecation_warning
+ ("Non-zero suffixes to `+nan.' are deprecated. Use
`+nan.0'.");
#else
- return SCM_BOOL_F;
+ return SCM_BOOL_F;
#endif
- }
+ }
- *p_idx = idx;
- return scm_nan ();
- }
+ *p_idx = idx;
+ return scm_nan ();
+ }
+ }
+ }
+ }
if (scm_i_string_ref (mem, idx) == '.')
{
@@ -5800,7 +6096,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
return SCM_BOOL_F;
divisor = mem2uinteger (mem, &idx, radix, &implicit_x);
- if (scm_is_false (divisor))
+ if (scm_is_false (divisor) || scm_is_eq (divisor, SCM_INUM0))
return SCM_BOOL_F;
/* both are int/big here, I assume */
@@ -5876,7 +6172,7 @@ mem2complex (SCM mem, unsigned int idx,
if (idx == len)
return SCM_BOOL_F;
- ureal = mem2ureal (mem, &idx, radix, forced_x);
+ ureal = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
if (scm_is_false (ureal))
{
/* input must be either +i or -i */
@@ -5945,9 +6241,9 @@ mem2complex (SCM mem, unsigned int idx,
sign = -1;
}
else
- sign = 1;
+ sign = 0;
- angle = mem2ureal (mem, &idx, radix, forced_x);
+ angle = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
if (scm_is_false (angle))
return SCM_BOOL_F;
if (idx != len)
@@ -5969,7 +6265,7 @@ mem2complex (SCM mem, unsigned int idx,
else
{
int sign = (c == '+') ? 1 : -1;
- SCM imag = mem2ureal (mem, &idx, radix, forced_x);
+ SCM imag = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
if (scm_is_false (imag))
imag = SCM_I_MAKINUM (sign);
@@ -7323,8 +7619,9 @@ scm_difference (SCM x, SCM y)
return scm_c_make_rectangular (-SCM_COMPLEX_REAL (x),
-SCM_COMPLEX_IMAG (x));
else if (SCM_FRACTIONP (x))
- return scm_i_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x),
SCM_UNDEFINED),
- SCM_FRACTION_DENOMINATOR (x));
+ return scm_i_make_ratio_already_reduced
+ (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED),
+ SCM_FRACTION_DENOMINATOR (x));
else
return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference);
}
@@ -7850,8 +8147,8 @@ SCM_PRIMITIVE_GENERIC (scm_i_divide, "/", 0, 2, 1,
#define s_divide s_scm_i_divide
#define g_divide g_scm_i_divide
-static SCM
-do_divide (SCM x, SCM y, int inexact)
+SCM
+scm_divide (SCM x, SCM y)
#define FUNC_NAME s_divide
{
double a;
@@ -7870,18 +8167,10 @@ do_divide (SCM x, SCM y, int inexact)
scm_num_overflow (s_divide);
#endif
else
- {
- if (inexact)
- return scm_from_double (1.0 / (double) xx);
- else return scm_i_make_ratio (SCM_INUM1, x);
- }
+ return scm_i_make_ratio_already_reduced (SCM_INUM1, x);
}
else if (SCM_BIGP (x))
- {
- if (inexact)
- return scm_from_double (1.0 / scm_i_big2dbl (x));
- else return scm_i_make_ratio (SCM_INUM1, x);
- }
+ return scm_i_make_ratio_already_reduced (SCM_INUM1, x);
else if (SCM_REALP (x))
{
double xx = SCM_REAL_VALUE (x);
@@ -7910,8 +8199,8 @@ do_divide (SCM x, SCM y, int inexact)
}
}
else if (SCM_FRACTIONP (x))
- return scm_i_make_ratio (SCM_FRACTION_DENOMINATOR (x),
- SCM_FRACTION_NUMERATOR (x));
+ return scm_i_make_ratio_already_reduced (SCM_FRACTION_DENOMINATOR (x),
+ SCM_FRACTION_NUMERATOR (x));
else
return scm_wta_dispatch_1 (g_divide, x, SCM_ARG1, s_divide);
}
@@ -7931,11 +8220,7 @@ do_divide (SCM x, SCM y, int inexact)
#endif
}
else if (xx % yy != 0)
- {
- if (inexact)
- return scm_from_double ((double) xx / (double) yy);
- else return scm_i_make_ratio (x, y);
- }
+ return scm_i_make_ratio (x, y);
else
{
scm_t_inum z = xx / yy;
@@ -7946,11 +8231,7 @@ do_divide (SCM x, SCM y, int inexact)
}
}
else if (SCM_BIGP (y))
- {
- if (inexact)
- return scm_from_double ((double) xx / scm_i_big2dbl (y));
- else return scm_i_make_ratio (x, y);
- }
+ return scm_i_make_ratio (x, y);
else if (SCM_REALP (y))
{
double yy = SCM_REAL_VALUE (y);
@@ -7959,6 +8240,9 @@ do_divide (SCM x, SCM y, int inexact)
scm_num_overflow (s_divide);
else
#endif
+ /* FIXME: Precision may be lost here due to:
+ (1) The cast from 'scm_t_inum' to 'double'
+ (2) Double rounding */
return scm_from_double ((double) xx / yy);
}
else if (SCM_COMPLEXP (y))
@@ -7985,7 +8269,7 @@ do_divide (SCM x, SCM y, int inexact)
else if (SCM_FRACTIONP (y))
/* a / b/c = ac / b */
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)),
- SCM_FRACTION_NUMERATOR (y));
+ SCM_FRACTION_NUMERATOR (y));
else
return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
@@ -8029,43 +8313,24 @@ do_divide (SCM x, SCM y, int inexact)
return scm_i_normbig (result);
}
else
- {
- if (inexact)
- return scm_from_double (scm_i_big2dbl (x) / (double) yy);
- else return scm_i_make_ratio (x, y);
- }
+ return scm_i_make_ratio (x, y);
}
}
else if (SCM_BIGP (y))
{
- /* big_x / big_y */
- if (inexact)
- {
- /* It's easily possible for the ratio x/y to fit a double
- but one or both x and y be too big to fit a double,
- hence the use of mpq_get_d rather than converting and
- dividing. */
- mpq_t q;
- *mpq_numref(q) = *SCM_I_BIG_MPZ (x);
- *mpq_denref(q) = *SCM_I_BIG_MPZ (y);
- return scm_from_double (mpq_get_d (q));
- }
- else
- {
- int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
- SCM_I_BIG_MPZ (y));
- if (divisible_p)
- {
- SCM result = scm_i_mkbig ();
- mpz_divexact (SCM_I_BIG_MPZ (result),
- SCM_I_BIG_MPZ (x),
- SCM_I_BIG_MPZ (y));
- scm_remember_upto_here_2 (x, y);
- return scm_i_normbig (result);
- }
- else
- return scm_i_make_ratio (x, y);
- }
+ int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
+ SCM_I_BIG_MPZ (y));
+ if (divisible_p)
+ {
+ SCM result = scm_i_mkbig ();
+ mpz_divexact (SCM_I_BIG_MPZ (result),
+ SCM_I_BIG_MPZ (x),
+ SCM_I_BIG_MPZ (y));
+ scm_remember_upto_here_2 (x, y);
+ return scm_i_normbig (result);
+ }
+ else
+ return scm_i_make_ratio (x, y);
}
else if (SCM_REALP (y))
{
@@ -8075,6 +8340,8 @@ do_divide (SCM x, SCM y, int inexact)
scm_num_overflow (s_divide);
else
#endif
+ /* FIXME: Precision may be lost here due to:
+ (1) scm_i_big2dbl (2) Double rounding */
return scm_from_double (scm_i_big2dbl (x) / yy);
}
else if (SCM_COMPLEXP (y))
@@ -8084,7 +8351,7 @@ do_divide (SCM x, SCM y, int inexact)
}
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)),
- SCM_FRACTION_NUMERATOR (y));
+ SCM_FRACTION_NUMERATOR (y));
else
return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
@@ -8099,10 +8366,16 @@ do_divide (SCM x, SCM y, int inexact)
scm_num_overflow (s_divide);
else
#endif
+ /* FIXME: Precision may be lost here due to:
+ (1) The cast from 'scm_t_inum' to 'double'
+ (2) Double rounding */
return scm_from_double (rx / (double) yy);
}
else if (SCM_BIGP (y))
{
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from bignum to double
+ (2) Double rounding */
double dby = mpz_get_d (SCM_I_BIG_MPZ (y));
scm_remember_upto_here_1 (y);
return scm_from_double (rx / dby);
@@ -8140,12 +8413,18 @@ do_divide (SCM x, SCM y, int inexact)
else
#endif
{
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from 'scm_t_inum' to double
+ (2) Double rounding */
double d = yy;
return scm_c_make_rectangular (rx / d, ix / d);
}
}
else if (SCM_BIGP (y))
{
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from bignum to double
+ (2) Double rounding */
double dby = mpz_get_d (SCM_I_BIG_MPZ (y));
scm_remember_upto_here_1 (y);
return scm_c_make_rectangular (rx / dby, ix / dby);
@@ -8179,6 +8458,9 @@ do_divide (SCM x, SCM y, int inexact)
}
else if (SCM_FRACTIONP (y))
{
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from fraction to double
+ (2) Double rounding */
double yy = scm_i_fraction2double (y);
return scm_c_make_rectangular (rx / yy, ix / yy);
}
@@ -8196,12 +8478,12 @@ do_divide (SCM x, SCM y, int inexact)
else
#endif
return scm_i_make_ratio (SCM_FRACTION_NUMERATOR (x),
- scm_product (SCM_FRACTION_DENOMINATOR (x),
y));
+ scm_product (SCM_FRACTION_DENOMINATOR
(x), y));
}
else if (SCM_BIGP (y))
{
return scm_i_make_ratio (SCM_FRACTION_NUMERATOR (x),
- scm_product (SCM_FRACTION_DENOMINATOR (x), y));
+ scm_product (SCM_FRACTION_DENOMINATOR (x),
y));
}
else if (SCM_REALP (y))
{
@@ -8211,33 +8493,28 @@ do_divide (SCM x, SCM y, int inexact)
scm_num_overflow (s_divide);
else
#endif
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from fraction to double
+ (2) Double rounding */
return scm_from_double (scm_i_fraction2double (x) / yy);
}
else if (SCM_COMPLEXP (y))
{
+ /* FIXME: Precision may be lost here due to:
+ (1) The conversion from fraction to double
+ (2) Double rounding */
a = scm_i_fraction2double (x);
goto complex_div;
}
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio (scm_product (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (y)),
- scm_product (SCM_FRACTION_NUMERATOR (y),
SCM_FRACTION_DENOMINATOR (x)));
+ scm_product (SCM_FRACTION_NUMERATOR (y),
SCM_FRACTION_DENOMINATOR (x)));
else
return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else
return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARG1, s_divide);
}
-
-SCM
-scm_divide (SCM x, SCM y)
-{
- return do_divide (x, y, 0);
-}
-
-static SCM scm_divide2real (SCM x, SCM y)
-{
- return do_divide (x, y, 1);
-}
#undef FUNC_NAME
@@ -8875,8 +9152,9 @@ SCM_PRIMITIVE_GENERIC (scm_magnitude, "magnitude", 1, 0,
0,
{
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z))))
return z;
- return scm_i_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (z),
SCM_UNDEFINED),
- SCM_FRACTION_DENOMINATOR (z));
+ return scm_i_make_ratio_already_reduced
+ (scm_difference (SCM_FRACTION_NUMERATOR (z), SCM_UNDEFINED),
+ SCM_FRACTION_DENOMINATOR (z));
}
else
return scm_wta_dispatch_1 (g_scm_magnitude, z, SCM_ARG1,
@@ -8973,21 +9251,35 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact,
"inexact->exact", 1, 0, 0,
if (!SCM_LIKELY (DOUBLE_IS_FINITE (val)))
SCM_OUT_OF_RANGE (1, z);
+ else if (val == 0.0)
+ return SCM_INUM0;
else
{
- mpq_t frac;
- SCM q;
-
- mpq_init (frac);
- mpq_set_d (frac, val);
- q = scm_i_make_ratio (scm_i_mpz2num (mpq_numref (frac)),
- scm_i_mpz2num (mpq_denref (frac)));
+ int expon;
+ SCM numerator;
- /* When scm_i_make_ratio throws, we leak the memory allocated
- for frac...
- */
- mpq_clear (frac);
- return q;
+ numerator = scm_i_dbl2big (ldexp (frexp (val, &expon),
+ DBL_MANT_DIG));
+ expon -= DBL_MANT_DIG;
+ if (expon < 0)
+ {
+ int shift = mpz_scan1 (SCM_I_BIG_MPZ (numerator), 0);
+
+ if (shift > -expon)
+ shift = -expon;
+ mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (numerator),
+ SCM_I_BIG_MPZ (numerator),
+ shift);
+ expon += shift;
+ }
+ numerator = scm_i_normbig (numerator);
+ if (expon < 0)
+ return scm_i_make_ratio_already_reduced
+ (numerator, left_shift_exact_integer (SCM_INUM1, -expon));
+ else if (expon > 0)
+ return left_shift_exact_integer (numerator, expon);
+ else
+ return numerator;
}
}
}
@@ -9423,26 +9715,20 @@ log_of_shifted_double (double x, long shift)
return scm_c_make_rectangular (ans, M_PI);
}
-/* Returns log(n), for exact integer n of integer-length size */
-static SCM
-log_of_exact_integer_with_size (SCM n, long size)
-{
- long shift = size - 2 * scm_dblprec[0];
-
- if (shift > 0)
- return log_of_shifted_double
- (scm_to_double (scm_ash (n, scm_from_long(-shift))),
- shift);
- else
- return log_of_shifted_double (scm_to_double (n), 0);
-}
-
/* Returns log(n), for exact integer n */
static SCM
log_of_exact_integer (SCM n)
{
- return log_of_exact_integer_with_size
- (n, scm_to_long (scm_integer_length (n)));
+ if (SCM_I_INUMP (n))
+ return log_of_shifted_double (SCM_I_INUM (n), 0);
+ else if (SCM_BIGP (n))
+ {
+ long expon;
+ double signif = scm_i_big2dbl_2exp (n, &expon);
+ return log_of_shifted_double (signif, expon);
+ }
+ else
+ scm_wrong_type_arg ("log_of_exact_integer", SCM_ARG1, n);
}
/* Returns log(n/d), for exact non-zero integers n and d */
@@ -9453,16 +9739,15 @@ log_of_fraction (SCM n, SCM d)
long d_size = scm_to_long (scm_integer_length (d));
if (abs (n_size - d_size) > 1)
- return (scm_difference (log_of_exact_integer_with_size (n, n_size),
- log_of_exact_integer_with_size (d, d_size)));
+ return (scm_difference (log_of_exact_integer (n),
+ log_of_exact_integer (d)));
else if (scm_is_false (scm_negative_p (n)))
return scm_from_double
- (log1p (scm_to_double (scm_divide2real (scm_difference (n, d), d))));
+ (log1p (scm_i_divide2double (scm_difference (n, d), d)));
else
return scm_c_make_rectangular
- (log1p (scm_to_double (scm_divide2real
- (scm_difference (scm_abs (n), d),
- d))),
+ (log1p (scm_i_divide2double (scm_difference (scm_abs (n), d),
+ d)),
M_PI);
}
@@ -9610,25 +9895,17 @@ scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp)
{
if (SCM_LIKELY (SCM_I_INUMP (k)))
{
- scm_t_inum kk = SCM_I_INUM (k);
- scm_t_inum uu = kk;
- scm_t_inum ss;
+ mpz_t kk, ss, rr;
- if (SCM_LIKELY (kk > 0))
- {
- do
- {
- ss = uu;
- uu = (ss + kk/ss) / 2;
- } while (uu < ss);
- *sp = SCM_I_MAKINUM (ss);
- *rp = SCM_I_MAKINUM (kk - ss*ss);
- }
- else if (SCM_LIKELY (kk == 0))
- *sp = *rp = SCM_INUM0;
- else
+ if (SCM_I_INUM (k) < 0)
scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
"exact non-negative integer");
+ mpz_init_set_ui (kk, SCM_I_INUM (k));
+ mpz_inits (ss, rr, NULL);
+ mpz_sqrtrem (ss, rr, kk);
+ *sp = SCM_I_MAKINUM (mpz_get_ui (ss));
+ *rp = SCM_I_MAKINUM (mpz_get_ui (rr));
+ mpz_clears (kk, ss, rr, NULL);
}
else if (SCM_LIKELY (SCM_BIGP (k)))
{
@@ -9649,6 +9926,56 @@ scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp)
"exact non-negative integer");
}
+/* Return true iff K is a perfect square.
+ K must be an exact integer. */
+static int
+exact_integer_is_perfect_square (SCM k)
+{
+ int result;
+
+ if (SCM_LIKELY (SCM_I_INUMP (k)))
+ {
+ mpz_t kk;
+
+ mpz_init_set_si (kk, SCM_I_INUM (k));
+ result = mpz_perfect_square_p (kk);
+ mpz_clear (kk);
+ }
+ else
+ {
+ result = mpz_perfect_square_p (SCM_I_BIG_MPZ (k));
+ scm_remember_upto_here_1 (k);
+ }
+ return result;
+}
+
+/* Return the floor of the square root of K.
+ K must be an exact integer. */
+static SCM
+exact_integer_floor_square_root (SCM k)
+{
+ if (SCM_LIKELY (SCM_I_INUMP (k)))
+ {
+ mpz_t kk;
+ scm_t_inum ss;
+
+ mpz_init_set_ui (kk, SCM_I_INUM (k));
+ mpz_sqrt (kk, kk);
+ ss = mpz_get_ui (kk);
+ mpz_clear (kk);
+ return SCM_I_MAKINUM (ss);
+ }
+ else
+ {
+ SCM s;
+
+ s = scm_i_mkbig ();
+ mpz_sqrt (SCM_I_BIG_MPZ (s), SCM_I_BIG_MPZ (k));
+ scm_remember_upto_here_1 (k);
+ return scm_i_normbig (s);
+ }
+}
+
SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
(SCM z),
@@ -9679,11 +10006,111 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
}
else if (SCM_NUMBERP (z))
{
- double xx = scm_to_double (z);
- if (xx < 0)
- return scm_c_make_rectangular (0.0, sqrt (-xx));
- else
- return scm_from_double (sqrt (xx));
+ if (SCM_I_INUMP (z))
+ {
+ scm_t_inum x = SCM_I_INUM (z);
+
+ if (SCM_LIKELY (x >= 0))
+ {
+ if (SCM_LIKELY (SCM_I_FIXNUM_BIT < DBL_MANT_DIG
+ || x < (1L << (DBL_MANT_DIG - 1))))
+ {
+ double root = sqrt (x);
+
+ /* If 0 <= x < 2^(DBL_MANT_DIG-1) and sqrt(x) is an
+ integer, then the result is exact. */
+ if (root == floor (root))
+ return SCM_I_MAKINUM ((scm_t_inum) root);
+ else
+ return scm_from_double (root);
+ }
+ else
+ {
+ mpz_t xx;
+ scm_t_inum root;
+
+ mpz_init_set_ui (xx, x);
+ if (mpz_perfect_square_p (xx))
+ {
+ mpz_sqrt (xx, xx);
+ root = mpz_get_ui (xx);
+ mpz_clear (xx);
+ return SCM_I_MAKINUM (root);
+ }
+ else
+ mpz_clear (xx);
+ }
+ }
+ }
+ else if (SCM_BIGP (z))
+ {
+ if (mpz_perfect_square_p (SCM_I_BIG_MPZ (z)))
+ {
+ SCM root = scm_i_mkbig ();
+
+ mpz_sqrt (SCM_I_BIG_MPZ (root), SCM_I_BIG_MPZ (z));
+ scm_remember_upto_here_1 (z);
+ return scm_i_normbig (root);
+ }
+ else
+ {
+ long expon;
+ double signif = scm_i_big2dbl_2exp (z, &expon);
+
+ if (expon & 1)
+ {
+ signif *= 2;
+ expon--;
+ }
+ if (signif < 0)
+ return scm_c_make_rectangular
+ (0.0, ldexp (sqrt (-signif), expon / 2));
+ else
+ return scm_from_double (ldexp (sqrt (signif), expon / 2));
+ }
+ }
+ else if (SCM_FRACTIONP (z))
+ {
+ SCM n = SCM_FRACTION_NUMERATOR (z);
+ SCM d = SCM_FRACTION_DENOMINATOR (z);
+
+ if (exact_integer_is_perfect_square (n)
+ && exact_integer_is_perfect_square (d))
+ return scm_i_make_ratio_already_reduced
+ (exact_integer_floor_square_root (n),
+ exact_integer_floor_square_root (d));
+ else
+ {
+ double xx = scm_i_divide2double (n, d);
+ double abs_xx = fabs (xx);
+ long shift = 0;
+
+ if (SCM_UNLIKELY (abs_xx > DBL_MAX || abs_xx < DBL_MIN))
+ {
+ shift = (scm_to_long (scm_integer_length (n))
+ - scm_to_long (scm_integer_length (d))) / 2;
+ if (shift > 0)
+ d = left_shift_exact_integer (d, 2 * shift);
+ else
+ n = left_shift_exact_integer (n, -2 * shift);
+ xx = scm_i_divide2double (n, d);
+ }
+
+ if (xx < 0)
+ return scm_c_make_rectangular (0.0, ldexp (sqrt (-xx), shift));
+ else
+ return scm_from_double (ldexp (sqrt (xx), shift));
+ }
+ }
+
+ /* Fallback method, when the cases above do not apply. */
+ {
+ double xx = scm_to_double (z);
+ if (xx < 0)
+ return scm_c_make_rectangular (0.0, sqrt (-xx));
+ else
+ return scm_from_double (sqrt (xx));
+ }
}
else
return scm_wta_dispatch_1 (g_scm_sqrt, z, 1, s_scm_sqrt);
@@ -9695,8 +10122,6 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
void
scm_init_numbers ()
{
- int i;
-
if (scm_install_gmp_memory_functions)
mp_set_memory_functions (custom_gmp_malloc,
custom_gmp_realloc,
@@ -9718,18 +10143,25 @@ scm_init_numbers ()
flo0 = scm_from_double (0.0);
flo_log10e = scm_from_double (M_LOG10E);
- /* determine floating point precision */
- for (i=2; i <= SCM_MAX_DBL_RADIX; ++i)
- {
- init_dblprec(&scm_dblprec[i-2],i);
- init_fx_radix(fx_per_radix[i-2],i);
- }
-#ifdef DBL_DIG
- /* hard code precision for base 10 if the preprocessor tells us to... */
- scm_dblprec[10-2] = (DBL_DIG > 20) ? 20 : DBL_DIG;
-#endif
-
exactly_one_half = scm_divide (SCM_INUM1, SCM_I_MAKINUM (2));
+
+ {
+ /* Set scm_i_divide2double_lo2b to (2 b^p - 1) */
+ mpz_init_set_ui (scm_i_divide2double_lo2b, 1);
+ mpz_mul_2exp (scm_i_divide2double_lo2b,
+ scm_i_divide2double_lo2b,
+ DBL_MANT_DIG + 1); /* 2 b^p */
+ mpz_sub_ui (scm_i_divide2double_lo2b, scm_i_divide2double_lo2b, 1);
+ }
+
+ {
+ /* Set dbl_minimum_normal_mantissa to b^{p-1} */
+ mpz_init_set_ui (dbl_minimum_normal_mantissa, 1);
+ mpz_mul_2exp (dbl_minimum_normal_mantissa,
+ dbl_minimum_normal_mantissa,
+ DBL_MANT_DIG - 1);
+ }
+
#include "libguile/numbers.x"
}
diff --git a/libguile/numbers.h b/libguile/numbers.h
index 3c43ae4..01eb2cf 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -205,7 +205,8 @@ SCM_API SCM scm_logbit_p (SCM n1, SCM n2);
SCM_API SCM scm_lognot (SCM n);
SCM_API SCM scm_modulo_expt (SCM n, SCM k, SCM m);
SCM_API SCM scm_integer_expt (SCM z1, SCM z2);
-SCM_API SCM scm_ash (SCM n, SCM cnt);
+SCM_API SCM scm_ash (SCM n, SCM count);
+SCM_API SCM scm_round_ash (SCM n, SCM count);
SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
SCM_API SCM scm_logcount (SCM n);
SCM_API SCM scm_integer_length (SCM n);
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index c293233..3f51c70 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012
+ * 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -576,7 +577,7 @@ SCM_DEFINE (scm_load_thunk_from_file,
"load-thunk-from-file", 1, 0, 0,
SCM_VALIDATE_STRING (1, filename);
c_filename = scm_to_locale_string (filename);
- fd = open (c_filename, O_RDONLY | O_CLOEXEC);
+ fd = open (c_filename, O_RDONLY | O_BINARY | O_CLOEXEC);
free (c_filename);
if (fd < 0) SCM_SYSERROR;
diff --git a/libguile/poll.c b/libguile/poll.c
index 1bb7572..9ea846b 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -25,6 +25,8 @@
# include <config.h>
#endif
+#include <poll.h>
+
#include "libguile/_scm.h"
#include "libguile/bytevectors.h"
#include "libguile/numbers.h"
@@ -34,11 +36,6 @@
#include "libguile/poll.h"
-#ifdef HAVE_POLL_H
-#include <poll.h>
-#endif
-
-
/* {Poll}
*/
@@ -73,7 +70,6 @@
If timeout is given and is non-negative, the poll will return after that
number of milliseconds if no fd became active.
*/
-#ifdef HAVE_POLL
static SCM
scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
#define FUNC_NAME "primitive-poll"
@@ -174,7 +170,6 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
return scm_from_int (rv);
}
#undef FUNC_NAME
-#endif /* HAVE_POLL */
@@ -182,12 +177,8 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
static void
scm_init_poll (void)
{
-#if HAVE_POLL
scm_c_define_gsubr ("primitive-poll", 4, 0, 0, scm_primitive_poll);
scm_c_define ("%sizeof-struct-pollfd", scm_from_size_t (sizeof (struct
pollfd)));
-#else
- scm_misc_error ("%init-poll", "`poll' unavailable on this platform",
SCM_EOL);
-#endif
#ifdef POLLIN
scm_c_define ("POLLIN", scm_from_int (POLLIN));
diff --git a/libguile/ports.c b/libguile/ports.c
index 0aacacc..31d338e 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -383,10 +383,14 @@ SCM_DEFINE (scm_current_error_port, "current-error-port",
0, 0, 0,
SCM
scm_current_warning_port (void)
{
- static SCM cwp_var = SCM_BOOL_F;
-
- if (scm_is_false (cwp_var))
- cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+ 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));
}
diff --git a/libguile/posix.c b/libguile/posix.c
index 383ab76..a6bf900 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -32,23 +32,6 @@
# include <sched.h>
#endif
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/fports.h"
-#include "libguile/scmsigs.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
-#include "libguile/vectors.h"
-#include "libguile/values.h"
-
-#include "libguile/validate.h"
-#include "libguile/posix.h"
-#include "libguile/gettext.h"
-#include "libguile/threads.h"
-
-
#ifdef HAVE_STRING_H
#include <string.h>
#endif
@@ -65,10 +48,6 @@
#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#else
-#ifndef ttyname
-extern char *ttyname();
-#endif
#endif
#ifdef LIBC_H_WITH_UNISTD_H
@@ -85,15 +64,23 @@ extern char *ttyname();
#ifdef HAVE_IO_H
#include <io.h>
#endif
-#ifdef HAVE_WINSOCK2_H
-#include <winsock2.h>
-#endif
-#ifdef __MINGW32__
-/* Some defines for Windows here. */
-# include <process.h>
-# define pipe(fd) _pipe (fd, 256, O_BINARY)
-#endif /* __MINGW32__ */
+#include "libguile/_scm.h"
+#include "libguile/dynwind.h"
+#include "libguile/fports.h"
+#include "libguile/scmsigs.h"
+#include "libguile/feature.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-14.h"
+#include "libguile/vectors.h"
+#include "libguile/values.h"
+
+#include "libguile/validate.h"
+#include "libguile/posix.h"
+#include "libguile/gettext.h"
+#include "libguile/threads.h"
+
#if HAVE_SYS_WAIT_H
# include <sys/wait.h>
@@ -168,6 +155,13 @@ extern char *ttyname();
int sethostname (char *name, size_t namelen);
#endif
+#if defined HAVE_GETLOGIN && !HAVE_DECL_GETLOGIN
+/* MinGW doesn't supply this decl; see
+ http://lists.gnu.org/archive/html/bug-gnulib/2013-03/msg00030.html for more
+ details. */
+char *getlogin (void);
+#endif
+
/* On NextStep, <utime.h> doesn't define struct utime, unless we
#define _POSIX_SOURCE before #including it. I think this is less
of a kludge than defining struct utimbuf ourselves. */
@@ -1148,12 +1142,7 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
exec_argv = scm_i_allocate_string_pointers (args);
- execv (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execv (exec_file, exec_argv);
SCM_SYSERROR;
/* not reached. */
@@ -1182,12 +1171,7 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
exec_argv = scm_i_allocate_string_pointers (args);
- execvp (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execvp (exec_file, exec_argv);
SCM_SYSERROR;
/* not reached. */
@@ -1221,17 +1205,7 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
exec_argv = scm_i_allocate_string_pointers (args);
exec_env = scm_i_allocate_string_pointers (env);
- execve (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_env);
+ execve (exec_file, exec_argv, exec_env);
SCM_SYSERROR;
/* not reached. */
@@ -1432,12 +1406,7 @@ scm_open_process (SCM mode, SCM prog, SCM args)
close (err);
}
- execvp (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execvp (exec_file, exec_argv);
/* The exec failed! There is nothing sensible to do. */
if (err > 0)
@@ -1638,6 +1607,12 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
struct utimbuf utm;
utm.actime = atim_sec;
utm.modtime = mtim_sec;
+ /* Silence warnings. */
+ (void) atim_nsec;
+ (void) mtim_nsec;
+
+ if (f != 0)
+ scm_out_of_range(FUNC_NAME, flags);
STRING_SYSCALL (pathname, c_pathname,
rv = utime (c_pathname, &utm));
@@ -1922,22 +1897,6 @@ SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_CHROOT */
-
-#ifdef __MINGW32__
-/* Wrapper function to supplying `getlogin()' under Windows. */
-static char * getlogin (void)
-{
- static char user[256];
- static unsigned long len = 256;
-
- if (!GetUserName (user, &len))
- return NULL;
- return user;
-}
-#endif /* __MINGW32__ */
-
-
-#if defined (HAVE_GETLOGIN) || defined (__MINGW32__)
SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
(void),
"Return a string containing the name of the user logged in on\n"
@@ -1953,7 +1912,6 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
return scm_from_locale_string (p);
}
#undef FUNC_NAME
-#endif /* HAVE_GETLOGIN */
#if HAVE_GETPRIORITY
SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 60ba38c..07845c3 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -482,7 +482,7 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0,
0,
if ((c_read == 0) && (c_count > 0))
{
- if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+ if (scm_peek_byte_or_eof (port) == EOF)
result = SCM_EOF_VAL;
else
result = scm_null_bytevector;
@@ -529,7 +529,7 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4,
0, 0,
if ((c_read == 0) && (c_count > 0))
{
- if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+ if (scm_peek_byte_or_eof (port) == EOF)
result = SCM_EOF_VAL;
else
result = SCM_I_MAKINUM (0);
@@ -577,15 +577,17 @@ SCM_DEFINE (scm_get_bytevector_some,
"get-bytevector-some", 1, 0, 0,
}
/* We can't use `scm_c_read ()' since it blocks. */
- c_chr = scm_getc_unlocked (port);
+ c_chr = scm_get_byte_or_eof_unlocked (port);
if (c_chr != EOF)
{
c_bv[c_total] = (char) c_chr;
c_total++;
}
}
- while ((scm_is_true (scm_char_ready_p (port)))
- && (!SCM_EOF_OBJECT_P (scm_peek_char (port))));
+ /* XXX: We want to check for the availability of a byte, but that's
+ what `scm_char_ready_p' actually does. */
+ while (scm_is_true (scm_char_ready_p (port))
+ && (scm_peek_byte_or_eof_unlocked (port) != EOF));
if (c_total == 0)
{
@@ -645,7 +647,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all",
1, 0, 0,
c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count);
c_total += c_read, c_count -= c_read;
}
- while (!SCM_EOF_OBJECT_P (scm_peek_char (port)));
+ while (scm_peek_byte_or_eof (port) != EOF);
if (c_total == 0)
{
diff --git a/libguile/random.c b/libguile/random.c
index 2db19f7..c0b04bc 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 1999, 2000, 2001, 2003, 2005, 2006, 2009, 2010,
+ * 2012, 2013 Free Software Foundation, Inc.
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -17,7 +18,7 @@
-/* Author: Mikael Djurfeldt <address@hidden> */
+/* Original Author: Mikael Djurfeldt <address@hidden> */
#ifdef HAVE_CONFIG_H
# include <config.h>
@@ -29,6 +30,12 @@
#include <stdio.h>
#include <math.h>
#include <string.h>
+#include <sys/types.h>
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
#include "libguile/smob.h"
#include "libguile/numbers.h"
#include "libguile/feature.h"
@@ -665,7 +672,8 @@ random_state_of_last_resort (void)
SCM time_of_day = scm_gettimeofday ();
SCM sources = scm_list_n
(scm_from_unsigned_integer (SCM_UNPACK (time_of_day)), /* heap addr */
- scm_getpid (), /* process ID */
+ /* Avoid scm_getpid, since it depends on HAVE_POSIX. */
+ scm_from_unsigned_integer (getpid ()), /* process ID */
scm_get_internal_real_time (), /* high-resolution process timer */
scm_from_unsigned_integer ((scm_t_bits) &time_of_day), /* stack addr */
scm_car (time_of_day), /* seconds since midnight 1970-01-01 UTC */
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 86fce0f..497da2f 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007,
2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007,
2008, 2009, 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -28,17 +28,6 @@
#include <stdio.h>
#include <errno.h>
-#include "libguile/_scm.h"
-
-#include "libguile/async.h"
-#include "libguile/eval.h"
-#include "libguile/root.h"
-#include "libguile/vectors.h"
-#include "libguile/threads.h"
-
-#include "libguile/validate.h"
-#include "libguile/scmsigs.h"
-
#ifdef HAVE_PROCESS_H
#include <process.h> /* for mingw */
#endif
@@ -51,16 +40,19 @@
#include <sys/time.h>
#endif
-#ifdef __MINGW32__
-#include <windows.h>
-#define alarm(sec) (0)
-/* This weird comma expression is because Sleep is void under Windows. */
-#define sleep(sec) (Sleep ((sec) * 1000), 0)
-#define usleep(usec) (Sleep ((usec) / 1000), 0)
-#endif
-
#include <full-write.h>
+#include "libguile/_scm.h"
+
+#include "libguile/async.h"
+#include "libguile/eval.h"
+#include "libguile/root.h"
+#include "libguile/vectors.h"
+#include "libguile/threads.h"
+
+#include "libguile/validate.h"
+#include "libguile/scmsigs.h"
+
@@ -526,6 +518,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
}
#undef FUNC_NAME
+#if defined HAVE_ALARM && 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"
@@ -541,6 +534,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
return scm_from_uint (alarm (scm_to_uint (i)));
}
#undef FUNC_NAME
+#endif /* HAVE_ALARM */
#ifdef HAVE_SETITIMER
SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
diff --git a/libguile/smob.c b/libguile/smob.c
index c2347f3..857773c 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010,
2011, 2012 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
+ * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -283,6 +284,10 @@ scm_make_smob (scm_t_bits tc)
/* The GC kind used for SMOB types that provide a custom mark procedure. */
static int smob_gc_kind;
+/* Mark stack pointer and limit, used by `scm_gc_mark'. */
+static scm_i_pthread_key_t current_mark_stack_pointer;
+static scm_i_pthread_key_t current_mark_stack_limit;
+
/* The generic SMOB mark procedure that gets called for SMOBs allocated
with smob_gc_kind. */
@@ -321,14 +326,14 @@ smob_mark (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
{
SCM obj;
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
- SCM_I_CURRENT_THREAD->current_mark_stack_limit = mark_stack_limit;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
+ scm_i_pthread_setspecific (current_mark_stack_limit, mark_stack_limit);
/* Invoke the SMOB's mark procedure, which will in turn invoke
- `scm_gc_mark ()', which may modify `current_mark_stack_ptr'. */
+ `scm_gc_mark', which may modify `current_mark_stack_pointer'. */
obj = scm_smobs[smobnum].mark (cell);
- mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
+ mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
if (SCM_HEAP_OBJECT_P (obj))
/* Mark the returned object. */
@@ -336,42 +341,35 @@ smob_mark (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
mark_stack_ptr,
mark_stack_limit, NULL);
- SCM_I_CURRENT_THREAD->current_mark_stack_limit = NULL;
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = NULL;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, NULL);
+ scm_i_pthread_setspecific (current_mark_stack_limit, NULL);
}
return mark_stack_ptr;
}
-/* Mark object O. We assume that this function is only called during the
- mark phase, i.e., from within `smob_mark ()' or one of its
- descendents. */
+/* Mark object O. We assume that this function is only called during the mark
+ phase, i.e., from within `smob_mark' or one of its descendants. */
void
scm_gc_mark (SCM o)
{
-#define CURRENT_MARK_PTR \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
-#define CURRENT_MARK_LIMIT \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
-
if (SCM_HEAP_OBJECT_P (o))
{
- /* At this point, the `current_mark_*' fields of the current thread
- must be defined (they are set in `smob_mark ()'). */
- register struct GC_ms_entry *mark_stack_ptr;
+ void *mark_stack_ptr, *mark_stack_limit;
- if (!CURRENT_MARK_PTR)
+ mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
+ mark_stack_limit = scm_i_pthread_getspecific (current_mark_stack_limit);
+
+ if (mark_stack_ptr == NULL)
/* The function was not called from a mark procedure. */
abort ();
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (o),
- CURRENT_MARK_PTR, CURRENT_MARK_LIMIT,
+ mark_stack_ptr, mark_stack_limit,
NULL);
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
}
-#undef CURRENT_MARK_PTR
-#undef CURRENT_MARK_LIMIT
}
@@ -452,6 +450,9 @@ scm_smob_prehistory ()
{
long i;
+ scm_i_pthread_key_create (¤t_mark_stack_pointer, NULL);
+ scm_i_pthread_key_create (¤t_mark_stack_limit, NULL);
+
smob_gc_kind = GC_new_kind (GC_new_free_list (),
GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
0,
diff --git a/libguile/socket.c b/libguile/socket.c
index 2320414..7e735f4 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- * 2006, 2007, 2009, 2011, 2012 Free Software Foundation, Inc.
+ * 2006, 2007, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -25,26 +25,8 @@
#endif
#include <errno.h>
-#include <gmp.h>
#include <verify.h>
-#include "libguile/_scm.h"
-#include "libguile/arrays.h"
-#include "libguile/feature.h"
-#include "libguile/fports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
-#include "libguile/srfi-13.h"
-
-#include "libguile/validate.h"
-#include "libguile/socket.h"
-
-#ifdef __MINGW32__
-#include "win32-socket.h"
-#include <netdb.h>
-#endif
-
#ifdef HAVE_STDINT_H
#include <stdint.h>
#endif
@@ -55,9 +37,6 @@
#include <unistd.h>
#endif
#include <sys/types.h>
-#ifdef HAVE_WINSOCK2_H
-#include <winsock2.h>
-#else
#include <sys/socket.h>
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
#include <sys/un.h>
@@ -65,8 +44,27 @@
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>
+
+#include <gmp.h>
+
+#include "libguile/_scm.h"
+#include "libguile/arrays.h"
+#include "libguile/feature.h"
+#include "libguile/fports.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+#include "libguile/dynwind.h"
+#include "libguile/srfi-13.h"
+
+#include "libguile/validate.h"
+#include "libguile/socket.h"
+
+#if SCM_ENABLE_DEPRECATED == 1
+# include "libguile/deprecation.h"
#endif
+
+
#if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
#define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
+ strlen ((ptr)->sun_path))
@@ -512,6 +510,7 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
"@defvarx SO_OOBINLINE\n"
"@defvarx SO_NO_CHECK\n"
"@defvarx SO_PRIORITY\n"
+ "@defvarx SO_REUSEPORT\n"
"The value returned is an integer.\n"
"@end defvar\n"
"\n"
@@ -610,6 +609,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
"@defvarx SO_OOBINLINE\n"
"@defvarx SO_NO_CHECK\n"
"@defvarx SO_PRIORITY\n"
+ "@defvarx SO_REUSEPORT\n"
"@var{value} is an integer.\n"
"@end defvar\n"
"\n"
@@ -1767,6 +1767,9 @@ scm_init_socket ()
#ifdef SO_LINGER
scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
#endif
+#ifdef SO_REUSEPORT /* new in Linux 3.9 */
+ scm_c_define ("SO_REUSEPORT", scm_from_int (SO_REUSEPORT));
+#endif
/* recv/send options. */
#ifdef MSG_DONTWAIT
@@ -1782,10 +1785,6 @@ scm_init_socket ()
scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
#endif
-#ifdef __MINGW32__
- scm_i_init_socket_Win32 ();
-#endif
-
#ifdef IP_ADD_MEMBERSHIP
scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
diff --git a/libguile/srfi-14.i.c b/libguile/srfi-14.i.c
index f59a807..42a1c2c 100644
--- a/libguile/srfi-14.i.c
+++ b/libguile/srfi-14.i.c
@@ -4790,7 +4790,7 @@ scm_t_char_range cs_graphic_ranges[] = {
,
{0x2090, 0x209c}
,
- {0x20a0, 0x20b9}
+ {0x20a0, 0x20ba}
,
{0x20d0, 0x20f0}
,
@@ -5906,7 +5906,7 @@ scm_t_char_range cs_printing_ranges[] = {
,
{0x2090, 0x209c}
,
- {0x20a0, 0x20b9}
+ {0x20a0, 0x20ba}
,
{0x20d0, 0x20f0}
,
@@ -6897,7 +6897,7 @@ scm_t_char_range cs_symbol_ranges[] = {
,
{0x208a, 0x208c}
,
- {0x20a0, 0x20b9}
+ {0x20a0, 0x20ba}
,
{0x2100, 0x2101}
,
@@ -7728,7 +7728,7 @@ scm_t_char_range cs_designated_ranges[] = {
,
{0x2090, 0x209c}
,
- {0x20a0, 0x20b9}
+ {0x20a0, 0x20ba}
,
{0x20d0, 0x20f0}
,
diff --git a/libguile/stime.c b/libguile/stime.c
index 7fdbba9..90de697 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006,
2007, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006,
2007, 2008, 2009, 2011, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -84,13 +84,6 @@
# include <sys/timeb.h>
#endif
-#ifndef tzname /* For SGI. */
-extern char *tzname[]; /* RS6000 and others reject char **tzname. */
-#endif
-#if defined (__MINGW32__)
-# define tzname _tzname
-#endif
-
#if ! HAVE_DECL_STRPTIME
extern char *strptime ();
#endif
diff --git a/libguile/strports.c b/libguile/strports.c
index 425b089..40f656e 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -464,13 +464,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_BOOL_F, k_module = SCM_BOOL_F;
+ static SCM eval_string = SCM_UNDEFINED, k_module = SCM_UNDEFINED;
+ static scm_i_pthread_mutex_t init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
- if (scm_is_false (eval_string))
+ scm_i_scm_pthread_mutex_lock (&init_mutex);
+ if (SCM_UNBNDP (eval_string))
{
- eval_string = scm_c_public_lookup ("ice-9 eval-string", "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);
if (SCM_UNBNDP (module))
module = scm_current_module ();
diff --git a/libguile/struct.c b/libguile/struct.c
index db79e79..c7f410b 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008,
2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007,
+ * 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -152,8 +153,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout",
1, 0, 0,
#undef FUNC_NAME
-/* Check whether VTABLE instances have a simple layout (i.e., either only "pr"
- or only "pw" fields) and update its flags accordingly. */
+/* Check whether VTABLE instances have a simple layout (i.e., either
+ only "pr" or only "pw" fields and no tail array) and update its flags
+ accordingly. */
static void
set_vtable_layout_flags (SCM vtable)
{
@@ -179,13 +181,11 @@ set_vtable_layout_flags (SCM vtable)
switch (c_layout[field + 1])
{
case 'w':
- case 'W':
if (field == 0)
flags |= SCM_VTABLE_FLAG_SIMPLE_RW;
break;
case 'r':
- case 'R':
flags &= ~SCM_VTABLE_FLAG_SIMPLE_RW;
break;
diff --git a/libguile/struct.h b/libguile/struct.h
index 97b6768..0aecfb9 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -3,7 +3,7 @@
#ifndef SCM_STRUCT_H
#define SCM_STRUCT_H
-/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011,
2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011,
2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -108,8 +108,8 @@
#define SCM_VTABLE_FLAG_APPLICABLE (1L << 3) /* instances of this vtable are
applicable? */
#define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 4) /* instances of this vtable
are applicable-with-setter vtables? */
#define SCM_VTABLE_FLAG_SETTER (1L << 5) /* instances of this vtable are
applicable-with-setters? */
-#define SCM_VTABLE_FLAG_SIMPLE (1L << 6) /* instances of this vtable have only
"p" fields */
-#define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 7) /* instances of this vtable have
only "pw" fields */
+#define SCM_VTABLE_FLAG_SIMPLE (1L << 6) /* instances of this vtable have only
"p" fields and no tail array*/
+#define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 7) /* instances of this vtable have
only "pw" fields and no tail array */
#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 8)
#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 9)
#define SCM_VTABLE_FLAG_RESERVED_2 (1L << 10)
diff --git a/libguile/texi-fragments-to-docstrings
b/libguile/texi-fragments-to-docstrings
new file mode 100644
index 0000000..b72390b
--- /dev/null
+++ b/libguile/texi-fragments-to-docstrings
@@ -0,0 +1,55 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2013 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License 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
+
+
+;;;
+;;; Read Texinfo fragments from stdin (docstrings of Guile's primitives
+;;; in the format of `guile-procedures.texi'), and write to stdout a
+;;; textual rendering thereof. The output preserves page breaks (^L)
+;;; found in the input, as per the Guile Documentation Format
+;;; version 2---see (ice-9 documentation).
+;;;
+
+(use-modules (texinfo)
+ (texinfo plain-text)
+ (srfi srfi-1)
+ (ice-9 match)
+ (rnrs io ports))
+
+(define (docstring-fragments->strings str)
+ "Return the list resulting from the split of STR at each page
+break (^L)"
+ (string-tokenize str (char-set-complement (char-set #\page))))
+
+(match (command-line)
+ ((_ texi-file)
+ (let* ((fragments (remove (compose string-null? string-trim-both)
+ (call-with-input-file texi-file
+ (compose docstring-fragments->strings
+ get-string-all))))
+ (stexi (map texi-fragment->stexi fragments)))
+ (format #t "Produced by GNU Guile ~a from `~a'.~%~%"
+ (version) texi-file)
+ (for-each (lambda (stexi)
+ (display #\page)
+ (display (stexi->plain-text stexi)))
+ stexi)))
+ ((command args ...)
+ (format (current-error-port) "invalid arguments: ~s~%" args)
+ (format (current-error-port) "Usage: ~a TEXINFO-FILE~%" command)
+ (exit 1)))
diff --git a/libguile/threads.c b/libguile/threads.c
index 61fc43e..ef771dc 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- * 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
+ * 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -45,6 +45,8 @@
# include <pthread_np.h>
#endif
+#include <sys/select.h>
+
#include <assert.h>
#include <fcntl.h>
#include <nproc.h>
@@ -1057,7 +1059,10 @@ SCM_DEFINE (scm_call_with_new_thread,
"call-with-new-thread", 1, 1, 0,
errno = err;
scm_syserror (NULL);
}
- scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
+
+ while (scm_is_false (data.thread))
+ scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
+
scm_i_pthread_mutex_unlock (&data.mutex);
return data.thread;
@@ -1134,7 +1139,10 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data,
errno = err;
scm_syserror (NULL);
}
- scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
+
+ while (scm_is_false (data.thread))
+ scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
+
scm_i_pthread_mutex_unlock (&data.mutex);
assert (SCM_I_IS_THREAD (data.thread));
@@ -1867,9 +1875,9 @@ SCM_DEFINE (scm_condition_variable_p,
"condition-variable?", 1, 0, 0,
struct select_args
{
int nfds;
- SELECT_TYPE *read_fds;
- SELECT_TYPE *write_fds;
- SELECT_TYPE *except_fds;
+ fd_set *read_fds;
+ fd_set *write_fds;
+ fd_set *except_fds;
struct timeval *timeout;
int result;
@@ -1892,11 +1900,19 @@ do_std_select (void *args)
return NULL;
}
+#if !SCM_HAVE_SYS_SELECT_H
+static int scm_std_select (int nfds,
+ fd_set *readfds,
+ fd_set *writefds,
+ fd_set *exceptfds,
+ struct timeval *timeout);
+#endif
+
int
scm_std_select (int nfds,
- SELECT_TYPE *readfds,
- SELECT_TYPE *writefds,
- SELECT_TYPE *exceptfds,
+ fd_set *readfds,
+ fd_set *writefds,
+ fd_set *exceptfds,
struct timeval *timeout)
{
fd_set my_readfds;
diff --git a/libguile/threads.h b/libguile/threads.h
index 3030f6f..147e36d 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -3,7 +3,8 @@
#ifndef SCM_THREADS_H
#define SCM_THREADS_H
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008,
2009, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2006,
+ * 2007, 2008, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -71,8 +72,8 @@ typedef struct scm_i_thread {
scm_i_pthread_cond_t sleep_cond;
int sleep_fd, sleep_pipe[2];
- /* Information about the Boehm-GC mark stack during the mark phase. This
- is used by `scm_gc_mark ()'. */
+ /* XXX: These two fields used to hold information about the BDW-GC
+ mark stack during the mark phase. They are no longer used. */
void *current_mark_stack_ptr;
void *current_mark_stack_limit;
diff --git a/libguile/vm.c b/libguile/vm.c
index c264470..ccc182a 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -37,6 +37,8 @@
#include "programs.h"
#include "vm.h"
+#include "private-gc.h" /* scm_getenv_int */
+
static int vm_default_engine = SCM_VM_REGULAR_ENGINE;
/* Unfortunately we can't snarf these: snarfed things are only loaded up from
@@ -634,7 +636,17 @@ resolve_variable (SCM what, SCM program_module)
}
}
+#define VM_MIN_STACK_SIZE (1024)
#define VM_DEFAULT_STACK_SIZE (64 * 1024)
+static size_t vm_stack_size = VM_DEFAULT_STACK_SIZE;
+
+static void
+initialize_default_stack_size (void)
+{
+ int size = scm_getenv_int ("GUILE_STACK_SIZE", vm_stack_size);
+ if (size >= VM_MIN_STACK_SIZE)
+ vm_stack_size = size;
+}
#define VM_NAME vm_regular_engine
#define FUNC_NAME "vm-regular-engine"
@@ -671,7 +683,7 @@ make_vm (void)
vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
- vp->stack_size = VM_DEFAULT_STACK_SIZE;
+ vp->stack_size= vm_stack_size;
#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
vp->stack_base = (SCM *)
@@ -1085,6 +1097,8 @@ scm_bootstrap_vm (void)
"scm_init_vm",
(scm_t_extension_init_func)scm_init_vm, NULL);
+ initialize_default_stack_size ();
+
sym_vm_run = scm_from_latin1_symbol ("vm-run");
sym_vm_error = scm_from_latin1_symbol ("vm-error");
sym_keyword_argument_error = scm_from_latin1_symbol
("keyword-argument-error");
diff --git a/libguile/win32-socket.c b/libguile/win32-socket.c
deleted file mode 100644
index 825b4c4..0000000
--- a/libguile/win32-socket.c
+++ /dev/null
@@ -1,632 +0,0 @@
-/* Copyright (C) 2001, 2006 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
- */
-
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include "libguile/__scm.h"
-#include "libguile/modules.h"
-#include "libguile/numbers.h"
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <ctype.h>
-#include <errno.h>
-#include <limits.h>
-
-#ifndef PATH_MAX
-#define PATH_MAX 255
-#endif
-
-#include "win32-socket.h"
-
-/* Winsock API error description structure. The error description is
- necessary because there is no error list available. */
-typedef struct
-{
- int error; /* Error code. */
- char *str; /* Error description. */
- int replace; /* Possible error code replacement. */
- char *replace_str; /* Replacement symbol. */
- char *correct_str; /* Original symbol. */
-}
-socket_error_t;
-
-#define FILE_ETC_SERVICES "services"
-#define ENVIRON_ETC_SERVICES "SERVICES"
-#define FILE_ETC_NETWORKS "networks"
-#define ENVIRON_ETC_NETWORKS "NETWORKS"
-#define FILE_ETC_PROTOCOLS "protocol"
-#define ENVIRON_ETC_PROTOCOLS "PROTOCOLS"
-#define MAX_NAMLEN 256
-#define MAX_ALIASES 4
-
-/* Internal structure for a thread's M$-Windows servent interface. */
-typedef struct
-{
- FILE *fd; /* Current file. */
- char file[PATH_MAX]; /* File name. */
- struct servent ent; /* Return value. */
- char name[MAX_NAMLEN]; /* Service name. */
- char proto[MAX_NAMLEN]; /* Protocol name. */
- char alias[MAX_ALIASES][MAX_NAMLEN]; /* All aliases. */
- char *aliases[MAX_ALIASES]; /* Alias pointers. */
- int port; /* Network port. */
-}
-scm_i_servent_t;
-
-static scm_i_servent_t scm_i_servent;
-
-/* Internal structure for a thread's M$-Windows protoent interface. */
-typedef struct
-{
- FILE *fd; /* Current file. */
- char file[PATH_MAX]; /* File name. */
- struct protoent ent; /* Return value. */
- char name[MAX_NAMLEN]; /* Protocol name. */
- char alias[MAX_ALIASES][MAX_NAMLEN]; /* All aliases. */
- char *aliases[MAX_ALIASES]; /* Alias pointers. */
- int proto; /* Protocol number. */
-}
-scm_i_protoent_t;
-
-static scm_i_protoent_t scm_i_protoent;
-
-/* Define replacement symbols for most of the WSA* error codes. */
-#ifndef EWOULDBLOCK
-# define EWOULDBLOCK WSAEWOULDBLOCK
-#endif
-#ifndef EINPROGRESS
-# define EINPROGRESS WSAEINPROGRESS
-#endif
-#ifndef EALREADY
-# define EALREADY WSAEALREADY
-#endif
-#ifndef EDESTADDRREQ
-# define EDESTADDRREQ WSAEDESTADDRREQ
-#endif
-#ifndef EMSGSIZE
-# define EMSGSIZE WSAEMSGSIZE
-#endif
-#ifndef EPROTOTYPE
-# define EPROTOTYPE WSAEPROTOTYPE
-#endif
-#ifndef ENOTSOCK
-# define ENOTSOCK WSAENOTSOCK
-#endif
-#ifndef ENOPROTOOPT
-# define ENOPROTOOPT WSAENOPROTOOPT
-#endif
-#ifndef EPROTONOSUPPORT
-# define EPROTONOSUPPORT WSAEPROTONOSUPPORT
-#endif
-#ifndef ESOCKTNOSUPPORT
-# define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
-#endif
-#ifndef EOPNOTSUPP
-# define EOPNOTSUPP WSAEOPNOTSUPP
-#endif
-#ifndef EPFNOSUPPORT
-# define EPFNOSUPPORT WSAEPFNOSUPPORT
-#endif
-#ifndef EAFNOSUPPORT
-# define EAFNOSUPPORT WSAEAFNOSUPPORT
-#endif
-#ifndef EADDRINUSE
-# define EADDRINUSE WSAEADDRINUSE
-#endif
-#ifndef EADDRNOTAVAIL
-# define EADDRNOTAVAIL WSAEADDRNOTAVAIL
-#endif
-#ifndef ENETDOWN
-# define ENETDOWN WSAENETDOWN
-#endif
-#ifndef ENETUNREACH
-# define ENETUNREACH WSAENETUNREACH
-#endif
-#ifndef ENETRESET
-# define ENETRESET WSAENETRESET
-#endif
-#ifndef ECONNABORTED
-# define ECONNABORTED WSAECONNABORTED
-#endif
-#ifndef ECONNRESET
-# define ECONNRESET WSAECONNRESET
-#endif
-#ifndef ENOBUFS
-# define ENOBUFS WSAENOBUFS
-#endif
-#ifndef EISCONN
-# define EISCONN WSAEISCONN
-#endif
-#ifndef ENOTCONN
-# define ENOTCONN WSAENOTCONN
-#endif
-#ifndef ESHUTDOWN
-# define ESHUTDOWN WSAESHUTDOWN
-#endif
-#ifndef ETOOMANYREFS
-# define ETOOMANYREFS WSAETOOMANYREFS
-#endif
-#ifndef ETIMEDOUT
-# define ETIMEDOUT WSAETIMEDOUT
-#endif
-#ifndef ECONNREFUSED
-# define ECONNREFUSED WSAECONNREFUSED
-#endif
-#ifndef ELOOP
-# define ELOOP WSAELOOP
-#endif
-#ifndef EHOSTDOWN
-# define EHOSTDOWN WSAEHOSTDOWN
-#endif
-#ifndef EHOSTUNREACH
-# define EHOSTUNREACH WSAEHOSTUNREACH
-#endif
-#ifndef EPROCLIM
-# define EPROCLIM WSAEPROCLIM
-#endif
-#ifndef EUSERS
-# define EUSERS WSAEUSERS
-#endif
-#ifndef EDQUOT
-# define EDQUOT WSAEDQUOT
-#endif
-#ifndef ESTALE
-# define ESTALE WSAESTALE
-#endif
-#ifndef EREMOTE
-# define EREMOTE WSAEREMOTE
-#endif
-
-/* List of error structures. */
-static socket_error_t socket_errno [] = {
- /* 000 */ { 0, NULL, 0, NULL, NULL },
- /* 001 */ { 0, NULL, 0, NULL, NULL },
- /* 002 */ { 0, NULL, 0, NULL, NULL },
- /* 003 */ { 0, NULL, 0, NULL, NULL },
- /* 004 */ { WSAEINTR, "Interrupted function call", EINTR, NULL, "WSAEINTR" },
- /* 005 */ { 0, NULL, 0, NULL, NULL },
- /* 006 */ { 0, NULL, 0, NULL, NULL },
- /* 007 */ { 0, NULL, 0, NULL, NULL },
- /* 008 */ { 0, NULL, 0, NULL, NULL },
- /* 009 */ { WSAEBADF, "Bad file number", EBADF, NULL, "WSAEBADF" },
- /* 010 */ { 0, NULL, 0, NULL, NULL },
- /* 011 */ { 0, NULL, 0, NULL, NULL },
- /* 012 */ { 0, NULL, 0, NULL, NULL },
- /* 013 */ { WSAEACCES, "Permission denied", EACCES, NULL, "WSAEACCES" },
- /* 014 */ { WSAEFAULT, "Bad address", EFAULT, NULL, "WSAEFAULT" },
- /* 015 */ { 0, NULL, 0, NULL, NULL },
- /* 016 */ { 0, NULL, 0, NULL, NULL },
- /* 017 */ { 0, NULL, 0, NULL, NULL },
- /* 018 */ { 0, NULL, 0, NULL, NULL },
- /* 019 */ { 0, NULL, 0, NULL, NULL },
- /* 020 */ { 0, NULL, 0, NULL, NULL },
- /* 021 */ { 0, NULL, 0, NULL, NULL },
- /* 022 */ { WSAEINVAL, "Invalid argument", EINVAL, NULL, "WSAEINVAL" },
- /* 023 */ { 0, NULL, 0, NULL, NULL },
- /* 024 */ { WSAEMFILE, "Too many open files", EMFILE, NULL, "WSAEMFILE" },
- /* 025 */ { 0, NULL, 0, NULL, NULL },
- /* 026 */ { 0, NULL, 0, NULL, NULL },
- /* 027 */ { 0, NULL, 0, NULL, NULL },
- /* 028 */ { 0, NULL, 0, NULL, NULL },
- /* 029 */ { 0, NULL, 0, NULL, NULL },
- /* 030 */ { 0, NULL, 0, NULL, NULL },
- /* 031 */ { 0, NULL, 0, NULL, NULL },
- /* 032 */ { 0, NULL, 0, NULL, NULL },
- /* 033 */ { 0, NULL, 0, NULL, NULL },
- /* 034 */ { 0, NULL, 0, NULL, NULL },
- /* 035 */ { WSAEWOULDBLOCK, "Resource temporarily unavailable",
- EWOULDBLOCK, "EWOULDBLOCK", "WSAEWOULDBLOCK" },
- /* 036 */ { WSAEINPROGRESS, "Operation now in progress",
- EINPROGRESS, "EINPROGRESS", "WSAEINPROGRESS" },
- /* 037 */ { WSAEALREADY, "Operation already in progress",
- EALREADY, "EALREADY", "WSAEALREADY" },
- /* 038 */ { WSAENOTSOCK, "Socket operation on non-socket",
- ENOTSOCK, "ENOTSOCK", "WSAENOTSOCK"},
- /* 039 */ { WSAEDESTADDRREQ, "Destination address required",
- EDESTADDRREQ, "EDESTADDRREQ", "WSAEDESTADDRREQ" },
- /* 040 */ { WSAEMSGSIZE, "Message too long",
- EMSGSIZE, "EMSGSIZE", "WSAEMSGSIZE" },
- /* 041 */ { WSAEPROTOTYPE, "Protocol wrong type for socket",
- EPROTOTYPE, "EPROTOTYPE", "WSAEPROTOTYPE" },
- /* 042 */ { WSAENOPROTOOPT, "Bad protocol option",
- ENOPROTOOPT, "ENOPROTOOPT", "WSAENOPROTOOPT" },
- /* 043 */ { WSAEPROTONOSUPPORT, "Protocol not supported",
- EPROTONOSUPPORT, "EPROTONOSUPPORT", "WSAEPROTONOSUPPORT" },
- /* 044 */ { WSAESOCKTNOSUPPORT, "Socket type not supported",
- ESOCKTNOSUPPORT, "ESOCKTNOSUPPORT", "WSAESOCKTNOSUPPORT" },
- /* 045 */ { WSAEOPNOTSUPP, "Operation not supported",
- EOPNOTSUPP, "EOPNOTSUPP", "WSAEOPNOTSUPP" },
- /* 046 */ { WSAEPFNOSUPPORT, "Protocol family not supported",
- EPFNOSUPPORT, "EPFNOSUPPORT", "WSAEPFNOSUPPORT" },
- /* 047 */ { WSAEAFNOSUPPORT,
- "Address family not supported by protocol family",
- EAFNOSUPPORT, "EAFNOSUPPORT", "WSAEAFNOSUPPORT" },
- /* 048 */ { WSAEADDRINUSE, "Address already in use",
- EADDRINUSE, "EADDRINUSE", "WSAEADDRINUSE" },
- /* 049 */ { WSAEADDRNOTAVAIL, "Cannot assign requested address",
- EADDRNOTAVAIL, "EADDRNOTAVAIL", "WSAEADDRNOTAVAIL" },
- /* 050 */ { WSAENETDOWN, "Network is down",
- ENETDOWN, "ENETDOWN", "WSAENETDOWN" },
- /* 051 */ { WSAENETUNREACH, "Network is unreachable",
- ENETUNREACH, "ENETUNREACH", "WSAENETUNREACH" },
- /* 052 */ { WSAENETRESET, "Network dropped connection on reset",
- ENETRESET, "ENETRESET", "WSAENETRESET" },
- /* 053 */ { WSAECONNABORTED, "Software caused connection abort",
- ECONNABORTED, "ECONNABORTED", "WSAECONNABORTED" },
- /* 054 */ { WSAECONNRESET, "Connection reset by peer",
- ECONNRESET, "ECONNRESET", "WSAECONNRESET" },
- /* 055 */ { WSAENOBUFS, "No buffer space available",
- ENOBUFS, "ENOBUFS", "WSAENOBUFS" },
- /* 056 */ { WSAEISCONN, "Socket is already connected",
- EISCONN, "EISCONN", "WSAEISCONN" },
- /* 057 */ { WSAENOTCONN, "Socket is not connected",
- ENOTCONN, "ENOTCONN", "WSAENOTCONN" },
- /* 058 */ { WSAESHUTDOWN, "Cannot send after socket shutdown",
- ESHUTDOWN, "ESHUTDOWN", "WSAESHUTDOWN" },
- /* 059 */ { WSAETOOMANYREFS, "Too many references; can't splice",
- ETOOMANYREFS, "ETOOMANYREFS", "WSAETOOMANYREFS" },
- /* 060 */ { WSAETIMEDOUT, "Connection timed out",
- ETIMEDOUT, "ETIMEDOUT", "WSAETIMEDOUT" },
- /* 061 */ { WSAECONNREFUSED, "Connection refused",
- ECONNREFUSED, "ECONNREFUSED", "WSAECONNREFUSED" },
- /* 062 */ { WSAELOOP, "Too many levels of symbolic links",
- ELOOP, "ELOOP", "WSAELOOP" },
- /* 063 */ { WSAENAMETOOLONG, "File name too long",
- ENAMETOOLONG, NULL, "WSAENAMETOOLONG" },
- /* 064 */ { WSAEHOSTDOWN, "Host is down",
- EHOSTDOWN, "EHOSTDOWN", "WSAEHOSTDOWN" },
- /* 065 */ { WSAEHOSTUNREACH, "No route to host",
- EHOSTUNREACH, "EHOSTUNREACH", "WSAEHOSTUNREACH" },
- /* 066 */ { WSAENOTEMPTY, "Directory not empty",
- ENOTEMPTY, NULL, "WSAENOTEMPTY" },
- /* 067 */ { WSAEPROCLIM, "Too many processes",
- EPROCLIM, "EPROCLIM", "WSAEPROCLIM" },
- /* 068 */ { WSAEUSERS, "Too many users",
- EUSERS, "EUSERS", "WSAEUSERS" },
- /* 069 */ { WSAEDQUOT, "Disc quota exceeded",
- EDQUOT, "EDQUOT", "WSAEDQUOT" },
- /* 070 */ { WSAESTALE, "Stale NFS file handle",
- ESTALE, "ESTALE", "WSAESTALE" },
- /* 071 */ { WSAEREMOTE, "Too many levels of remote in path",
- EREMOTE, "EREMOTE", "WSAEREMOTE" },
- /* 072 */ { 0, NULL, 0, NULL, NULL },
- /* 073 */ { 0, NULL, 0, NULL, NULL },
- /* 074 */ { 0, NULL, 0, NULL, NULL },
- /* 075 */ { 0, NULL, 0, NULL, NULL },
- /* 076 */ { 0, NULL, 0, NULL, NULL },
- /* 077 */ { 0, NULL, 0, NULL, NULL },
- /* 078 */ { 0, NULL, 0, NULL, NULL },
- /* 079 */ { 0, NULL, 0, NULL, NULL },
- /* 080 */ { 0, NULL, 0, NULL, NULL },
- /* 081 */ { 0, NULL, 0, NULL, NULL },
- /* 082 */ { 0, NULL, 0, NULL, NULL },
- /* 083 */ { 0, NULL, 0, NULL, NULL },
- /* 084 */ { 0, NULL, 0, NULL, NULL },
- /* 085 */ { 0, NULL, 0, NULL, NULL },
- /* 086 */ { 0, NULL, 0, NULL, NULL },
- /* 087 */ { 0, NULL, 0, NULL, NULL },
- /* 088 */ { 0, NULL, 0, NULL, NULL },
- /* 089 */ { 0, NULL, 0, NULL, NULL },
- /* 090 */ { 0, NULL, 0, NULL, NULL },
- /* 091 */ { WSASYSNOTREADY, "Network subsystem is unavailable",
- 0, NULL, "WSASYSNOTREADY" },
- /* 092 */ { WSAVERNOTSUPPORTED, "WINSOCK.DLL version out of range",
- 0, NULL, "WSAVERNOTSUPPORTED" },
- /* 093 */ { WSANOTINITIALISED, "Successful WSAStartup not yet performed",
- 0, NULL, "WSANOTINITIALISED" },
- /* 094 */ { 0, NULL, 0, NULL, NULL },
- /* 095 */ { 0, NULL, 0, NULL, NULL },
- /* 096 */ { 0, NULL, 0, NULL, NULL },
- /* 097 */ { 0, NULL, 0, NULL, NULL },
- /* 098 */ { 0, NULL, 0, NULL, NULL },
- /* 099 */ { 0, NULL, 0, NULL, NULL },
- /* 100 */ { 0, NULL, 0, NULL, NULL },
- /* 101 */ { WSAEDISCON, "Graceful shutdown in progress",
- 0, NULL, "WSAEDISCON" },
- /* 102 */ { WSAENOMORE, "No more services",
- 0, NULL, "WSAENOMORE" },
- /* 103 */ { WSAECANCELLED, "Service lookup cancelled",
- 0, NULL, "WSAECANCELLED" },
- /* 104 */ { WSAEINVALIDPROCTABLE, "Invalid procedure call table",
- 0, NULL, "WSAEINVALIDPROCTABLE" },
- /* 105 */ { WSAEINVALIDPROVIDER, "Invalid service provider",
- 0, NULL, "WSAEINVALIDPROVIDER" },
- /* 106 */ { WSAEPROVIDERFAILEDINIT, "Service provider failure",
- 0, NULL, "WSAEPROVIDERFAILEDINIT" },
- /* 107 */ { WSASYSCALLFAILURE, "System call failed",
- 0, NULL, "WSASYSCALLFAILURE" },
- /* 108 */ { WSASERVICE_NOT_FOUND, "No such service",
- 0, NULL, "WSASERVICE_NOT_FOUND" },
- /* 109 */ { WSATYPE_NOT_FOUND, "Class not found",
- 0, NULL, "WSATYPE_NOT_FOUND" },
- /* 110 */ { WSA_E_NO_MORE, "No more services",
- 0, NULL, "WSA_E_NO_MORE" },
- /* 111 */ { WSA_E_CANCELLED, "Service lookup cancelled",
- 0, NULL, "WSA_E_CANCELLED" },
- /* 112 */ { WSAEREFUSED, "Database query refused",
- 0, NULL, "WSAEREFUSED" },
- /* end */ { -1, NULL, -1, NULL, NULL }
-};
-
-/* Extended list of error structures. */
-static socket_error_t socket_h_errno [] = {
- /* 000 */ { 0, NULL, 0, NULL, NULL },
- /* 001 */ { WSAHOST_NOT_FOUND, "Host not found",
- HOST_NOT_FOUND, "HOST_NOT_FOUND", "WSAHOST_NOT_FOUND" },
- /* 002 */ { WSATRY_AGAIN, "Non-authoritative host not found",
- TRY_AGAIN, "TRY_AGAIN", "WSATRY_AGAIN" },
- /* 003 */ { WSANO_RECOVERY, "This is a non-recoverable error",
- NO_RECOVERY, "NO_RECOVERY", "WSANO_RECOVERY" },
- /* 004 */ { WSANO_DATA, "Valid name, no data record of requested type",
- NO_DATA, "NO_DATA", "WSANO_DATA" },
- /* 005 */ { WSANO_ADDRESS, "No address, look for MX record",
- NO_ADDRESS, "NO_ADDRESS", "WSANO_ADDRESS" },
- /* end */ { -1, NULL, -1, NULL, NULL }
-};
-
-/* Returns the result of @code{WSAGetLastError()}. */
-int
-scm_i_socket_errno (void)
-{
- return WSAGetLastError ();
-}
-
-/* Returns a valid error message for Winsock-API error codes obtained via
- @code{WSAGetLastError()} or NULL otherwise. */
-char *
-scm_i_socket_strerror (int error)
-{
- if (error >= WSABASEERR && error <= (WSABASEERR + 112))
- return socket_errno[error - WSABASEERR].str;
- else if (error >= (WSABASEERR + 1000) && error <= (WSABASEERR + 1005))
- return socket_h_errno[error - (WSABASEERR + 1000)].str;
- return NULL;
-}
-
-/* Constructs a valid filename for the given file @var{file} in the M$-Windows
- directory. This is usually the default location for the network files. */
-char *
-scm_i_socket_filename (char *file)
-{
- static char dir[PATH_MAX];
- int len = PATH_MAX;
-
- len = GetWindowsDirectory (dir, len);
- if (dir[len - 1] != '\\')
- strcat (dir, "\\");
- strcat (dir, file);
- return dir;
-}
-
-/* Removes comments and white spaces at end of line and returns a pointer
- to the end of the line. */
-static char *
-scm_i_socket_uncomment (char *line)
-{
- char *end;
-
- if ((end = strchr (line, '#')) != NULL)
- *end-- = '\0';
- else
- {
- end = line + strlen (line) - 1;
- while (end > line && (*end == '\r' || *end == '\n'))
- *end-- = '\0';
- }
- while (end > line && isspace ((int) (*end)))
- *end-- = '\0';
-
- return end;
-}
-
-/* The getservent() function reads the next line from the file `/etc/services'
- and returns a structure servent containing the broken out fields from the
- line. The `/etc/services' file is opened if necessary. */
-struct servent *
-getservent (void)
-{
- char line[MAX_NAMLEN], *end, *p;
- int done = 0, i, n, a;
- struct servent *e = NULL;
-
- /* Ensure a open file. */
- if (scm_i_servent.fd == NULL || feof (scm_i_servent.fd))
- {
- setservent (1);
- if (scm_i_servent.fd == NULL)
- return NULL;
- }
-
- while (!done)
- {
- /* Get new line. */
- if (fgets (line, MAX_NAMLEN, scm_i_servent.fd) != NULL)
- {
- end = scm_i_socket_uncomment (line);
-
- /* Scan the line. */
- if ((i = sscanf (line, "%s %d/%s%n",
- scm_i_servent.name,
- &scm_i_servent.port,
- scm_i_servent.proto, &n)) != 3)
- continue;
-
- /* Scan the remaining aliases. */
- p = line + n;
- for (a = 0; a < MAX_ALIASES && p < end && i != -1 && n > 1;
- a++, p += n)
- i = sscanf (p, "%s%n", scm_i_servent.alias[a], &n);
-
- /* Prepare the return value. */
- e = &scm_i_servent.ent;
- e->s_name = scm_i_servent.name;
- e->s_port = htons (scm_i_servent.port);
- e->s_proto = scm_i_servent.proto;
- e->s_aliases = scm_i_servent.aliases;
- scm_i_servent.aliases[a] = NULL;
- while (a--)
- scm_i_servent.aliases[a] = scm_i_servent.alias[a];
- done = 1;
- }
- else
- break;
- }
- return done ? e : NULL;
-}
-
-/* The setservent() function opens and rewinds the `/etc/services' file.
- This file can be set from outside with an environment variable specifying
- the file name. */
-void
-setservent (int stayopen)
-{
- char *file = NULL;
-
- endservent ();
- if ((file = getenv (ENVIRON_ETC_SERVICES)) != NULL)
- strcpy (scm_i_servent.file, file);
- else if ((file = scm_i_socket_filename (FILE_ETC_SERVICES)) != NULL)
- strcpy (scm_i_servent.file, file);
- scm_i_servent.fd = fopen (scm_i_servent.file, "rt");
-}
-
-/* The endservent() function closes the `/etc/services' file. */
-void
-endservent (void)
-{
- if (scm_i_servent.fd != NULL)
- {
- fclose (scm_i_servent.fd);
- scm_i_servent.fd = NULL;
- }
-}
-
-/* The getprotoent() function reads the next line from the file
- `/etc/protocols' and returns a structure protoent containing the broken
- out fields from the line. The `/etc/protocols' file is opened if
- necessary. */
-struct protoent *
-getprotoent (void)
-{
- char line[MAX_NAMLEN], *end, *p;
- int done = 0, i, n, a;
- struct protoent *e = NULL;
-
- /* Ensure a open file. */
- if (scm_i_protoent.fd == NULL || feof (scm_i_protoent.fd))
- {
- setprotoent (1);
- if (scm_i_protoent.fd == NULL)
- return NULL;
- }
-
- while (!done)
- {
- /* Get new line. */
- if (fgets (line, MAX_NAMLEN, scm_i_protoent.fd) != NULL)
- {
- end = scm_i_socket_uncomment (line);
-
- /* Scan the line. */
- if ((i = sscanf (line, "%s %d%n",
- scm_i_protoent.name,
- &scm_i_protoent.proto, &n)) != 2)
- continue;
-
- /* Scan the remaining aliases. */
- p = line + n;
- for (a = 0; a < MAX_ALIASES && p < end && i != -1 && n > 1;
- a++, p += n)
- i = sscanf (p, "%s%n", scm_i_protoent.alias[a], &n);
-
- /* Prepare the return value. */
- e = &scm_i_protoent.ent;
- e->p_name = scm_i_protoent.name;
- e->p_proto = scm_i_protoent.proto;
- e->p_aliases = scm_i_protoent.aliases;
- scm_i_protoent.aliases[a] = NULL;
- while (a--)
- scm_i_protoent.aliases[a] = scm_i_protoent.alias[a];
- done = 1;
- }
- else
- break;
- }
- return done ? e : NULL;
-}
-
-/* The setprotoent() function opens and rewinds the `/etc/protocols' file.
- As in setservent() the user can modify the location of the file using
- an environment variable. */
-void
-setprotoent (int stayopen)
-{
- char *file = NULL;
-
- endprotoent ();
- if ((file = getenv (ENVIRON_ETC_PROTOCOLS)) != NULL)
- strcpy (scm_i_protoent.file, file);
- else if ((file = scm_i_socket_filename (FILE_ETC_PROTOCOLS)) != NULL)
- strcpy (scm_i_protoent.file, file);
- scm_i_protoent.fd = fopen (scm_i_protoent.file, "rt");
-}
-
-/* The endprotoent() function closes `/etc/protocols'. */
-void
-endprotoent (void)
-{
- if (scm_i_protoent.fd != NULL)
- {
- fclose (scm_i_protoent.fd);
- scm_i_protoent.fd = NULL;
- }
-}
-
-/* Define both the original and replacement error symbol is possible. Thus
- the user is able to check symbolic errors after unsuccessful networking
- function calls. */
-static void
-scm_socket_symbols_Win32 (socket_error_t * e)
-{
- while (e->error != -1)
- {
- if (e->error)
- {
- if (e->correct_str)
- scm_c_define (e->correct_str, scm_from_int (e->error));
- if (e->replace && e->replace_str)
- scm_c_define (e->replace_str, scm_from_int (e->replace));
- }
- e++;
- }
-}
-
-/* Initialize Winsock API under M$-Windows. */
-void
-scm_i_init_socket_Win32 (void)
-{
- scm_socket_symbols_Win32 (socket_errno);
- scm_socket_symbols_Win32 (socket_h_errno);
-}
diff --git a/libguile/win32-socket.h b/libguile/win32-socket.h
deleted file mode 100644
index 4ab9b94..0000000
--- a/libguile/win32-socket.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_WIN32_SOCKET_H
-#define SCM_WIN32_SOCKET_H
-
-/* Copyright (C) 2001, 2006 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
- */
-
-#include "libguile/__scm.h"
-
-#ifdef SCM_HAVE_WINSOCK2_H
-# include <winsock2.h>
-#endif
-
-int scm_i_socket_errno (void);
-char * scm_i_socket_strerror (int error);
-void scm_i_init_socket_Win32 (void);
-char * scm_i_socket_filename (char *file);
-
-struct servent * getservent (void);
-void setservent (int stayopen);
-void endservent (void);
-struct protoent * getprotoent (void);
-void setprotoent (int stayopen);
-void endprotoent (void);
-
-#endif /* SCM_WIN32_SOCKET_H */
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index d978cb8..d4ad759 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,5 +1,5 @@
# 00gnulib.m4 serial 2
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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/absolute-header.m4 b/m4/absolute-header.m4
index 8a91d20..89ff5be 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,5 +1,5 @@
# absolute-header.m4 serial 16
-dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2013 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 656924b..270abd0 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-2012 Free Software Foundation,
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2013 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 36915d1..ea69af5 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2013 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 284dc60..3147b5b 100644
--- a/m4/autobuild.m4
+++ b/m4/autobuild.m4
@@ -1,5 +1,5 @@
# autobuild.m4 serial 7
-dnl Copyright (C) 2004, 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006-2013 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 e565321..978a06e 100644
--- a/m4/btowc.m4
+++ b/m4/btowc.m4
@@ -1,5 +1,5 @@
# btowc.m4 serial 10
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 f3b7ec9..7566903 100644
--- a/m4/byteswap.m4
+++ b/m4/byteswap.m4
@@ -1,5 +1,5 @@
# byteswap.m4 serial 4
-dnl Copyright (C) 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2007, 2009-2013 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 ea51ac4..cef3124 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,6 +1,6 @@
# canonicalize.m4 serial 26
-dnl Copyright (C) 2003-2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2007, 2009-2013 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 890517b..c617561 100644
--- a/m4/ceil.m4
+++ b/m4/ceil.m4
@@ -1,5 +1,5 @@
# ceil.m4 serial 9
-dnl Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 4f370eb..77570f4 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 fb3a17a..767a1be 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2013 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 379e70d..bccd981 100644
--- a/m4/close.m4
+++ b/m4/close.m4
@@ -1,5 +1,5 @@
# close.m4 serial 8
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 cf53d24..c2761be 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2006, 2008-2013 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 8c82371..823ffc0 100644
--- a/m4/configmake.m4
+++ b/m4/configmake.m4
@@ -1,5 +1,5 @@
# configmake.m4 serial 1
-dnl Copyright (C) 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2013 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 f6c0fa7..54c1663 100644
--- a/m4/dirent_h.m4
+++ b/m4/dirent_h.m4
@@ -1,5 +1,5 @@
# dirent_h.m4 serial 16
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 fc475d7..39bc789 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2001-2006, 2008-2013 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 65639ec..5897a2a 100644
--- a/m4/dirname.m4
+++ b/m4/dirname.m4
@@ -1,5 +1,5 @@
#serial 10 -*- autoconf -*-
-dnl Copyright (C) 2002-2006, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2013 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 1e03751..bd6f867 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2013 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
new file mode 100644
index 0000000..269cfdc
--- /dev/null
+++ b/m4/dup2.m4
@@ -0,0 +1,84 @@
+#serial 19
+dnl Copyright (C) 2002, 2005, 2007, 2009-2013 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_FUNC_DUP2],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [
+ AC_CHECK_FUNCS_ONCE([dup2])
+ if test $ac_cv_func_dup2 = no; then
+ HAVE_DUP2=0
+ fi
+ ], [
+ AC_DEFINE([HAVE_DUP2], [1], [Define to 1 if you have the 'dup2' function.])
+ ])
+ if test $HAVE_DUP2 = 1; then
+ AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works],
+ [AC_RUN_IFELSE([
+ AC_LANG_PROGRAM([[#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>]],
+ [int result = 0;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
+ result |= 1;
+#endif
+ if (dup2 (1, 1) == 0)
+ result |= 2;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_GETFD) != FD_CLOEXEC)
+ result |= 4;
+#endif
+ close (0);
+ if (dup2 (0, 0) != -1)
+ result |= 8;
+ /* Many gnulib modules require POSIX conformance of EBADF. */
+ if (dup2 (2, 1000000) == -1 && errno != EBADF)
+ result |= 16;
+ /* Flush out a cygwin core dump. */
+ if (dup2 (2, -1) != -1 || errno != EBADF)
+ result |= 32;
+ return result;
+ ])
+ ],
+ [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
+ [case "$host_os" in
+ mingw*) # on this platform, dup2 always returns 0 for success
+ gl_cv_func_dup2_works="guessing no" ;;
+ cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
+ gl_cv_func_dup2_works="guessing no" ;;
+ linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a
+ # closed fd may yield -EBADF instead of -1 / errno=EBADF.
+ gl_cv_func_dup2_works="guessing no" ;;
+ freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
+ gl_cv_func_dup2_works="guessing no" ;;
+ haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
+ esac])
+ ])
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ ;;
+ esac
+ fi
+ dnl Replace dup2() for supporting the gnulib-defined fchdir() function,
+ dnl to keep fchdir's bookkeeping up-to-date.
+ m4_ifdef([gl_FUNC_FCHDIR], [
+ gl_TEST_FCHDIR
+ if test $HAVE_FCHDIR = 0; then
+ if test $HAVE_DUP2 = 1; then
+ REPLACE_DUP2=1
+ fi
+ fi
+ ])
+])
+
+# Prerequisites of lib/dup2.c.
+AC_DEFUN([gl_PREREQ_DUP2], [])
diff --git a/m4/duplocale.m4 b/m4/duplocale.m4
index 6096f5c..9ef894c 100644
--- a/m4/duplocale.m4
+++ b/m4/duplocale.m4
@@ -1,5 +1,5 @@
# duplocale.m4 serial 7
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 9e5df45..c640ec1 100644
--- a/m4/eealloc.m4
+++ b/m4/eealloc.m4
@@ -1,5 +1,5 @@
# eealloc.m4 serial 3
-dnl Copyright (C) 2003, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2009-2013 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 8eb57c9..593a33e 100644
--- a/m4/environ.m4
+++ b/m4/environ.m4
@@ -1,5 +1,5 @@
# environ.m4 serial 6
-dnl Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2004, 2006-2013 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 4e33ba8..c813ea5 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006, 2008-2013 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 0ae4ccf..09df468 100644
--- a/m4/exponentd.m4
+++ b/m4/exponentd.m4
@@ -1,5 +1,5 @@
# exponentd.m4 serial 3
-dnl Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2008, 2010-2013 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 94d1167..55a04e6 100644
--- a/m4/exponentf.m4
+++ b/m4/exponentf.m4
@@ -1,5 +1,5 @@
# exponentf.m4 serial 2
-dnl Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2008, 2010-2013 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 a7cd13b..f877cf1 100644
--- a/m4/exponentl.m4
+++ b/m4/exponentl.m4
@@ -1,5 +1,5 @@
# exponentl.m4 serial 3
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 6d17d8a..07ba376 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,14 +1,14 @@
-# serial 12 -*- Autoconf -*-
+# serial 13 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
-# Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2013 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
# Autoconf. Perhaps we can remove this once we can assume Autoconf
-# 2.62 or later everywhere, but since CVS Autoconf mutates rapidly
+# 2.70 or later everywhere, but since Autoconf mutates rapidly
# enough in this area it's likely we'll need to redefine
# AC_USE_SYSTEM_EXTENSIONS for quite some time.
@@ -30,6 +30,7 @@
# ------------------------
# Enable extensions on systems that normally disable them,
# typically due to standards-conformance issues.
+#
# Remember that #undef in AH_VERBATIM gets replaced with #define by
# AC_DEFINE. The goal here is to define all known feature-enabling
# macros, then, if reports of conflicts are made, disable macros that
@@ -38,8 +39,6 @@ AC_DEFUN_ONCE([AC_USE_SYSTEM_EXTENSIONS],
[AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl
AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
- AC_REQUIRE([AC_CANONICAL_HOST])
-
AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=])
if test "$MINIX" = yes; then
AC_DEFINE([_POSIX_SOURCE], [1],
@@ -50,24 +49,18 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
except with this defined.])
AC_DEFINE([_MINIX], [1],
[Define to 1 if on MINIX.])
+ AC_DEFINE([_NETBSD_SOURCE], [1],
+ [Define to 1 to make NetBSD features available. MINIX 3 needs this.])
fi
- dnl HP-UX 11.11 defines mbstate_t only if _XOPEN_SOURCE is defined to 500,
- dnl regardless of whether the flags -Ae or _D_HPUX_SOURCE=1 are already
- dnl provided.
- case "$host_os" in
- hpux*)
- AC_DEFINE([_XOPEN_SOURCE], [500],
- [Define to 500 only on HP-UX.])
- ;;
- esac
-
- AH_VERBATIM([__EXTENSIONS__],
+dnl Use a different key than __EXTENSIONS__, as that name broke existing
+dnl configure.ac when using autoheader 2.62.
+ AH_VERBATIM([USE_SYSTEM_EXTENSIONS],
[/* Enable extensions on AIX 3, Interix. */
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
-/* Enable general extensions on Mac OS X. */
+/* Enable general extensions on OS X. */
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
@@ -83,6 +76,12 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
#ifndef _TANDEM_SOURCE
# undef _TANDEM_SOURCE
#endif
+/* Enable X/Open extensions if necessary. HP-UX 11.11 defines
+ mbstate_t only if _XOPEN_SOURCE is defined to 500, regardless of
+ whether compiling with -Ae or -D_HPUX_SOURCE=1. */
+#ifndef _XOPEN_SOURCE
+# undef _XOPEN_SOURCE
+#endif
/* Enable general extensions on Solaris. */
#ifndef __EXTENSIONS__
# undef __EXTENSIONS__
@@ -103,6 +102,22 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
AC_DEFINE([_GNU_SOURCE])
AC_DEFINE([_POSIX_PTHREAD_SEMANTICS])
AC_DEFINE([_TANDEM_SOURCE])
+ AC_CACHE_CHECK([whether _XOPEN_SOURCE should be defined],
+ [ac_cv_should_define__xopen_source],
+ [ac_cv_should_define__xopen_source=no
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #include <wchar.h>
+ mbstate_t x;]])],
+ [],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #define _XOPEN_SOURCE 500
+ #include <wchar.h>
+ mbstate_t x;]])],
+ [ac_cv_should_define__xopen_source=yes])])])
+ test $ac_cv_should_define__xopen_source = yes &&
+ AC_DEFINE([_XOPEN_SOURCE], [500])
])# AC_USE_SYSTEM_EXTENSIONS
# gl_USE_SYSTEM_EXTENSIONS
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 600c8d3..5880d4f 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -1,13 +1,12 @@
dnl 'extern inline' a la ISO C99.
-dnl Copyright 2012 Free Software Foundation, Inc.
+dnl Copyright 2012-2013 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_EXTERN_INLINE],
[
- AC_REQUIRE([AC_C_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'.
@@ -17,13 +16,19 @@ AC_DEFUN([gl_EXTERN_INLINE],
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. */
-#if (__GNUC__ \
- ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
- : 199901L <= __STDC_VERSION__)
+ in the same include file, after uses of _GL_INLINE.
+
+ Suppress the use of extern inline on Apple's platforms,
+ as Libc-825.25 (2012-09-19) is incompatible with it; see
+ <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ Perhaps Apple will fix this some day. */
+#if ((__GNUC__ \
+ ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
+ : 199901L <= __STDC_VERSION__) \
+ && !defined __APPLE__)
# define _GL_INLINE inline
# define _GL_EXTERN_INLINE extern inline
-#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__) && !defined __APPLE__
# if __GNUC_GNU_INLINE__
/* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
@@ -32,8 +37,8 @@ AC_DEFUN([gl_EXTERN_INLINE],
# endif
# define _GL_EXTERN_INLINE extern
#else
-# define _GL_INLINE static inline
-# define _GL_EXTERN_INLINE static inline
+# define _GL_INLINE static _GL_UNUSED
+# define _GL_EXTERN_INLINE static _GL_UNUSED
#endif
#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
diff --git a/m4/fcntl-o.m4 b/m4/fcntl-o.m4
index 740e78b..87cc4bd 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2009-2013 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 cac28ae..3cff1fd 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2007, 2009-2013 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 51c9c7b..397f2d1 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 7746883..bbcc4f9 100644
--- a/m4/flock.m4
+++ b/m4/flock.m4
@@ -1,5 +1,5 @@
# flock.m4 serial 3
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 a6e7ec8..c176a99 100644
--- a/m4/floor.m4
+++ b/m4/floor.m4
@@ -1,5 +1,5 @@
# floor.m4 serial 8
-dnl Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 82fd778..97941bb 100644
--- a/m4/fpieee.m4
+++ b/m4/fpieee.m4
@@ -1,5 +1,5 @@
# fpieee.m4 serial 2
-dnl Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 fb8db70..3909792 100644
--- a/m4/frexp.m4
+++ b/m4/frexp.m4
@@ -1,5 +1,5 @@
# frexp.m4 serial 14
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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/fstat.m4 b/m4/fstat.m4
index 3ab3297..b2cf2ad 100644
--- a/m4/fstat.m4
+++ b/m4/fstat.m4
@@ -1,5 +1,5 @@
-# fstat.m4 serial 3
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+# fstat.m4 serial 4
+dnl Copyright (C) 2011-2013 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.
@@ -33,7 +33,4 @@ AC_DEFUN([gl_FUNC_FSTAT],
])
# Prerequisites of lib/fstat.c.
-AC_DEFUN([gl_PREREQ_FSTAT],
-[
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_FSTAT], [:])
diff --git a/m4/func.m4 b/m4/func.m4
index 13c204d..5548d5e 100644
--- a/m4/func.m4
+++ b/m4/func.m4
@@ -1,5 +1,5 @@
# func.m4 serial 2
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 9cd3e67..1d631f8 100644
--- a/m4/getaddrinfo.m4
+++ b/m4/getaddrinfo.m4
@@ -1,5 +1,5 @@
-# getaddrinfo.m4 serial 29
-dnl Copyright (C) 2004-2012 Free Software Foundation, Inc.
+# getaddrinfo.m4 serial 30
+dnl Copyright (C) 2004-2013 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.
@@ -134,7 +134,6 @@ AC_DEFUN([gl_PREREQ_GETADDRINFO], [
AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([gl_SOCKET_FAMILIES])
AC_REQUIRE([gl_HEADER_SYS_SOCKET])
- AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
dnl Including sys/socket.h is wrong for Windows, but Windows does not
diff --git a/m4/getlogin.m4 b/m4/getlogin.m4
new file mode 100644
index 0000000..9b3f3cd
--- /dev/null
+++ b/m4/getlogin.m4
@@ -0,0 +1,14 @@
+# getlogin.m4 serial 3
+dnl Copyright (C) 2010-2013 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_FUNC_GETLOGIN],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([getlogin])
+ if test $ac_cv_func_getlogin = no; then
+ HAVE_GETLOGIN=0
+ fi
+])
diff --git a/m4/glibc21.m4 b/m4/glibc21.m4
index c938fb1..613fb2a 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-2012 Free Software Foundation,
+dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2013 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 50102b2..310b6db 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -1,4 +1,4 @@
-# Copyright (C) 2002-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 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
@@ -27,7 +27,7 @@
# Specification in the form of a command-line invocation:
-# 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 canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp full-read full-write func
gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nl_langinfo nproc open pipe2 putenv recv recvfrom regex rename send
sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh
string sys_stat trunc verify vsnprintf warnings wchar
+# 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 canonicalize-lgpl ceil clock-time close connect 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 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 times
trunc verify vsnprintf warnings wchar
# Specification in the form of a few gnulib-tool.m4 macro invocations:
gl_LOCAL_DIR([gnulib-local])
@@ -52,11 +52,13 @@ gl_MODULES([
floor
fpieee
frexp
+ fstat
full-read
full-write
func
gendocs
getaddrinfo
+ getlogin
getpeername
getsockname
getsockopt
@@ -85,12 +87,15 @@ gl_MODULES([
nl_langinfo
nproc
open
+ pipe-posix
pipe2
+ poll
putenv
recv
recvfrom
regex
rename
+ select
send
sendto
setenv
@@ -103,6 +108,7 @@ gl_MODULES([
striconveh
string
sys_stat
+ times
trunc
verify
vsnprintf
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 15d2b2b..0ae5a9e 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,5 +1,5 @@
# gnulib-common.m4 serial 33
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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.
@@ -294,6 +294,8 @@ Amsterdam
# for interoperability with automake-1.9.6 from autoconf-2.62.
# Remove this macro when we can assume autoconf >= 2.62 or
# autoconf >= 2.60 && automake >= 1.10.
+# AC_AUTOCONF_VERSION was introduced in 2.62, so use that as the witness.
+m4_ifndef([AC_AUTOCONF_VERSION],[
m4_ifdef([AC_PROG_MKDIR_P], [
dnl For automake-1.9.6 && autoconf < 2.62: Ensure MKDIR_P is AC_SUBSTed.
m4_define([AC_PROG_MKDIR_P],
@@ -304,13 +306,15 @@ m4_ifdef([AC_PROG_MKDIR_P], [
[AC_REQUIRE([AM_PROG_MKDIR_P])dnl defined by automake
MKDIR_P='$(mkdir_p)'
AC_SUBST([MKDIR_P])])])
+])
# AC_C_RESTRICT
# This definition overrides the AC_C_RESTRICT macro from autoconf 2.60..2.61,
# so that mixed use of GNU C and GNU C++ and mixed use of Sun C and Sun C++
# works.
# This definition can be removed once autoconf >= 2.62 can be assumed.
-m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.62]),[-1],[
+# AC_AUTOCONF_VERSION was introduced in 2.62, so use that as the witness.
+m4_ifndef([AC_AUTOCONF_VERSION],[
AC_DEFUN([AC_C_RESTRICT],
[AC_CACHE_CHECK([for C/C++ restrict keyword], [ac_cv_c_restrict],
[ac_cv_c_restrict=no
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index b52b972..55c003a 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -1,5 +1,5 @@
# DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 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
@@ -41,6 +41,7 @@ AC_DEFUN([gl_EARLY],
AC_REQUIRE([AM_PROG_CC_C_O])
# Code from module accept:
# Code from module alignof:
+ # Code from module alloca:
# Code from module alloca-opt:
# Code from module announce-gen:
# Code from module arpa_inet:
@@ -65,6 +66,7 @@ AC_DEFUN([gl_EARLY],
# Code from module dirname-lgpl:
# Code from module dosname:
# Code from module double-slash-root:
+ # Code from module dup2:
# Code from module duplocale:
# Code from module environ:
# Code from module errno:
@@ -85,6 +87,7 @@ AC_DEFUN([gl_EARLY],
# Code from module func:
# Code from module gendocs:
# Code from module getaddrinfo:
+ # Code from module getlogin:
# Code from module getpeername:
# Code from module getsockname:
# Code from module getsockopt:
@@ -144,7 +147,10 @@ AC_DEFUN([gl_EARLY],
# Code from module nproc:
# Code from module open:
# Code from module pathmax:
+ # Code from module pipe-posix:
# Code from module pipe2:
+ # Code from module poll:
+ # Code from module poll-h:
# Code from module putenv:
# Code from module raise:
# Code from module read:
@@ -158,6 +164,7 @@ AC_DEFUN([gl_EARLY],
# Code from module safe-read:
# Code from module safe-write:
# Code from module same-inode:
+ # Code from module select:
# Code from module send:
# Code from module sendto:
# Code from module servent:
@@ -190,13 +197,16 @@ AC_DEFUN([gl_EARLY],
# Code from module striconveh:
# Code from module string:
# Code from module sys_file:
+ # Code from module sys_select:
# Code from module sys_socket:
# Code from module sys_stat:
# Code from module sys_time:
+ # Code from module sys_times:
# Code from module sys_types:
# Code from module sys_uio:
# Code from module time:
# Code from module time_r:
+ # Code from module times:
# Code from module trunc:
# Code from module unistd:
# Code from module unistr/base:
@@ -238,6 +248,10 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([accept])
fi
gl_SYS_SOCKET_MODULE_INDICATOR([accept])
+changequote(,)dnl
+LTALLOCA=`echo "$ALLOCA" | sed -e 's/\.[^.]* /.lo /g;s/\.[^.]*$/.lo/'`
+changequote([, ])dnl
+AC_SUBST([LTALLOCA])
gl_FUNC_ALLOCA
gl_HEADER_ARPA_INET
AC_PROG_MKDIR_P
@@ -287,6 +301,12 @@ AC_DEFUN([gl_INIT],
gl_DIRENT_MODULE_INDICATOR([dirfd])
gl_DIRNAME_LGPL
gl_DOUBLE_SLASH_ROOT
+ gl_FUNC_DUP2
+ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+ AC_LIBOBJ([dup2])
+ gl_PREREQ_DUP2
+ fi
+ gl_UNISTD_MODULE_INDICATOR([dup2])
gl_FUNC_DUPLOCALE
if test $REPLACE_DUPLOCALE = 1; then
AC_LIBOBJ([duplocale])
@@ -336,6 +356,11 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([gai_strerror])
fi
gl_NETDB_MODULE_INDICATOR([getaddrinfo])
+ gl_FUNC_GETLOGIN
+ if test $HAVE_GETLOGIN = 0; then
+ AC_LIBOBJ([getlogin])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([getlogin])
AC_REQUIRE([gl_HEADER_SYS_SOCKET])
if test "$ac_cv_header_winsock2_h" = yes; then
AC_LIBOBJ([getpeername])
@@ -529,11 +554,24 @@ AC_DEFUN([gl_INIT],
fi
gl_FCNTL_MODULE_INDICATOR([open])
gl_PATHMAX
+ gl_FUNC_PIPE
+ if test $HAVE_PIPE = 0; then
+ AC_LIBOBJ([pipe])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([pipe])
gl_FUNC_PIPE2
gl_UNISTD_MODULE_INDICATOR([pipe2])
+ gl_FUNC_POLL
+ if test $HAVE_POLL = 0 || test $REPLACE_POLL = 1; then
+ AC_LIBOBJ([poll])
+ gl_PREREQ_POLL
+ fi
+ gl_POLL_MODULE_INDICATOR([poll])
+ gl_POLL_H
gl_FUNC_PUTENV
if test $REPLACE_PUTENV = 1; then
AC_LIBOBJ([putenv])
+ gl_PREREQ_PUTENV
fi
gl_STDLIB_MODULE_INDICATOR([putenv])
gl_FUNC_RAISE
@@ -586,6 +624,11 @@ AC_DEFUN([gl_INIT],
gl_MATH_MODULE_INDICATOR([round])
gl_PREREQ_SAFE_READ
gl_PREREQ_SAFE_WRITE
+ gl_FUNC_SELECT
+ if test $REPLACE_SELECT = 1; then
+ AC_LIBOBJ([select])
+ fi
+ gl_SYS_SELECT_MODULE_INDICATOR([select])
AC_REQUIRE([gl_HEADER_SYS_SOCKET])
if test "$ac_cv_header_winsock2_h" = yes; then
AC_LIBOBJ([send])
@@ -657,12 +700,16 @@ AC_DEFUN([gl_INIT],
gl_HEADER_STRING_H
gl_HEADER_SYS_FILE_H
AC_PROG_MKDIR_P
+ gl_HEADER_SYS_SELECT
+ AC_PROG_MKDIR_P
gl_HEADER_SYS_SOCKET
AC_PROG_MKDIR_P
gl_HEADER_SYS_STAT_H
AC_PROG_MKDIR_P
gl_HEADER_SYS_TIME_H
AC_PROG_MKDIR_P
+ gl_SYS_TIMES_H
+ AC_PROG_MKDIR_P
gl_SYS_TYPES_H
AC_PROG_MKDIR_P
gl_HEADER_SYS_UIO
@@ -674,6 +721,11 @@ AC_DEFUN([gl_INIT],
gl_PREREQ_TIME_R
fi
gl_TIME_MODULE_INDICATOR([time_r])
+ gl_FUNC_TIMES
+ if test $HAVE_TIMES = 0; then
+ AC_LIBOBJ([times])
+ fi
+ gl_SYS_TIMES_MODULE_INDICATOR([times])
gl_FUNC_TRUNC
if test $HAVE_DECL_TRUNC = 0 || test $REPLACE_TRUNC = 1; then
AC_LIBOBJ([trunc])
@@ -862,6 +914,7 @@ AC_DEFUN([gl_FILE_LIST], [
doc/gendocs_template
lib/accept.c
lib/alignof.h
+ lib/alloca.c
lib/alloca.in.h
lib/arpa_inet.in.h
lib/asnprintf.c
@@ -887,6 +940,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/dirname-lgpl.c
lib/dirname.h
lib/dosname.h
+ lib/dup2.c
lib/duplocale.c
lib/errno.in.h
lib/fcntl.in.h
@@ -905,6 +959,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/full-write.h
lib/gai_strerror.c
lib/getaddrinfo.c
+ lib/getlogin.c
lib/getpeername.c
lib/getsockname.c
lib/getsockopt.c
@@ -942,6 +997,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/malloca.c
lib/malloca.h
lib/malloca.valgrind
+ lib/math.c
lib/math.in.h
lib/mbrtowc.c
lib/mbsinit.c
@@ -960,7 +1016,10 @@ AC_DEFUN([gl_FILE_LIST], [
lib/nproc.h
lib/open.c
lib/pathmax.h
+ lib/pipe.c
lib/pipe2.c
+ lib/poll.c
+ lib/poll.in.h
lib/printf-args.c
lib/printf-args.h
lib/printf-parse.c
@@ -987,6 +1046,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/safe-write.c
lib/safe-write.h
lib/same-inode.h
+ lib/select.c
lib/send.c
lib/sendto.c
lib/setenv.c
@@ -1015,14 +1075,19 @@ AC_DEFUN([gl_FILE_LIST], [
lib/string.in.h
lib/stripslash.c
lib/sys_file.in.h
+ lib/sys_select.in.h
+ lib/sys_socket.c
lib/sys_socket.in.h
lib/sys_stat.in.h
lib/sys_time.in.h
+ lib/sys_times.in.h
lib/sys_types.in.h
lib/sys_uio.in.h
lib/time.in.h
lib/time_r.c
+ lib/times.c
lib/trunc.c
+ lib/unistd.c
lib/unistd.in.h
lib/unistr.in.h
lib/unistr/u8-mbtouc-aux.c
@@ -1041,6 +1106,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/w32sock.h
lib/wchar.in.h
lib/wcrtomb.c
+ lib/wctype-h.c
lib/wctype.in.h
lib/write.c
lib/xsize.c
@@ -1063,6 +1129,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/dirfd.m4
m4/dirname.m4
m4/double-slash-root.m4
+ m4/dup2.m4
m4/duplocale.m4
m4/eealloc.m4
m4/environ.m4
@@ -1082,6 +1149,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/fstat.m4
m4/func.m4
m4/getaddrinfo.m4
+ m4/getlogin.m4
m4/glibc21.m4
m4/gnulib-common.m4
m4/hostent.m4
@@ -1141,7 +1209,10 @@ AC_DEFUN([gl_FILE_LIST], [
m4/off_t.m4
m4/open.m4
m4/pathmax.m4
+ m4/pipe.m4
m4/pipe2.m4
+ m4/poll.m4
+ m4/poll_h.m4
m4/printf.m4
m4/putenv.m4
m4/raise.m4
@@ -1153,6 +1224,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/round.m4
m4/safe-read.m4
m4/safe-write.m4
+ m4/select.m4
m4/servent.m4
m4/setenv.m4
m4/signal_h.m4
@@ -1175,13 +1247,16 @@ AC_DEFUN([gl_FILE_LIST], [
m4/strftime.m4
m4/string_h.m4
m4/sys_file_h.m4
+ m4/sys_select_h.m4
m4/sys_socket_h.m4
m4/sys_stat_h.m4
m4/sys_time_h.m4
+ m4/sys_times_h.m4
m4/sys_types_h.m4
m4/sys_uio_h.m4
m4/time_h.m4
m4/time_r.m4
+ m4/times.m4
m4/tm_gmtoff.m4
m4/trunc.m4
m4/unistd_h.m4
diff --git a/m4/gnulib-tool.m4 b/m4/gnulib-tool.m4
index a09ffc1..f3dea1a 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2004-2005, 2009-2013 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 5134775..72be876 100644
--- a/m4/hostent.m4
+++ b/m4/hostent.m4
@@ -1,5 +1,5 @@
# hostent.m4 serial 2
-dnl Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2013 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 6a47236..a503646 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2007-2013 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 aa86cf8..f0519d9 100644
--- a/m4/iconv_h.m4
+++ b/m4/iconv_h.m4
@@ -1,5 +1,5 @@
# iconv_h.m4 serial 8
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 f450f55..0ab3a18 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 07f4849..1dcf414 100644
--- a/m4/iconv_open.m4
+++ b/m4/iconv_open.m4
@@ -1,5 +1,5 @@
# iconv_open.m4 serial 14
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 a60a261..108d945 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,5 +1,5 @@
# include_next.m4 serial 23
-dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2013 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_ntop.m4 b/m4/inet_ntop.m4
index 1ebd960..476f063 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-2013 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 e7b44e2..e86db82 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2013 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 6fa9972..3a50621 100644
--- a/m4/inline.m4
+++ b/m4/inline.m4
@@ -1,5 +1,5 @@
# inline.m4 serial 4
-dnl Copyright (C) 2006, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2009-2013 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 c1a4a75..6ea7053 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-2012 Free Software Foundation,
+dnl Copyright (C) 1997-2004, 2006-2007, 2009-2013 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 91c7bca..5f05ac5 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 1997-2004, 2006, 2008-2013 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 0f6309e..513a1ba 100644
--- a/m4/isinf.m4
+++ b/m4/isinf.m4
@@ -1,5 +1,5 @@
# isinf.m4 serial 9
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 7ad7127..ababb25 100644
--- a/m4/isnan.m4
+++ b/m4/isnan.m4
@@ -1,5 +1,5 @@
# isnan.m4 serial 5
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 54b64a4..ee05e0f 100644
--- a/m4/isnand.m4
+++ b/m4/isnand.m4
@@ -1,5 +1,5 @@
# isnand.m4 serial 11
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 97f638a..f01886a 100644
--- a/m4/isnanf.m4
+++ b/m4/isnanf.m4
@@ -1,5 +1,5 @@
# isnanf.m4 serial 14
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 81469ab..ed5bbf8 100644
--- a/m4/isnanl.m4
+++ b/m4/isnanl.m4
@@ -1,5 +1,5 @@
# isnanl.m4 serial 17
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 b93fe70..73bef8b 100644
--- a/m4/langinfo_h.m4
+++ b/m4/langinfo_h.m4
@@ -1,5 +1,5 @@
# langinfo_h.m4 serial 7
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 a88850a..1e605e3 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,13 +1,14 @@
# Enable large files on systems where this is not the default.
-# Copyright 1992-1996, 1998-2012 Free Software Foundation, Inc.
+# Copyright 1992-1996, 1998-2013 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.
-# The following implementation works around a problem in autoconf <= 2.68;
-# AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5.
-m4_version_prereq([2.69], [] ,[
+# The following implementation works around a problem in autoconf <= 2.69;
+# AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5,
+# or configures them incorrectly in some cases.
+m4_version_prereq([2.70], [] ,[
# _AC_SYS_LARGEFILE_TEST_INCLUDES
# -------------------------------
@@ -25,9 +26,9 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES],
# _AC_SYS_LARGEFILE_MACRO_VALUE(C-MACRO, VALUE,
-# CACHE-VAR,
-# DESCRIPTION,
-# PROLOGUE, [FUNCTION-BODY])
+# CACHE-VAR,
+# DESCRIPTION,
+# PROLOGUE, [FUNCTION-BODY])
# --------------------------------------------------------
m4_define([_AC_SYS_LARGEFILE_MACRO_VALUE],
[AC_CACHE_CHECK([for $1 value needed for large files], [$3],
@@ -93,15 +94,11 @@ if test "$enable_largefile" != no; then
[_AC_SYS_LARGEFILE_TEST_INCLUDES])
fi
- AH_VERBATIM([_DARWIN_USE_64_BIT_INODE],
-[/* Enable large inode numbers on Mac OS X. */
-#ifndef _DARWIN_USE_64_BIT_INODE
-# define _DARWIN_USE_64_BIT_INODE 1
-#endif])
+ AC_DEFINE([_DARWIN_USE_64_BIT_INODE], [1],
+ [Enable large inode numbers on Mac OS X 10.5.])
fi
])# AC_SYS_LARGEFILE
-
-])# m4_version_prereq 2.69
+])# m4_version_prereq 2.70
# Enable large files on systems where this is implemented by Gnulib, not by the
# system headers.
diff --git a/m4/ld-version-script.m4 b/m4/ld-version-script.m4
index 5ed93ef..63386f1 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 6d26b56..7a75b1b 100644
--- a/m4/ldexp.m4
+++ b/m4/ldexp.m4
@@ -1,5 +1,5 @@
# ldexp.m4 serial 1
-dnl Copyright (C) 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2013 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 e1feab5..c145e47 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 1996-2003, 2009-2013 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 d11b4b4..073f040 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2013 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 007aa05..60908e8 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2005, 2008-2013 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 d91c42b..d105c72 100644
--- a/m4/libunistring-base.m4
+++ b/m4/libunistring-base.m4
@@ -1,5 +1,5 @@
# libunistring-base.m4 serial 5
-dnl Copyright (C) 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2013 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 c1bf4d5..fa74d72 100644
--- a/m4/libunistring.m4
+++ b/m4/libunistring.m4
@@ -1,5 +1,5 @@
# libunistring.m4 serial 11
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 8010379..2e93e58 100644
--- a/m4/localcharset.m4
+++ b/m4/localcharset.m4
@@ -1,5 +1,5 @@
# localcharset.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2009-2013 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 71b6847..ef199e3 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2013 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 5ba0e43..132a3e7 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2013 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 e5502b2..4eed73f 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2013 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 c0f4d52..8bd12e8 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 5fae06d..b8bb596 100644
--- a/m4/localeconv.m4
+++ b/m4/localeconv.m4
@@ -1,5 +1,5 @@
# localeconv.m4 serial 1
-dnl Copyright (C) 2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2013 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/log.m4 b/m4/log.m4
index a04362a..31a6adf 100644
--- a/m4/log.m4
+++ b/m4/log.m4
@@ -1,5 +1,5 @@
# log.m4 serial 4
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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 4bca324..8a81511 100644
--- a/m4/log1p.m4
+++ b/m4/log1p.m4
@@ -1,5 +1,5 @@
# log1p.m4 serial 3
-dnl Copyright (C) 2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2013 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 b9c65c7..3af6ab5 100644
--- a/m4/longlong.m4
+++ b/m4/longlong.m4
@@ -1,5 +1,5 @@
# longlong.m4 serial 17
-dnl Copyright (C) 1999-2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 1999-2007, 2009-2013 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 b7335bd..5f4db64 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,6 +1,6 @@
-# serial 25
+# serial 26
-# Copyright (C) 1997-2001, 2003-2012 Free Software Foundation, Inc.
+# Copyright (C) 1997-2001, 2003-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -27,11 +27,7 @@ AC_DEFUN([gl_FUNC_LSTAT],
])
# Prerequisites of lib/lstat.c.
-AC_DEFUN([gl_PREREQ_LSTAT],
-[
- AC_REQUIRE([AC_C_INLINE])
- :
-])
+AC_DEFUN([gl_PREREQ_LSTAT], [:])
AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
[
diff --git a/m4/malloc.m4 b/m4/malloc.m4
index 8fa48e9..4b24a0b 100644
--- a/m4/malloc.m4
+++ b/m4/malloc.m4
@@ -1,5 +1,5 @@
# malloc.m4 serial 14
-dnl Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 7841979..791ce10 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-2012 Free Software Foundation,
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2013 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 90d248a..bf0845f 100644
--- a/m4/math_h.m4
+++ b/m4/math_h.m4
@@ -1,5 +1,5 @@
-# math_h.m4 serial 113
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+# math_h.m4 serial 114
+dnl Copyright (C) 2007-2013 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,7 +8,6 @@ AC_DEFUN([gl_MATH_H],
[
AC_REQUIRE([gl_MATH_H_DEFAULTS])
gl_CHECK_NEXT_HEADERS([math.h])
- AC_REQUIRE([AC_C_INLINE])
AC_CACHE_CHECK([whether NAN macro works], [gl_cv_header_math_nan_works],
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM(address@hidden:@include <math.h>]],
diff --git a/m4/mathfunc.m4 b/m4/mathfunc.m4
index 7147f7e..67b601f 100644
--- a/m4/mathfunc.m4
+++ b/m4/mathfunc.m4
@@ -1,5 +1,5 @@
# mathfunc.m4 serial 11
-dnl Copyright (C) 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2013 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 8f829c8..4c9f388 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-2012 Free Software Foundation,
+dnl Copyright (C) 2001-2002, 2004-2005, 2008-2013 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 da56c3d..2e6d092 100644
--- a/m4/mbsinit.m4
+++ b/m4/mbsinit.m4
@@ -1,5 +1,5 @@
# mbsinit.m4 serial 8
-dnl Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2013 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 61a8190..ed00117 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2008-2013 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 fec0d25..e479461 100644
--- a/m4/mbtowc.m4
+++ b/m4/mbtowc.m4
@@ -1,5 +1,5 @@
# mbtowc.m4 serial 2
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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 0040294..2d8abe7 100644
--- a/m4/memchr.m4
+++ b/m4/memchr.m4
@@ -1,5 +1,5 @@
# memchr.m4 serial 12
-dnl Copyright (C) 2002-2004, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2009-2013 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 748b17d..9b60ddf 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2007, 2009-2013 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 40f612a..d5b66d4 100644
--- a/m4/mode_t.m4
+++ b/m4/mode_t.m4
@@ -1,5 +1,5 @@
# mode_t.m4 serial 2
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 8db4617..9a6a47a 100644
--- a/m4/msvc-inval.m4
+++ b/m4/msvc-inval.m4
@@ -1,5 +1,5 @@
# msvc-inval.m4 serial 1
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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 0125050..a39618a 100644
--- a/m4/msvc-nothrow.m4
+++ b/m4/msvc-nothrow.m4
@@ -1,5 +1,5 @@
# msvc-nothrow.m4 serial 1
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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 0c288b8..552ec7e 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,5 +1,5 @@
# multiarch.m4 serial 7
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 e0f3ee8..2c69f99 100644
--- a/m4/netdb_h.m4
+++ b/m4/netdb_h.m4
@@ -1,5 +1,5 @@
# netdb_h.m4 serial 11
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 e181388..21971b2 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2013 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 80fe60d..25e2101 100644
--- a/m4/nl_langinfo.m4
+++ b/m4/nl_langinfo.m4
@@ -1,5 +1,5 @@
# nl_langinfo.m4 serial 5
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 c2638df..105b884 100644
--- a/m4/nocrash.m4
+++ b/m4/nocrash.m4
@@ -1,5 +1,5 @@
# nocrash.m4 serial 4
-dnl Copyright (C) 2005, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2009-2013 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 a94b97f..0261938 100644
--- a/m4/nproc.m4
+++ b/m4/nproc.m4
@@ -1,5 +1,5 @@
# nproc.m4 serial 4
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 dfca2df..d355d01 100644
--- a/m4/off_t.m4
+++ b/m4/off_t.m4
@@ -1,5 +1,5 @@
# off_t.m4 serial 1
-dnl Copyright (C) 2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-2013 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 c85971d..a6cb101 100644
--- a/m4/open.m4
+++ b/m4/open.m4
@@ -1,5 +1,5 @@
-# open.m4 serial 13
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+# open.m4 serial 14
+dnl Copyright (C) 2007-2013 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.
@@ -86,7 +86,6 @@ changequote([,])dnl
# Prerequisites of lib/open.c.
AC_DEFUN([gl_PREREQ_OPEN],
[
- AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([gl_PROMOTED_TYPE_MODE_T])
:
])
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index 0117861..e11bf57 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-2012 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2013 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
new file mode 100644
index 0000000..5831283
--- /dev/null
+++ b/m4/pipe.m4
@@ -0,0 +1,15 @@
+# pipe.m4 serial 2
+dnl Copyright (C) 2010-2013 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_FUNC_PIPE],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ AC_CHECK_FUNCS_ONCE([pipe])
+ if test $ac_cv_func_pipe != yes; then
+ HAVE_PIPE=0
+ fi
+])
diff --git a/m4/pipe2.m4 b/m4/pipe2.m4
index 00ad82b..6ccee10 100644
--- a/m4/pipe2.m4
+++ b/m4/pipe2.m4
@@ -1,5 +1,5 @@
# pipe2.m4 serial 2
-dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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
new file mode 100644
index 0000000..f0f0b80
--- /dev/null
+++ b/m4/poll.m4
@@ -0,0 +1,103 @@
+# poll.m4 serial 17
+dnl Copyright (c) 2003, 2005-2007, 2009-2013 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_FUNC_POLL],
+[
+ AC_REQUIRE([gl_POLL_H])
+ AC_REQUIRE([gl_SOCKETS])
+ if test $ac_cv_header_poll_h = no; then
+ ac_cv_func_poll=no
+ gl_cv_func_poll=no
+ else
+ AC_CHECK_FUNC([poll],
+ [# Check whether poll() works on special files (like /dev/null) and
+ # and ttys (like /dev/tty). On Mac OS X 10.4.0 and AIX 5.3, it doesn't.
+ AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <fcntl.h>
+#include <poll.h>
+ int main()
+ {
+ int result = 0;
+ struct pollfd ufd;
+ /* Try /dev/null for reading. */
+ ufd.fd = open ("/dev/null", O_RDONLY);
+ /* If /dev/null does not exist, it's not Mac OS X nor AIX. */
+ if (ufd.fd >= 0)
+ {
+ ufd.events = POLLIN;
+ ufd.revents = 0;
+ if (!(poll (&ufd, 1, 0) == 1 && ufd.revents == POLLIN))
+ result |= 1;
+ }
+ /* Try /dev/null for writing. */
+ ufd.fd = open ("/dev/null", O_WRONLY);
+ /* If /dev/null does not exist, it's not Mac OS X nor AIX. */
+ if (ufd.fd >= 0)
+ {
+ ufd.events = POLLOUT;
+ ufd.revents = 0;
+ if (!(poll (&ufd, 1, 0) == 1 && ufd.revents == POLLOUT))
+ result |= 2;
+ }
+ /* Trying /dev/tty may be too environment dependent. */
+ return result;
+ }]])],
+ [gl_cv_func_poll=yes],
+ [gl_cv_func_poll=no],
+ [# When cross-compiling, assume that poll() works everywhere except on
+ # Mac OS X or AIX, regardless of its version.
+ AC_EGREP_CPP([MacOSX], [
+#if (defined(__APPLE__) && defined(__MACH__)) || defined(_AIX)
+This is MacOSX or AIX
+#endif
+], [gl_cv_func_poll=no], [gl_cv_func_poll=yes])])])
+ fi
+ if test $gl_cv_func_poll != yes; then
+ AC_CHECK_FUNC([poll], [ac_cv_func_poll=yes], [ac_cv_func_poll=no])
+ if test $ac_cv_func_poll = no; then
+ HAVE_POLL=0
+ else
+ REPLACE_POLL=1
+ fi
+ fi
+ if test $HAVE_POLL = 0 || test $REPLACE_POLL = 1; then
+ :
+ else
+ AC_DEFINE([HAVE_POLL], [1],
+ [Define to 1 if you have the 'poll' function and it works.])
+ fi
+
+ dnl Determine the needed libraries.
+ LIB_POLL="$LIBSOCKET"
+ if test $HAVE_POLL = 0 || test $REPLACE_POLL = 1; then
+ case "$host_os" in
+ mingw*)
+ dnl On the MSVC platform, the function MsgWaitForMultipleObjects
+ dnl (used in lib/poll.c) requires linking with -luser32. On mingw,
+ dnl it is implicit.
+ AC_LINK_IFELSE(
+ [AC_LANG_SOURCE([[
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+int
+main ()
+{
+ MsgWaitForMultipleObjects (0, NULL, 0, 0, 0);
+ return 0;
+}]])],
+ [],
+ [LIB_POLL="$LIB_POLL -luser32"])
+ ;;
+ esac
+ fi
+ AC_SUBST([LIB_POLL])
+])
+
+# Prerequisites of lib/poll.c.
+AC_DEFUN([gl_PREREQ_POLL],
+[
+ AC_CHECK_HEADERS_ONCE([sys/ioctl.h sys/filio.h])
+])
diff --git a/m4/poll_h.m4 b/m4/poll_h.m4
new file mode 100644
index 0000000..4930674
--- /dev/null
+++ b/m4/poll_h.m4
@@ -0,0 +1,47 @@
+# poll_h.m4 serial 2
+dnl Copyright (C) 2010-2013 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 Written by Bruno Haible.
+
+AC_DEFUN([gl_POLL_H],
+[
+ dnl Use AC_REQUIRE here, so that the default behavior below is expanded
+ dnl once only, before all statements that occur in other macros.
+ AC_REQUIRE([gl_POLL_H_DEFAULTS])
+
+ AC_CHECK_HEADERS_ONCE([poll.h])
+ if test $ac_cv_header_poll_h = yes; then
+ HAVE_POLL_H=1
+ else
+ HAVE_POLL_H=0
+ fi
+ AC_SUBST([HAVE_POLL_H])
+
+ dnl <poll.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([poll.h])
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[#include <poll.h>]],
+ [poll])
+])
+
+AC_DEFUN([gl_POLL_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_POLL_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_POLL_H_DEFAULTS],
+[
+ GNULIB_POLL=0; AC_SUBST([GNULIB_POLL])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_POLL=1; AC_SUBST([HAVE_POLL])
+ REPLACE_POLL=0; AC_SUBST([REPLACE_POLL])
+])
diff --git a/m4/printf.m4 b/m4/printf.m4
index 751e896..ef44f78 100644
--- a/m4/printf.m4
+++ b/m4/printf.m4
@@ -1,5 +1,5 @@
# printf.m4 serial 50
-dnl Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007-2013 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 b971b12..03ed4f9 100644
--- a/m4/putenv.m4
+++ b/m4/putenv.m4
@@ -1,5 +1,5 @@
# putenv.m4 serial 19
-dnl Copyright (C) 2002-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2013 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.
@@ -48,3 +48,9 @@ AC_DEFUN([gl_FUNC_PUTENV],
;;
esac
])
+
+# Prerequisites of lib/putenv.c.
+AC_DEFUN([gl_PREREQ_PUTENV],
+[
+ AC_CHECK_FUNCS([_putenv])
+])
diff --git a/m4/raise.m4 b/m4/raise.m4
index 18eb8b9..7df3317 100644
--- a/m4/raise.m4
+++ b/m4/raise.m4
@@ -1,5 +1,5 @@
-# raise.m4 serial 2
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+# raise.m4 serial 3
+dnl Copyright (C) 2011-2013 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,6 +31,4 @@ AC_DEFUN([gl_FUNC_RAISE],
])
# Prerequisites of lib/raise.c.
-AC_DEFUN([gl_PREREQ_RAISE], [
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_RAISE], [:])
diff --git a/m4/read.m4 b/m4/read.m4
index 69aeb09..81f0f3a 100644
--- a/m4/read.m4
+++ b/m4/read.m4
@@ -1,5 +1,5 @@
-# read.m4 serial 3
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+# read.m4 serial 4
+dnl Copyright (C) 2011-2013 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.
@@ -23,7 +23,4 @@ AC_DEFUN([gl_FUNC_READ],
])
# Prerequisites of lib/read.c.
-AC_DEFUN([gl_PREREQ_READ],
-[
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_READ], [:])
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index ccf5141..96e5042 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,5 +1,5 @@
# readlink.m4 serial 12
-dnl Copyright (C) 2003, 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007, 2009-2013 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 41be5e8..ae89e31 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,6 +1,6 @@
-# serial 61
+# serial 63
-# Copyright (C) 1996-2001, 2003-2012 Free Software Foundation, Inc.
+# Copyright (C) 1996-2001, 2003-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -27,15 +27,21 @@ 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_CACHE_CHECK([for working re_compile_pattern],
[gl_cv_func_re_compile_pattern_working],
[AC_RUN_IFELSE(
[AC_LANG_PROGRAM(
- [AC_INCLUDES_DEFAULT[
- #include <locale.h>
- #include <limits.h>
- #include <regex.h>
- ]],
+ [[#include <regex.h>
+
+ #include <locale.h>
+ #include <limits.h>
+ #include <string.h>
+ #if HAVE_ALARM
+ # include <unistd.h>
+ # include <signal.h>
+ #endif
+ ]],
[[int result = 0;
static struct re_pattern_buffer regex;
unsigned char folded_chars[UCHAR_MAX + 1];
@@ -43,26 +49,54 @@ AC_DEFUN([gl_REGEX],
const char *s;
struct re_registers regs;
- /* http://sourceware.org/ml/libc-hacker/2006-09/msg00008.html
- This test needs valgrind to catch the bug on Debian
- GNU/Linux 3.1 x86, but it might catch the bug better
- on other platforms and it shouldn't hurt to try the
- test here. */
+#if HAVE_ALARM
+ /* Some builds of glibc go into an infinite loop on this test. */
+ signal (SIGALRM, SIG_DFL);
+ alarm (2);
+#endif
if (setlocale (LC_ALL, "en_US.UTF-8"))
{
- static char const pat[] = "insert into";
- static char const data[] =
- "\xFF\0\x12\xA2\xAA\xC4\xB1,K\x12\xC4\xB1*\xACK";
- re_set_syntax (RE_SYNTAX_GREP | RE_HAT_LISTS_NOT_NEWLINE
- | RE_ICASE);
- 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, ®s)
- != -1)
- result |= 1;
+ {
+ /* http://sourceware.org/ml/libc-hacker/2006-09/msg00008.html
+ This test needs valgrind to catch the bug on Debian
+ GNU/Linux 3.1 x86, but it might catch the bug better
+ on other platforms and it shouldn't hurt to try the
+ test here. */
+ static char const pat[] = "insert into";
+ static char const data[] =
+ "\xFF\0\x12\xA2\xAA\xC4\xB1,K\x12\xC4\xB1*\xACK";
+ re_set_syntax (RE_SYNTAX_GREP | RE_HAT_LISTS_NOT_NEWLINE
+ | RE_ICASE);
+ 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, ®s)
+ != -1)
+ result |= 1;
+ }
+
+ {
+ /* This test is from glibc bug 15078.
+ The test case is from Andreas Schwab in
+
<http://www.sourceware.org/ml/libc-alpha/2013-01/msg00967.html>.
+ */
+ 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";
+ 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;
+ }
+
if (! setlocale (LC_ALL, "C"))
return 1;
}
@@ -220,6 +254,7 @@ AC_DEFUN([gl_PREREQ_REGEX],
AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
+ AC_REQUIRE([gl_EEMALLOC])
AC_CHECK_HEADERS([libintl.h])
AC_CHECK_FUNCS_ONCE([isblank iswctype wcscoll])
AC_CHECK_DECLS([isblank], [], [], [[#include <ctype.h>]])
diff --git a/m4/rename.m4 b/m4/rename.m4
index 378b5ec..66430aa 100644
--- a/m4/rename.m4
+++ b/m4/rename.m4
@@ -1,6 +1,6 @@
# serial 26
-# Copyright (C) 2001, 2003, 2005-2006, 2009-2012 Free Software Foundation, Inc.
+# Copyright (C) 2001, 2003, 2005-2006, 2009-2013 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 34ca876..f6a02dd 100644
--- a/m4/rmdir.m4
+++ b/m4/rmdir.m4
@@ -1,5 +1,5 @@
# rmdir.m4 serial 13
-dnl Copyright (C) 2002, 2005, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005, 2009-2013 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 514c4f7..aab67ac 100644
--- a/m4/round.m4
+++ b/m4/round.m4
@@ -1,5 +1,5 @@
# round.m4 serial 16
-dnl Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2009-2013 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 c82acdb..be5207a 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-2012 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2013 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 c1eff6e..bc2a33f 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2013 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
new file mode 100644
index 0000000..d025355
--- /dev/null
+++ b/m4/select.m4
@@ -0,0 +1,113 @@
+# select.m4 serial 7
+dnl Copyright (C) 2009-2013 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_FUNC_SELECT],
+[
+ AC_REQUIRE([gl_HEADER_SYS_SELECT])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_REQUIRE([gl_SOCKETS])
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ REPLACE_SELECT=1
+ else
+ dnl On Interix 3.5, select(0, NULL, NULL, NULL, timeout) fails with error
+ dnl EFAULT.
+ AC_CHECK_HEADERS_ONCE([sys/select.h])
+ AC_CACHE_CHECK([whether select supports a 0 argument],
+ [gl_cv_func_select_supports0],
+ [
+ AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#include <sys/time.h>
+#if HAVE_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+int main ()
+{
+ struct timeval timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 5;
+ return select (0, (fd_set *)0, (fd_set *)0, (fd_set *)0, &timeout) < 0;
+}]])], [gl_cv_func_select_supports0=yes], [gl_cv_func_select_supports0=no],
+ [
+changequote(,)dnl
+ case "$host_os" in
+ # Guess no on Interix.
+ interix*) gl_cv_func_select_supports0="guessing no";;
+ # Guess yes otherwise.
+ *) gl_cv_func_select_supports0="guessing yes";;
+ esac
+changequote([,])dnl
+ ])
+ ])
+ case "$gl_cv_func_select_supports0" in
+ *yes) ;;
+ *) REPLACE_SELECT=1 ;;
+ esac
+
+ dnl On FreeBSD 8.2, select() doesn't always reject bad fds.
+ AC_CACHE_CHECK([whether select detects invalid fds],
+ [gl_cv_func_select_detects_ebadf],
+ [
+ AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <sys/types.h>
+#include <sys/time.h>
+#if HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <unistd.h>
+#include <errno.h>
+]],[[
+ fd_set set;
+ dup2(0, 16);
+ FD_ZERO(&set);
+ FD_SET(16, &set);
+ close(16);
+ struct timeval timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 5;
+ return select (17, &set, NULL, NULL, &timeout) != -1 || errno != EBADF;
+]])], [gl_cv_func_select_detects_ebadf=yes],
+ [gl_cv_func_select_detects_ebadf=no],
+ [
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_select_detects_ebadf="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_select_detects_ebadf="guessing no" ;;
+ esac
+ ])
+ ])
+ case $gl_cv_func_select_detects_ebadf in
+ *yes) ;;
+ *) REPLACE_SELECT=1 ;;
+ esac
+ fi
+
+ dnl Determine the needed libraries.
+ LIB_SELECT="$LIBSOCKET"
+ if test $REPLACE_SELECT = 1; then
+ case "$host_os" in
+ mingw*)
+ dnl On the MSVC platform, the function MsgWaitForMultipleObjects
+ dnl (used in lib/select.c) requires linking with -luser32. On mingw,
+ dnl it is implicit.
+ AC_LINK_IFELSE(
+ [AC_LANG_SOURCE([[
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+int
+main ()
+{
+ MsgWaitForMultipleObjects (0, NULL, 0, 0, 0);
+ return 0;
+}]])],
+ [],
+ [LIB_SELECT="$LIB_SELECT -luser32"])
+ ;;
+ esac
+ fi
+ AC_SUBST([LIB_SELECT])
+])
diff --git a/m4/servent.m4 b/m4/servent.m4
index 21da957..01c037a 100644
--- a/m4/servent.m4
+++ b/m4/servent.m4
@@ -1,5 +1,5 @@
# servent.m4 serial 2
-dnl Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008, 2010-2013 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 e1931e7..cb5351a 100644
--- a/m4/setenv.m4
+++ b/m4/setenv.m4
@@ -1,5 +1,5 @@
# setenv.m4 serial 26
-dnl Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2004, 2006-2013 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 ed4d730..3de9f27 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,5 +1,5 @@
# signal_h.m4 serial 18
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 5a8162b..4b247ab 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2005-2006, 2008-2013 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 de94edd..3698e84 100644
--- a/m4/snprintf.m4
+++ b/m4/snprintf.m4
@@ -1,5 +1,5 @@
# snprintf.m4 serial 6
-dnl Copyright (C) 2002-2004, 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2007-2013 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 92a1af2..b08a72f 100644
--- a/m4/socketlib.m4
+++ b/m4/socketlib.m4
@@ -1,5 +1,5 @@
# socketlib.m4 serial 1
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 e3738d9..b407391 100644
--- a/m4/sockets.m4
+++ b/m4/sockets.m4
@@ -1,5 +1,5 @@
# sockets.m4 serial 7
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 a4ab43b..e3efd6e 100644
--- a/m4/socklen.m4
+++ b/m4/socklen.m4
@@ -1,5 +1,5 @@
# socklen.m4 serial 10
-dnl Copyright (C) 2005-2007, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2007, 2009-2013 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 5f97c3e..89557b1 100644
--- a/m4/sockpfaf.m4
+++ b/m4/sockpfaf.m4
@@ -1,5 +1,5 @@
# sockpfaf.m4 serial 8
-dnl Copyright (C) 2004, 2006, 2009-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006, 2009-2013 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 209d64c..6338134 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-2013 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 9371d7b..d777f74 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-2012 Free Software
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2013 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
diff --git a/m4/stat.m4 b/m4/stat.m4
index a8b79f5..2456297 100644
--- a/m4/stat.m4
+++ b/m4/stat.m4
@@ -1,6 +1,6 @@
-# serial 10
+# serial 11
-# Copyright (C) 2009-2012 Free Software Foundation, Inc.
+# Copyright (C) 2009-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -68,8 +68,4 @@ AC_DEFUN([gl_FUNC_STAT],
])
# Prerequisites of lib/stat.c.
-AC_DEFUN([gl_PREREQ_STAT],
-[
- AC_REQUIRE([AC_C_INLINE])
- :
-])
+AC_DEFUN([gl_PREREQ_STAT], [:])
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index 6659c9c..3d7993d 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -1,6 +1,6 @@
# Check for stdalign.h that conforms to C11.
-dnl Copyright 2011-2012 Free Software Foundation, Inc.
+dnl Copyright 2011-2013 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/stdbool.m4 b/m4/stdbool.m4
index eabfa64..80d5559 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2013 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 cc11609..5da8ab1 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2013 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 28d342e..27cdcdb 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,5 +1,5 @@
# stdint.m4 serial 43
-dnl Copyright (C) 2001-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2013 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 581de96..511ab4e 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 1997-2004, 2006, 2008-2013 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 5298dd6..ebade06 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,5 +1,5 @@
-# stdio_h.m4 serial 42
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+# stdio_h.m4 serial 43
+dnl Copyright (C) 2007-2013 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,7 +7,6 @@ dnl with or without modifications, as long as this notice is
preserved.
AC_DEFUN([gl_STDIO_H],
[
AC_REQUIRE([gl_STDIO_H_DEFAULTS])
- AC_REQUIRE([AC_C_INLINE])
gl_NEXT_HEADERS([stdio.h])
dnl No need to create extra modules for these functions. Everyone who uses
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 9c69f2e..2027ab3 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,5 +1,5 @@
-# stdlib_h.m4 serial 41
-dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
+# stdlib_h.m4 serial 42
+dnl Copyright (C) 2007-2013 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.
@@ -22,7 +22,7 @@ AC_DEFUN([gl_STDLIB_H],
]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt
initstate initstate_r mkdtemp mkostemp mkostemps mkstemp mkstemps
posix_openpt ptsname ptsname_r random random_r realpath rpmatch
- setenv setstate setstate_r srandom srandom_r
+ secure_getenv setenv setstate setstate_r srandom srandom_r
strtod strtoll strtoull unlockpt unsetenv])
])
@@ -60,6 +60,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX])
GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH])
GNULIB_RPMATCH=0; AC_SUBST([GNULIB_RPMATCH])
+ GNULIB_SECURE_GETENV=0; AC_SUBST([GNULIB_SECURE_GETENV])
GNULIB_SETENV=0; AC_SUBST([GNULIB_SETENV])
GNULIB_STRTOD=0; AC_SUBST([GNULIB_STRTOD])
GNULIB_STRTOLL=0; AC_SUBST([GNULIB_STRTOLL])
@@ -88,6 +89,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R])
HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH])
HAVE_RPMATCH=1; AC_SUBST([HAVE_RPMATCH])
+ HAVE_SECURE_GETENV=1; AC_SUBST([HAVE_SECURE_GETENV])
HAVE_SETENV=1; AC_SUBST([HAVE_SETENV])
HAVE_DECL_SETENV=1; AC_SUBST([HAVE_DECL_SETENV])
HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD])
diff --git a/m4/strftime.m4 b/m4/strftime.m4
index 4204301..b31f495 100644
--- a/m4/strftime.m4
+++ b/m4/strftime.m4
@@ -1,6 +1,6 @@
# serial 33
-# Copyright (C) 1996-1997, 1999-2007, 2009-2012 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2013 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 5677e09..cc5fbbb 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2007-2013 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 89272f1..0cec958 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2008-2013 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
new file mode 100644
index 0000000..4962328
--- /dev/null
+++ b/m4/sys_select_h.m4
@@ -0,0 +1,95 @@
+# sys_select_h.m4 serial 20
+dnl Copyright (C) 2006-2013 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_HEADER_SYS_SELECT],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ AC_CACHE_CHECK([whether <sys/select.h> is self-contained],
+ [gl_cv_header_sys_select_h_selfcontained],
+ [
+ dnl Test against two bugs:
+ dnl 1. On many platforms, <sys/select.h> assumes prior inclusion of
+ dnl <sys/types.h>.
+ dnl 2. On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ dnl of 'struct timeval', and no definition of this type.
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[struct timeval b;]])],
+ [gl_cv_header_sys_select_h_selfcontained=yes],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ dnl Test against another bug:
+ dnl 3. On Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ dnl that relies on memset(), but without including <string.h>.
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[int memset; int bzero;]])
+ ],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]], [[
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+ ]])
+ ],
+ [],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ ])
+ fi
+ ])
+ dnl <sys/select.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([sys/select.h])
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+ AC_SUBST([HAVE_SYS_SELECT_H])
+ gl_PREREQ_SYS_H_WINSOCK2
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems require prerequisite headers. */
+#include <sys/types.h>
+#if !(defined __GLIBC__ && !defined __UCLIBC__) && HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+#include <sys/select.h>
+ ]], [pselect select])
+])
+
+AC_DEFUN([gl_SYS_SELECT_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_SELECT_H_DEFAULTS],
+[
+ GNULIB_PSELECT=0; AC_SUBST([GNULIB_PSELECT])
+ GNULIB_SELECT=0; AC_SUBST([GNULIB_SELECT])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_PSELECT=1; AC_SUBST([HAVE_PSELECT])
+ REPLACE_PSELECT=0; AC_SUBST([REPLACE_PSELECT])
+ REPLACE_SELECT=0; AC_SUBST([REPLACE_SELECT])
+])
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
index 8d4e7e1..9486377 100644
--- a/m4/sys_socket_h.m4
+++ b/m4/sys_socket_h.m4
@@ -1,5 +1,5 @@
-# sys_socket_h.m4 serial 22
-dnl Copyright (C) 2005-2012 Free Software Foundation, Inc.
+# sys_socket_h.m4 serial 23
+dnl Copyright (C) 2005-2013 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.
@@ -10,7 +10,6 @@ AC_DEFUN([gl_HEADER_SYS_SOCKET],
[
AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS])
AC_REQUIRE([AC_CANONICAL_HOST])
- AC_REQUIRE([AC_C_INLINE])
dnl On OSF/1, the functions recv(), send(), recvfrom(), sendto() have
dnl old-style declarations (with return type 'int' instead of 'ssize_t')
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index f45dee1..6dd3d99 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,5 +1,5 @@
-# sys_stat_h.m4 serial 27 -*- Autoconf -*-
-dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+# sys_stat_h.m4 serial 28 -*- Autoconf -*-
+dnl Copyright (C) 2006-2013 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.
@@ -11,9 +11,6 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H],
[
AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
- dnl For the mkdir substitute.
- AC_REQUIRE([AC_C_INLINE])
-
dnl Check for broken stat macros.
AC_REQUIRE([AC_HEADER_STAT])
diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4
index c4a30cd..0ac71ac 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-2012 Free Software Foundation, Inc.
+# Copyright (C) 2007, 2009-2013 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
new file mode 100644
index 0000000..6006985
--- /dev/null
+++ b/m4/sys_times_h.m4
@@ -0,0 +1,51 @@
+# Configure a replacement for <sys/times.h>.
+# serial 8
+
+# Copyright (C) 2008-2013 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.
+
+# Written by Simon Josefsson.
+
+AC_DEFUN([gl_SYS_TIMES_H],
+[
+ AC_REQUIRE([gl_SYS_TIMES_H_DEFAULTS])
+
+ dnl <sys/times.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([sys/times.h])
+ if test $ac_cv_header_sys_times_h = yes; then
+ HAVE_SYS_TIMES_H=1
+ AC_CHECK_TYPES([struct tms], [], [HAVE_STRUCT_TMS=0], [[
+#include <sys/times.h>
+ ]])
+ else
+ HAVE_SYS_TIMES_H=0
+ HAVE_STRUCT_TMS=0
+ fi
+ AC_SUBST([HAVE_SYS_TIMES_H])
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems have incomplete headers. */
+#if !(defined __GLIBC__ && !defined __UCLIBC__)
+# include <time.h>
+#endif
+#include <sys/times.h>
+ ]], [times])
+])
+
+AC_DEFUN([gl_SYS_TIMES_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_TIMES_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+])
+
+AC_DEFUN([gl_SYS_TIMES_H_DEFAULTS],
+[
+ GNULIB_TIMES=0; AC_SUBST([GNULIB_TIMES])
+ HAVE_STRUCT_TMS=1; AC_SUBST([HAVE_STRUCT_TMS])
+ HAVE_TIMES=1; AC_SUBST([HAVE_TIMES])
+])
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index f11eef2..6132727 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -1,5 +1,5 @@
# sys_types_h.m4 serial 4
-dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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_uio_h.m4 b/m4/sys_uio_h.m4
index ddf844b..c75cbbd 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-2013 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/time_h.m4 b/m4/time_h.m4
index 6415bfb..3b83900 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,6 +1,6 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2013 Free Software Foundation, Inc.
# serial 7
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index 9ddbd01..c388a83 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2006-2013 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
new file mode 100644
index 0000000..a0c8667
--- /dev/null
+++ b/m4/times.m4
@@ -0,0 +1,14 @@
+# times.m4 serial 2
+dnl Copyright (C) 2009-2013 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_FUNC_TIMES],
+[
+ AC_REQUIRE([gl_SYS_TIMES_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([times])
+ if test $ac_cv_func_times = no; then
+ HAVE_TIMES=0
+ fi
+])
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index c12e6ce..55e7ea3 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2009-2013 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 278384d..079cbcb 100644
--- a/m4/trunc.m4
+++ b/m4/trunc.m4
@@ -1,5 +1,5 @@
# trunc.m4 serial 9
-dnl Copyright (C) 2007, 2010-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 2010-2013 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 7e7651b..32dcfa5 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,5 +1,5 @@
-# unistd_h.m4 serial 65
-dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+# unistd_h.m4 serial 66
+dnl Copyright (C) 2006-2013 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.
@@ -11,7 +11,6 @@ AC_DEFUN([gl_UNISTD_H],
dnl Use AC_REQUIRE here, so that the default behavior below is expanded
dnl once only, before all statements that occur in other macros.
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
- AC_REQUIRE([AC_C_INLINE])
gl_CHECK_NEXT_HEADERS([unistd.h])
if test $ac_cv_header_unistd_h = yes; then
diff --git a/m4/vasnprintf.m4 b/m4/vasnprintf.m4
index 0ce11da..d730e43 100644
--- a/m4/vasnprintf.m4
+++ b/m4/vasnprintf.m4
@@ -1,5 +1,5 @@
-# vasnprintf.m4 serial 35
-dnl Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
+# vasnprintf.m4 serial 36
+dnl Copyright (C) 2002-2004, 2006-2013 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.
@@ -55,7 +55,6 @@ AC_DEFUN([gl_PREREQ_PRINTF_PARSE],
# Prerequisites of lib/vasnprintf.c.
AC_DEFUN_ONCE([gl_PREREQ_VASNPRINTF],
[
- AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([AC_FUNC_ALLOCA])
AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
AC_REQUIRE([gt_TYPE_WCHAR_T])
diff --git a/m4/visibility.m4 b/m4/visibility.m4
index a7d4d8c..6cbd7e5 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2008, 2010-2013 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 22ec57b..4900764 100644
--- a/m4/vsnprintf.m4
+++ b/m4/vsnprintf.m4
@@ -1,5 +1,5 @@
# vsnprintf.m4 serial 6
-dnl Copyright (C) 2002-2004, 2007-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2007-2013 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 a77802e..e43beeb 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2010-2013 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 28b8294..4b2ac38 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,5 +1,5 @@
# warnings.m4 serial 7
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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_h.m4 b/m4/wchar_h.m4
index c7a8b2d..bedb15a 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2013 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 534735d..e1e1e69 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2008-2013 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 00d7302..f56b5ba 100644
--- a/m4/wcrtomb.m4
+++ b/m4/wcrtomb.m4
@@ -1,5 +1,5 @@
# wcrtomb.m4 serial 11
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-2013 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 4b19f64..82ada0e 100644
--- a/m4/wctype_h.m4
+++ b/m4/wctype_h.m4
@@ -1,8 +1,8 @@
-# wctype_h.m4 serial 17
+# wctype_h.m4 serial 18
dnl A placeholder for ISO C99 <wctype.h>, for platforms that lack it.
-dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2013 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.
@@ -22,8 +22,6 @@ AC_DEFUN([gl_WCTYPE_H],
fi
AC_SUBST([HAVE_ISWCNTRL])
- AC_REQUIRE([AC_C_INLINE])
-
AC_REQUIRE([gt_TYPE_WINT_T])
if test $gt_cv_c_wint_t = yes; then
HAVE_WINT_T=1
diff --git a/m4/wint_t.m4 b/m4/wint_t.m4
index 3260cce..d7cd3db 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-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007-2013 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 a6b1229..a79b2cc 100644
--- a/m4/write.m4
+++ b/m4/write.m4
@@ -1,5 +1,5 @@
-# write.m4 serial 4
-dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+# write.m4 serial 5
+dnl Copyright (C) 2008-2013 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.
@@ -29,7 +29,4 @@ AC_DEFUN([gl_FUNC_WRITE],
])
# Prerequisites of lib/write.c.
-AC_DEFUN([gl_PREREQ_WRITE],
-[
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_WRITE], [:])
diff --git a/m4/xsize.m4 b/m4/xsize.m4
index d85a5f1..8ea9f2c 100644
--- a/m4/xsize.m4
+++ b/m4/xsize.m4
@@ -1,5 +1,5 @@
# xsize.m4 serial 5
-dnl Copyright (C) 2003-2004, 2008-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2004, 2008-2013 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 ea44ece..2b454a1 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-2012 Free Software Foundation, Inc.
+## Copyright (C) 2001-2013 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
@@ -155,7 +155,7 @@ export LC_ALL = C
## Sanity checks. ##
## --------------- ##
-_cfg_mk := $(shell test -f $(srcdir)/cfg.mk && echo '$(srcdir)/cfg.mk')
+_cfg_mk := $(wildcard $(srcdir)/cfg.mk)
# Collect the names of rules starting with 'sc_'.
syntax-check-rules := $(sort $(shell sed -n 's/^\(sc_[a-zA-Z0-9_-]*\):.*/\1/p'
\
@@ -1315,7 +1315,7 @@ announcement_mail_Cc_ ?=
$(announcement_mail_Cc_$(release-type))
announcement_mail_headers_ ?= $(announcement_mail_headers_$(release-type))
announcement: NEWS ChangeLog $(rel-files)
# Not $(AM_V_GEN) since the output of this command serves as
-# annoucement message: it would start with " GEN announcement".
+# announcement message: it would start with " GEN announcement".
$(AM_V_at)$(srcdir)/$(_build-aux)/announce-gen \
--mail-headers='$(announcement_mail_headers_)' \
--release-type=$(release-type) \
@@ -1370,7 +1370,8 @@ endef
.PHONY: no-submodule-changes
no-submodule-changes:
- $(AM_V_GEN)if test -d $(srcdir)/.git; then \
+ $(AM_V_GEN)if test -d $(srcdir)/.git \
+ && git --version >/dev/null 2>&1; then \
diff=$$(cd $(srcdir) && git submodule -q foreach \
git diff-index --name-only HEAD) \
|| exit 1; \
@@ -1388,10 +1389,12 @@ submodule-checks ?= no-submodule-changes
public-submodule-commit
# cannot be built from a fresh clone.
.PHONY: public-submodule-commit
public-submodule-commit:
- $(AM_V_GEN)if test -d $(srcdir)/.git; then \
+ $(AM_V_GEN)if test -d $(srcdir)/.git \
+ && git --version >/dev/null 2>&1; then \
cd $(srcdir) && \
- git submodule --quiet foreach test '$$(git rev-parse $$sha1)' \
- = '$$(git merge-base origin $$sha1)' \
+ git submodule --quiet foreach \
+ test '"$$(git rev-parse "$$sha1")"' \
+ = '"$$(git merge-base origin "$$sha1")"' \
|| { echo '$(ME): found non-public submodule commit' >&2; \
exit 1; }; \
else \
diff --git a/meta/Makefile.am b/meta/Makefile.am
index c9d6a3f..184c0d9 100644
--- a/meta/Makefile.am
+++ b/meta/Makefile.am
@@ -2,7 +2,7 @@
## Jim Blandy <address@hidden> --- September 1997
##
## Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008, 2009, 2011,
-## 2012 Free Software Foundation, Inc.
+## 2012, 2013 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -46,10 +46,10 @@ aclocal_DATA = guile.m4
guile-config: $(srcdir)/guile-config.in $(top_builddir)/config.status
guile="@bindir@/`echo guile | $(SED) -e '$(program_transform_name)'`" ;
\
- cat $(srcdir)/guile-config.in
\
- | $(SED) -e "s,@pkgconfigdir@,$(pkgconfigdir),g ;
\
- s,@""PKG_CONFIG@,$(PKG_CONFIG),g ;
\
- s,@installed_guile@,$$guile,g"
\
+ cat $(srcdir)/guile-config.in
\
+ | $(SED) -e "s,@pkgconfigdir@,$(pkgconfigdir),g"
\
+ -e "s,@""PKG_CONFIG@,$(PKG_CONFIG),g"
\
+ -e "s,@installed_guile@,$$guile,g"
\
> guile-config.out
mv guile-config.out guile-config
chmod +x guile-config
diff --git a/meta/guile.in b/meta/guile.in
index 5125827..3d4cacf 100644
--- a/meta/guile.in
+++ b/meta/guile.in
@@ -1,6 +1,6 @@
#!/bin/sh
-# Copyright (C) 2002, 2006, 2008, 2009 Free Software Foundation
+# Copyright (C) 2002, 2006, 2008, 2009, 2013 Free Software Foundation
#
# This file is part of GUILE.
#
@@ -39,7 +39,7 @@
top_builddir="@top_builddir_absolute@"
# set GUILE (clobber)
-GUILE=${top_builddir}/libguile/guile
+GUILE=${top_builddir}/libguile/address@hidden@
export GUILE
XDG_CACHE_HOME=${top_builddir}/cache
export XDG_CACHE_HOME
diff --git a/meta/guile.m4 b/meta/guile.m4
index a7186fb..a3e1ef1 100644
--- a/meta/guile.m4
+++ b/meta/guile.m4
@@ -1,6 +1,6 @@
## Autoconf macros for working with Guile.
##
-## Copyright (C) 1998,2001, 2006, 2010 Free Software Foundation, Inc.
+## Copyright (C) 1998,2001, 2006, 2010, 2012 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
@@ -22,6 +22,7 @@
## Index
## -----
##
+## GUILE_PKG -- find Guile development files
## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
## GUILE_FLAGS -- set flags for compiling and linking with Guile
## GUILE_SITE_DIR -- find path to Guile "site" directory
@@ -38,53 +39,85 @@
## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged
## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory).
-# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
-#
-# Usage: GUILE_PROGS
-#
-# This macro looks for programs @code{guile}, @code{guile-config} and
-# @code{guile-tools}, and sets variables @var{GUILE}, @var{GUILE_CONFIG} and
-# @var{GUILE_TOOLS}, to their paths, respectively. If either of the first two
-# is not found, signal error.
-#
-# The variables are marked for substitution, as by @code{AC_SUBST}.
-#
-AC_DEFUN([GUILE_PROGS],
- [AC_PATH_PROG(GUILE,guile)
- if test "$GUILE" = "" ; then
- AC_MSG_ERROR([guile required but not found])
+# GUILE_PKG -- find Guile development files
+#
+# Usage: GUILE_PKG([VERSIONS])
+#
+# This macro runs the @code{pkg-config} tool to find development files
+# for an available version of Guile.
+#
+# By default, this macro will search for the latest stable version of
+# Guile (e.g. 2.0), falling back to the previous stable version
+# (e.g. 1.8) if it is available. If no address@hidden file is
+# found, an error is signalled. The found version is stored in
+# @var{GUILE_EFFECTIVE_VERSION}.
+#
+# If @code{GUILE_PROGS} was already invoked, this macro ensures that the
+# development files have the same effective version as the Guile
+# program.
+#
+# @var{GUILE_EFFECTIVE_VERSION} is marked for substitution, as by
+# @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_PKG],
+ [PKG_PROG_PKG_CONFIG
+ _guile_versions_to_search="m4_default([$1], [2.0 1.8])"
+ if test -n "$GUILE_EFFECTIVE_VERSION"; then
+ _guile_tmp=""
+ for v in $_guile_versions_to_search; do
+ if test "$v" = "$GUILE_EFFECTIVE_VERSION"; then
+ _guile_tmp=$v
+ fi
+ done
+ if test -z "$_guile_tmp"; then
+ AC_MSG_FAILURE([searching for guile development files for versions
$_guile_versions_to_search, but previously found $GUILE version
$GUILE_EFFECTIVE_VERSION])
+ fi
+ _guile_versions_to_search=$GUILE_EFFECTIVE_VERSION
fi
- AC_SUBST(GUILE)
- AC_PATH_PROG(GUILE_CONFIG,guile-config)
- if test "$GUILE_CONFIG" = "" ; then
- AC_MSG_ERROR([guile-config required but not found])
+ GUILE_EFFECTIVE_VERSION=""
+ _guile_errors=""
+ for v in $_guile_versions_to_search; do
+ AC_MSG_NOTICE([checking for guile $v])
+ if test -z "$GUILE_EFFECTIVE_VERSION"; then
+ PKG_CHECK_EXISTS([guile-$v], [GUILE_EFFECTIVE_VERSION=$v], [])
+ fi
+ done
+
+ if test -z "$GUILE_EFFECTIVE_VERSION"; then
+ AC_MSG_ERROR([
+No Guile development packages were found.
+
+Please verify that you have Guile installed. If you installed Guile
+from a binary distribution, please verify that you have also installed
+the development packages. If you installed it yourself, you might need
+to adjust your PKG_CONFIG_PATH; see the pkg-config man page for more.
+])
fi
- AC_SUBST(GUILE_CONFIG)
- AC_PATH_PROG(GUILE_TOOLS,guile-tools)
- AC_SUBST(GUILE_TOOLS)
+ AC_MSG_NOTICE([found guile $v])
+ AC_SUBST([GUILE_EFFECTIVE_VERSION])
])
# GUILE_FLAGS -- set flags for compiling and linking with Guile
#
# Usage: GUILE_FLAGS
#
-# This macro runs the @code{guile-config} script, installed with Guile, to
-# find out where Guile's header files and libraries are installed. It sets
-# four variables, @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS},
-# and @var{GUILE_LTLIBS}.
+# This macro runs the @code{pkg-config} tool to find out how to compile
+# and link programs against Guile. It sets four variables:
+# @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, and
+# @var{GUILE_LTLIBS}.
#
# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that
# uses Guile header files. This is almost always just one or more @code{-I}
# flags.
#
-# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program against
-# Guile. This includes @code{-lguile} for the Guile library itself, any
-# libraries that Guile itself requires (like -lqthreads), and so on. It may
-# also include one or more @code{-L} flag to tell the compiler where to find
-# the libraries. But it does not include flags that influence the program's
-# runtime search path for libraries, and will therefore lead to a program
-# that fails to start, unless all necessary libraries are installed in a
-# standard location such as @file{/usr/lib}.
+# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program
+# against Guile. This includes @address@hidden for the
+# Guile library itself, and may also include one or more @code{-L} flag
+# to tell the compiler where to find the libraries. But it does not
+# include flags that influence the program's runtime search path for
+# libraries, and will therefore lead to a program that fails to start,
+# unless all necessary libraries are installed in a standard location
+# such as @file{/usr/lib}.
#
# @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to
# libtool, respectively, to link a program against Guile. It includes flags
@@ -97,16 +130,14 @@ AC_DEFUN([GUILE_PROGS],
# The variables are marked for substitution, as by @code{AC_SUBST}.
#
AC_DEFUN([GUILE_FLAGS],
- [dnl Find guile-config.
- AC_REQUIRE([GUILE_PROGS])dnl
+ [AC_REQUIRE([GUILE_PKG])
+ PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION])
- AC_MSG_CHECKING([libguile compile flags])
- GUILE_CFLAGS="`$GUILE_CONFIG compile`"
- AC_MSG_RESULT([$GUILE_CFLAGS])
+ dnl GUILE_CFLAGS and GUILE_LIBS are already defined and AC_SUBST'd by
+ dnl PKG_CHECK_MODULES. But GUILE_LIBS to pkg-config is GUILE_LDFLAGS
+ dnl to us.
- AC_MSG_CHECKING([libguile link flags])
- GUILE_LDFLAGS="`$GUILE_CONFIG link`"
- AC_MSG_RESULT([$GUILE_LDFLAGS])
+ GUILE_LDFLAGS=$GUILE_LIBS
dnl Determine the platform dependent parameters needed to use rpath.
dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs
@@ -116,6 +147,7 @@ AC_DEFUN([GUILE_FLAGS],
AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes])
GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS"
+ AC_SUBST([GUILE_EFFECTIVE_VERSION])
AC_SUBST([GUILE_CFLAGS])
AC_SUBST([GUILE_LDFLAGS])
AC_SUBST([GUILE_LIBS])
@@ -133,16 +165,61 @@ AC_DEFUN([GUILE_FLAGS],
# The variable is marked for substitution, as by @code{AC_SUBST}.
#
AC_DEFUN([GUILE_SITE_DIR],
- [AC_REQUIRE([GUILE_PROGS])dnl
+ [AC_REQUIRE([GUILE_PKG])
AC_MSG_CHECKING(for Guile site directory)
- GUILE_SITE=`[$GUILE_CONFIG] info sitedir`
+ GUILE_SITE=`$PKG_CONFIG --print-errors --variable=sitedir
guile-$GUILE_EFFECTIVE_VERSION`
+ AC_MSG_RESULT($GUILE_SITE)
if test "$GUILE_SITE" = ""; then
- GUILE_SITE=`[$GUILE_CONFIG] info pkgdatadir`/site
+ AC_MSG_FAILURE(sitedir not found)
fi
- AC_MSG_RESULT($GUILE_SITE)
AC_SUBST(GUILE_SITE)
])
+# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
+#
+# Usage: GUILE_PROGS
+#
+# This macro looks for programs @code{guile} and @code{guild}, setting
+# variables @var{GUILE} and @var{GUILD} to their paths, respectively.
+# If @code{guile} is not found, signal an error.
+#
+# The effective version of the found @code{guile} is set to
+# @var{GUILE_EFFECTIVE_VERSION}. This macro ensures that the effective
+# version is compatible with the result of a previous invocation of
+# @code{GUILE_FLAGS}, if any.
+#
+# As a legacy interface, it also looks for @code{guile-config} and
+# @code{guile-tools}, setting @var{GUILE_CONFIG} and @var{GUILE_TOOLS}.
+#
+# The variables are marked for substitution, as by @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_PROGS],
+ [AC_PATH_PROG(GUILE,guile)
+ if test "$GUILE" = "" ; then
+ AC_MSG_ERROR([guile required but not found])
+ fi
+ AC_SUBST(GUILE)
+
+ _guile_prog_version=`$GUILE -c "(display (effective-version))"`
+ if test -z "$GUILE_EFFECTIVE_VERSION"; then
+ GUILE_EFFECTIVE_VERSION=$_guile_prog_version
+ elif test "$GUILE_EFFECTIVE_VERSION" != "$_guile_prog_version"; then
+ AC_MSG_ERROR([found development files for Guile $GUILE_EFFECTIVE_VERSION,
but $GUILE has effective version $_guile_prog_version])
+ fi
+
+ AC_PATH_PROG(GUILD,guild)
+ AC_SUBST(GUILD)
+
+ AC_PATH_PROG(GUILE_CONFIG,guile-config)
+ AC_SUBST(GUILE_CONFIG)
+ if test -n "$GUILD"; then
+ GUILE_TOOLS=$GUILD
+ else
+ AC_PATH_PROG(GUILE_TOOLS,guile-tools)
+ fi
+ AC_SUBST(GUILE_TOOLS)
+ ])
+
# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
#
# Usage: GUILE_CHECK_RETVAL(var,check)
diff --git a/module/Makefile.am b/module/Makefile.am
index c070014..7f3c8f8 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -112,8 +112,7 @@ TREE_IL_LANG_SOURCES =
\
language/tree-il/spec.scm
GLIL_LANG_SOURCES = \
- language/glil/spec.scm language/glil/compile-assembly.scm \
- language/glil/decompile-assembly.scm
+ language/glil/spec.scm language/glil/compile-assembly.scm
ASSEMBLY_LANG_SOURCES = \
language/assembly/spec.scm \
@@ -287,6 +286,7 @@ SRFI_SOURCES = \
srfi/srfi-35.scm \
srfi/srfi-37.scm \
srfi/srfi-38.scm \
+ srfi/srfi-41.scm \
srfi/srfi-42.scm \
srfi/srfi-39.scm \
srfi/srfi-45.scm \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 5f42ef4..69a7fbc 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -391,6 +391,12 @@ file with the given name already exists, the effect is
unspecified."
(apply f (car l1) (map car rest))
(lp (cdr l1) (map cdr rest))))))))
+;; Temporary definition used in the include-from-path expansion;
+;; replaced later.
+
+(define (absolute-file-name? file-name)
+ #t)
+
;;; {and-map and or-map}
;;;
;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
@@ -1033,13 +1039,32 @@ VALUE."
(lambda _
value))
-(define (and=> value procedure) (and value (procedure value)))
+(define (and=> value procedure)
+ "When VALUE is #f, return #f. Otherwise, return (PROC VALUE)."
+ (and value (procedure value)))
+
(define call/cc call-with-current-continuation)
-(define-syntax-rule (false-if-exception expr)
- (catch #t
- (lambda () expr)
- (lambda (k . args) #f)))
+(define-syntax false-if-exception
+ (syntax-rules ()
+ ((false-if-exception expr)
+ (catch #t
+ (lambda () expr)
+ (lambda args #f)))
+ ((false-if-exception expr #:warning template arg ...)
+ (catch #t
+ (lambda () expr)
+ (lambda (key . args)
+ (for-each (lambda (s)
+ (if (not (string-null? s))
+ (format (current-warning-port) ";;; ~a\n" s)))
+ (string-split
+ (call-with-output-string
+ (lambda (port)
+ (format port template arg ...)
+ (print-exception port #f key args)))
+ #\newline))
+ #f)))))
@@ -1777,16 +1802,70 @@ written into the port is returned."
;;; {Load Paths}
;;;
+(let-syntax ((compile-time-case
+ (lambda (stx)
+ (syntax-case stx ()
+ ((_ exp clauses ...)
+ (let ((val (primitive-eval (syntax->datum #'exp))))
+ (let next-clause ((clauses #'(clauses ...)))
+ (syntax-case clauses (else)
+ (()
+ (syntax-violation 'compile-time-case
+ "all clauses failed to match" stx))
+ (((else form ...))
+ #'(begin form ...))
+ ((((k ...) form ...) clauses ...)
+ (if (memv val (syntax->datum #'(k ...)))
+ #'(begin form ...)
+ (next-clause #'(clauses ...))))))))))))
+ ;; emacs: (put 'compile-time-case 'scheme-indent-function 1)
+ (compile-time-case (system-file-name-convention)
+ ((posix)
+ (define (file-name-separator? c)
+ (char=? c #\/))
+
+ (define file-name-separator-string "/")
+
+ (define (absolute-file-name? file-name)
+ (string-prefix? "/" file-name)))
+
+ ((windows)
+ (define (file-name-separator? c)
+ (or (char=? c #\/)
+ (char=? c #\\)))
+
+ (define file-name-separator-string "\\")
+
+ (define (absolute-file-name? file-name)
+ (define (file-name-separator-at-index? idx)
+ (and (> (string-length file-name) idx)
+ (file-name-separator? (string-ref file-name idx))))
+ (define (unc-file-name?)
+ ;; Universal Naming Convention (UNC) file-names start with \\,
+ ;; and are always absolute. See:
+ ;;
http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx#fully_qualified_vs._relative_paths
+ (and (file-name-separator-at-index? 0)
+ (file-name-separator-at-index? 1)))
+ (define (has-drive-specifier?)
+ (and (>= (string-length file-name) 2)
+ (let ((drive (string-ref file-name 0)))
+ (or (char<=? #\a drive #\z)
+ (char<=? #\A drive #\Z)))
+ (eqv? (string-ref file-name 1) #\:)))
+ (or (unc-file-name?)
+ (if (has-drive-specifier?)
+ (file-name-separator-at-index? 2)
+ (file-name-separator-at-index? 0)))))))
+
(define (in-vicinity vicinity file)
(let ((tail (let ((len (string-length vicinity)))
(if (zero? len)
#f
(string-ref vicinity (- len 1))))))
(string-append vicinity
- (if (or (not tail)
- (eq? tail #\/))
+ (if (or (not tail) (file-name-separator? tail))
""
- "/")
+ file-name-separator-string)
file)))
@@ -1806,7 +1885,7 @@ written into the port is returned."
(define (load-user-init)
(let* ((home (or (getenv "HOME")
(false-if-exception (passwd:dir (getpwuid (getuid))))
- "/")) ;; fallback for cygwin etc.
+ file-name-separator-string)) ;; fallback for cygwin etc.
(init-file (in-vicinity home ".guile")))
(if (file-exists? init-file)
(primitive-load init-file))))
@@ -3061,16 +3140,18 @@ written into the port is returned."
(define (make-autoload-interface module name bindings)
(let ((b (lambda (a sym definep)
- (and (memq sym bindings)
- (let ((i (module-public-interface (resolve-module name))))
- (if (not i)
- (error "missing interface for module" name))
- (let ((autoload (memq a (module-uses module))))
- ;; Replace autoload-interface with actual interface if
- ;; that has not happened yet.
- (if (pair? autoload)
- (set-car! autoload i)))
- (module-local-variable i sym))))))
+ (false-if-exception
+ (and (memq sym bindings)
+ (let ((i (module-public-interface (resolve-module name))))
+ (if (not i)
+ (error "missing interface for module" name))
+ (let ((autoload (memq a (module-uses module))))
+ ;; Replace autoload-interface with actual interface if
+ ;; that has not happened yet.
+ (if (pair? autoload)
+ (set-car! autoload i)))
+ (module-local-variable i sym)))
+ #:warning "Failed to autoload ~a in ~a:\n" sym name))))
(module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
(make-hash-table 0) '() (make-weak-value-hash-table
31) #f
(make-hash-table 0) #f #f #f)))
@@ -3112,7 +3193,8 @@ but it fails to load."
(dir-hint-module-name (reverse (cdr reverse-name)))
(dir-hint (apply string-append
(map (lambda (elt)
- (string-append (symbol->string elt) "/"))
+ (string-append (symbol->string elt)
+ file-name-separator-string))
dir-hint-module-name))))
(resolve-module dir-hint-module-name #f)
(and (not (autoload-done-or-in-progress? dir-hint name))
@@ -3795,16 +3877,17 @@ but it fails to load."
;;; {`load'.}
;;;
-;;; Load is tricky when combined with relative paths, compilation, and
-;;; the file system. If a path is relative, what is it relative to? The
-;;; path of the source file at the time it was compiled? The path of
-;;; the compiled file? What if both or either were installed? And how
-;;; do you get that information? Tricky, I say.
+;;; Load is tricky when combined with relative file names, compilation,
+;;; and the file system. If a file name is relative, what is it
+;;; relative to? The name of the source file at the time it was
+;;; compiled? The name of the compiled file? What if both or either
+;;; were installed? And how do you get that information? Tricky, I
+;;; say.
;;;
;;; To get around all of this, we're going to do something nasty, and
-;;; turn `load' into a macro. That way it can know the path of the
+;;; turn `load' into a macro. That way it can know the name of the
;;; source file with respect to which it was invoked, so it can resolve
-;;; relative paths with respect to the original source path.
+;;; relative file names with respect to the original source file.
;;;
;;; There is an exception, and that is that if the source file was in
;;; the load path when it was compiled, instead of looking up against
@@ -3817,18 +3900,28 @@ but it fails to load."
'(#:warnings (unbound-variable arity-mismatch format
duplicate-case-datum bad-case-datum)))
-(define* (load-in-vicinity dir path #:optional reader)
- "Load source file PATH in vicinity of directory DIR. Use a pre-compiled
-version of PATH when available, and auto-compile one when none is available,
-reading PATH with READER."
+(define* (load-in-vicinity dir file-name #:optional reader)
+ "Load source file FILE-NAME in vicinity of directory DIR. Use a
+pre-compiled version of FILE-NAME when available, and auto-compile one
+when none is available, reading FILE-NAME with READER."
+ ;; The auto-compilation code will residualize a .go file in the cache
+ ;; dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go. This
+ ;; function determines the PATH to use as a key into the compilation
+ ;; cache.
(define (canonical->suffix canon)
(cond
- ((string-prefix? "/" canon) canon)
- ((and (> (string-length canon) 2)
- (eqv? (string-ref canon 1) #\:))
- ;; Paths like C:... transform to /C...
- (string-append "/" (substring canon 0 1) (substring canon 2)))
+ ((and (not (string-null? canon))
+ (file-name-separator? (string-ref canon 0)))
+ canon)
+ ((and (eq? (system-file-name-convention) 'windows)
+ (absolute-file-name? canon))
+ ;; An absolute file name that doesn't start with a separator
+ ;; starts with a drive component. Transform the drive component
+ ;; to a file name element: c:\foo -> \c\foo.
+ (string-append file-name-separator-string
+ (substring canon 0 1)
+ (substring canon 2)))
(else canon)))
(define compiled-extension
@@ -3847,14 +3940,16 @@ reading PATH with READER."
(>= (stat:mtimensec stat1)
(stat:mtimensec stat2)))))
- (define (fallback-file-name canon-path)
- ;; Return the in-cache compiled file name for source file CANON-PATH.
+ (define (fallback-file-name canon-file-name)
+ ;; Return the in-cache compiled file name for source file
+ ;; CANON-FILE-NAME.
- ;; FIXME: would probably be better just to append SHA1(canon-path)
- ;; to the %compile-fallback-path, to avoid deep directory stats.
+ ;; FIXME: would probably be better just to append
+ ;; SHA1(canon-file-name) to the %compile-fallback-path, to avoid
+ ;; deep directory stats.
(and %compile-fallback-path
(string-append %compile-fallback-path
- (canonical->suffix canon-path)
+ (canonical->suffix canon-file-name)
compiled-extension)))
(define (compile file)
@@ -3865,55 +3960,41 @@ reading PATH with READER."
#:opts %auto-compilation-options
#:env (current-module)))
- (define (warn-about-exception key args)
- (for-each (lambda (s)
- (if (not (string-null? s))
- (format (current-warning-port) ";;; ~a\n" s)))
- (string-split
- (call-with-output-string
- (lambda (port) (print-exception port #f key args)))
- #\newline)))
-
- ;; Returns the .go file corresponding to `name'. Does not search load
- ;; paths, only the fallback path. If the .go file is missing or out of
- ;; date, and auto-compilation is enabled, will try auto-compilation, just
- ;; as primitive-load-path does internally. primitive-load is
- ;; unaffected. Returns #f if auto-compilation failed or was disabled.
+ ;; Returns the .go file corresponding to `name'. Does not search load
+ ;; paths, only the fallback path. If the .go file is missing or out
+ ;; of date, and auto-compilation is enabled, will try
+ ;; auto-compilation, just as primitive-load-path does internally.
+ ;; primitive-load is unaffected. Returns #f if auto-compilation
+ ;; failed or was disabled.
;;
- ;; NB: Unless we need to compile the file, this function should not cause
- ;; (system base compile) to be loaded up. For that reason compiled-file-name
- ;; partially duplicates functionality from (system base compile).
-
- (define (fresh-compiled-file-name name scmstat go-path)
- ;; Return GO-PATH after making sure that it contains a freshly compiled
- ;; version of source file NAME with stat SCMSTAT; return #f on failure.
- (catch #t
- (lambda ()
- (let ((gostat (and (not %fresh-auto-compile)
- (stat go-path #f))))
- (if (and gostat (more-recent? gostat scmstat))
- go-path
- (begin
- (if gostat
- (format (current-warning-port)
- ";;; note: source file ~a\n;;; newer than
compiled ~a\n"
- name go-path))
- (cond
- (%load-should-auto-compile
- (%warn-auto-compilation-enabled)
- (format (current-warning-port) ";;; compiling ~a\n" name)
- (let ((cfn (compile name)))
- (format (current-warning-port) ";;; compiled ~a\n" cfn)
- cfn))
- (else #f))))))
- (lambda (k . args)
- (format (current-warning-port)
- ";;; WARNING: compilation of ~a failed:\n" name)
- (warn-about-exception k args)
- #f)))
-
- (define (absolute-path? path)
- (string-prefix? "/" path))
+ ;; NB: Unless we need to compile the file, this function should not
+ ;; cause (system base compile) to be loaded up. For that reason
+ ;; compiled-file-name partially duplicates functionality from (system
+ ;; base compile).
+
+ (define (fresh-compiled-file-name name scmstat go-file-name)
+ ;; Return GO-FILE-NAME after making sure that it contains a freshly
+ ;; compiled version of source file NAME with stat SCMSTAT; return #f
+ ;; on failure.
+ (false-if-exception
+ (let ((gostat (and (not %fresh-auto-compile)
+ (stat go-file-name #f))))
+ (if (and gostat (more-recent? gostat scmstat))
+ go-file-name
+ (begin
+ (if gostat
+ (format (current-warning-port)
+ ";;; note: source file ~a\n;;; newer than
compiled ~a\n"
+ name go-file-name))
+ (cond
+ (%load-should-auto-compile
+ (%warn-auto-compilation-enabled)
+ (format (current-warning-port) ";;; compiling ~a\n" name)
+ (let ((cfn (compile name)))
+ (format (current-warning-port) ";;; compiled ~a\n" cfn)
+ cfn))
+ (else #f)))))
+ #:warning "WARNING: compilation of ~a failed:\n" name))
(define (sans-extension file)
(let ((dot (string-rindex file #\.)))
@@ -3921,52 +4002,51 @@ reading PATH with READER."
(substring file 0 dot)
file)))
- (define (load-absolute abs-path)
- ;; Load from ABS-PATH, using a compiled file or auto-compiling if needed.
+ (define (load-absolute abs-file-name)
+ ;; Load from ABS-FILE-NAME, using a compiled file or auto-compiling
+ ;; if needed.
(define scmstat
- (catch #t
- (lambda ()
- (stat abs-path))
- (lambda (key . args)
- (warn-about-exception key args)
- #f)))
+ (false-if-exception
+ (stat abs-file-name)
+ #:warning "Stat of ~a failed:\n" abs-file-name))
(define (pre-compiled)
- (let ((go-path (search-path %load-compiled-path (sans-extension path)
- %load-compiled-extensions #t)))
- (and go-path
- (let ((gostat (stat go-path #f)))
- (and gostat (more-recent? gostat scmstat)
- go-path)))))
+ (and=> (search-path %load-compiled-path (sans-extension file-name)
+ %load-compiled-extensions #t)
+ (lambda (go-file-name)
+ (let ((gostat (stat go-file-name #f)))
+ (and gostat (more-recent? gostat scmstat)
+ go-file-name)))))
(define (fallback)
- (let ((canon (false-if-exception (canonicalize-path abs-path))))
- (and canon
- (let ((go-path (fallback-file-name canon)))
- (and go-path
- (fresh-compiled-file-name abs-path scmstat go-path))))))
-
- (let ((compiled (and scmstat
- (or (pre-compiled) (fallback)))))
+ (and=> (false-if-exception (canonicalize-path abs-file-name))
+ (lambda (canon)
+ (and=> (fallback-file-name canon)
+ (lambda (go-file-name)
+ (fresh-compiled-file-name abs-file-name
+ scmstat
+ go-file-name))))))
+
+ (let ((compiled (and scmstat (or (pre-compiled) (fallback)))))
(if compiled
(begin
(if %load-hook
- (%load-hook abs-path))
+ (%load-hook abs-file-name))
(load-compiled compiled))
(start-stack 'load-stack
- (primitive-load abs-path)))))
+ (primitive-load abs-file-name)))))
(save-module-excursion
(lambda ()
(with-fluids ((current-reader reader)
(%file-port-name-canonicalization 'relative))
(cond
- ((absolute-path? path)
- (load-absolute path))
- ((absolute-path? dir)
- (load-absolute (in-vicinity dir path)))
+ ((absolute-file-name? file-name)
+ (load-absolute file-name))
+ ((absolute-file-name? dir)
+ (load-absolute (in-vicinity dir file-name)))
(else
- (load-from-path (in-vicinity dir path))))))))
+ (load-from-path (in-vicinity dir file-name))))))))
(define-syntax load
(make-variable-transformer
@@ -4009,22 +4089,22 @@ reading PATH with READER."
;;; <feature-identifier>s `guile' and `r5rs', so that programs can
;;; determine the implementation type and the supported standard.
;;;
-;;; Currently, the following feature identifiers are supported:
-;;;
-;;; guile r5rs srfi-0 srfi-4 srfi-6 srfi-13 srfi-14 srfi-55 srfi-61 srfi-105
-;;;
;;; Remember to update the features list when adding more SRFIs.
;;;
(define %cond-expand-features
- ;; Adjust the above comment when changing this.
+ ;; This should contain only features that are present in core Guile,
+ ;; before loading any modules. Modular features are handled by
+ ;; placing 'cond-expand-provide' in the relevant module.
'(guile
guile-2
guile-2.2
r5rs
srfi-0 ;; cond-expand itself
- srfi-4 ;; homogenous numeric vectors
- srfi-6 ;; open-input-string etc, in the guile core
+ srfi-4 ;; homogeneous numeric vectors
+ ;; We omit srfi-6 because the 'open-input-string' etc in Guile
+ ;; core are not conformant with SRFI-6; they expose details
+ ;; of the binary I/O model and may fail to support some characters.
srfi-13 ;; string library
srfi-14 ;; character sets
srfi-23 ;; `error` procedure
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 6ff104d..35a36ca 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
-;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -88,8 +88,14 @@ touched."
;; A mapping of nested futures to futures waiting for them to complete.
(define %futures-waiting '())
-;; Whether currently running within a future.
-(define %within-future? (make-parameter #f))
+;; Nesting level of futures. Incremented each time a future is touched
+;; from within a future.
+(define %nesting-level (make-parameter 0))
+
+;; Maximum nesting level. The point is to avoid stack overflows when
+;; nested futures are executed on the same stack. See
+;; <http://bugs.gnu.org/13188>.
+(define %max-nesting-level 200)
(define-syntax-rule (with-mutex m e0 e1 ...)
;; Copied from (ice-9 threads) to avoid circular dependency.
@@ -155,7 +161,8 @@ adding it to the waiter queue."
(thunk (lambda ()
(call-with-prompt %future-prompt
(lambda ()
- (parameterize ((%within-future? #t))
+ (parameterize ((%nesting-level
+ (1+ (%nesting-level))))
((future-thunk future))))
suspend))))
(set-future-result! future
@@ -254,14 +261,16 @@ adding it to the waiter queue."
(unlock-mutex (future-mutex future)))
((started)
(unlock-mutex (future-mutex future))
- (if (%within-future?)
+ (if (> (%nesting-level) 0)
(abort-to-prompt %future-prompt future)
(begin
(work)
(loop))))
- (else
+ (else ; queued
(unlock-mutex (future-mutex future))
- (work)
+ (if (> (%nesting-level) %max-nesting-level)
+ (abort-to-prompt %future-prompt future)
+ (work))
(loop))))
((future-result future)))
diff --git a/module/ice-9/mapping.scm b/module/ice-9/mapping.scm
index 2907a8d..bd4dbfb 100644
--- a/module/ice-9/mapping.scm
+++ b/module/ice-9/mapping.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 1996, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1996, 2001, 2006, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -29,6 +29,9 @@
mapping-ref mapping-set! hash-table-mapping-hooks
make-hash-table-mapping hash-table-mapping))
+(issue-deprecation-warning
+ "(ice-9 mapping) is deprecated. Use srfi-69 or rnrs hash tables instead.")
+
(define mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle
create-handle
remove)))
@@ -50,16 +53,15 @@
(define (mapping-get-handle map key)
((mapping-hooks-get-handle (mapping-hooks map)) map key))
-(define (mapping-create-handle! map key . opts)
- (apply (mapping-hooks-create-handle (mapping-hooks map)) map key opts))
+(define (mapping-create-handle! map key init)
+ ((mapping-hooks-create-handle (mapping-hooks map)) map key init))
(define (mapping-remove! map key)
((mapping-hooks-remove (mapping-hooks map)) map key))
-(define (mapping-ref map key . dflt)
+(define* (mapping-ref map key #:optional dflt)
(cond
- ((mapping-get-handle map key) => cdr)
- (dflt => car)
- (else #f)))
+ ((mapping-get-handle map key) => cdr)
+ (else dflt)))
(define (mapping-set! map key val)
(set-cdr! (mapping-create-handle! map key #f) val))
@@ -70,18 +72,18 @@
(let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data
1st) rest)))))
(perfect-funcq 17
- (lambda (hash-proc assoc-proc delete-proc)
- (let ((procs (list hash-proc assoc-proc delete-proc)))
+ (lambda (hash-proc assoc-proc)
+ (let ((procs (list hash-proc assoc-proc)))
(cond
- ((equal? procs `(,hashq ,assq ,delq!))
+ ((equal? procs `(,hashq ,assq))
(make-mapping-hooks (wrap hashq-get-handle)
(wrap hashq-create-handle!)
(wrap hashq-remove!)))
- ((equal? procs `(,hashv ,assv ,delv!))
+ ((equal? procs `(,hashv ,assv))
(make-mapping-hooks (wrap hashv-get-handle)
(wrap hashv-create-handle!)
(wrap hashv-remove!)))
- ((equal? procs `(,hash ,assoc ,delete!))
+ ((equal? procs `(,hash ,assoc))
(make-mapping-hooks (wrap hash-get-handle)
(wrap hash-create-handle!)
(wrap hash-remove!)))
@@ -90,39 +92,27 @@
(lambda (table key)
(hashx-get-handle hash-proc
assoc-proc table key)))
(wrap
- (lambda (table key)
- (hashx-create-handle hash-proc
assoc-proc table key)))
+ (lambda (table key init)
+ (hashx-create-handle! hash-proc
assoc-proc table key init)))
(wrap
(lambda (table key)
- (hashx-get-handle hash-proc
assoc-proc delete-proc table key)))))))))))
-
-(define (make-hash-table-mapping table hash-proc assoc-proc delete-proc)
- (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc delete-proc)
table))
-
-(define (hash-table-mapping . options)
- (let* ((size (or (and options (number? (car options)) (car options))
- 71))
- (hash-proc (or (kw-arg-ref options #:hash-proc) hash))
- (assoc-proc (or (kw-arg-ref options #:assoc-proc)
- (cond
- ((eq? hash-proc hash) assoc)
- ((eq? hash-proc hashv) assv)
- ((eq? hash-proc hashq) assq)
- (else (error 'hash-table-mapping
- "Hash-procedure specified with no known
assoc function."
- hash-proc)))))
- (delete-proc (or (kw-arg-ref options #:delete-proc)
- (cond
- ((eq? hash-proc hash) delete!)
- ((eq? hash-proc hashv) delv!)
- ((eq? hash-proc hashq) delq!)
- (else (error 'hash-table-mapping
- "Hash-procedure specified with no known
delete function."
- hash-proc)))))
- (table-constructor (or (kw-arg-ref options #:table-constructor)
- (lambda (len) (make-vector len '())))))
- (make-hash-table-mapping (table-constructor size)
- hash-proc
- assoc-proc
- delete-proc)))
-
+ (hashx-remove! hash-proc
assoc-proc table key)))))))))))
+
+(define (make-hash-table-mapping table hash-proc assoc-proc)
+ (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc) table))
+
+(define* (hash-table-mapping #:optional (size 71) #:key
+ (hash-proc hash)
+ (assoc-proc
+ (or (assq-ref `((,hashq . ,assq)
+ (,hashv . ,assv)
+ (,hash . ,assoc))
+ hash-proc)
+ (error 'hash-table-mapping
+ "Hash-procedure specified with no
known assoc function."
+ hash-proc)))
+ (table-constructor
+ (lambda (len) (make-vector len '()))))
+ (make-hash-table-mapping (table-constructor size)
+ hash-proc
+ assoc-proc))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index ada9307..1225d92 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1776,11 +1776,9 @@
'case-lambda
(lambda (e r w s mod)
(let* ((tmp e)
- (tmp ($sc-dispatch
- tmp
- '(_ (any any . each-any) . #(each (any any . each-any))))))
+ (tmp ($sc-dispatch tmp '(_ . #(each (any any . each-any))))))
(if tmp
- (apply (lambda (args e1 e2 args* e1* e2*)
+ (apply (lambda (args e1 e2)
(call-with-values
(lambda ()
(expand-lambda-case
@@ -1790,11 +1788,10 @@
s
mod
lambda-formals
- (cons (cons args (cons e1 e2))
- (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons
tmp-1 tmp-2)))
- e2*
- e1*
- args*))))
+ (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-1
tmp-2)))
+ e2
+ e1
+ args)))
(lambda (meta lcase) (build-case-lambda s meta lcase))))
tmp)
(syntax-violation 'case-lambda "bad case-lambda" e)))))
@@ -1803,11 +1800,9 @@
'case-lambda*
(lambda (e r w s mod)
(let* ((tmp e)
- (tmp ($sc-dispatch
- tmp
- '(_ (any any . each-any) . #(each (any any . each-any))))))
+ (tmp ($sc-dispatch tmp '(_ . #(each (any any . each-any))))))
(if tmp
- (apply (lambda (args e1 e2 args* e1* e2*)
+ (apply (lambda (args e1 e2)
(call-with-values
(lambda ()
(expand-lambda-case
@@ -1817,11 +1812,10 @@
s
mod
lambda*-formals
- (cons (cons args (cons e1 e2))
- (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons
tmp-1 tmp-2)))
- e2*
- e1*
- args*))))
+ (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-1
tmp-2)))
+ e2
+ e1
+ args)))
(lambda (meta lcase) (build-case-lambda s meta lcase))))
tmp)
(syntax-violation 'case-lambda "bad case-lambda*" e)))))
@@ -3029,10 +3023,10 @@
'macro
(lambda (x)
(letrec*
- ((absolute-path? (lambda (path) (string-prefix? "/" path)))
- (read-file
+ ((read-file
(lambda (fn dir k)
- (let ((p (open-input-file (if (absolute-path? fn) fn (in-vicinity
dir fn)))))
+ (let ((p (open-input-file
+ (if (absolute-file-name? fn) fn (in-vicinity dir
fn)))))
(let f ((x (read p)) (result '()))
(if (eof-object? x)
(begin (close-input-port p) (reverse result))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 90c76d5..1aa5402 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2173,12 +2173,12 @@
(global-extend 'core 'case-lambda
(lambda (e r w s mod)
(syntax-case e ()
- ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+ ((_ (args e1 e2 ...) ...)
(call-with-values
(lambda ()
(expand-lambda-case e r w s mod
lambda-formals
- #'((args e1 e2 ...) (args*
e1* e2* ...) ...)))
+ #'((args e1 e2 ...) ...)))
(lambda (meta lcase)
(build-case-lambda s meta lcase))))
(_ (syntax-violation 'case-lambda "bad case-lambda"
e)))))
@@ -2186,12 +2186,12 @@
(global-extend 'core 'case-lambda*
(lambda (e r w s mod)
(syntax-case e ()
- ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+ ((_ (args e1 e2 ...) ...)
(call-with-values
(lambda ()
(expand-lambda-case e r w s mod
lambda*-formals
- #'((args e1 e2 ...) (args*
e1* e2* ...) ...)))
+ #'((args e1 e2 ...) ...)))
(lambda (meta lcase)
(build-case-lambda s meta lcase))))
(_ (syntax-violation 'case-lambda "bad case-lambda*"
e)))))
@@ -3020,13 +3020,10 @@
(define-syntax include
(lambda (x)
- (define (absolute-path? path)
- (string-prefix? "/" path))
-
(define read-file
(lambda (fn dir k)
(let ((p (open-input-file
- (if (absolute-path? fn)
+ (if (absolute-file-name? fn)
fn
(in-vicinity dir fn)))))
(let f ((x (read p))
diff --git a/module/language/glil/compile-assembly.scm
b/module/language/glil/compile-assembly.scm
index 767fda3..4633485 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -597,33 +597,32 @@
(else (error "what" op)))
(let ((a (quotient index 256))
(b (modulo index 256)))
- `((,(case op
- ((ref)
- (if boxed?
- `((long-local-ref ,a ,b)
- (variable-ref))
- `((long-local-ref ,a ,b))))
- ((set)
- (if boxed?
- `((long-local-ref ,a ,b)
- (variable-set))
- `((long-local-set ,a ,b))))
- ((box)
- `((make-variable)
- (variable-set)
- (long-local-set ,a ,b)))
- ((empty-box)
- `((make-variable)
- (long-local-set ,a ,b)))
- ((fix)
- `((fix-closure ,a ,b)))
- ((bound?)
- (if boxed?
- `((long-local-ref ,a ,b)
- (variable-bound?))
- `((long-local-bound? ,a ,b))))
- (else (error "what" op)))
- ,index))))
+ (case op
+ ((ref)
+ (if boxed?
+ `((long-local-ref ,a ,b)
+ (variable-ref))
+ `((long-local-ref ,a ,b))))
+ ((set)
+ (if boxed?
+ `((long-local-ref ,a ,b)
+ (variable-set))
+ `((long-local-set ,a ,b))))
+ ((box)
+ `((make-variable)
+ (variable-set)
+ (long-local-set ,a ,b)))
+ ((empty-box)
+ `((make-variable)
+ (long-local-set ,a ,b)))
+ ((fix)
+ `((fix-closure ,a ,b)))
+ ((bound?)
+ (if boxed?
+ `((long-local-ref ,a ,b)
+ (variable-bound?))
+ `((long-local-bound? ,a ,b))))
+ (else (error "what" op)))))
`((,(case op
((ref) (if boxed? 'free-boxed-ref 'free-ref))
((set) (if boxed? 'free-boxed-set (error "what." glil)))
diff --git a/module/language/glil/decompile-assembly.scm
b/module/language/glil/decompile-assembly.scm
deleted file mode 100644
index a50b640..0000000
--- a/module/language/glil/decompile-assembly.scm
+++ /dev/null
@@ -1,191 +0,0 @@
-;;; Guile VM code converters
-
-;; Copyright (C) 2001, 2009, 2010 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
-
-;;; Code:
-
-(define-module (language glil decompile-assembly)
- #:use-module (system base pmatch)
- #:use-module (system vm program)
- #:use-module (language assembly)
- #:use-module (language glil)
- #:export (decompile-assembly))
-
-(define (decompile-assembly x env opts)
- (values (decompile-toplevel x)
- env))
-
-(define (decompile-toplevel x)
- (pmatch x
- ((load-program ,labels ,len ,meta . ,body)
- (decompile-load-program (decompile-meta meta)
- body labels #f))
- (else
- (error "invalid assembly" x))))
-
-(define (decompile-meta meta)
- (and meta
- (let ((prog (decompile-toplevel meta)))
- (if (and (glil-program? prog)
- (= (length (glil-program-body prog)) 2)
- (glil-const? (car (glil-program-body prog))))
- (glil-const-obj (car (glil-program-body prog)))
- (error "metadata not a thunk returning a const" prog)))))
-
-(define *placeholder* (list 'placeholder))
-
-(define (emit-constants l out)
- (let lp ((in (reverse l)) (out out))
- (cond ((null? in) out)
- ((eq? (car in) *placeholder*) (lp (cdr in) out))
- ((glil-program? (car in)) (lp (cdr in) (cons (car in) out)))
- (else (lp (cdr in) (cons (make-glil-const (car l)) out))))))
-
-(define (decompile-load-program meta body labels
- objects)
- (let ((glil-labels (sort (map (lambda (x)
- (cons (cdr x) (make-glil-label (car x))))
- labels)
- (lambda (x y) (< (car x) (car y)))))
- (bindings (sort (if meta (car meta) '())
- (lambda (x y) (< (binding:start x) (binding:start
y)))))
- (unbindings (sort (if meta (car meta) '())
- (lambda (x y) (< (binding:end x) (binding:end y)))))
- (sources (if meta (cadr meta) '()))
- (filename #f)
- (props (if meta (cddr meta) '())))
- (define (pop-bindings! addr)
- (let lp ((in bindings) (out '()))
- (if (or (null? in) (> (binding:start (car in)) addr))
- (begin
- (set! bindings in)
- (if (null? out) #f (reverse out)))
- (lp (cdr in) (cons (car in) out)))))
- (define (pop-unbindings! addr)
- (let lp ((in unbindings) (out '()))
- (if (or (null? in) (> (binding:end (car in)) addr))
- (begin
- (set! unbindings in)
- (if (null? out) #f (reverse out)))
- (lp (cdr in) (cons (car in) out)))))
- (define (pop-source! addr)
- ;; a fragile algorithm.
- (cond ((null? sources) #f)
- ((eq? (caar sources) 'filename)
- (set! filename (cdar sources))
- (pop-source! addr))
- ((eqv? (caar sources) addr)
- (let ((x (car sources)))
- (set! sources (cdr sources))
- `((filename . ,filename)
- (line . ,(cadr x))
- (column . ,(cddr x)))))
- (else #f)))
- (let lp ((in body) (stack '()) (out '()) (pos 0))
- (cond
- ((null? in)
- (or (null? stack) (error "leftover stack insts" stack body))
- (make-glil-program props (reverse out)))
- ((pop-bindings! pos)
- => (lambda (bindings)
- (lp in stack
- (cons (make-glil-bind bindings)
- out)
- pos)))
- ((pop-unbindings! pos)
- => (lambda (bindings)
- (lp in stack (cons (make-glil-unbind) out) pos)))
- ((pop-source! pos)
- => (lambda (s)
- (lp in stack (cons (make-glil-source s) out) pos)))
- ((and (or (null? out) (not (glil-label? (car out))))
- (assv-ref glil-labels pos))
- => (lambda (label)
- (lp in stack (cons label out) pos)))
- (else
- (pmatch (car in)
- ((nop)
- (lp (cdr in) stack out (1+ pos)))
- ((make-false)
- (lp (cdr in) (cons #f stack) out (1+ pos)))
- ((make-nil)
- (lp (cdr in) (cons #nil stack) out (1+ pos)))
- ((load-program ,labels ,sublen ,meta . ,body)
- (lp (cdr in)
- (cons (decompile-load-program (decompile-meta meta)
- body labels (car stack))
- (cdr stack))
- out
- (+ pos (byte-length (car in)))))
- ((load-symbol ,str)
- (lp (cdr in) (cons (string->symbol str) stack) out
- (+ pos 1 (string-length str))))
- ((make-int8:0)
- (lp (cdr in) (cons 0 stack) out (1+ pos)))
- ((make-int8:1)
- (lp (cdr in) (cons 1 stack) out (1+ pos)))
- ((make-int8 ,n)
- (lp (cdr in) (cons n stack) out (+ pos 2)))
- ((cons)
- (let ((head (list-head stack 2))
- (stack (list-tail stack 2)))
- (if (memq *placeholder* head)
- (lp (cdr in) (cons *placeholder* stack)
- (cons (make-glil-call 'cons 2) (emit-constants head out))
- (+ pos 1))
- (lp (cdr in) (cons (cons (cadr head) (car head)) stack)
- out (+ pos 3)))))
- ((list ,a ,b)
- (let* ((len (+ (ash a 8) b))
- (head (list-head stack len))
- (stack (list-tail stack len)))
- (if (memq *placeholder* head)
- (lp (cdr in) (cons *placeholder* stack)
- (cons (make-glil-call 'list len) (emit-constants head
out))
- (+ pos 3))
- (lp (cdr in) (cons (reverse head) stack) out (+ pos 3)))))
- ((make-eol)
- (lp (cdr in) (cons '() stack) out (1+ pos)))
- ((return)
- (lp (cdr in) (cdr stack)
- (cons (make-glil-call 'return 1)
- (emit-constants (list-head stack 1) out))
- (1+ pos)))
- ((local-ref ,n)
- (lp (cdr in) (cons *placeholder* stack)
- (cons (make-glil-local 'ref n)
- out) (+ pos 2)))
- ((local-set ,n)
- (lp (cdr in) (cdr stack)
- (cons (make-glil-local 'set n)
- (emit-constants (list-head stack 1) out))
- (+ pos 2)))
- ((br-if-not ,l)
- (lp (cdr in) (cdr stack)
- (cons (make-glil-branch 'br-if-not l) out)
- (+ pos 3)))
- ((mul)
- (lp (cdr in) (cons *placeholder* (cddr stack))
- (cons (make-glil-call 'mul 2)
- (emit-constants (list-head stack 2) out))
- (+ pos 1)))
- ((tail-call ,n)
- (lp (cdr in) (list-tail stack (1+ n))
- (cons (make-glil-call 'tail-call n)
- (emit-constants (list-head stack (1+ n)) out))
- (+ pos 2)))
- (else (error "unsupported decompilation" (car in)))))))))
diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm
index 3679e21..81e06af 100644
--- a/module/language/glil/spec.scm
+++ b/module/language/glil/spec.scm
@@ -22,7 +22,6 @@
#:use-module (system base language)
#:use-module (language glil)
#:use-module (language glil compile-assembly)
- #:use-module (language glil decompile-assembly)
#:export (glil))
(define (write-glil exp . port)
@@ -37,6 +36,5 @@
#:printer write-glil
#:parser parse-glil
#:compilers `((assembly . ,compile-asm))
- #:decompilers `((assembly . ,decompile-assembly))
#:for-humans? #f
)
diff --git a/module/language/scheme/decompile-tree-il.scm
b/module/language/scheme/decompile-tree-il.scm
index f5bb699..c065474 100644
--- a/module/language/scheme/decompile-tree-il.scm
+++ b/module/language/scheme/decompile-tree-il.scm
@@ -1,6 +1,6 @@
;;; Guile VM code converters
-;; Copyright (C) 2001, 2009, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2012, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -261,20 +261,22 @@
(build-define name (recurse exp)))
((<lambda> meta body)
- (let ((body (recurse body))
- (doc (assq-ref meta 'documentation)))
- (if (not doc)
- body
- (match body
- (('lambda formals body ...)
- `(lambda ,formals ,doc ,@body))
- (('lambda* formals body ...)
- `(lambda* ,formals ,doc ,@body))
- (('case-lambda (formals body ...) clauses ...)
- `(case-lambda (,formals ,doc ,@body) ,@clauses))
- (('case-lambda* (formals body ...) clauses ...)
- `(case-lambda* (,formals ,doc ,@body) ,@clauses))
- (e e)))))
+ (if body
+ (let ((body (recurse body))
+ (doc (assq-ref meta 'documentation)))
+ (if (not doc)
+ body
+ (match body
+ (('lambda formals body ...)
+ `(lambda ,formals ,doc ,@body))
+ (('lambda* formals body ...)
+ `(lambda* ,formals ,doc ,@body))
+ (('case-lambda (formals body ...) clauses ...)
+ `(case-lambda (,formals ,doc ,@body) ,@clauses))
+ (('case-lambda* (formals body ...) clauses ...)
+ `(case-lambda* (,formals ,doc ,@body) ,@clauses))
+ (e e))))
+ '(case-lambda)))
((<lambda-case> req opt rest kw inits gensyms body alternate)
(let ((names (map output-name gensyms)))
@@ -702,7 +704,8 @@
((<seq> head tail)
(primitive 'begin) (recurse head) (recurse tail))
- ((<lambda> body) (recurse body))
+ ((<lambda> body)
+ (if body (recurse body)))
((<lambda-case> req opt rest kw inits gensyms body alternate)
(primitive 'lambda)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index a3991b6..ddcba99 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -311,7 +311,9 @@
`(define ,name ,(unparse-tree-il exp)))
((<lambda> meta body)
- `(lambda ,meta ,(unparse-tree-il body)))
+ (if body
+ `(lambda ,meta ,(unparse-tree-il body))
+ `(lambda ,meta (lambda-case))))
((<lambda-case> req opt rest kw inits gensyms body alternate)
`(lambda-case ((,req ,opt ,rest ,kw ,(map unparse-tree-il inits) ,gensyms)
@@ -397,7 +399,11 @@ This is an implementation of `foldts' as described by Andy
Wingo in
((<seq> head tail)
(up tree (loop tail (loop head (down tree result)))))
((<lambda> body)
- (up tree (loop body (down tree result))))
+ (let ((result (down tree result)))
+ (up tree
+ (if body
+ (loop body result)
+ result))))
((<lambda-case> inits body alternate)
(up tree (if alternate
(loop alternate
@@ -475,7 +481,9 @@ This is an implementation of `foldts' as described by Andy
Wingo in
(let-values (((seed ...) (foldts head seed ...)))
(foldts tail seed ...)))
((<lambda> body)
- (foldts body seed ...))
+ (if body
+ (foldts body seed ...)
+ (values seed ...)))
((<lambda-case> inits body alternate)
(let-values (((seed ...) (fold-values foldts inits seed ...)))
(if alternate
@@ -549,7 +557,8 @@ This is an implementation of `foldts' as described by Andy
Wingo in
(set! (toplevel-define-exp x) (lp exp)))
((<lambda> body)
- (set! (lambda-body x) (lp body)))
+ (if body
+ (set! (lambda-body x) (lp body))))
((<lambda-case> inits body alternate)
(set! inits (map lp inits))
@@ -639,7 +648,8 @@ This is an implementation of `foldts' as described by Andy
Wingo in
(set! (toplevel-define-exp x) (lp exp)))
((<lambda> body)
- (set! (lambda-body x) (lp body)))
+ (if body
+ (set! (lambda-body x) (lp body))))
((<lambda-case> inits body alternate)
(set! inits (map lp inits))
diff --git a/module/language/tree-il/canonicalize.scm
b/module/language/tree-il/canonicalize.scm
index 2536a71..1db8420 100644
--- a/module/language/tree-il/canonicalize.scm
+++ b/module/language/tree-il/canonicalize.scm
@@ -1,6 +1,6 @@
;;; Tree-il canonicalizer
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -44,6 +44,21 @@
body)
(($ <dynlet> src () () body)
body)
+ (($ <lambda> src meta #f)
+ ;; Give a body to case-lambda with no clauses.
+ (make-lambda
+ src meta
+ (make-lambda-case
+ #f '() #f #f #f '() '()
+ (make-primcall
+ #f
+ 'throw
+ (list (make-const #f 'wrong-number-of-args)
+ (make-const #f #f)
+ (make-const #f "Wrong number of arguments")
+ (make-const #f '())
+ (make-const #f #f)))
+ #f)))
(($ <prompt> src tag body handler)
(define (escape-only? handler)
(match handler
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index 79f4ff9..1b6fea6 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler
-;; Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,2009,2010,2011,2012,2013 Free Software Foundation,
Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -344,9 +344,20 @@
(for-each comp-push args)
(let ((len (length args)))
(case context
- ((tail) (emit-code src (make-glil-call 'tail-call len)))
- ((push) (emit-code src (make-glil-call 'call len))
+ ((tail) (if (<= len #xff)
+ (emit-code src (make-glil-call 'tail-call len))
+ (begin
+ (comp-push (make-const #f len))
+ (emit-code src (make-glil-call 'tail-call/nargs
0)))))
+ ((push) (if (<= len #xff)
+ (emit-code src (make-glil-call 'call len))
+ (begin
+ (comp-push (make-const #f len))
+ (emit-code src (make-glil-call 'call/nargs 0))))
(maybe-emit-return))
+ ;; FIXME: mv-call doesn't have a /nargs variant, so it is
+ ;; limited to 255 args. Can work around it with a
+ ;; trampoline and tail-call/nargs, but it's not so nice.
((vals) (emit-code src (make-glil-mv-call len MVRA))
(maybe-emit-return))
((drop) (let ((MV (make-label)) (POST (make-label)))
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index f8fd1cd..f8df3ce 100644
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -1,6 +1,6 @@
;;; Common Subexpression Elimination (CSE) on Tree-IL
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -539,8 +539,10 @@
(return (make-call src proc args)
(concat db** db*))))
(($ <lambda> src meta body)
- (let*-values (((body _) (visit body (control-flow-boundary db)
- env 'values)))
+ (let*-values (((body _) (if body
+ (visit body (control-flow-boundary db)
+ env 'values)
+ (values #f #f))))
(return (make-lambda src meta body)
vlist-null)))
(($ <lambda-case> src req opt rest kw inits gensyms body alt)
diff --git a/module/language/tree-il/debug.scm
b/module/language/tree-il/debug.scm
index a32fc41..65fd58e 100644
--- a/module/language/tree-il/debug.scm
+++ b/module/language/tree-il/debug.scm
@@ -1,6 +1,6 @@
;;; Tree-IL verifier
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -115,10 +115,11 @@
(cond
((and meta (not (and (list? meta) (and-map pair? meta))))
(error "meta should be alist" meta))
- ((not (lambda-case? body))
+ ((and body (not (lambda-case? body)))
(error "lambda body should be lambda-case" exp))
(else
- (visit body env))))
+ (if body
+ (visit body env)))))
(($ <let> src names gensyms vals body)
(cond
((not (and (list? names) (and-map symbol? names)))
diff --git a/module/language/tree-il/effects.scm
b/module/language/tree-il/effects.scm
index 8b380da..b5586e2 100644
--- a/module/language/tree-il/effects.scm
+++ b/module/language/tree-il/effects.scm
@@ -1,6 +1,6 @@
;;; Effects analysis on Tree-IL
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -311,7 +311,12 @@ of an expression."
(cause &type-check))))
(($ <lambda-case>)
(logior (compute-effects body)
- (cause &type-check))))))
+ (cause &type-check)))
+ (#f
+ ;; Calling a case-lambda with no clauses
+ ;; definitely causes bailout.
+ (logior (cause &definite-bailout)
+ (cause &possible-bailout))))))
;; Bailout primitives.
(($ <primcall> _ (? bailout-primitive? name) args)
diff --git a/module/language/tree-il/peval.scm
b/module/language/tree-il/peval.scm
index 2d2c30b..fe637f0 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1439,13 +1439,13 @@ top-level bindings from ENV and return the resulting
expression."
((operator) exp)
(else (record-source-expression!
exp
- (make-lambda src meta (for-values body))))))
+ (make-lambda src meta (and body (for-values body)))))))
(($ <lambda-case> src req opt rest kw inits gensyms body alt)
(define (lift-applied-lambda body gensyms)
(and (not opt) rest (not kw)
(match body
(($ <primcall> _ '@apply
- (($ <lambda> _ _ lcase)
+ (($ <lambda> _ _ (and lcase ($ <lambda-case>)))
($ <lexical-ref> _ _ sym)
...))
(and (equal? sym gensyms)
diff --git a/module/srfi/srfi-27.scm b/module/srfi/srfi-27.scm
index 9777ace..0794a43 100644
--- a/module/srfi/srfi-27.scm
+++ b/module/srfi/srfi-27.scm
@@ -36,6 +36,8 @@
random-source-make-reals)
#:use-module (srfi srfi-9))
+(cond-expand-provide (current-module) '(srfi-27))
+
(define-record-type :random-source
(%make-random-source state)
random-source?
diff --git a/module/srfi/srfi-31.scm b/module/srfi/srfi-31.scm
index cf67e8a..f11aa84 100644
--- a/module/srfi/srfi-31.scm
+++ b/module/srfi/srfi-31.scm
@@ -21,6 +21,8 @@
(define-module (srfi srfi-31)
#:export (rec))
+(cond-expand-provide (current-module) '(srfi-31))
+
(define-syntax rec
(syntax-rules ()
"Return the given object, defined in a lexical environment where
diff --git a/module/srfi/srfi-37.scm b/module/srfi/srfi-37.scm
index 565b44c..3f654af 100644
--- a/module/srfi/srfi-37.scm
+++ b/module/srfi/srfi-37.scm
@@ -1,6 +1,6 @@
;;; srfi-37.scm --- args-fold
-;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2013 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -145,6 +145,9 @@ program-arguments in ARGS, as decided by the OPTIONS'
(let ((result (cadr args)))
(set! args (cddr args))
result))
+ ((pair? args)
+ (set! args (cdr args))
+ #f)
(else #f)))
;; Interpret the short-option at index POSITION in (car ARGS),
diff --git a/module/srfi/srfi-38.scm b/module/srfi/srfi-38.scm
index 874dd90..34cf22e 100644
--- a/module/srfi/srfi-38.scm
+++ b/module/srfi/srfi-38.scm
@@ -32,6 +32,7 @@
#:use-module (srfi srfi-69)
#:use-module (system vm trap-state))
+(cond-expand-provide (current-module) '(srfi-38))
;; A printer that shows all sharing of substructures. Uses the Common
;; Lisp print-circle notation: #n# refers to a previous substructure
diff --git a/module/srfi/srfi-39.scm b/module/srfi/srfi-39.scm
index 0d54063..661ab0f 100644
--- a/module/srfi/srfi-39.scm
+++ b/module/srfi/srfi-39.scm
@@ -41,6 +41,8 @@
parameterize
current-input-port current-output-port current-error-port))
+(cond-expand-provide (current-module) '(srfi-39))
+
(define (with-parameters* params values thunk)
(let more ((params params)
(values values)
diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index 43f5ef6..c6eb00b 100644
--- a/module/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -69,6 +69,7 @@
f64vector? make-f64vector f64vector f64vector-length f64vector-ref
f64vector-set! f64vector->list list->f64vector))
+(cond-expand-provide (current-module) '(srfi-4))
;; Need quasisyntax to do this effectively using syntax-case
(define-macro (define-bytevector-type tag infix size)
diff --git a/module/srfi/srfi-41.scm b/module/srfi/srfi-41.scm
new file mode 100644
index 0000000..edf95d7
--- /dev/null
+++ b/module/srfi/srfi-41.scm
@@ -0,0 +1,482 @@
+;;; srfi-41.scm -- SRFI 41 streams
+
+;; Copyright (c) 2007 Philip L. Bewig
+;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.
+
+;; 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.
+
+(define-module (srfi srfi-41)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:export (stream-null stream-cons stream? stream-null? stream-pair?
+ stream-car stream-cdr stream-lambda define-stream
+ list->stream port->stream stream stream->list stream-append
+ stream-concat stream-constant stream-drop stream-drop-while
+ stream-filter stream-fold stream-for-each stream-from
+ stream-iterate stream-length stream-let stream-map
+ stream-match stream-of stream-range stream-ref stream-reverse
+ stream-scan stream-take stream-take-while stream-unfold
+ stream-unfolds stream-zip))
+
+(cond-expand-provide (current-module) '(srfi-41))
+
+;;; Private supporting functions and macros.
+
+(define-syntax-rule (must pred obj func msg args ...)
+ (let ((item obj))
+ (unless (pred item)
+ (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-not pred obj func msg args ...)
+ (let ((item obj))
+ (when (pred item)
+ (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-every pred objs func msg args ...)
+ (let ((flunk (remove pred objs)))
+ (unless (null? flunk)
+ (throw 'wrong-type-arg func msg (list args ...) flunk))))
+
+(define-syntax-rule (first-value expr)
+ (receive (first . _) expr
+ first))
+
+(define-syntax-rule (second-value expr)
+ (receive (first second . _) expr
+ second))
+
+(define-syntax-rule (third-value expr)
+ (receive (first second third . _) expr
+ third))
+
+(define-syntax define-syntax*
+ (syntax-rules ()
+ ((_ (name . args) body ...)
+ (define-syntax name (lambda* args body ...)))
+ ((_ name syntax)
+ (define-syntax name syntax))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Here we include a copy of the code of srfi-45.scm (but with renamed
+;; identifiers), in order to create a new promise type that's disjoint
+;; from the promises created by srfi-45. Ideally this should be done
+;; using a 'make-promise-type' macro that instantiates a copy of this
+;; code, but a psyntax bug in Guile 2.0 prevents this from working
+;; properly: <http://bugs.gnu.org/13995>. So for now, we duplicate the
+;; code.
+
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
+
+;; 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.
+
+(define-record-type stream-promise (make-stream-promise val) stream-promise?
+ (val stream-promise-val stream-promise-val-set!))
+
+(define-record-type stream-value (make-stream-value tag proc) stream-value?
+ (tag stream-value-tag stream-value-tag-set!)
+ (proc stream-value-proc stream-value-proc-set!))
+
+(define-syntax-rule (stream-lazy exp)
+ (make-stream-promise (make-stream-value 'lazy (lambda () exp))))
+
+(define (stream-eager x)
+ (make-stream-promise (make-stream-value 'eager x)))
+
+(define-syntax-rule (stream-delay exp)
+ (stream-lazy (stream-eager exp)))
+
+(define (stream-force promise)
+ (let ((content (stream-promise-val promise)))
+ (case (stream-value-tag content)
+ ((eager) (stream-value-proc content))
+ ((lazy) (let* ((promise* ((stream-value-proc content)))
+ (content (stream-promise-val promise)))
+ (if (not (eqv? (stream-value-tag content) 'eager))
+ (begin (stream-value-tag-set! content
+ (stream-value-tag
(stream-promise-val promise*)))
+ (stream-value-proc-set! content
+ (stream-value-proc
(stream-promise-val promise*)))
+ (stream-promise-val-set! promise* content)))
+ (stream-force promise))))))
+
+;;
+;; End of the copy of the code from srfi-45.scm
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Primitive stream functions and macros: (streams primitive)
+
+(define stream? stream-promise?)
+
+(define %stream-null '(stream . null))
+(define stream-null (stream-eager %stream-null))
+
+(define (stream-null? obj)
+ (and (stream-promise? obj)
+ (eqv? (stream-force obj) %stream-null)))
+
+(define-record-type stream-pare (make-stream-pare kar kdr) stream-pare?
+ (kar stream-kar)
+ (kdr stream-kdr))
+
+(define (stream-pair? obj)
+ (and (stream-promise? obj) (stream-pare? (stream-force obj))))
+
+(define-syntax-rule (stream-cons obj strm)
+ (stream-eager (make-stream-pare (stream-delay obj) (stream-lazy strm))))
+
+(define (stream-car strm)
+ (must stream? strm 'stream-car "non-stream")
+ (let ((pare (stream-force strm)))
+ (must stream-pare? pare 'stream-car "null stream")
+ (stream-force (stream-kar pare))))
+
+(define (stream-cdr strm)
+ (must stream? strm 'stream-cdr "non-stream")
+ (let ((pare (stream-force strm)))
+ (must stream-pare? pare 'stream-cdr "null stream")
+ (stream-kdr pare)))
+
+(define-syntax-rule (stream-lambda formals body0 body1 ...)
+ (lambda formals (stream-lazy (begin body0 body1 ...))))
+
+;;; Derived stream functions and macros: (streams derived)
+
+(define-syntax-rule (define-stream (name . formal) body0 body1 ...)
+ (define name (stream-lambda formal body0 body1 ...)))
+
+(define-syntax-rule (stream-let tag ((name val) ...) body1 body2 ...)
+ ((letrec ((tag (stream-lambda (name ...) body1 body2 ...))) tag) val ...))
+
+(define (list->stream objs)
+ (define (list? x)
+ (or (proper-list? x) (circular-list? x)))
+ (must list? objs 'list->stream "non-list argument")
+ (stream-let recur ((objs objs))
+ (if (null? objs) stream-null
+ (stream-cons (car objs) (recur (cdr objs))))))
+
+(define* (port->stream #:optional (port (current-input-port)))
+ (must input-port? port 'port->stream "non-input-port argument")
+ (stream-let recur ()
+ (let ((c (read-char port)))
+ (if (eof-object? c) stream-null
+ (stream-cons c (recur))))))
+
+(define-syntax stream
+ (syntax-rules ()
+ ((_) stream-null)
+ ((_ x y ...) (stream-cons x (stream y ...)))))
+
+;; Common helper for the various eager-folding functions, such as
+;; stream-fold, stream-drop, stream->list, stream-length, etc.
+(define-inlinable (stream-fold-aux proc base strm limit)
+ (do ((val base (and proc (proc val (stream-car strm))))
+ (strm strm (stream-cdr strm))
+ (limit limit (and limit (1- limit))))
+ ((or (and limit (zero? limit)) (stream-null? strm))
+ (values val strm limit))))
+
+(define stream->list
+ (case-lambda
+ ((strm) (stream->list #f strm))
+ ((n strm)
+ (must stream? strm 'stream->list "non-stream argument")
+ (when n
+ (must integer? n 'stream->list "non-integer count")
+ (must exact? n 'stream->list "inexact count")
+ (must-not negative? n 'stream->list "negative count"))
+ (reverse! (first-value (stream-fold-aux xcons '() strm n))))))
+
+(define (stream-append . strms)
+ (must-every stream? strms 'stream-append "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (null? strms) stream-null
+ (let ((strm (car strms)))
+ (if (stream-null? strm) (recur (cdr strms))
+ (stream-cons (stream-car strm)
+ (recur (cons (stream-cdr strm) (cdr strms)))))))))
+
+(define (stream-concat strms)
+ (must stream? strms 'stream-concat "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (stream-null? strms) stream-null
+ (let ((strm (stream-car strms)))
+ (must stream? strm 'stream-concat "non-stream object in input
stream")
+ (if (stream-null? strm) (recur (stream-cdr strms))
+ (stream-cons (stream-car strm)
+ (recur (stream-cons (stream-cdr strm)
+ (stream-cdr strms)))))))))
+
+(define stream-constant
+ (case-lambda
+ (() stream-null)
+ (objs (list->stream (apply circular-list objs)))))
+
+(define-syntax* (stream-do x)
+ (define (end x)
+ (syntax-case x ()
+ (() #'(if #f #f))
+ ((result) #'result)
+ ((result ...) #'(begin result ...))))
+ (define (var-step v s)
+ (syntax-case s ()
+ (() v)
+ ((e) #'e)
+ (_ (syntax-violation 'stream-do "bad step expression" x s))))
+
+ (syntax-case x ()
+ ((_ ((var init . step) ...)
+ (test result ...)
+ expr ...)
+ (with-syntax ((result (end #'(result ...)))
+ ((step ...) (map var-step #'(var ...) #'(step ...))))
+ #'(stream-let loop ((var init) ...)
+ (if test result
+ (begin
+ expr ...
+ (loop step ...))))))))
+
+(define (stream-drop n strm)
+ (must integer? n 'stream-drop "non-integer argument")
+ (must exact? n 'stream-drop "inexact argument")
+ (must-not negative? n 'stream-drop "negative argument")
+ (must stream? strm 'stream-drop "non-stream argument")
+ (second-value (stream-fold-aux #f #f strm n)))
+
+(define (stream-drop-while pred? strm)
+ (must procedure? pred? 'stream-drop-while "non-procedural argument")
+ (must stream? strm 'stream-drop-while "non-stream argument")
+ (stream-do ((strm strm (stream-cdr strm)))
+ ((or (stream-null? strm) (not (pred? (stream-car strm)))) strm)))
+
+(define (stream-filter pred? strm)
+ (must procedure? pred? 'stream-filter "non-procedural argument")
+ (must stream? strm 'stream-filter "non-stream argument")
+ (stream-let recur ((strm strm))
+ (cond ((stream-null? strm) stream-null)
+ ((pred? (stream-car strm))
+ (stream-cons (stream-car strm) (recur (stream-cdr strm))))
+ (else (recur (stream-cdr strm))))))
+
+(define (stream-fold proc base strm)
+ (must procedure? proc 'stream-fold "non-procedural argument")
+ (must stream? strm 'stream-fold "non-stream argument")
+ (first-value (stream-fold-aux proc base strm #f)))
+
+(define stream-for-each
+ (case-lambda
+ ((proc strm)
+ (must procedure? proc 'stream-for-each "non-procedural argument")
+ (must stream? strm 'stream-for-each "non-stream argument")
+ (do ((strm strm (stream-cdr strm)))
+ ((stream-null? strm))
+ (proc (stream-car strm))))
+ ((proc strm . rest)
+ (let ((strms (cons strm rest)))
+ (must procedure? proc 'stream-for-each "non-procedural argument")
+ (must-every stream? strms 'stream-for-each "non-stream argument")
+ (do ((strms strms (map stream-cdr strms)))
+ ((any stream-null? strms))
+ (apply proc (map stream-car strms)))))))
+
+(define* (stream-from first #:optional (step 1))
+ (must number? first 'stream-from "non-numeric starting number")
+ (must number? step 'stream-from "non-numeric step size")
+ (stream-let recur ((first first))
+ (stream-cons first (recur (+ first step)))))
+
+(define (stream-iterate proc base)
+ (must procedure? proc 'stream-iterate "non-procedural argument")
+ (stream-let recur ((base base))
+ (stream-cons base (recur (proc base)))))
+
+(define (stream-length strm)
+ (must stream? strm 'stream-length "non-stream argument")
+ (- -1 (third-value (stream-fold-aux #f #f strm -1))))
+
+(define stream-map
+ (case-lambda
+ ((proc strm)
+ (must procedure? proc 'stream-map "non-procedural argument")
+ (must stream? strm 'stream-map "non-stream argument")
+ (stream-let recur ((strm strm))
+ (if (stream-null? strm) stream-null
+ (stream-cons (proc (stream-car strm))
+ (recur (stream-cdr strm))))))
+ ((proc strm . rest)
+ (let ((strms (cons strm rest)))
+ (must procedure? proc 'stream-map "non-procedural argument")
+ (must-every stream? strms 'stream-map "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (any stream-null? strms) stream-null
+ (stream-cons (apply proc (map stream-car strms))
+ (recur (map stream-cdr strms)))))))))
+
+(define-syntax* (stream-match x)
+ (define (make-matcher x)
+ (syntax-case x ()
+ (() #'(? stream-null?))
+ (rest (identifier? #'rest) #'rest)
+ ((var . rest) (identifier? #'var)
+ (with-syntax ((next (make-matcher #'rest)))
+ #'(? (negate stream-null?)
+ (= stream-car var)
+ (= stream-cdr next))))))
+ (define (make-guarded x fail)
+ (syntax-case (list x fail) ()
+ (((expr) _) #'expr)
+ (((guard expr) fail) #'(if guard expr (fail)))))
+
+ (syntax-case x ()
+ ((_ strm-expr (pat . expr) ...)
+ (with-syntax (((fail ...) (generate-temporaries #'(pat ...))))
+ (with-syntax (((matcher ...) (map make-matcher #'(pat ...)))
+ ((expr ...) (map make-guarded #'(expr ...) #'(fail ...))))
+ #'(let ((strm strm-expr))
+ (must stream? strm 'stream-match "non-stream argument")
+ (match strm (matcher (=> fail) expr) ...)))))))
+
+(define-syntax-rule (stream-of expr rest ...)
+ (stream-of-aux expr stream-null rest ...))
+
+(define-syntax stream-of-aux
+ (syntax-rules (in is)
+ ((_ expr base)
+ (stream-cons expr base))
+ ((_ expr base (var in stream) rest ...)
+ (stream-let recur ((strm stream))
+ (if (stream-null? strm) base
+ (let ((var (stream-car strm)))
+ (stream-of-aux expr (recur (stream-cdr strm)) rest ...)))))
+ ((_ expr base (var is exp) rest ...)
+ (let ((var exp)) (stream-of-aux expr base rest ...)))
+ ((_ expr base pred? rest ...)
+ (if pred? (stream-of-aux expr base rest ...) base))))
+
+(define* (stream-range first past #:optional step)
+ (must number? first 'stream-range "non-numeric starting number")
+ (must number? past 'stream-range "non-numeric ending number")
+ (when step
+ (must number? step 'stream-range "non-numeric step size"))
+ (let* ((step (or step (if (< first past) 1 -1)))
+ (lt? (if (< 0 step) < >)))
+ (stream-let recur ((first first))
+ (if (lt? first past)
+ (stream-cons first (recur (+ first step)))
+ stream-null))))
+
+(define (stream-ref strm n)
+ (must stream? strm 'stream-ref "non-stream argument")
+ (must integer? n 'stream-ref "non-integer argument")
+ (must exact? n 'stream-ref "inexact argument")
+ (must-not negative? n 'stream-ref "negative argument")
+ (let ((res (stream-drop n strm)))
+ (must-not stream-null? res 'stream-ref "beyond end of stream")
+ (stream-car res)))
+
+(define (stream-reverse strm)
+ (must stream? strm 'stream-reverse "non-stream argument")
+ (stream-do ((strm strm (stream-cdr strm))
+ (rev stream-null (stream-cons (stream-car strm) rev)))
+ ((stream-null? strm) rev)))
+
+(define (stream-scan proc base strm)
+ (must procedure? proc 'stream-scan "non-procedural argument")
+ (must stream? strm 'stream-scan "non-stream argument")
+ (stream-let recur ((base base) (strm strm))
+ (if (stream-null? strm) (stream base)
+ (stream-cons base (recur (proc base (stream-car strm))
+ (stream-cdr strm))))))
+
+(define (stream-take n strm)
+ (must stream? strm 'stream-take "non-stream argument")
+ (must integer? n 'stream-take "non-integer argument")
+ (must exact? n 'stream-take "inexact argument")
+ (must-not negative? n 'stream-take "negative argument")
+ (stream-let recur ((n n) (strm strm))
+ (if (or (zero? n) (stream-null? strm)) stream-null
+ (stream-cons (stream-car strm) (recur (1- n) (stream-cdr strm))))))
+
+(define (stream-take-while pred? strm)
+ (must procedure? pred? 'stream-take-while "non-procedural argument")
+ (must stream? strm 'stream-take-while "non-stream argument")
+ (stream-let recur ((strm strm))
+ (cond ((stream-null? strm) stream-null)
+ ((pred? (stream-car strm))
+ (stream-cons (stream-car strm) (recur (stream-cdr strm))))
+ (else stream-null))))
+
+(define (stream-unfold mapper pred? generator base)
+ (must procedure? mapper 'stream-unfold "non-procedural mapper")
+ (must procedure? pred? 'stream-unfold "non-procedural pred?")
+ (must procedure? generator 'stream-unfold "non-procedural generator")
+ (stream-let recur ((base base))
+ (if (pred? base)
+ (stream-cons (mapper base) (recur (generator base)))
+ stream-null)))
+
+(define (stream-unfolds gen seed)
+ (define-stream (generator-stream seed)
+ (receive (next . items) (gen seed)
+ (stream-cons (list->vector items) (generator-stream next))))
+ (define-stream (make-result-stream genstrm index)
+ (define head (vector-ref (stream-car genstrm) index))
+ (define-stream (tail) (make-result-stream (stream-cdr genstrm) index))
+ (match head
+ (() stream-null)
+ (#f (tail))
+ ((item) (stream-cons item (tail)))
+ ((? list? items) (stream-append (list->stream items) (tail)))))
+
+ (must procedure? gen 'stream-unfolds "non-procedural argument")
+ (let ((genstrm (generator-stream seed)))
+ (apply values (list-tabulate (vector-length (stream-car genstrm))
+ (cut make-result-stream genstrm <>)))))
+
+(define (stream-zip strm . rest)
+ (let ((strms (cons strm rest)))
+ (must-every stream? strms 'stream-zip "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (any stream-null? strms) stream-null
+ (stream-cons (map stream-car strms) (recur (map stream-cdr
strms)))))))
diff --git a/module/srfi/srfi-42.scm b/module/srfi/srfi-42.scm
index 0aaaf8f..c826f6f 100644
--- a/module/srfi/srfi-42.scm
+++ b/module/srfi/srfi-42.scm
@@ -61,4 +61,6 @@
vector-ec
vector-of-length-ec))
+(cond-expand-provide (current-module) '(srfi-42))
+
(include-from-path "srfi/srfi-42/ec.scm")
diff --git a/module/srfi/srfi-45.scm b/module/srfi/srfi-45.scm
index 29b0393..5194770 100644
--- a/module/srfi/srfi-45.scm
+++ b/module/srfi/srfi-45.scm
@@ -1,6 +1,6 @@
;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
;; Permission is hereby granted, free of charge, to any person
@@ -25,8 +25,8 @@
;;; Commentary:
-;; This is the code of the reference implementation of SRFI-45, slightly
-;; modified to use SRFI-9.
+;; This is the code of the reference implementation of SRFI-45, modified
+;; to use SRFI-9 and to add 'promise?' to the list of exports.
;; This module is documented in the Guile Reference Manual.
@@ -36,10 +36,13 @@
#:export (delay
lazy
force
- eager)
- #:replace (delay force)
+ eager
+ promise?)
+ #:replace (delay force promise?)
#:use-module (srfi srfi-9))
+(cond-expand-provide (current-module) '(srfi-45))
+
(define-record-type promise (make-promise val) promise?
(val promise-val promise-val-set!))
diff --git a/module/srfi/srfi-67.scm b/module/srfi/srfi-67.scm
index 7a43ee5..6d9d4c5 100644
--- a/module/srfi/srfi-67.scm
+++ b/module/srfi/srfi-67.scm
@@ -83,4 +83,6 @@
#:replace (string-compare string-compare-ci)
#:use-module (srfi srfi-27))
+(cond-expand-provide (current-module) '(srfi-67))
+
(include-from-path "srfi/srfi-67/compare.scm")
diff --git a/module/srfi/srfi-69.scm b/module/srfi/srfi-69.scm
index df07f75..b9486c4 100644
--- a/module/srfi/srfi-69.scm
+++ b/module/srfi/srfi-69.scm
@@ -88,7 +88,7 @@
#:re-export (string-hash)
#:replace (hash make-hash-table hash-table?))
-(cond-expand-provide (current-module) '(srfi-37))
+(cond-expand-provide (current-module) '(srfi-69))
;;;; Internal helper macros
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index f3e4641..c522b74 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -48,7 +48,7 @@
thunk
(lambda () #t))))
-;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
+;; emacs: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
(define* (call-with-output-file/atomic filename proc #:optional reference)
(let* ((template (string-append filename ".XXXXXX"))
(tmp (mkstemp! template)))
@@ -57,10 +57,13 @@
(with-throw-handler #t
(lambda ()
(proc tmp)
- (chmod tmp (logand #o0666 (lognot (umask))))
+ ;; Chmodding by name instead of by port allows this chmod to
+ ;; work on systems without fchmod, like MinGW.
+ (chmod template (logand #o0666 (lognot (umask))))
(close-port tmp)
(rename-file template filename))
(lambda args
+ (close-port tmp)
(delete-file template)))))))
(define (ensure-language x)
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index 304056d..c74ae67 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -1,6 +1,6 @@
;;; Compilation targets
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -55,7 +55,7 @@
(let ((cpu (triplet-cpu target)))
(with-fluids ((%target-type target)
(%target-endianness (cpu-endianness cpu))
- (%target-word-size (cpu-word-size cpu)))
+ (%target-word-size (triplet-pointer-size target)))
(thunk))))
(define (cpu-endianness cpu)
@@ -75,16 +75,30 @@
(else
(error "unknown CPU endianness" cpu)))))
-(define (cpu-word-size cpu)
- "Return the word size for CPU."
- (if (string=? cpu (triplet-cpu %host-type))
- %native-word-size
- (cond ((string-match "^i[0-9]86$" cpu) 4)
- ((string-match "64$" cpu) 8)
- ((string-match "64[lbe][lbe]$" cpu) 8)
- ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
- ((string-match "^arm.*" cpu) 4)
- (else (error "unknown CPU word size" cpu)))))
+(define (triplet-pointer-size triplet)
+ "Return the size of pointers in bytes for TRIPLET."
+ (let ((cpu (triplet-cpu triplet)))
+ (cond ((and (string=? cpu (triplet-cpu %host-type))
+ (string=? (triplet-os triplet) (triplet-os %host-type)))
+ %native-word-size)
+
+ ((string-match "^i[0-9]86$" cpu) 4)
+
+ ;; Although GNU config.guess doesn't yet recognize them,
+ ;; Debian (ab)uses the OS part to denote the specific ABI
+ ;; being used: <http://wiki.debian.org/Multiarch/Tuples>.
+ ;; See <http://www.linux-mips.org/wiki/WhatsWrongWithO32N32N64>
+ ;; for details on the MIPS ABIs.
+ ((string-match "^mips64.*-gnuabi64" triplet) 8) ; n64 ABI
+ ((string-match "^mips64" cpu) 4) ; n32 or o32
+
+ ((string-match "^x86_64-.*-gnux32" triplet) 4) ; x32
+
+ ((string-match "64$" cpu) 8)
+ ((string-match "64[lbe][lbe]$" cpu) 8)
+ ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
+ ((string-match "^arm.*" cpu) 4)
+ (else (error "unknown CPU word size" cpu)))))
(define (triplet-cpu t)
(substring t 0 (string-index t #\-)))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index aa16f5d..a3e43fe 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -351,18 +351,20 @@ Show description/documentation."
(newline))
(define-meta-command (option repl . args)
- "option [KEY VALUE]
+ "option [NAME] [EXP]
List/show/set options."
(pmatch args
(()
(for-each (lambda (spec)
(format #t " ~A~24t~A\n" (car spec) (cadr spec)))
(repl-options repl)))
- ((,key)
- (display (repl-option-ref repl key))
+ ((,name)
+ (display (repl-option-ref repl name))
(newline))
- ((,key ,val)
- (repl-option-set! repl key val))))
+ ((,name ,exp)
+ ;; Would be nice to evaluate in the current language, but the REPL
+ ;; option parser doesn't permit that, currently.
+ (repl-option-set! repl name (eval exp (current-module))))))
(define-meta-command (quit repl)
"quit
diff --git a/module/texinfo.scm b/module/texinfo.scm
index edee5b3..91bb46d 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -216,7 +216,8 @@ lambda. Only present for @code{INLINE-ARGS},
@code{EOL-ARGS},
(value INLINE-ARGS . (key))
(ref INLINE-ARGS . (node #:opt name section info-file
manual))
(xref INLINE-ARGS . (node #:opt name section info-file
manual))
- (pxref INLINE-ARGS . (node #:opt name section info-file
manual))
+ (pxref INLINE-TEXT-ARGS
+ . (node #:opt name section info-file manual))
(url ALIAS . uref)
(uref INLINE-ARGS . (url #:opt title replacement))
(anchor INLINE-ARGS . (name))
@@ -484,7 +485,7 @@ Examples:
(assert-curr-char '(#\@) "start of the command" port)
(let ((peeked (peek-char port)))
(cond
- ((memq peeked '(#\! #\. #\? #\@ #\\ #\{ #\}))
+ ((memq peeked '(#\! #\: #\. #\? #\@ #\\ #\{ #\}))
;; @-commands that escape characters
(make-token 'STRING (string (read-char port))))
(else
diff --git a/module/texinfo/plain-text.scm b/module/texinfo/plain-text.scm
index 83e5e38..809cdb7 100644
--- a/module/texinfo/plain-text.scm
+++ b/module/texinfo/plain-text.scm
@@ -31,6 +31,7 @@
#:use-module (sxml transform)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
+ #:use-module (ice-9 match)
#:export (stexi->plain-text))
;; The return value is a string.
@@ -95,13 +96,6 @@
(string-append "`" url "'"))))
(define (def tag args . body)
- (define (list/spaces . elts)
- (let lp ((in elts) (out '()))
- (cond ((null? in) (reverse! out))
- ((null? (car in)) (lp (cdr in) out))
- (else (lp (cdr in)
- (cons (car in)
- (if (null? out) out (cons " " out))))))))
(define (first-line)
(string-join
(filter identity
@@ -255,6 +249,7 @@
(sc ,var)
(copyright ,(lambda args "(C)"))
(result ,(lambda args "==>"))
+ (dots ,(lambda args "..."))
(xref ,ref)
(ref ,ref)
(pxref ,ref)
@@ -296,18 +291,18 @@
(define (stexi->plain-text tree)
"Transform @var{tree} into plain text. Returns a string."
- (cond
- ((null? tree) "")
- ((string? tree) tree)
- ((pair? tree)
- (cond
- ((symbol? (car tree))
- (let ((handler (and (not (ignored? (car tree)))
- (or (and=> (assq (car tree) tag-handlers) cadr)
- para))))
- (if handler (apply handler tree) "")))
- (else
- (string-concatenate (map-in-order stexi->plain-text tree)))))
- (else "")))
+ (match tree
+ (() "")
+ ((? string?) tree)
+ (((? symbol? tag) body ...)
+ (let ((handler (and (not (ignored? tag))
+ (or (and=> (assq tag tag-handlers) cadr)
+ para))))
+ (if handler
+ (apply handler tree)
+ "")))
+ ((tree ...)
+ (string-concatenate (map-in-order stexi->plain-text tree)))
+ (_ "")))
;;; arch-tag: f966c3f6-3b46-4790-bbf9-3ad27e4917c2
diff --git a/module/texinfo/string-utils.scm b/module/texinfo/string-utils.scm
index 7675149..22f969c 100644
--- a/module/texinfo/string-utils.scm
+++ b/module/texinfo/string-utils.scm
@@ -1,6 +1,6 @@
;;;; (texinfo string-utils) -- text filling and wrapping
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2003 Richard Todd
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -262,6 +262,13 @@ the default value for @var{num} is 1.
;; did not find non-ws... only ws at end of the string...
(reverse ans))))))
+(define (end-of-sentence? str)
+ "Return #t when STR likely denotes the end of sentence."
+ (let ((len (string-length str)))
+ (and (> len 1)
+ (eqv? #\. (string-ref str (- len 1)))
+ (not (eqv? #\. (string-ref str (- len 2)))))))
+
(define* (make-text-wrapper #:key
(line-width 80)
(expand-tabs? #t)
@@ -352,7 +359,11 @@ returns a list of strings, where each element of the list
is one line."
length-left)
(loop ans
(cdr words)
- (string-append line next-word)
+ (if (and collapse-whitespace?
+ (end-of-sentence? line))
+ ;; Add an extra space after the period.
+ (string-append line " " next-word)
+ (string-append line next-word))
(+ count 1)))
;; ok, it didn't fit...is there already at least one word on the
line?
diff --git a/module/web/client.scm b/module/web/client.scm
index 9fbb25b..7d5ea49 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -248,10 +248,10 @@ pass it as PORT. The port will be closed at the end of
the
request unless KEEP-ALIVE? is true. Any extra headers in the
alist HEADERS will be added to the request.
-If BODY is not #f, a message body will also be sent with the HTTP
+If BODY is not â#fâ, a message body will also be sent with the HTTP
request. If BODY is a string, it is encoded according to the
content-type in HEADERS, defaulting to UTF-8. Otherwise BODY should be
-a bytevector, or #f for no body. Although it's allowed to send a
+a bytevector, or â#fâ for no body. Although it's allowed to send a
message body along with any request, usually only POST and PUT requests
have bodies. See âhttp-putâ and âhttp-postâ documentation, for more.
@@ -317,7 +317,7 @@ This function is similar to âhttp-getâ, except it uses
the \"HEAD\"
method. See âhttp-getâ for full documentation on the various keyword
arguments that are accepted by this function.
-Returns two values: the resulting response, and #f. Responses to HEAD
+Returns two values: the resulting response, and â#fâ. Responses to HEAD
requests do not have a body. The second value is only returned so that
other procedures can treat all of the http-foo verbs identically.")
diff --git a/module/web/http.scm b/module/web/http.scm
index c79d57d..35169ef 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -167,7 +167,7 @@ The default writer is âdisplayâ."
(define *eof* (call-with-input-string "" read))
(define (read-header port)
- "Reads one HTTP header from PORT. Returns two values: the header
+ "Read one HTTP header from PORT. Return two values: the header
name and the parsed Scheme value. May raise an exception if the header
was known but the value was invalid.
@@ -220,7 +220,7 @@ as an ordered alist."
(define (write-headers headers port)
"Write the given header alist to PORT. Doesn't write the final
address@hidden, as the user might want to add another header."
+â\\r\\nâ, as the user might want to add another header."
(let lp ((headers headers))
(if (pair? headers)
(begin
@@ -702,29 +702,50 @@ as an ordered alist."
(else (bad))))
(else (bad))))))
+;; "GMT" | "+" 4DIGIT | "-" 4DIGIT
+;;
+;; RFC 2616 requires date values to use "GMT", but recommends accepting
+;; the others as they are commonly generated by e.g. RFC 822 sources.
+(define (parse-zone-offset str start)
+ (let ((s (substring str start)))
+ (define (bad)
+ (bad-header-component 'zone-offset s))
+ (cond
+ ((string=? s "GMT")
+ 0)
+ ((string-match? s ".dddd")
+ (let ((sign (case (string-ref s 0)
+ ((#\+) +1)
+ ((#\-) -1)
+ (else (bad))))
+ (hours (parse-non-negative-integer s 1 3))
+ (minutes (parse-non-negative-integer s 3 5)))
+ (* sign 60 (+ (* 60 hours) minutes)))) ; seconds east of Greenwich
+ (else (bad)))))
+
;; RFC 822, updated by RFC 1123
;;
;; Sun, 06 Nov 1994 08:49:37 GMT
;; 01234567890123456789012345678
;; 0 1 2
-(define (parse-rfc-822-date str)
+(define (parse-rfc-822-date str space zone-offset)
;; We could verify the day of the week but we don't.
- (cond ((string-match? str "aaa, dd aaa dddd dd:dd:dd GMT")
+ (cond ((string-match? (substring str 0 space) "aaa, dd aaa dddd dd:dd:dd")
(let ((date (parse-non-negative-integer str 5 7))
(month (parse-month str 8 11))
(year (parse-non-negative-integer str 12 16))
(hour (parse-non-negative-integer str 17 19))
(minute (parse-non-negative-integer str 20 22))
(second (parse-non-negative-integer str 23 25)))
- (make-date 0 second minute hour date month year 0)))
- ((string-match? str "aaa, d aaa dddd dd:dd:dd GMT")
+ (make-date 0 second minute hour date month year zone-offset)))
+ ((string-match? (substring str 0 space) "aaa, d aaa dddd dd:dd:dd")
(let ((date (parse-non-negative-integer str 5 6))
(month (parse-month str 7 10))
(year (parse-non-negative-integer str 11 15))
(hour (parse-non-negative-integer str 16 18))
(minute (parse-non-negative-integer str 19 21))
(second (parse-non-negative-integer str 22 24)))
- (make-date 0 second minute hour date month year 0)))
+ (make-date 0 second minute hour date month year zone-offset)))
(else
(bad-header 'date str) ; prevent tail call
#f)))
@@ -733,10 +754,10 @@ as an ordered alist."
;; Sunday, 06-Nov-94 08:49:37 GMT
;; 0123456789012345678901
;; 0 1 2
-(define (parse-rfc-850-date str comma)
+(define (parse-rfc-850-date str comma space zone-offset)
;; We could verify the day of the week but we don't.
- (let ((tail (substring str (1+ comma))))
- (if (not (string-match? tail " dd-aaa-dd dd:dd:dd GMT"))
+ (let ((tail (substring str (1+ comma) space)))
+ (if (not (string-match? tail " dd-aaa-dd dd:dd:dd"))
(bad-header 'date str))
(let ((date (parse-non-negative-integer tail 1 3))
(month (parse-month tail 4 7))
@@ -750,7 +771,7 @@ as an ordered alist."
(cond ((< (+ then 50) now) (+ then 100))
((< (+ now 50) then) (- then 100))
(else then)))
- 0))))
+ zone-offset))))
;; ANSI C's asctime() format
;; Sun Nov 6 08:49:37 1994
@@ -770,13 +791,23 @@ as an ordered alist."
(second (parse-non-negative-integer str 17 19)))
(make-date 0 second minute hour date month year 0)))
+;; Convert all date values to GMT time zone, as per RFC 2616 appendix C.
+(define (normalize-date date)
+ (if (zero? (date-zone-offset date))
+ date
+ (time-utc->date (date->time-utc date) 0)))
+
(define (parse-date str)
- (if (string-suffix? " GMT" str)
- (let ((comma (string-index str #\,)))
- (cond ((not comma) (bad-header 'date str))
- ((= comma 3) (parse-rfc-822-date str))
- (else (parse-rfc-850-date str comma))))
- (parse-asctime-date str)))
+ (let* ((space (string-rindex str #\space))
+ (zone-offset (and space (false-if-exception
+ (parse-zone-offset str (1+ space))))))
+ (normalize-date
+ (if zone-offset
+ (let ((comma (string-index str #\,)))
+ (cond ((not comma) (bad-header 'date str))
+ ((= comma 3) (parse-rfc-822-date str space zone-offset))
+ (else (parse-rfc-850-date str comma space zone-offset))))
+ (parse-asctime-date str)))))
(define (write-date date port)
(define (display-digits n digits port)
@@ -971,7 +1002,7 @@ as an ordered alist."
(define *known-versions* '())
(define* (parse-http-version str #:optional (start 0) (end (string-length
str)))
- "Parse an HTTP version from STR, returning it as a major-minor
+ "Parse an HTTP version from STR, returning it as a majorâminor
pair. For example, âHTTP/1.1â parses as the pair of integers,
â(1 . 1)â."
(or (let lp ((known *known-versions*))
@@ -1628,18 +1659,32 @@ treated specially, and is just returned as a plain
string."
;;
(declare-header! "Host"
(lambda (str)
- (let ((colon (string-index str #\:)))
- (if colon
- (cons (substring str 0 colon)
- (parse-non-negative-integer str (1+ colon)))
- (cons str #f))))
+ (let* ((rbracket (string-index str #\]))
+ (colon (string-index str #\: (or rbracket 0)))
+ (host (cond
+ (rbracket
+ (unless (eqv? (string-ref str 0) #\[)
+ (bad-header 'host str))
+ (substring str 1 rbracket))
+ (colon
+ (substring str 0 colon))
+ (else
+ str)))
+ (port (and colon
+ (parse-non-negative-integer str (1+ colon)))))
+ (cons host port)))
(lambda (val)
(and (pair? val)
(string? (car val))
(or (not (cdr val))
(non-negative-integer? (cdr val)))))
(lambda (val port)
- (display (car val) port)
+ (if (string-index (car val) #\:)
+ (begin
+ (display #\[ port)
+ (display (car val) port)
+ (display #\] port))
+ (display (car val) port))
(if (cdr val)
(begin
(display #\: port)
diff --git a/module/web/response.scm b/module/web/response.scm
index 7e14f4d..570a2d7 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -267,19 +267,32 @@ closes PORT, unless KEEP-ALIVE? is true."
(define* (response-body-port r #:key (decode? #t) (keep-alive? #t))
"Return an input port from which the body of R can be read. The
encoding of the returned port is set according to R's âcontent-typeâ
-header, when it's textual, except if DECODE? is #f. Return #f when no
-body is available.
+header, when it's textual, except if DECODE? is â#fâ. Return #f when
+no body is available.
-When KEEP-ALIVE? is #f, closing the returned port also closes R's
+When KEEP-ALIVE? is â#fâ, closing the returned port also closes R's
response port."
(define port
- (if (member '(chunked) (response-transfer-encoding r))
- (make-chunked-input-port (response-port r)
- #:keep-alive? keep-alive?)
- (let ((len (response-content-length r)))
- (and len
- (make-delimited-input-port (response-port r)
- len keep-alive?)))))
+ (cond
+ ((member '(chunked) (response-transfer-encoding r))
+ (make-chunked-input-port (response-port r)
+ #:keep-alive? keep-alive?))
+ ((response-content-length r)
+ => (lambda (len)
+ (make-delimited-input-port (response-port r)
+ len keep-alive?)))
+ ((response-must-not-include-body? r)
+ #f)
+ ((or (memq 'close (response-connection r))
+ (and (equal? (response-version r) '(1 . 0))
+ (not (memq 'keep-alive (response-connection r)))))
+ (response-port r))
+ (else
+ ;; Here we have a message with no transfer encoding, no
+ ;; content-length, and a response that won't necessarily be closed
+ ;; by the server. Not much we can do; assume that the client
+ ;; knows how to handle it.
+ (response-port r))))
(when (and decode? port)
(match (response-content-type r)
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 25406b3..7fe0100 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -53,8 +53,8 @@
(query uri-query)
(fragment uri-fragment))
-(define (absolute-uri? x)
- (and (uri? x) (uri-scheme x) #t))
+(define (absolute-uri? obj)
+ (and (uri? obj) (uri-scheme obj) #t))
(define (uri-error message . args)
(throw 'uri-error message args))
@@ -309,17 +309,16 @@ serialization."
which should be the name of a character encoding.
Note that this function should not generally be applied to a full URI
-string. For paths, use split-and-decode-uri-path instead. For query
+string. For paths, use âsplit-and-decode-uri-pathâ instead. For query
strings, split the query on â&â and â=â boundaries, and decode
the components separately.
-Note also that percent-encoded strings encode @emph{bytes}, not
-characters. There is no guarantee that a given byte sequence is a valid
-string encoding. Therefore this routine may signal an error if the
-decoded bytes are not valid for the given encoding. Pass â#fâ for
-ENCODING if you want decoded bytes as a bytevector directly.
address@hidden, âset-port-encoding!â}, for more information on
-character encodings.
+Note also that percent-encoded strings encode _bytes_, not characters.
+There is no guarantee that a given byte sequence is a valid string
+encoding. Therefore this routine may signal an error if the decoded
+bytes are not valid for the given encoding. Pass â#fâ for ENCODING if
+you want decoded bytes as a bytevector directly. âset-port-encoding!â,
+for more information on character encodings.
Returns a string of the decoded characters, or a bytevector if
ENCODING was â#fâ."
@@ -380,11 +379,10 @@ ENCODING was â#fâ."
UNESCAPED-CHARS.
The default character set includes alphanumerics from ASCII, as well as
-the special characters @samp{-}, @samp{.}, @samp{_}, and @samp{~}. Any
-other character will be percent-encoded, by writing out the character to
-a bytevector within the given ENCODING, then encoding each byte as
-â%HHâ, where HH is the hexadecimal representation of
-the byte."
+the special characters â-â, â.â, â_â, and â~â. Any other
character will
+be percent-encoded, by writing out the character to a bytevector within
+the given ENCODING, then encoding each byte as â%HHâ, where HH is the
+hexadecimal representation of the byte."
(define (needs-escaped? ch)
(not (char-set-contains? unescaped-chars ch)))
(if (string-index str needs-escaped?)
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index b1e90ba..b78f599 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -132,6 +132,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/srfi-37.test \
tests/srfi-38.test \
tests/srfi-39.test \
+ tests/srfi-41.test \
tests/srfi-42.test \
tests/srfi-45.test \
tests/srfi-60.test \
diff --git a/test-suite/standalone/Makefile.am
b/test-suite/standalone/Makefile.am
index be5d913..eb47f30 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -37,7 +37,7 @@ TESTS_ENVIRONMENT =
\
@LOCALCHARSET_TESTS_ENVIRONMENT@ \
GUILE_AUTO_COMPILE=0 "${top_builddir}/meta/uninstalled-env"
-## Check for headers in $(srcdir) and bulid dir before $(CPPFLAGS), which
+## Check for headers in $(srcdir) and build dir before $(CPPFLAGS), which
## may point us to an old, installed version of guile.
AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \
-I$(top_srcdir)/lib -I$(top_builddir)/lib
@@ -251,4 +251,10 @@ EXTRA_DIST += test-with-guile-module.c
test-scm-with-guile.c
endif
+test_smob_mark_SOURCES = test-smob-mark.c
+test_smob_mark_CFLAGS = ${test_cflags}
+test_smob_mark_LDADD = $(LIBGUILE_LDADD)
+check_PROGRAMS += test-smob-mark
+TESTS += test-smob-mark
+
EXTRA_DIST += ${check_SCRIPTS}
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index ad68660..0a91f63 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -170,6 +170,21 @@ exec guile -q -s "$0" "$@"
(+ -1 2000 -30000 40000000000))
;;
+;; More than ten arguments
+;;
+(define f-sum-many
+ (pointer->procedure int64 (dynamic-func "test_ffi_sum_many" lib)
+ (list uint8 uint16 uint32 uint64
+ int8 int16 int32 int64
+ int8 int16 int32 int64)))
+(test (f-sum-many 255 65535 4294967295 1844674407370955161
+ -1 2000 -30000 40000000000
+ 5 -6000 70000 -80000000000)
+ (+ 255 65535 4294967295 1844674407370955161
+ -1 2000 -30000 40000000000
+ 5 -6000 70000 -80000000000))
+
+;;
;; Structs
;;
(define f-sum-struct
diff --git a/test-suite/standalone/test-ffi-lib.c
b/test-suite/standalone/test-ffi-lib.c
index 37d6e43..f265339 100644
--- a/test-suite/standalone/test-ffi-lib.c
+++ b/test-suite/standalone/test-ffi-lib.c
@@ -194,6 +194,23 @@ scm_t_int64 test_ffi_sum (scm_t_int8 a, scm_t_int16 b,
}
+scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
+ scm_t_uint32 c, scm_t_uint64 d,
+ scm_t_int8 e, scm_t_int16 f,
+ scm_t_int32 g, scm_t_int64 h,
+ scm_t_int8 i, scm_t_int16 j,
+ scm_t_int32 k, scm_t_int64 l);
+scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
+ scm_t_uint32 c, scm_t_uint64 d,
+ scm_t_int8 e, scm_t_int16 f,
+ scm_t_int32 g, scm_t_int64 h,
+ scm_t_int8 i, scm_t_int16 j,
+ scm_t_int32 k, scm_t_int64 l)
+{
+ return l + k + j + i + h + g + f + e + d + c + b + a;
+}
+
+
struct foo
{
scm_t_int8 a;
diff --git a/test-suite/standalone/test-round.c
b/test-suite/standalone/test-round.c
index f1458af..150c881 100644
--- a/test-suite/standalone/test-round.c
+++ b/test-suite/standalone/test-round.c
@@ -25,7 +25,16 @@
#include <stdio.h>
#if HAVE_FENV_H
-#include <fenv.h>
+# if defined __GNUC__ && defined __GLIBC__
+/* In Glibc 2.17, <bits/fenv.h> defines `feraiseexcept' as an inline
+ without declaring it first, so ignore the warning. */
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Wmissing-prototypes"
+# endif
+# include <fenv.h>
+# if defined __GNUC__ && defined __GLIBC__
+# pragma GCC diagnostic pop
+# endif
#elif defined HAVE_MACHINE_FPU_H
/* On Tru64 5.1b, the declaration of fesetround(3) is in <machine/fpu.h>.
On NetBSD, this header has to be included along with <sys/types.h>. */
diff --git a/test-suite/standalone/test-smob-mark.c
b/test-suite/standalone/test-smob-mark.c
new file mode 100644
index 0000000..d9db9a6
--- /dev/null
+++ b/test-suite/standalone/test-smob-mark.c
@@ -0,0 +1,133 @@
+/* Copyright (C) 2013 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * 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
+ */
+
+#if HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include <assert.h>
+#include <libguile.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#define SMOBS_COUNT (10000)
+
+struct x_tag
+{
+ SCM scm_value;
+ int c_value;
+};
+
+typedef struct x_tag x_t;
+
+unsigned int mark_call_count = 0;
+
+static scm_t_bits x_tag;
+static SCM make_x (void);
+static SCM mark_x (SCM x);
+static int print_x (SCM x, SCM port, scm_print_state * pstate);
+static size_t free_x (SCM x);
+static void init_smob_type (void);
+static void test_scm_smob_mark (void);
+
+static SCM
+make_x ()
+{
+ static int i = 0;
+ SCM s_x;
+ x_t *c_x;
+
+ i++;
+ c_x = (x_t *) scm_gc_malloc (sizeof (x_t), "x");
+ c_x->scm_value = scm_from_int (i);
+ c_x->c_value = i;
+ SCM_NEWSMOB (s_x, x_tag, c_x);
+ return s_x;
+}
+
+static SCM
+mark_x (SCM x)
+{
+ x_t *c_x;
+ c_x = (x_t *) SCM_SMOB_DATA (x);
+ scm_gc_mark (c_x->scm_value);
+ mark_call_count++;
+ return SCM_BOOL_F;
+}
+
+static size_t
+free_x (SCM x)
+{
+ x_t *c_x;
+ c_x = (x_t *) SCM_SMOB_DATA (x);
+ scm_gc_free (c_x, sizeof (x_t), "x");
+ c_x = NULL;
+ return 0;
+}
+
+static int
+print_x (SCM x, SCM port, scm_print_state * pstate SCM_UNUSED)
+{
+ x_t *c_x = (x_t *) SCM_SMOB_DATA (x);
+ scm_puts ("#<x ", port);
+ if (c_x == (x_t *) NULL)
+ scm_puts ("(freed)", port);
+ else
+ scm_write (c_x->scm_value, port);
+ scm_puts (">", port);
+
+ return 1;
+}
+
+static void
+test_scm_smob_mark ()
+{
+ int i;
+ mark_call_count = 0;
+ for (i = 0; i < SMOBS_COUNT; i++)
+ make_x ();
+ scm_gc ();
+ if (mark_call_count < SMOBS_COUNT)
+ {
+ fprintf (stderr, "FAIL: SMOB mark function called for each SMOB\n");
+ exit (EXIT_FAILURE);
+ }
+}
+
+static void
+init_smob_type ()
+{
+ x_tag = scm_make_smob_type ("x", sizeof (x_t));
+ scm_set_smob_free (x_tag, free_x);
+ scm_set_smob_print (x_tag, print_x);
+ scm_set_smob_mark (x_tag, mark_x);
+}
+
+static void
+tests (void *data, int argc, char **argv)
+{
+ init_smob_type ();
+ test_scm_smob_mark ();
+}
+
+int
+main (int argc, char *argv[])
+{
+ scm_boot_guile (argc, argv, tests, NULL);
+ return 0;
+}
diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index e74d376..7b13c5f 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -339,7 +339,7 @@
(if (not server-pid)
(throw 'unresolved)
(let ((status (cdr (waitpid server-pid))))
- (eq? 0 (status:exit-val status)))))
+ (eqv? 0 (status:exit-val status)))))
(false-if-exception (delete-file path))
@@ -412,7 +412,7 @@
(if (not server-pid)
(throw 'unresolved)
(let ((status (cdr (waitpid server-pid))))
- (eq? 0 (status:exit-val status)))))
+ (eqv? 0 (status:exit-val status)))))
(false-if-exception (delete-file path))
@@ -508,7 +508,7 @@
(if (not server-pid)
(throw 'unresolved)
(let ((status (cdr (waitpid server-pid))))
- (eq? 0 (status:exit-val status)))))
+ (eqv? 0 (status:exit-val status)))))
#t)))
diff --git a/test-suite/tests/alist.test b/test-suite/tests/alist.test
index 699c10e..0ed5d22 100644
--- a/test-suite/tests/alist.test
+++ b/test-suite/tests/alist.test
@@ -124,8 +124,8 @@
(pass-if "assoc-ref"
(let ((x (assoc-ref b "one")))
(and (list? x)
- (eq? (car x) 2)
- (eq? (cadr x) 3))))
+ (eqv? (car x) 2)
+ (eqv? (cadr x) 3))))
(pass-if-not "assoc-ref not" (assoc-ref a 'testing))
diff --git a/test-suite/tests/asm-to-bytecode.test
b/test-suite/tests/asm-to-bytecode.test
index ddbe2ee..688e752 100644
--- a/test-suite/tests/asm-to-bytecode.test
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -1,6 +1,6 @@
;;;; Assembly to bytecode compilation -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -134,6 +134,9 @@
(define (native-cpu)
(with-target %host-type target-cpu))
+(define (native-os)
+ (with-target %host-type target-os))
+
(define (native-word-size)
((@ (system foreign) sizeof) '*))
@@ -154,7 +157,8 @@
;; actually has a 32-bit user-land, for instance (see
;; <http://www.debian.org/ports/sparc/#sparc64bit>
;; for details.)
- (if (string=? (native-cpu) (target-cpu))
+ (if (and (string=? (native-cpu) (target-cpu))
+ (string=? (native-os) (target-os)))
(native-word-size)
word-size))
(b (compile-bytecode
@@ -187,6 +191,13 @@
(test-target "powerpc-unknown-linux-gnu" (endianness big) 4)
(test-target "sparc64-unknown-freebsd8.2" (endianness big) 8)
+ (test-target "mips64el-unknown-linux-gnu" ; n32 or o32 ABI
+ (endianness little) 4)
+ (test-target "mips64el-unknown-linux-gnuabi64" ; n64 ABI (Debian tuplet)
+ (endianness little) 8)
+ (test-target "x86_64-unknown-linux-gnux32" ; x32 ABI (Debian tuplet)
+ (endianness little) 4)
+
(pass-if-exception "unknown target"
exception:miscellaneous-error
(call-with-values (lambda ()
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index 41800fd..baf8546 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -124,8 +124,8 @@
(with-fluids* (cons f (cons g #nil))
'(3 4)
(lambda ()
- (and (eq? (fluid-ref f) 3)
- (eq? (fluid-ref g) 4))))))
+ (and (eqv? (fluid-ref f) 3)
+ (eqv? (fluid-ref g) 4))))))
(pass-if "append!"
(let ((a (copy-tree '(1 2 3)))
@@ -150,11 +150,11 @@
'(5 4 3 2 1))) ; Ditto.
(pass-if "list-ref"
- (eq? (list-ref '(0 1 2 3 4 . #nil) 4) 4))
+ (eqv? (list-ref '(0 1 2 3 4 . #nil) 4) 4))
(pass-if-exception "list-ref"
exception:out-of-range
- (eq? (list-ref '(0 1 2 3 4 . #nil) 6) 6))
+ (eqv? (list-ref '(0 1 2 3 4 . #nil) 6) 6))
(pass-if "list-set!"
(let ((l (copy-tree '(0 1 2 3 4 . #nil))))
diff --git a/test-suite/tests/encoding-iso88591.test
b/test-suite/tests/encoding-iso88591.test
index f7bec5e..8265ff1 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -106,16 +106,16 @@
(with-test-prefix "string length"
(pass-if "última"
- (eq? (string-length s1) 6))
+ (eqv? (string-length s1) 6))
(pass-if "cédula"
- (eq? (string-length s2) 6))
+ (eqv? (string-length s2) 6))
(pass-if "años"
- (eq? (string-length s3) 4))
+ (eqv? (string-length s3) 4))
(pass-if "¿Cómo?"
- (eq? (string-length s4) 6)))
+ (eqv? (string-length s4) 6)))
(with-test-prefix "internal encoding"
@@ -168,7 +168,7 @@
(pass-if "1"
(let ((á 1)
(ñ 2))
- (eq? (+ á ñ) 3))))
+ (eqv? (+ á ñ) 3))))
(with-test-prefix "output errors"
diff --git a/test-suite/tests/encoding-iso88597.test
b/test-suite/tests/encoding-iso88597.test
index f116194..a577b2a 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -95,16 +95,16 @@
(with-test-prefix "string length"
(pass-if "s1"
- (eq? (string-length s1) 4))
+ (eqv? (string-length s1) 4))
(pass-if "s2"
- (eq? (string-length s2) 3))
+ (eqv? (string-length s2) 3))
(pass-if "s3"
- (eq? (string-length s3) 8))
+ (eqv? (string-length s3) 8))
(pass-if "s4"
- (eq? (string-length s4) 3)))
+ (eqv? (string-length s4) 3)))
(with-test-prefix "internal encoding"
@@ -157,7 +157,7 @@
(pass-if "1"
(let ((á 1)
(ñ 2))
- (eq? (+ á ñ) 3))))
+ (eqv? (+ á ñ) 3))))
(with-test-prefix "output errors"
diff --git a/test-suite/tests/encoding-utf8.test
b/test-suite/tests/encoding-utf8.test
index 966a04d..1de3fa7 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -126,16 +126,16 @@
(with-test-prefix "string length"
(pass-if "última"
- (eq? (string-length s1) 6))
+ (eqv? (string-length s1) 6))
(pass-if "cédula"
- (eq? (string-length s2) 6))
+ (eqv? (string-length s2) 6))
(pass-if "años"
- (eq? (string-length s3) 4))
+ (eqv? (string-length s3) 4))
(pass-if "ç¾
çé"
- (eq? (string-length s4) 3)))
+ (eqv? (string-length s4) 3)))
(with-test-prefix "internal encoding"
@@ -188,7 +188,7 @@
(pass-if "1"
(let ((è¥å·é¾ä¹ä» 1)
(ñ 2))
- (eq? (+ è¥å·é¾ä¹ä» ñ) 3))))
+ (eqv? (+ è¥å·é¾ä¹ä» ñ) 3))))
(if (defined? 'setlocale)
(setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index a6bfb6e..21b8937 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,6 @@
;;;; filesys.test --- test file system functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,7 +18,10 @@
(define-module (test-suite test-filesys)
#:use-module (test-suite lib)
- #:use-module (test-suite guile-test))
+ #:use-module (test-suite guile-test)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs io ports)
+ #:use-module (rnrs bytevectors))
(define (test-file)
(data-file-name "filesys-test.tmp"))
@@ -125,5 +128,72 @@
(close-port port)
(eqv? 5 (stat:size st))))))
+(with-test-prefix "sendfile"
+
+ (pass-if "file"
+ (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (call-with-output-file (test-file)
+ (lambda (output)
+ (sendfile output input len 0))))))
+ (let ((ref (call-with-input-file file get-bytevector-all))
+ (out (call-with-input-file (test-file) get-bytevector-all)))
+ (bytevector=? ref out))))
+
+ (pass-if "file with offset"
+ (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (call-with-output-file (test-file)
+ (lambda (output)
+ (sendfile output input (- len 777) 777))))))
+ (let ((ref (call-with-input-file file
+ (lambda (input)
+ (seek input 777 SEEK_SET)
+ (get-bytevector-all input))))
+ (out (call-with-input-file (test-file) get-bytevector-all)))
+ (bytevector=? ref out))))
+
+ (pass-if "pipe"
+ (if (provided? 'threads)
+ (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+ (in+out (pipe))
+ (child (call-with-new-thread
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (sendfile (cdr in+out) (fileno input) len 0)
+ (close-port (cdr in+out)))))))))
+ (let ((ref (call-with-input-file file get-bytevector-all))
+ (out (get-bytevector-all (car in+out))))
+ (close-port (car in+out))
+ (bytevector=? ref out)))
+ (throw 'unresolved)))
+
+ (pass-if "pipe with offset"
+ (if (provided? 'threads)
+ (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+ (in+out (pipe))
+ (child (call-with-new-thread
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (sendfile (cdr in+out) (fileno input)
+ (- len 777) 777)
+ (close-port (cdr in+out)))))))))
+ (let ((ref (call-with-input-file file
+ (lambda (input)
+ (seek input 777 SEEK_SET)
+ (get-bytevector-all input))))
+ (out (get-bytevector-all (car in+out))))
+ (close-port (car in+out))
+ (bytevector=? ref out)))
+ (throw 'unresolved))))
+
(delete-file (test-file))
(delete-file (test-symlink))
diff --git a/test-suite/tests/fluids.test b/test-suite/tests/fluids.test
index 9ed846c..9ad9e81 100644
--- a/test-suite/tests/fluids.test
+++ b/test-suite/tests/fluids.test
@@ -18,7 +18,8 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(define-module (test-suite test-fluids)
- :use-module (test-suite lib))
+ :use-module (test-suite lib)
+ :use-module (system base compile))
(define exception:syntax-error
@@ -78,16 +79,31 @@
(not (fluid-ref a))))))
(with-test-prefix "with-fluids with duplicate fluid"
+ ;; These tests must be compiled, because the evaluator
+ ;; effectively transforms (with-fluids ((a 1) (b 2)) ...)
+ ;; into (with-fluids ((a 1)) (with-fluids ((b 2)) ...))
+
(pass-if "last value wins"
- (with-fluids ((a 1)
- (a 2))
- (eqv? (fluid-ref a) 2)))
+ (compile '(with-fluids ((a 1)
+ (a 2)
+ (a 3))
+ (eqv? (fluid-ref a) 3))
+ #:env (current-module)))
+ (pass-if "remove the duplicate, not the last binding"
+ (compile '(with-fluids ((a 1)
+ (a 2)
+ (a 3)
+ (b 4))
+ (eqv? (fluid-ref b) 4))
+ #:env (current-module)))
+
(pass-if "original value restored"
- (and (with-fluids ((a 1)
- (a 2))
- (eqv? (fluid-ref a) 2))
- (eqv? (fluid-ref a) #f))))
+ (compile '(and (with-fluids ((a 1)
+ (a 2))
+ (eqv? (fluid-ref a) 2))
+ (eqv? (fluid-ref a) #f))
+ #:env (current-module))))
(pass-if "fluid values are thread-local"
(if (provided? 'threads)
diff --git a/test-suite/tests/future.test b/test-suite/tests/future.test
index b8bacb2..a398aff 100644
--- a/test-suite/tests/future.test
+++ b/test-suite/tests/future.test
@@ -2,7 +2,7 @@
;;;;
;;;; Ludovic Courtès <address@hidden>
;;;;
-;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2012, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -22,8 +22,7 @@
#:use-module (test-suite lib)
#:use-module (ice-9 futures)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (system base compile))
+ #:use-module (srfi srfi-26))
(define specific-exception-key (gensym))
@@ -98,11 +97,8 @@
(touch (future (1+ (touch (future (1+ (touch (future 0)))))))))
(pass-if-equal "loop" (map - (iota 1000))
- ;; Compile to avoid stack overflows.
- (compile '(let loop ((list (iota 1000)))
- (if (null? list)
- '()
- (cons (- (car list))
- (touch (future (loop (cdr list)))))))
- #:to 'value
- #:env (current-module))))
+ (let loop ((list (iota 1000)))
+ (if (null? list)
+ '()
+ (cons (- (car list))
+ (touch (future (loop (cdr list)))))))))
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index a969752..04f3539 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,6 +1,6 @@
;;;; gc.test --- test guile's garbage collection -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009,
-;;;; 2011, 2012 Free Software Foundation, Inc.
+;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -101,4 +101,4 @@
(guardian))
;; Prevent the optimizer from propagating f.
#:opts '(#:partial-eval? #f))))
- (equal? l '(foo)))))
+ (maybe-gc-flakiness (equal? l '(foo))))))
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 72aa0c4..3bd4004 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -134,7 +134,7 @@
(with-output-to-string
(lambda () (write table)))))))
- ;; 1 and 1 are equal? and eqv? and eq?
+ ;; 1 and 1 are equal? and eqv? (but not necessarily eq?)
(pass-if (equal? 'foo
(let ((table (make-hash-table)))
(hash-set! table 1 'foo)
@@ -143,12 +143,8 @@
(let ((table (make-hash-table)))
(hashv-set! table 1 'foo)
(hashv-ref table 1))))
- (pass-if (equal? 'foo
- (let ((table (make-hash-table)))
- (hashq-set! table 1 'foo)
- (hashq-ref table 1))))
- ;; 1/2 and 2/4 are equal? and eqv? but not eq?
+ ;; 1/2 and 2/4 are equal? and eqv? (but not necessarily eq?)
(pass-if (equal? 'foo
(let ((table (make-hash-table)))
(hash-set! table 1/2 'foo)
@@ -157,10 +153,6 @@
(let ((table (make-hash-table)))
(hashv-set! table 1/2 'foo)
(hashv-ref table 2/4))))
- (pass-if (equal? #f
- (let ((table (make-hash-table)))
- (hashq-set! table 1/2 'foo)
- (hashq-ref table 2/4))))
;; (list 1 2) is equal? but not eqv? or eq? to another (list 1 2)
(pass-if (equal? 'foo
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index ef08dd4..ad65b73 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -255,30 +255,30 @@
(with-test-prefix "character mapping"
(pass-if "char-locale-downcase"
- (and (eq? #\a (char-locale-downcase #\A))
- (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
+ (and (eqv? #\a (char-locale-downcase #\A))
+ (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
(pass-if "char-locale-upcase"
- (and (eq? #\Z (char-locale-upcase #\z))
- (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
+ (and (eqv? #\Z (char-locale-upcase #\z))
+ (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase"
- (and (eq? #\T (char-locale-titlecase #\t))
- (eq? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
+ (and (eqv? #\T (char-locale-titlecase #\t))
+ (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase Dž"
- (and (eq? #\762 (char-locale-titlecase #\763))
- (eq? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
+ (and (eqv? #\762 (char-locale-titlecase #\763))
+ (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
(pass-if "char-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
- (eq? #\Ä° (char-locale-upcase #\i %turkish-utf8-locale)))))
+ (eqv? #\Ä° (char-locale-upcase #\i %turkish-utf8-locale)))))
(pass-if "char-locale-downcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
- (eq? #\i (char-locale-downcase #\Ä° %turkish-utf8-locale))))))
+ (eqv? #\i (char-locale-downcase #\Ä° %turkish-utf8-locale))))))
(with-test-prefix "string mapping"
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 79e3c98..fb54061 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -345,7 +345,7 @@
(set-module-binder! m (lambda args (set! invoked? #t) #f))
(module-define! m 'something 2)
(and invoked?
- (eq? (module-ref m 'something) 2))))
+ (eqv? (module-ref m 'something) 2))))
(pass-if "honored (ref)"
(let ((m (make-module))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 66aa01a..7d30392 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -46,15 +46,35 @@
;; the usual 53.
;;
(define dbl-mant-dig
- (let more ((i 1)
- (d 2.0))
- (if (> i 1024)
- (error "Oops, cannot determine number of bits in mantissa of inexact"))
- (let* ((sum (+ 1.0 d))
- (diff (- sum d)))
- (if (= diff 1.0)
- (more (1+ i) (* 2.0 d))
- i))))
+ (do ((prec 0 (+ prec 1))
+ (eps 1.0 (/ eps 2.0)))
+ ((begin (when (> prec 1000000)
+ (error "Unable to determine dbl-mant-dig"))
+ (= 1.0 (+ 1.0 eps)))
+ prec)))
+
+(define dbl-epsilon
+ (expt 0.5 (- dbl-mant-dig 1)))
+
+(define dbl-epsilon-exact
+ (expt 1/2 (- dbl-mant-dig 1)))
+
+(define dbl-min-exp
+ (do ((x 1.0 (/ x 2.0))
+ (y (+ 1.0 dbl-epsilon) (/ y 2.0))
+ (e 2 (- e 1)))
+ ((begin (when (< e -100000000)
+ (error "Unable to determine dbl-min-exp"))
+ (= x y))
+ e)))
+
+(define dbl-max-exp
+ (do ((x 1.0 (* x 2.0))
+ (e 0 (+ e 1)))
+ ((begin (when (> e 100000000)
+ (error "Unable to determine dbl-max-exp"))
+ (inf? x))
+ e)))
;; like ash, but working on a flonum
(define (ash-flo x n)
@@ -201,71 +221,6 @@
(eqv? -2305843009213693953 (1- -2305843009213693952))))
;;;
-;;; ash
-;;;
-
-(with-test-prefix "ash"
-
- (pass-if "documented?"
- (documented? ash))
-
- (pass-if (eqv? 0 (ash 0 0)))
- (pass-if (eqv? 0 (ash 0 1)))
- (pass-if (eqv? 0 (ash 0 1000)))
- (pass-if (eqv? 0 (ash 0 -1)))
- (pass-if (eqv? 0 (ash 0 -1000)))
-
- (pass-if (eqv? 1 (ash 1 0)))
- (pass-if (eqv? 2 (ash 1 1)))
- (pass-if (eqv? 340282366920938463463374607431768211456 (ash 1 128)))
- (pass-if (eqv? 0 (ash 1 -1)))
- (pass-if (eqv? 0 (ash 1 -1000)))
-
- (pass-if (eqv? -1 (ash -1 0)))
- (pass-if (eqv? -2 (ash -1 1)))
- (pass-if (eqv? -340282366920938463463374607431768211456 (ash -1 128)))
- (pass-if (eqv? -1 (ash -1 -1)))
- (pass-if (eqv? -1 (ash -1 -1000)))
-
- (pass-if (eqv? -3 (ash -3 0)))
- (pass-if (eqv? -6 (ash -3 1)))
- (pass-if (eqv? -1020847100762815390390123822295304634368 (ash -3 128)))
- (pass-if (eqv? -2 (ash -3 -1)))
- (pass-if (eqv? -1 (ash -3 -1000)))
-
- (pass-if (eqv? -6 (ash -23 -2)))
-
- (pass-if (eqv? most-positive-fixnum (ash most-positive-fixnum 0)))
- (pass-if (eqv? (* 2 most-positive-fixnum) (ash most-positive-fixnum 1)))
- (pass-if (eqv? (* 4 most-positive-fixnum) (ash most-positive-fixnum 2)))
- (pass-if
- (eqv? (* most-positive-fixnum 340282366920938463463374607431768211456)
- (ash most-positive-fixnum 128)))
- (pass-if (eqv? (quotient most-positive-fixnum 2)
- (ash most-positive-fixnum -1)))
- (pass-if (eqv? 0 (ash most-positive-fixnum -1000)))
-
- (let ((mpf4 (quotient most-positive-fixnum 4)))
- (pass-if (eqv? (* 2 mpf4) (ash mpf4 1)))
- (pass-if (eqv? (* 4 mpf4) (ash mpf4 2)))
- (pass-if (eqv? (* 8 mpf4) (ash mpf4 3))))
-
- (pass-if (eqv? most-negative-fixnum (ash most-negative-fixnum 0)))
- (pass-if (eqv? (* 2 most-negative-fixnum) (ash most-negative-fixnum 1)))
- (pass-if (eqv? (* 4 most-negative-fixnum) (ash most-negative-fixnum 2)))
- (pass-if
- (eqv? (* most-negative-fixnum 340282366920938463463374607431768211456)
- (ash most-negative-fixnum 128)))
- (pass-if (eqv? (quotient-floor most-negative-fixnum 2)
- (ash most-negative-fixnum -1)))
- (pass-if (eqv? -1 (ash most-negative-fixnum -1000)))
-
- (let ((mnf4 (quotient-floor most-negative-fixnum 4)))
- (pass-if (eqv? (* 2 mnf4) (ash mnf4 1)))
- (pass-if (eqv? (* 4 mnf4) (ash mnf4 2)))
- (pass-if (eqv? (* 8 mnf4) (ash mnf4 3)))))
-
-;;;
;;; exact?
;;;
@@ -1428,21 +1383,39 @@
(lambda (n radix)
(string->number (number->string n radix) radix))))
+ (define (test num)
+ (pass-if-equal (list num 'pos)
+ num
+ (num->str->num num 10))
+ (pass-if-equal (list num 'neg)
+ (- num)
+ (num->str->num (- num) 10)))
+
(pass-if (documented? number->string))
(pass-if (string=? (number->string 0) "0"))
(pass-if (string=? (number->string 171) "171"))
(pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
(pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
- (pass-if (= (inf) (num->str->num (inf) 10)))
- (pass-if (= 1.3 (num->str->num 1.3 10)))
- ;; XXX - some results depend on whether Guile is compiled optimzed
- ;; or not. It is clearly undesirable to have number->string to be
- ;; influenced by this.
+ (test (inf))
+ (test 1.3)
+ (test (acos -1)) ; pi
+ (test (exp 1)) ; e
+ (test (/ 3.0))
+ (test (/ 7.0))
+ (test 2.2250738585072011e-308)
+ (test 2.2250738585072012e-308)
+
+ ;; Largest finite inexact
+ (test (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
+
+ (pass-if (string=? "0.0" (number->string 0.0)))
+ (pass-if (or (eqv? 0.0 -0.0)
+ (string=? "-0.0" (number->string -0.0))))
(pass-if (string=? (number->string 35.25 36) "z.9"))
- (pass-if (or (string=? (number->string 0.25 2) "0.01")
- (string=? (number->string 0.25 2) "0.010")))
+ (pass-if (string=? (number->string 0.25 2) "0.01"))
(pass-if (string=? (number->string 255.0625 16) "ff.1"))
(pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
@@ -1456,26 +1429,65 @@
(pass-if (string=? (number->string 35 36) "z"))
(pass-if (= (num->str->num 35 36) 35))
+ (pass-if (string=? (number->string 12342342340000.0) "1.234234234e13"))
+ (pass-if (string=? (number->string 1234234234000.0) "1234234234000.0"))
+ (pass-if (string=? (number->string 1240000.0) "1240000.0"))
+
+ (with-test-prefix "powers of radix"
+ (for-each
+ (lambda (radix)
+ (for-each (lambda (k)
+ (let ((val (exact->inexact (expt radix k)))
+ (str (if (<= -3 k 6)
+ (assoc-ref '((-3 . "0.001")
+ (-2 . "0.01")
+ (-1 . "0.1")
+ ( 0 . "1.0")
+ ( 1 . "10.0")
+ ( 2 . "100.0")
+ ( 3 . "1000.0")
+ ( 4 . "10000.0")
+ ( 5 . "100000.0")
+ ( 6 . "1000000.0"))
+ k)
+ (string-append "1.0e"
+ (number->string k radix)))))
+ (pass-if-equal (list radix k 'pos)
+ str
+ (number->string val radix))
+ (pass-if-equal (list radix k 'neg)
+ (string-append "-" str)
+ (number->string (- val) radix))))
+ (iota 41 -20)))
+ (iota 35 2)))
+
+ (with-test-prefix "multiples of smallest inexact"
+ (for-each (lambda (k)
+ (let ((val (* k (expt 2.0 (- dbl-min-exp dbl-mant-dig)))))
+ (test val)))
+ (iota 40 1)))
+
+ (with-test-prefix "one plus multiples of epsilon"
+ (for-each (lambda (k)
+ (let ((val (+ 1.0 (* k dbl-epsilon))))
+ (test val)))
+ (iota 40 1)))
+
+ (with-test-prefix "one minus multiples of 1/2 epsilon"
+ (for-each (lambda (k)
+ (let ((val (- 1.0 (* k 1/2 dbl-epsilon))))
+ (test val)))
+ (iota 40 1)))
+
;; Before Guile 2.0.1, even in the presence of a #e forced exactness
;; specifier, negative exponents were applied inexactly and then
;; later coerced to exact, yielding an incorrect fraction.
(pass-if (eqv? (string->number "#e1e-10") 1/10000000000))
- ;; Numeric conversion from decimal is not precise, in its current
- ;; implementation, so 11.333... and 1.324... can't be expected to
- ;; reliably come out to precise values. These tests did actually work
- ;; for a while, but something in gcc changed, affecting the conversion
- ;; code.
- ;;
- ;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
- ;; "B.4")
- ;; (string=? (number->string 11.33333333333333333 12)
- ;; "B.400000000000009")))
- ;; (pass-if (or (string=? (number->string 1.324e44 16)
- ;; "5.EFE0A14FAFEe24")
- ;; (string=? (number->string 1.324e44 16)
- ;; "5.EFE0A14FAFDF8e24")))
- ))
+ (pass-if (string=? (number->string 11.33333333333333333 12)
+ "b.4"))
+ (pass-if (string=? (number->string 1.324e44 16)
+ "5.efe0a14fafdf8e24"))))
;;;
;;; string->number
@@ -1493,7 +1505,9 @@
"#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
"#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
"#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
- "#i#i1" "address@hidden"))
+ "#i#i1" "address@hidden" "3/0" "0/0" "4+3/0i" "4/0-3i" "2+0/0i"
+ "nan.0" "inf.0" "#e+nan.0" "#e+inf.0" "#e-inf.0"
+ "address@hidden" "address@hidden"))
#t)
(pass-if "valid number strings"
@@ -1532,6 +1546,14 @@
("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
("#i6/8" 0.75) ("#i1/1" 1.0)
+ ;; Infinities and NaNs:
+ ("+inf.0" ,(inf)) ("-inf.0" ,(- (inf)))
+ ("+Inf.0" ,(inf)) ("-Inf.0" ,(- (inf)))
+ ("+InF.0" ,(inf)) ("-InF.0" ,(- (inf)))
+ ("+INF.0" ,(inf)) ("-INF.0" ,(- (inf)))
+ ("#i+InF.0" ,(inf)) ("#i-InF.0" ,(- (inf)))
+ ("+nan.0" ,(nan)) ("-nan.0" ,(nan))
+ ("#i+nan.0" ,(nan)) ("#i-nan.0" ,(nan))
;; Decimal numbers:
;; * <uinteger 10> <suffix>
("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
@@ -3913,21 +3935,17 @@
;;;
(with-test-prefix "exact->inexact"
-
+
+ ;; Test "(exact->inexact n)", expect "want".
+ (define (test name n want)
+ (with-test-prefix name
+ (pass-if-equal "pos" want (exact->inexact n))
+ (pass-if-equal "neg" (- want) (exact->inexact (- n)))))
+
;; Test "(exact->inexact n)", expect "want".
;; "i" is a index, for diagnostic purposes.
(define (try-i i n want)
- (with-test-prefix (list i n want)
- (with-test-prefix "pos"
- (let ((got (exact->inexact n)))
- (pass-if "inexact?" (inexact? got))
- (pass-if (list "=" got) (= want got))))
- (set! n (- n))
- (set! want (- want))
- (with-test-prefix "neg"
- (let ((got (exact->inexact n)))
- (pass-if "inexact?" (inexact? got))
- (pass-if (list "=" got) (= want got))))))
+ (test (list i n want) n want))
(with-test-prefix "2^i, no round"
(do ((i 0 (1+ i))
@@ -4000,7 +4018,155 @@
;; convert the num and den to doubles, resulting in infs.
(pass-if "frac big/big, exceeding double"
(let ((big (ash 1 4096)))
- (= 1.0 (exact->inexact (/ (1+ big) big))))))
+ (= 1.0 (exact->inexact (/ (1+ big) big)))))
+
+ (test "round up to odd"
+ ;; =====================================================
+ ;; 11111111111111111111111111111111111111111111111111000101 ->
+ ;; 11111111111111111111111111111111111111111111111111001000
+ (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b000101)
+ (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
+
+ (test "round down to odd"
+ ;; =====================================================
+ ;; 11111111111111111111111111111111111111111111111111001011 ->
+ ;; 11111111111111111111111111111111111111111111111111001000
+ (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b001011)
+ (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
+
+ (test "round tie up to even"
+ ;; =====================================================
+ ;; 11111111111111111111111111111111111111111111111111011100 ->
+ ;; 11111111111111111111111111111111111111111111111111100000
+ (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b011100)
+ (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b100000))
+
+ (test "round tie down to even"
+ ;; =====================================================
+ ;; 11111111111111111111111111111111111111111111111111000100 ->
+ ;; 11111111111111111111111111111111111111111111111111000000
+ (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b000100)
+ (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b000000))
+
+ (test "round tie up to next power of two"
+ ;; =====================================================
+ ;; 11111111111111111111111111111111111111111111111111111100 ->
+ ;; 100000000000000000000000000000000000000000000000000000000
+ (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b111100)
+ (expt 2.0 (+ dbl-mant-dig 3)))
+
+ (test "miniscule value rounds to zero of appropriate sign"
+ (expt 17 (- dbl-min-exp dbl-mant-dig))
+ 0.0)
+
+ (test "smallest inexact"
+ (expt 2 (- dbl-min-exp dbl-mant-dig))
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
+
+ (test "1/2 smallest inexact rounds down to zero"
+ (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ 0.0)
+
+ (test "just over 1/2 smallest inexact rounds up"
+ (+ (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ (expt 7 (- dbl-min-exp dbl-mant-dig)))
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
+
+ (test "3/2 smallest inexact rounds up to twice smallest inexact"
+ (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
+
+ (test "just under 3/2 smallest inexact rounds down"
+ (- (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ (expt 11 (- dbl-min-exp dbl-mant-dig)))
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
+
+ (test "5/2 smallest inexact rounds down to twice smallest inexact"
+ (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
+
+ (test "just over 5/2 smallest inexact rounds up"
+ (+ (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
+ (expt 13 (- dbl-min-exp dbl-mant-dig)))
+ (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
+
+ (test "one plus dbl-epsilon"
+ (+ 1 dbl-epsilon-exact)
+ (+ 1.0 dbl-epsilon))
+
+ (test "one plus 1/2 dbl-epsilon rounds down to 1.0"
+ (+ 1 (* 1/2 dbl-epsilon-exact))
+ 1.0)
+
+ (test "just over one plus 1/2 dbl-epsilon rounds up"
+ (+ 1
+ (* 1/2 dbl-epsilon-exact)
+ (expt 13 (- dbl-min-exp dbl-mant-dig)))
+ (+ 1.0 dbl-epsilon))
+
+ (test "one plus 3/2 dbl-epsilon rounds up"
+ (+ 1 (* 3/2 dbl-epsilon-exact))
+ (+ 1.0 (* 2.0 dbl-epsilon)))
+
+ (test "just under one plus 3/2 dbl-epsilon rounds down"
+ (+ 1
+ (* 3/2 dbl-epsilon-exact)
+ (- (expt 17 (- dbl-min-exp dbl-mant-dig))))
+ (+ 1.0 dbl-epsilon))
+
+ (test "one plus 5/2 dbl-epsilon rounds down"
+ (+ 1 (* 5/2 dbl-epsilon-exact))
+ (+ 1.0 (* 2.0 dbl-epsilon)))
+
+ (test "just over one plus 5/2 dbl-epsilon rounds up"
+ (+ 1
+ (* 5/2 dbl-epsilon-exact)
+ (expt 13 (- dbl-min-exp dbl-mant-dig)))
+ (+ 1.0 (* 3.0 dbl-epsilon)))
+
+ (test "largest finite inexact"
+ (* (- (expt 2 dbl-mant-dig) 1)
+ (expt 2 (- dbl-max-exp dbl-mant-dig)))
+ (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
+
+ (test "largest finite inexact plus 1/2 epsilon rounds up to infinity"
+ (* (+ (expt 2 dbl-mant-dig) -1 1/2)
+ (expt 2 (- dbl-max-exp dbl-mant-dig)))
+ (inf))
+
+ (test "largest finite inexact plus just under 1/2 epsilon rounds down"
+ (* (+ (expt 2 dbl-mant-dig) -1 1/2
+ (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
+ (expt 2 (- dbl-max-exp dbl-mant-dig)))
+ (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
+
+ (test "1/2 largest finite inexact"
+ (* (- (expt 2 dbl-mant-dig) 1)
+ (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
+ (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
+
+ (test "1/2 largest finite inexact plus 1/2 epsilon rounds up to next power
of two"
+ (* (+ (expt 2 dbl-mant-dig) -1 1/2)
+ (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
+ (expt 2.0 (- dbl-max-exp 1)))
+
+ (test "1/2 largest finite inexact plus just over 1/2 epsilon rounds up to
next power of two"
+ (* (+ (expt 2 dbl-mant-dig) -1 1/2
+ (expt 13 (- dbl-min-exp dbl-mant-dig)))
+ (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
+ (expt 2.0 (- dbl-max-exp 1)))
+
+ (test "1/2 largest finite inexact plus just under 1/2 epsilon rounds down"
+ (* (+ (expt 2 dbl-mant-dig) -1 1/2
+ (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
+ (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
+ (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
+
+ )
;;;
;;; expt
@@ -4044,6 +4210,9 @@
(pass-if (eqv? -0.125 (expt -2 -3.0)))
(pass-if (eqv? -0.125 (expt -2.0 -3.0)))
(pass-if (eqv? 0.25 (expt 2.0 -2.0)))
+ (pass-if (eqv? 32/243 (expt 2/3 5)))
+ (pass-if (eqv? 243/32 (expt 2/3 -5)))
+ (pass-if (eqv? 32 (expt 1/2 -5)))
(pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0)))
(pass-if (eqv-loosely? +i (expt -1 0.5)))
(pass-if (eqv-loosely? +i (expt -1 1/2)))
@@ -4272,6 +4441,13 @@
;;;
(with-test-prefix "inexact->exact"
+
+ ;; Test "(inexact->exact f)", expect "want".
+ (define (test name f want)
+ (with-test-prefix name
+ (pass-if-equal "pos" want (inexact->exact f))
+ (pass-if-equal "neg" (- want) (inexact->exact (- f)))))
+
(pass-if (documented? inexact->exact))
(pass-if-exception "+inf" exception:out-of-range
@@ -4282,13 +4458,55 @@
(pass-if-exception "nan" exception:out-of-range
(inexact->exact +nan.0))
-
- (with-test-prefix "2.0**i to exact and back"
+
+ (test "0.0" 0.0 0)
+ (test "small even integer" 72.0 72)
+ (test "small odd integer" 73.0 73)
+
+ (test "largest inexact odd integer"
+ (- (expt 2.0 dbl-mant-dig) 1)
+ (- (expt 2 dbl-mant-dig) 1))
+
+ (test "largest inexact odd integer - 1"
+ (- (expt 2.0 dbl-mant-dig) 2)
+ (- (expt 2 dbl-mant-dig) 2))
+
+ (test "largest inexact odd integer + 3"
+ (+ (expt 2.0 dbl-mant-dig) 2)
+ (+ (expt 2 dbl-mant-dig) 2))
+
+ (test "largest inexact odd integer * 2^48"
+ (* (expt 2.0 48) (- (expt 2.0 dbl-mant-dig) 1))
+ (* (expt 2 48) (- (expt 2 dbl-mant-dig) 1)))
+
+ (test "largest inexact odd integer / 2^48"
+ (* (expt 0.5 48) (- (expt 2.0 dbl-mant-dig) 1))
+ (* (expt 1/2 48) (- (expt 2 dbl-mant-dig) 1)))
+
+ (test "largest finite inexact"
+ (* (- (expt 2.0 dbl-mant-dig) 1)
+ (expt 2.0 (- dbl-max-exp dbl-mant-dig)))
+ (* (- (expt 2 dbl-mant-dig) 1)
+ (expt 2 (- dbl-max-exp dbl-mant-dig))))
+
+ (test "smallest inexact"
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig))
+ (expt 2 (- dbl-min-exp dbl-mant-dig)))
+
+ (test "smallest inexact * 2"
+ (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
+ (* 2 (expt 2 (- dbl-min-exp dbl-mant-dig))))
+
+ (test "smallest inexact * 3"
+ (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
+ (* 3 (expt 2 (- dbl-min-exp dbl-mant-dig))))
+
+ (with-test-prefix "2.0**i to exact"
(do ((i 0 (1+ i))
- (n 1.0 (* 2.0 n)))
+ (n 1 (* 2 n))
+ (f 1.0 (* 2.0 f)))
((> i 100))
- (pass-if (list i n)
- (= n (inexact->exact (exact->inexact n)))))))
+ (test (list i n) f n))))
;;;
;;; integer-expt
@@ -4317,6 +4535,9 @@
(pass-if (eqv? -1/8 (integer-expt -2 -3)))
(pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
(pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
+ (pass-if (eqv? 32/243 (integer-expt 2/3 5)))
+ (pass-if (eqv? 243/32 (integer-expt 2/3 -5)))
+ (pass-if (eqv? 32 (integer-expt 1/2 -5)))
(pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
@@ -4619,7 +4840,80 @@
(pass-if-exception "two args" exception:wrong-num-args
(sqrt 123 456))
- (pass-if (eqv? 0.0 (sqrt 0)))
+ (pass-if (eqv? 0 (sqrt 0)))
+ (pass-if (eqv? 1 (sqrt 1)))
+ (pass-if (eqv? 2 (sqrt 4)))
+ (pass-if (eqv? 3 (sqrt 9)))
+ (pass-if (eqv? 4 (sqrt 16)))
+ (pass-if (eqv? fixnum-max (sqrt (expt fixnum-max 2))))
+ (pass-if (eqv? (+ 1 fixnum-max) (sqrt (expt (+ 1 fixnum-max) 2))))
+ (pass-if (eqv? (expt 10 400) (sqrt (expt 10 800))))
+ (pass-if (eqv? (/ (expt 10 1000)
+ (expt 13 1000))
+ (sqrt (/ (expt 10 2000)
+ (expt 13 2000)))))
+
+ (with-test-prefix "exact sqrt"
+
+ (define (test root)
+ (pass-if (list root 'exact)
+ (eqv? root (sqrt (expt root 2))))
+ (pass-if (list root '*2)
+ (let ((r (sqrt (* 2 (expt root 2)))))
+ (and (inexact? r)
+ (eqv-loosely? (* (sqrt 2) root) r))))
+ (pass-if (list root '-1)
+ (let ((r (sqrt (- (expt root 2) 1))))
+ (and (inexact? r)
+ (eqv-loosely? root r))))
+ (pass-if (list root '+1)
+ (let ((r (sqrt (+ (expt root 2) 1))))
+ (and (inexact? r)
+ (eqv-loosely? root r))))
+ (pass-if (list root 'negative)
+ (eqv-loosely? (* +i root) (sqrt (- (expt root 2))))))
+
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ 2 dbl-mant-dig)))))
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ 1 dbl-mant-dig)))))
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ 0 dbl-mant-dig)))))
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ -1 dbl-mant-dig)))))
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ -2 dbl-mant-dig)))))
+
+ ;; largest finite inexact
+ (test (* (- (expt 2 dbl-mant-dig) 1)
+ (expt 2 (- dbl-max-exp dbl-mant-dig)))))
+
+ (pass-if-equal "smallest inexact"
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig))
+ (sqrt (/ (+ -1 (expt 2 (* 2 (- dbl-mant-dig dbl-min-exp)))))))
+
+ (with-test-prefix "extreme ratios"
+ (define-syntax-rule (test want x)
+ (pass-if 'x
+ (let ((got (sqrt x)))
+ (and (inexact? got)
+ (test-eqv? 1.0 (/ want got))))))
+ (test 1.511139943175573e176 (/ (expt 3 2001) (expt 2 2001)))
+ (test 2.1370746022826034e176 (/ (expt 3 2001) (expt 2 2000)))
+ (test 8.724570529756128e175 (/ (expt 3 2000) (expt 2 2001)))
+ (test 6.6175207962444435e-177 (/ (expt 2 2001) (expt 3 2001)))
+ (test 1.1461882239239027e-176 (/ (expt 2 2001) (expt 3 2000)))
+ (test 4.679293829667447e-177 (/ (expt 2 2000) (expt 3 2001))))
+
+ (pass-if (eqv? (/ (expt 2 1000)
+ (expt 3 1000))
+ (sqrt (/ (expt 2 2000)
+ (expt 3 2000)))))
+
+ (pass-if (eqv? (/ (expt 3 1000)
+ (expt 2 1000))
+ (sqrt (/ (expt 3 2000)
+ (expt 2 2000)))))
+
+ (pass-if (eqv? +4i (sqrt -16)))
+ (pass-if (eqv-loosely? +1.0e150i (sqrt #e-1e300)))
+ (pass-if (eqv-loosely? +0.7071i (sqrt -1/2)))
+
(pass-if (eqv? 0.0 (sqrt 0.0)))
(pass-if (eqv? 1.0 (sqrt 1.0)))
(pass-if (eqv-loosely? 2.0 (sqrt 4.0)))
@@ -4898,3 +5192,52 @@
round-quotient
round-remainder
valid-round-answer?)))
+
+;;;
+;;; ash
+;;; round-ash
+;;;
+
+(let ()
+ (define (test-ash-variant name ash-variant round-variant)
+ (with-test-prefix name
+ (define (test n count)
+ (pass-if (list n count)
+ (eqv? (ash-variant n count)
+ (round-variant (* n (expt 2 count))))))
+
+ (pass-if "documented?"
+ (documented? ash-variant))
+
+ (for-each (lambda (n)
+ (for-each (lambda (count) (test n count))
+ '(-1000 -3 -2 -1 0 1 2 3 1000)))
+ (list 0 1 3 23 -1 -3 -23
+ fixnum-max
+ (1+ fixnum-max)
+ (1- fixnum-max)
+ (* fixnum-max 4)
+ (quotient fixnum-max 4)
+ fixnum-min
+ (1+ fixnum-min)
+ (1- fixnum-min)
+ (* fixnum-min 4)
+ (quotient fixnum-min 4)))
+
+ (do ((count -2 (1- count))
+ (vals '(1 3 5 7 9 11)
+ (map (lambda (n) (* 2 n)) vals)))
+ ((> (car vals) (* 2 fixnum-max)) 'done)
+ (for-each (lambda (n)
+ (test n count)
+ (test (- n) count))
+ vals))
+
+ ;; Test rounding
+ (for-each (lambda (base)
+ (for-each (lambda (offset) (test (+ base offset) -3))
+ '(#b11001 #b11100 #b11101 #b10001 #b10100
#b10101)))
+ (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))))
+
+ (test-ash-variant 'ash ash floor)
+ (test-ash-variant 'round-ash round-ash round))
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index 396fdec..0be1a54 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -221,7 +221,20 @@
(equal? (transmogrify quote)
10)))
+(with-test-prefix/c&e "case-lambda"
+ (pass-if-exception "no clauses, no args" exception:wrong-num-args
+ ((case-lambda)))
+
+ (pass-if-exception "no clauses, args" exception:wrong-num-args
+ ((case-lambda) 1)))
+
(with-test-prefix/c&e "case-lambda*"
+ (pass-if-exception "no clauses, no args" exception:wrong-num-args
+ ((case-lambda*)))
+
+ (pass-if-exception "no clauses, args" exception:wrong-num-args
+ ((case-lambda*) 1))
+
(pass-if "unambiguous"
((case-lambda*
((a b) #t)
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 613d269..3729930 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -482,7 +482,7 @@
(display str))))
#f) ; so the test really fails here
(lambda (key subr message errno port chr)
- (and (eq? chr #\Ä)
+ (and (eqv? chr #\Ä)
(string? (strerror errno)))))))
(pass-if "wrong encoding, substitute"
@@ -548,12 +548,12 @@
((_ port (proc -> error))
(if (eq? 'substitute
(port-conversion-strategy port))
- (eq? (proc port) #\?)
+ (eqv? (proc port) #\?)
(decoding-error? port (proc port))))
((_ port (proc -> eof))
(eof-object? (proc port)))
((_ port (proc -> char))
- (eq? (proc port) char))))
+ (eqv? (proc port) char))))
(make-checks
(syntax-rules ()
((_ port check ...)
@@ -1136,7 +1136,7 @@
(display "This is GNU Guile.\nWelcome." p)))
(call-with-input-file (test-file)
(lambda (p)
- (and (eq? #\T (read-char p))
+ (and (eqv? #\T (read-char p))
(let ((line (port-line p))
(col (port-column p)))
(and (= line 0) (= col 1)
diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test
index 6d725dc..5e4cb27 100644
--- a/test-suite/tests/srfi-35.test
+++ b/test-suite/tests/srfi-35.test
@@ -65,17 +65,17 @@
(pass-if "condition-ref"
(let* ((ct (make-condition-type 'chbouib &condition '(a b)))
(c (make-condition ct 'b 1 'a 0)))
- (and (eq? (condition-ref c 'a) 0)
- (eq? (condition-ref c 'b) 1))))
+ (and (eqv? (condition-ref c 'a) 0)
+ (eqv? (condition-ref c 'b) 1))))
(pass-if "condition-ref with inheritance"
(let* ((top (make-condition-type 'foo &condition '(a b)))
(ct (make-condition-type 'bar top '(c d)))
(c (make-condition ct 'b 1 'a 0 'd 3 'c 2)))
- (and (eq? (condition-ref c 'a) 0)
- (eq? (condition-ref c 'b) 1)
- (eq? (condition-ref c 'c) 2)
- (eq? (condition-ref c 'd) 3))))
+ (and (eqv? (condition-ref c 'a) 0)
+ (eqv? (condition-ref c 'b) 1)
+ (eqv? (condition-ref c 'c) 2)
+ (eqv? (condition-ref c 'd) 3))))
(pass-if "extract-condition"
(let* ((ct (make-condition-type 'chbouib &condition '(a b)))
@@ -149,8 +149,8 @@
(let ((c (make-condition &chbouib 'one 1 'two 2)))
(and (condition? c)
(chbouib? c)
- (eq? (chbouib-one c) 1)
- (eq? (chbouib-two c) 2))))
+ (eqv? (chbouib-one c) 1)
+ (eqv? (chbouib-two c) 2))))
m)))
(pass-if "condition"
diff --git a/test-suite/tests/srfi-37.test b/test-suite/tests/srfi-37.test
index 1f739c5..5a39750 100644
--- a/test-suite/tests/srfi-37.test
+++ b/test-suite/tests/srfi-37.test
@@ -1,6 +1,6 @@
;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*-
;;;;
-;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2007, 2008, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -105,4 +105,26 @@
(lambda (opt name arg k) #f)
'()))))
+ (pass-if-equal "short option with optional argument omitted" 'good
+ ;; This would trigger an infinite loop in Guile up to 2.0.7.
+ ;; See <http://bugs.gnu.org/13176>.
+ (args-fold '("-I")
+ (list (option '(#\I) #f #t
+ (lambda (opt name arg value)
+ (and (eqv? name #\I) (not arg)
+ 'good))))
+ (lambda _ (error "unrecognized"))
+ (const #f)
+ #f))
+
+ (pass-if-equal "short option with optional argument provided"
+ "the-argument"
+ (args-fold '("-I" "the-argument")
+ (list (option '(#\I) #f #t
+ (lambda (opt name arg result)
+ (and (eqv? name #\I) arg))))
+ (lambda _ (error "unrecognized"))
+ (const #f)
+ #f))
+
)
diff --git a/test-suite/tests/srfi-41.test b/test-suite/tests/srfi-41.test
new file mode 100644
index 0000000..f2e0864
--- /dev/null
+++ b/test-suite/tests/srfi-41.test
@@ -0,0 +1,680 @@
+;;; srfi-41.test -- test suite for SRFI 41
+
+;; Copyright (c) 2007 Philip L. Bewig
+;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.
+
+;; 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.
+
+(define-module (test-srfi-41)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-31)
+ #:use-module (srfi srfi-41)
+ #:use-module (test-suite lib))
+
+(define-stream (qsort lt? strm)
+ (if (stream-null? strm) stream-null
+ (let ((x (stream-car strm))
+ (xs (stream-cdr strm)))
+ (stream-append
+ (qsort lt? (stream-filter (cut lt? <> x) xs))
+ (stream x)
+ (qsort lt? (stream-filter (cut (negate lt?) <> x) xs))))))
+
+(define-stream (isort lt? strm)
+ (define-stream (insert strm x)
+ (stream-match strm
+ (() (stream x))
+ ((y . ys) (if (lt? y x)
+ (stream-cons y (insert ys x))
+ (stream-cons x strm)))))
+ (stream-fold insert stream-null strm))
+
+(define-stream (stream-merge lt? . strms)
+ (stream-let loop ((strms strms))
+ (cond ((null? strms) stream-null)
+ ((null? (cdr strms)) (car strms))
+ (else (stream-let merge ((xx (car strms))
+ (yy (loop (cdr strms))))
+ (stream-match xx
+ (() yy)
+ ((x . xs)
+ (stream-match yy
+ (() xx)
+ ((y . ys)
+ (if (lt? y x)
+ (stream-cons y (merge xx ys))
+ (stream-cons x (merge xs yy))))))))))))
+
+(define-stream (msort lt? strm)
+ (let* ((n (quotient (stream-length strm) 2))
+ (ts (stream-take n strm))
+ (ds (stream-drop n strm)))
+ (if (zero? n) strm
+ (stream-merge lt? (msort < ts) (msort < ds)))))
+
+(define-stream (stream-unique eql? strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (stream-car strm)
+ (stream-unique eql?
+ (stream-drop-while (cut eql? (stream-car strm) <>) strm)))))
+
+(define nats
+ (stream-cons 1
+ (stream-map 1+ nats)))
+
+(define hamming
+ (stream-unique =
+ (stream-cons 1
+ (stream-merge <
+ (stream-map (cut * 2 <>) hamming)
+ (stream-merge <
+ (stream-map (cut * 3 <>) hamming)
+ (stream-map (cut * 5 <>) hamming))))))
+
+(define primes (let ()
+ (define-stream (next base mult strm)
+ (let ((first (stream-car strm))
+ (rest (stream-cdr strm)))
+ (cond ((< first mult)
+ (stream-cons first
+ (next base mult rest)))
+ ((< mult first)
+ (next base (+ base mult) strm))
+ (else (next base
+ (+ base mult) rest)))))
+ (define-stream (sift base strm)
+ (next base (+ base base) strm))
+ (stream-let sieve ((strm (stream-from 2)))
+ (let ((first (stream-car strm))
+ (rest (stream-cdr strm)))
+ (stream-cons first (sieve (sift first rest)))))))
+
+(define strm123 (stream 1 2 3))
+
+(define (stream-equal? s1 s2)
+ (cond ((and (stream-null? s1) (stream-null? s2)) #t)
+ ((or (stream-null? s1) (stream-null? s2)) #f)
+ ((equal? (stream-car s1) (stream-car s2))
+ (stream-equal? (stream-cdr s1) (stream-cdr s2)))
+ (else #f)))
+
+(with-test-prefix "stream-null"
+ (pass-if "is a stream" (stream? stream-null))
+ (pass-if "is a null stream" (stream-null? stream-null))
+ (pass-if "is not a stream pair" (not (stream-pair? stream-null))))
+
+(with-test-prefix "stream-cons"
+ (pass-if "is a stream" (stream? (stream-cons 1 stream-null)))
+ (pass-if "is not a null stream" (not (stream-null? (stream-cons 1
stream-null))))
+ (pass-if "is a stream pair" (stream-pair? (stream-cons 1 stream-null))))
+
+(with-test-prefix "stream?"
+ (pass-if "is true for null stream" (stream? stream-null))
+ (pass-if "is true for stream pair" (stream? (stream-cons 1 stream-null)))
+ (pass-if "is false for non-stream" (not (stream? "four"))))
+
+(with-test-prefix "stream-null?"
+ (pass-if "is true for null stream" (stream-null? stream-null))
+ (pass-if "is false for stream pair" (not (stream-null? (stream-cons 1
stream-null))))
+ (pass-if "is false for non-stream" (not (stream-null? "four"))))
+
+(with-test-prefix "stream-pair?"
+ (pass-if "is false for null stream" (not (stream-pair? stream-null)))
+ (pass-if "is true for stream pair" (stream-pair? (stream-cons 1
stream-null)))
+ (pass-if "is false for non-stream" (not (stream-pair? "four"))))
+
+(with-test-prefix "stream-car"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream")
+ (stream-car "four"))
+ (pass-if-exception "throws for null stream"
+ '(wrong-type-arg . "null stream")
+ (stream-car stream-null))
+ (pass-if "returns first of stream" (eqv? (stream-car strm123) 1)))
+
+(with-test-prefix "stream-cdr"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream")
+ (stream-cdr "four"))
+ (pass-if-exception "throws for null stream"
+ '(wrong-type-arg . "null stream")
+ (stream-cdr stream-null))
+ (pass-if "returns rest of stream" (eqv? (stream-car (stream-cdr strm123))
2)))
+
+(with-test-prefix "stream-lambda"
+ (pass-if "returns correct result"
+ (stream-equal?
+ ((rec double (stream-lambda (strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (double (stream-cdr strm))))))
+ strm123)
+ (stream 2 4 6))))
+
+(with-test-prefix "define-stream"
+ (pass-if "returns correct result"
+ (stream-equal?
+ (let ()
+ (define-stream (double strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (double (stream-cdr strm)))))
+ (double strm123))
+ (stream 2 4 6))))
+
+(with-test-prefix "list->stream"
+ (pass-if-exception "throws for non-list"
+ '(wrong-type-arg . "non-list argument")
+ (list->stream "four"))
+ (pass-if "returns empty stream for empty list"
+ (stream-null? (list->stream '())))
+ (pass-if "returns stream with same content as given list"
+ (stream-equal? (list->stream '(1 2 3)) strm123)))
+
+(with-test-prefix "port->stream"
+ (pass-if-exception "throws for non-input-port"
+ '(wrong-type-arg . "non-input-port argument")
+ (port->stream "four"))
+ (call-with-input-string "Hello, world!"
+ (lambda (p)
+ (pass-if-equal "reads input string correctly"
+ "Hello, world!"
+ (list->string (stream->list (port->stream p)))))))
+
+(with-test-prefix "stream"
+ (pass-if-equal "with empty stream"
+ '()
+ (stream->list (stream)))
+ (pass-if-equal "with one-element stream"
+ '(1)
+ (stream->list (stream 1)))
+ (pass-if-equal "with three-element stream"
+ '(1 2 3)
+ (stream->list strm123)))
+
+(with-test-prefix "stream->list"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream->list '()))
+ (pass-if-exception "throws for non-integer count"
+ '(wrong-type-arg . "non-integer count")
+ (stream->list "four" strm123))
+ (pass-if-exception "throws for negative count"
+ '(wrong-type-arg . "negative count")
+ (stream->list -1 strm123))
+ (pass-if-equal "returns empty list for empty stream"
+ '()
+ (stream->list (stream)))
+ (pass-if-equal "without count"
+ '(1 2 3)
+ (stream->list strm123))
+ (pass-if-equal "with count longer than stream"
+ '(1 2 3)
+ (stream->list 5 strm123))
+ (pass-if-equal "with count shorter than stream"
+ '(1 2 3)
+ (stream->list 3 (stream-from 1))))
+
+(with-test-prefix "stream-append"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-append "four"))
+ (pass-if "with one stream"
+ (stream-equal? (stream-append strm123) strm123))
+ (pass-if "with two streams"
+ (stream-equal? (stream-append strm123 strm123) (stream 1 2 3 1 2
3)))
+ (pass-if "with three streams"
+ (stream-equal? (stream-append strm123 strm123 strm123)
+ (stream 1 2 3 1 2 3 1 2 3)))
+ (pass-if "append with null is noop"
+ (stream-equal? (stream-append strm123 stream-null) strm123))
+ (pass-if "prepend with null is noop"
+ (stream-equal? (stream-append stream-null strm123) strm123)))
+
+(with-test-prefix "stream-concat"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-concat "four"))
+ (pass-if "with one stream"
+ (stream-equal? (stream-concat (stream strm123)) strm123))
+ (pass-if "with two streams"
+ (stream-equal? (stream-concat (stream strm123 strm123))
+ (stream 1 2 3 1 2 3))))
+
+(with-test-prefix "stream-constant"
+ (pass-if "circular stream of 1 has >100 elements"
+ (eqv? (stream-ref (stream-constant 1) 100) 1))
+ (pass-if "circular stream of 2 has >100 elements"
+ (eqv? (stream-ref (stream-constant 1 2) 100) 1))
+ (pass-if "circular stream of 3 repeats after 3"
+ (eqv? (stream-ref (stream-constant 1 2 3) 3) 1))
+ (pass-if "circular stream of 1 repeats at 1"
+ (stream-equal? (stream-take 8 (stream-constant 1))
+ (stream 1 1 1 1 1 1 1 1)))
+ (pass-if "circular stream of 2 repeats at 2"
+ (stream-equal? (stream-take 8 (stream-constant 1 2))
+ (stream 1 2 1 2 1 2 1 2)))
+ (pass-if "circular stream of 3 repeats at 3"
+ (stream-equal? (stream-take 8 (stream-constant 1 2 3))
+ (stream 1 2 3 1 2 3 1 2))))
+
+(with-test-prefix "stream-drop"
+ (pass-if-exception "throws for non-integer count"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-drop "four" strm123))
+ (pass-if-exception "throws for negative count"
+ '(wrong-type-arg . "negative argument")
+ (stream-drop -1 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-drop 2 "four"))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-drop 0 stream-null)))
+ (pass-if "returns same stream when count is zero"
+ (eq? (stream-drop 0 strm123) strm123))
+ (pass-if "returns dropped-by-one stream when count is one"
+ (stream-equal? (stream-drop 1 strm123) (stream 2 3)))
+ (pass-if "returns null if count is longer than stream"
+ (stream-null? (stream-drop 5 strm123))))
+
+(with-test-prefix "stream-drop-while"
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-drop-while "four" strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-drop-while odd? "four"))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-drop-while odd? stream-null)))
+ (pass-if "returns dropped stream when first element matches"
+ (stream-equal? (stream-drop-while odd? strm123) (stream 2 3)))
+ (pass-if "returns whole stream when first element doesn't match"
+ (stream-equal? (stream-drop-while even? strm123) strm123))
+ (pass-if "returns empty stream if all elements match"
+ (stream-null? (stream-drop-while positive? strm123)))
+ (pass-if "return whole stream if no elements match"
+ (stream-equal? (stream-drop-while negative? strm123) strm123)))
+
+(with-test-prefix "stream-filter"
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-filter "four" strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-filter odd? '()))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-filter odd? (stream))))
+ (pass-if "filters out even numbers"
+ (stream-equal? (stream-filter odd? strm123) (stream 1 3)))
+ (pass-if "filters out odd numbers"
+ (stream-equal? (stream-filter even? strm123) (stream 2)))
+ (pass-if "returns all elements if predicate matches all"
+ (stream-equal? (stream-filter positive? strm123) strm123))
+ (pass-if "returns null if predicate matches none"
+ (stream-null? (stream-filter negative? strm123)))
+ (pass-if "all elements of an odd-filtered stream are odd"
+ (every odd? (stream->list 10 (stream-filter odd? (stream-from 0)))))
+ (pass-if "no elements of an odd-filtered stream are even"
+ (not (any even? (stream->list 10 (stream-filter odd? (stream-from
0)))))))
+
+(with-test-prefix "stream-fold"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-fold "four" 0 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-fold + 0 '()))
+ (pass-if "returns the correct result" (eqv? (stream-fold + 0 strm123) 6)))
+
+(with-test-prefix "stream-for-each"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-for-each "four" strm123))
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-for-each display))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-for-each display "four"))
+ (pass-if "function is called for stream elements"
+ (eqv? (let ((sum 0))
+ (stream-for-each (lambda (x)
+ (set! sum (+ sum x)))
+ strm123)
+ sum)
+ 6)))
+
+(with-test-prefix "stream-from"
+ (pass-if-exception "throws for non-numeric start"
+ '(wrong-type-arg . "non-numeric starting number")
+ (stream-from "four"))
+ (pass-if-exception "throws for non-numeric step"
+ '(wrong-type-arg . "non-numeric step size")
+ (stream-from 1 "four"))
+ (pass-if "works for default values"
+ (eqv? (stream-ref (stream-from 0) 100) 100))
+ (pass-if "works for non-default start and step"
+ (eqv? (stream-ref (stream-from 1 2) 100) 201))
+ (pass-if "works for negative step"
+ (eqv? (stream-ref (stream-from 0 -1) 100) -100)))
+
+(with-test-prefix "stream-iterate"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-iterate "four" 0))
+ (pass-if "returns correct iterated stream with 1+"
+ (stream-equal? (stream-take 3 (stream-iterate 1+ 1)) strm123))
+ (pass-if "returns correct iterated stream with exact-integer-sqrt"
+ (stream-equal? (stream-take 5 (stream-iterate exact-integer-sqrt
65536))
+ (stream 65536 256 16 4 2))))
+
+(with-test-prefix "stream-length"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-length "four"))
+ (pass-if "returns 0 for empty stream" (zero? (stream-length (stream))))
+ (pass-if "returns correct stream length" (eqv? (stream-length strm123) 3)))
+
+(with-test-prefix "stream-let"
+ (pass-if "returns correct result"
+ (stream-equal?
+ (stream-let loop ((strm strm123))
+ (if (stream-null? strm)
+ stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (loop (stream-cdr strm)))))
+ (stream 2 4 6))))
+
+(with-test-prefix "stream-map"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-map "four" strm123))
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-map odd?))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-map odd? "four"))
+ (pass-if "works for one stream"
+ (stream-equal? (stream-map - strm123) (stream -1 -2 -3)))
+ (pass-if "works for two streams"
+ (stream-equal? (stream-map + strm123 strm123) (stream 2 4 6)))
+ (pass-if "returns finite stream for finite first stream"
+ (stream-equal? (stream-map + strm123 (stream-from 1)) (stream 2 4
6)))
+ (pass-if "returns finite stream for finite last stream"
+ (stream-equal? (stream-map + (stream-from 1) strm123) (stream 2 4
6)))
+ (pass-if "works for three streams"
+ (stream-equal? (stream-map + strm123 strm123 strm123) (stream 3 6
9))))
+
+(with-test-prefix "stream-match"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-match '(1 2 3) (_ 'ok)))
+ (pass-if-exception "throws when no pattern matches"
+ '(match-error . "no matching pattern")
+ (stream-match strm123 (() 42)))
+ (pass-if-equal "matches empty stream correctly"
+ 'ok
+ (stream-match stream-null (() 'ok)))
+ (pass-if-equal "matches non-empty stream correctly"
+ 'ok
+ (stream-match strm123 (() 'no) (else 'ok)))
+ (pass-if-equal "matches stream of one element"
+ 1
+ (stream-match (stream 1) (() 'no) ((a) a)))
+ (pass-if-equal "matches wildcard"
+ 'ok
+ (stream-match (stream 1) (() 'no) ((_) 'ok)))
+ (pass-if-equal "matches stream of three elements"
+ '(1 2 3)
+ (stream-match strm123 ((a b c) (list a b c))))
+ (pass-if-equal "matches first element with wildcard rest"
+ 1
+ (stream-match strm123 ((a . _) a)))
+ (pass-if-equal "matches first two elements with wildcard rest"
+ '(1 2)
+ (stream-match strm123 ((a b . _) (list a b))))
+ (pass-if-equal "rest variable matches as stream"
+ '(1 2 3)
+ (stream-match strm123 ((a b . c) (list a b (stream-car c)))))
+ (pass-if-equal "rest variable can match whole stream"
+ '(1 2 3)
+ (stream-match strm123 (s (stream->list s))))
+ (pass-if-equal "successful guard match"
+ 'ok
+ (stream-match strm123 ((a . _) (= a 1) 'ok)))
+ (pass-if-equal "unsuccessful guard match"
+ 'no
+ (stream-match strm123 ((a . _) (= a 2) 'yes) (_ 'no)))
+ (pass-if-equal "unsuccessful guard match with two variables"
+ 'no
+ (stream-match strm123 ((a b c) (= a b) 'yes) (_ 'no)))
+ (pass-if-equal "successful guard match with two variables"
+ 'yes
+ (stream-match (stream 1 1 2) ((a b c) (= a b) 'yes) (_ 'no))))
+
+(with-test-prefix "stream-of"
+ (pass-if "all 3 clause types work"
+ (stream-equal? (stream-of (+ y 6)
+ (x in (stream-range 1 6))
+ (odd? x)
+ (y is (* x x)))
+ (stream 7 15 31)))
+ (pass-if "using two streams creates cartesian product"
+ (stream-equal? (stream-of (* x y)
+ (x in (stream-range 1 4))
+ (y in (stream-range 1 5)))
+ (stream 1 2 3 4 2 4 6 8 3 6 9 12)))
+ (pass-if "using no clauses returns just the expression"
+ (stream-equal? (stream-of 1) (stream 1))))
+
+(with-test-prefix "stream-range"
+ (pass-if-exception "throws for non-numeric start"
+ '(wrong-type-arg . "non-numeric starting number")
+ (stream-range "four" 0))
+ (pass-if-exception "throws for non-numeric end"
+ '(wrong-type-arg . "non-numeric ending number")
+ (stream-range 0 "four"))
+ (pass-if-exception "throws for non-numeric step"
+ '(wrong-type-arg . "non-numeric step size")
+ (stream-range 1 2 "three"))
+ (pass-if "returns increasing range if start < end"
+ (stream-equal? (stream-range 0 5) (stream 0 1 2 3 4)))
+ (pass-if "returns decreasing range if start > end"
+ (stream-equal? (stream-range 5 0) (stream 5 4 3 2 1)))
+ (pass-if "returns increasing range of step 2"
+ (stream-equal? (stream-range 0 5 2) (stream 0 2 4)))
+ (pass-if "returns decreasing range of step 2"
+ (stream-equal? (stream-range 5 0 -2) (stream 5 3 1)))
+ (pass-if "returns empty range if start is past end value"
+ (stream-null? (stream-range 0 1 -1))))
+
+(with-test-prefix "stream-ref"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-ref '() 4))
+ (pass-if-exception "throws for non-integer index"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-ref nats 3.5))
+ (pass-if-exception "throws for negative index"
+ '(wrong-type-arg . "negative argument")
+ (stream-ref nats -3))
+ (pass-if-exception "throws if index goes past end of stream"
+ '(wrong-type-arg . "beyond end of stream")
+ (stream-ref strm123 5))
+ (pass-if-equal "returns first element when index = 0"
+ 1
+ (stream-ref nats 0))
+ (pass-if-equal "returns second element when index = 1"
+ 2
+ (stream-ref nats 1))
+ (pass-if-equal "returns third element when index = 2"
+ 3
+ (stream-ref nats 2)))
+
+(with-test-prefix "stream-reverse"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-reverse '()))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-reverse (stream))))
+ (pass-if "returns (3 2 1) for (1 2 3)"
+ (stream-equal? (stream-reverse strm123) (stream 3 2 1))))
+
+(with-test-prefix "stream-scan"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-scan "four" 0 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-scan + 0 '()))
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-scan + 0 strm123) (stream 0 1 3 6))))
+
+(with-test-prefix "stream-take"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-take 5 "four"))
+ (pass-if-exception "throws for non-integer index"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-take "four" strm123))
+ (pass-if-exception "throws for negative index"
+ '(wrong-type-arg . "negative argument")
+ (stream-take -4 strm123))
+ (pass-if "returns null for empty stream"
+ (stream-null? (stream-take 5 stream-null)))
+ (pass-if "using 0 index returns null for empty stream"
+ (stream-null? (stream-take 0 stream-null)))
+ (pass-if "using 0 index returns null for non-empty stream"
+ (stream-null? (stream-take 0 strm123)))
+ (pass-if "returns first 2 elements of stream"
+ (stream-equal? (stream-take 2 strm123) (stream 1 2)))
+ (pass-if "returns whole stream when index is same as length"
+ (stream-equal? (stream-take 3 strm123) strm123))
+ (pass-if "returns whole stream when index exceeds length"
+ (stream-equal? (stream-take 5 strm123) strm123)))
+
+(with-test-prefix "stream-take-while"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-take-while odd? "four"))
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-take-while "four" strm123))
+ (pass-if "returns stream up to first non-matching item"
+ (stream-equal? (stream-take-while odd? strm123) (stream 1)))
+ (pass-if "returns empty stream if first item doesn't match"
+ (stream-null? (stream-take-while even? strm123)))
+ (pass-if "returns whole stream if every item matches"
+ (stream-equal? (stream-take-while positive? strm123) strm123))
+ (pass-if "return empty stream if no item matches"
+ (stream-null? (stream-take-while negative? strm123))))
+
+(with-test-prefix "stream-unfold"
+ (pass-if-exception "throws for invalid mapper"
+ '(wrong-type-arg . "non-procedural mapper")
+ (stream-unfold "four" odd? + 0))
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural pred?")
+ (stream-unfold + "four" + 0))
+ (pass-if-exception "throws for invalid generator"
+ '(wrong-type-arg . "non-procedural generator")
+ (stream-unfold + odd? "four" 0))
+
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-unfold (cut expt <> 2) (cut < <> 10) 1+ 0)
+ (stream 0 1 4 9 16 25 36 49 64 81))))
+
+(with-test-prefix "stream-unfolds"
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-unfolds
+ (lambda (x)
+ (receive (n s) (car+cdr x)
+ (if (zero? n)
+ (values 'dummy '())
+ (values
+ (cons (- n 1) (stream-cdr s))
+ (list (stream-car s))))))
+ (cons 5 (stream-from 0)))
+ (stream 0 1 2 3 4)))
+ (pass-if "handles returns of multiple elements correctly"
+ (stream-equal? (stream-take 16 (stream-unfolds
+ (lambda (n)
+ (values (1+ n) (iota n)))
+ 1))
+ (stream 0 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0)))
+ (receive (p np)
+ (stream-unfolds (lambda (x)
+ (receive (n p) (car+cdr x)
+ (if (= n (stream-car p))
+ (values (cons (1+ n) (stream-cdr p))
+ (list n) #f)
+ (values (cons (1+ n) p)
+ #f (list n)))))
+ (cons 1 primes))
+ (pass-if "returns first stream correctly"
+ (stream-equal? (stream-take 15 p)
+ (stream 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)))
+ (pass-if "returns second stream correctly"
+ (stream-equal? (stream-take 15 np)
+ (stream 1 4 6 8 9 10 12 14 15 16 18 20 21 22
24)))))
+
+(with-test-prefix "stream-zip"
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-zip))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-zip "four"))
+ (pass-if-exception "throws if any argument is non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-zip strm123 "four"))
+ (pass-if "returns null when given null as any argument"
+ (stream-null? (stream-zip strm123 stream-null)))
+ (pass-if "returns single-element lists when given one stream"
+ (stream-equal? (stream-zip strm123) (stream '(1) '(2) '(3))))
+ (pass-if "returns double-element lists when given two streams"
+ (stream-equal? (stream-zip strm123 strm123)
+ (stream '(1 1) '(2 2) '(3 3))))
+ (pass-if "returns finite stream if at least one given stream is"
+ (stream-equal? (stream-zip strm123 (stream-from 1))
+ (stream '(1 1) '(2 2) '(3 3))))
+ (pass-if "returns triple-element lists when given three streams"
+ (stream-equal? (stream-zip strm123 strm123 strm123)
+ (stream '(1 1 1) '(2 2 2) '(3 3 3)))))
+
+(with-test-prefix "other tests"
+ (pass-if-equal "returns biggest prime under 1000"
+ 997
+ (stream-car
+ (stream-reverse (stream-take-while (cut < <> 1000) primes))))
+
+ (pass-if "quicksort returns same result as insertion sort"
+ (stream-equal? (qsort < (stream 3 1 5 2 4))
+ (isort < (stream 2 5 1 4 3))))
+
+ (pass-if "merge sort returns same result as insertion sort"
+ (stream-equal? (msort < (stream 3 1 5 2 4))
+ (isort < (stream 2 5 1 4 3))))
+
+ ;; http://www.research.att.com/~njas/sequences/A051037
+ (pass-if-equal "returns 1000th Hamming number"
+ 51200000
+ (stream-ref hamming 999)))
diff --git a/test-suite/tests/srfi-45.test b/test-suite/tests/srfi-45.test
index 573eea0..e9fd029 100644
--- a/test-suite/tests/srfi-45.test
+++ b/test-suite/tests/srfi-45.test
@@ -1,6 +1,7 @@
;;; -*- mode: scheme; coding: utf-8; -*-
-;; Copyright André van Tonder. All Rights Reserved.
+;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
@@ -258,3 +259,10 @@
;; Commented out since it takes too long
#;
(test-equal 300000000 (force (times3 100000000))) ;==> bounded space
+
+
+;======================================================================
+; Test promise? predicate (non-standard Guile extension)
+
+(pass-if "promise? predicate"
+ (promise? (delay 1)))
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 3b44ba0..ee64467 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -240,6 +240,16 @@
(even? 10))
(current-module))))
+(define-module (test-suite test-syncase-3)
+ #:autoload (test-syncase-3-does-not-exist) (baz))
+
+(define-module (test-suite test-syncase)) ;; back to main module
+
+(pass-if "missing autoloads do not foil psyntax"
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (eval '(if #f (baz) #t)
+ (resolve-module '(test-suite test-syncase-3)))))
+
(use-modules (system syntax))
(with-test-prefix "syntax-local-binding"
diff --git a/test-suite/tests/texinfo.serialize.test
b/test-suite/tests/texinfo.serialize.test
index 95e26b8..554390c 100644
--- a/test-suite/tests/texinfo.serialize.test
+++ b/test-suite/tests/texinfo.serialize.test
@@ -1,6 +1,6 @@
;;;; texinfo.serialize.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -103,7 +103,7 @@
"@iftex
This is only for tex.
-Note. Foo.
+Note. Foo.
@end iftex
diff --git a/test-suite/tests/texinfo.string-utils.test
b/test-suite/tests/texinfo.string-utils.test
index ad19df8..4f2e4c5 100644
--- a/test-suite/tests/texinfo.string-utils.test
+++ b/test-suite/tests/texinfo.string-utils.test
@@ -1,6 +1,6 @@
;;;; texinfo.string-utils.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2009, 2010, 2013 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
@@ -109,6 +109,13 @@ to using the function `set-language-environment'.
variable should be set only with M-x customize, which is equivalent to using
the function `set-language-environment'.")))
+ (with-test-prefix "two spaces after end of sentence"
+ (pass-if-equal "This is a sentence. There should be two spaces before."
+ (fill-string "This is a sentence. There should be two spaces before."))
+
+ (pass-if-equal "This is version 2.0..."
+ (fill-string "This is version 2.0...")))
+
(with-test-prefix "test-no-word-break"
(pass-if (equal? "thisisalongword
blah
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test
index 8a4b593..2cb4a71 100644
--- a/test-suite/tests/texinfo.test
+++ b/test-suite/tests/texinfo.test
@@ -1,6 +1,6 @@
;;;; texinfo.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -56,24 +56,24 @@
str
(lambda (port) (texinfo:read-verbatim-body port consumer '())))))
- (pass-if (equal? '()
- (read-verbatim-body-from-string "@end verbatim\n")))
+ (pass-if-equal '()
+ (read-verbatim-body-from-string "@end verbatim\n"))
;; after @verbatim, the current position will always directly after
;; the newline.
(pass-if-exception "@end verbatim needs a newline"
exception:eof-while-reading-token
(read-verbatim-body-from-string "@end verbatim"))
-
- (pass-if (equal? '("@@end verbatim" " NL\n")
- (read-verbatim-body-from-string "@@end address@hidden
verbatim\n")))
- (pass-if (equal? '("@@@@faosfasf adsfas " " NL\n" " asf @foo{asdf}" " NL\n")
- (read-verbatim-body-from-string
- "@@@@faosfasf adsfas \n asf @address@hidden verbatim\n")))
+ (pass-if-equal '("@@end verbatim" " NL\n")
+ (read-verbatim-body-from-string "@@end address@hidden verbatim\n"))
- (pass-if (equal? '("@end verbatim " " NL\n")
- (read-verbatim-body-from-string "@end verbatim
address@hidden verbatim\n"))))
+ (pass-if-equal '("@@@@faosfasf adsfas " " NL\n" " asf @foo{asdf}" " NL\n")
+ (read-verbatim-body-from-string
+ "@@@@faosfasf adsfas \n asf @address@hidden verbatim\n"))
+
+ (pass-if-equal '("@end verbatim " " NL\n")
+ (read-verbatim-body-from-string "@end verbatim address@hidden
verbatim\n")))
(define texinfo:read-arguments
(@@ (texinfo) read-arguments))
@@ -84,8 +84,8 @@
(lambda (port) (texinfo:read-arguments port #\}))))
(define (test str expected-res)
- (pass-if (equal? expected-res
- (read-arguments-from-string str))))
+ (pass-if-equal expected-res
+ (read-arguments-from-string str)))
(test "}" '())
(test "foo}" '("foo"))
@@ -111,20 +111,20 @@
(texinfo:complete-start-command command port))
list))))
- (pass-if (equal? '(section () EOL-TEXT)
- (test 'section "foo bar baz bonzerts")))
- (pass-if (equal? '(deffnx ((category "Function") (name "foo") (arguments))
EOL-TEXT-ARGS)
- (test 'deffnx "Function foo")))
+ (pass-if-equal '(section () EOL-TEXT)
+ (test 'section "foo bar baz bonzerts"))
+ (pass-if-equal '(deffnx ((category "Function") (name "foo") (arguments))
EOL-TEXT-ARGS)
+ (test 'deffnx "Function foo"))
(pass-if-exception "@emph missing a start brace"
exception:wrong-character
(test 'emph "no brace here"))
- (pass-if (equal? '(emph () INLINE-TEXT)
- (test 'emph "{foo bar baz bonzerts")))
- (pass-if (equal? '(ref ((node "foo bar") (section "baz") (info-file
"bonzerts"))
- INLINE-ARGS)
- (test 'ref "{ foo bar ,, baz, bonzerts}")))
- (pass-if (equal? '(node ((name "referenced node")) EOL-ARGS)
- (test 'node " referenced node\n"))))
+ (pass-if-equal '(emph () INLINE-TEXT)
+ (test 'emph "{foo bar baz bonzerts"))
+ (pass-if-equal '(ref ((node "foo bar") (section "baz") (info-file
"bonzerts"))
+ INLINE-ARGS)
+ (test 'ref "{ foo bar ,, baz, bonzerts}"))
+ (pass-if-equal '(node ((name "referenced node")) EOL-ARGS)
+ (test 'node " referenced node\n")))
(define texinfo:read-char-data
(@@ (texinfo) read-char-data))
@@ -149,8 +149,8 @@
port expect-eof? preserve-ws? str-handler '()))))
(lambda (seed token)
(let ((result (reverse seed)))
- (pass-if (equal? expected-data result))
- (pass-if (equal? expected-token token))))))
+ (pass-if-equal expected-data result)
+ (pass-if-equal expected-token token)))))
;; add some newline-related tests here
(test "" #t #f '() eof-object)
@@ -167,8 +167,8 @@
(with-test-prefix "test-texinfo->stexinfo"
(define (test str expected-res)
- (pass-if (equal? expected-res
- (call-with-input-string str texi->stexi))))
+ (pass-if-equal expected-res
+ (call-with-input-string str texi->stexi)))
(define (try-with-title title str)
(call-with-input-string
(string-append "foo bar address@hidden " title "\n" str)
@@ -177,9 +177,8 @@
(test (string-append "foo bar address@hidden " title "\n" str)
expected-res))
(define (test-body str expected-res)
- (pass-if str
- (equal? expected-res
- (cddr (try-with-title "zog" str)))))
+ (pass-if-equal str expected-res
+ (cddr (try-with-title "zog" str))))
(define (list-intersperse src-l elem)
(if (null? src-l) src-l
@@ -417,4 +416,9 @@
(name "foo")
(arguments "bar " (code "baz"))))
(para "text that should be in a para")))
+ (test-body "@pxref{Locales, @code{setlocale}}"
+ '((para (pxref (% (node "Locales")
+ (name (code "setlocale")))))))
+ (test-body "Like this---e.g.@:, at colon."
+ '((para "Like this---e.g.:, at colon.")))
)
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index be722fc..8178120 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012 Free Software
Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -86,7 +86,12 @@
(equal? (par-map fibo (iota 13))
(map fibo (iota 13))))
#:to 'value
- #:env (current-module))))
+ #:env (current-module)))
+
+ (pass-if-equal "long list" (map 1+ (iota 10000))
+ ;; In Guile 2.0.7, this would trigger a stack overflow.
+ ;; See <http://bugs.gnu.org/13188>.
+ (par-map 1+ (iota 10000))))
;;
;; par-for-each
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 6d501ec..2ed15c7 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,7 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <address@hidden> --- May 2009
;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -702,6 +702,22 @@
#:opts '(#:partial-eval? #f)))))
+(define (sum . args)
+ (apply + args))
+
+(with-test-prefix "many args"
+ (pass-if "call with > 256 args"
+ (equal? (compile `(1+ (sum ,@(iota 1000)))
+ #:env (current-module))
+ (1+ (apply sum (iota 1000)))))
+
+ (pass-if "tail call with > 256 args"
+ (equal? (compile `(sum ,@(iota 1000))
+ #:env (current-module))
+ (apply sum (iota 1000)))))
+
+
+
(with-test-prefix "tree-il-fold"
(pass-if "empty tree"
diff --git a/test-suite/tests/vlist.test b/test-suite/tests/vlist.test
index d9bbbeb..dc54ffa 100644
--- a/test-suite/tests/vlist.test
+++ b/test-suite/tests/vlist.test
@@ -287,12 +287,12 @@
;; using the supplied hash procedure, which could lead to
;; inconsistencies.
(let* ((s "hello")
- (vh (fold vhash-consq
- (vhash-consq s "world" vlist-null)
+ (vh (fold vhash-consv
+ (vhash-consv s "world" vlist-null)
(iota 300)
(iota 300))))
- (and (vhash-assq s vh)
- (pair? (vhash-assq s (vhash-delete 123 vh eq? hashq))))))
+ (and (vhash-assv s vh)
+ (pair? (vhash-assv s (vhash-delete 123 vh eqv? hashv))))))
(pass-if "vhash-fold"
(let* ((keys '(a b c d e f g d h i))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 97f5559..b2c5c2c 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -85,6 +85,113 @@
#t
(error "unexpected exception" component arg))))))))
+(define-syntax pass-if-read-request-line
+ (syntax-rules ()
+ ((_ str expected-method expected-uri expected-version)
+ (pass-if str
+ (equal? (call-with-values
+ (lambda ()
+ (read-request-line (open-input-string
+ (string-append str "\r\n"))))
+ list)
+ (list 'expected-method
+ expected-uri
+ 'expected-version))))))
+
+(define-syntax pass-if-write-request-line
+ (syntax-rules ()
+ ((_ expected-str method uri version)
+ (pass-if expected-str
+ (equal? (string-append expected-str "\r\n")
+ (call-with-output-string
+ (lambda (port)
+ (write-request-line 'method uri 'version port))))))))
+
+(define-syntax pass-if-read-response-line
+ (syntax-rules ()
+ ((_ str expected-version expected-code expected-phrase)
+ (pass-if str
+ (equal? (call-with-values
+ (lambda ()
+ (read-response-line (open-input-string
+ (string-append str "\r\n"))))
+ list)
+ (list 'expected-version
+ expected-code
+ expected-phrase))))))
+
+(define-syntax pass-if-write-response-line
+ (syntax-rules ()
+ ((_ expected-str version code phrase)
+ (pass-if expected-str
+ (equal? (string-append expected-str "\r\n")
+ (call-with-output-string
+ (lambda (port)
+ (write-response-line 'version code phrase port))))))))
+
+(with-test-prefix "read-request-line"
+ (pass-if-read-request-line "GET / HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/")
+ (1 . 1))
+ (pass-if-read-request-line "GET http://www.w3.org/pub/WWW/TheProject.html
HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:host "www.w3.org"
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-read-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-read-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
+ HEAD
+ (build-uri 'http
+ #:path "/etc/hosts"
+ #:query "foo=bar")
+ (1 . 1)))
+
+(with-test-prefix "write-request-line"
+ (pass-if-write-request-line "GET / HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/")
+ (1 . 1))
+ ;;; FIXME: Test fails due to scheme, host always being removed.
+ ;;; However, it should be supported to request these be present, and
+ ;;; that is possible with absolute/relative URI support.
+ ;; (pass-if-write-request-line "GET
http://www.w3.org/pub/WWW/TheProject.html HTTP/1.1"
+ ;; GET
+ ;; (build-uri 'http
+ ;; #:host "www.w3.org"
+ ;; #:path "/pub/WWW/TheProject.html")
+ ;; (1 . 1))
+ (pass-if-write-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-write-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
+ HEAD
+ (build-uri 'http
+ #:path "/etc/hosts"
+ #:query "foo=bar")
+ (1 . 1)))
+
+(with-test-prefix "read-response-line"
+ (pass-if-read-response-line "HTTP/1.0 404 Not Found"
+ (1 . 0) 404 "Not Found")
+ (pass-if-read-response-line "HTTP/1.1 200 OK"
+ (1 . 1) 200 "OK"))
+
+(with-test-prefix "write-response-line"
+ (pass-if-write-response-line "HTTP/1.0 404 Not Found"
+ (1 . 0) 404 "Not Found")
+ (pass-if-write-response-line "HTTP/1.1 200 OK"
+ (1 . 1) 200 "OK"))
+
(with-test-prefix "general headers"
(pass-if-parse cache-control "no-transform" '(no-transform))
@@ -109,6 +216,9 @@
(pass-if-parse date "Tue, 15 Nov 1994 08:12:31 GMT"
(string->date "Tue, 15 Nov 1994 08:12:31 +0000"
"~a, ~d ~b ~Y ~H:~M:~S ~z"))
+ (pass-if-parse date "Tue, 15 Nov 1994 16:12:31 +0800"
+ (string->date "Tue, 15 Nov 1994 08:12:31 +0000"
+ "~a, ~d ~b ~Y ~H:~M:~S ~z"))
(pass-if-parse date "Wed, 7 Sep 2011 11:25:00 GMT"
(string->date "Wed, 7 Sep 2011 11:25:00 +0000"
"~a,~e ~b ~Y ~H:~M:~S ~z"))
@@ -180,6 +290,10 @@
(pass-if-parse from "address@hidden" "address@hidden")
(pass-if-parse host "qux" '("qux" . #f))
(pass-if-parse host "qux:80" '("qux" . 80))
+ (pass-if-parse host "[2001:db8::1]" '("2001:db8::1" . #f))
+ (pass-if-parse host "[2001:db8::1]:80" '("2001:db8::1" . 80))
+ (pass-if-parse host "[::ffff:192.0.2.1]" '("::ffff:192.0.2.1" . #f))
+ (pass-if-round-trip "Host: [2001:db8::1]\r\n")
(pass-if-parse if-match "\"xyzzy\", W/\"qux\""
'(("xyzzy" . #t) ("qux" . #f)))
(pass-if-parse if-match "*" '*)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-329-g26d1480,
Mark H Weaver <=