bug#15411: libguile initialization inside a pthread segfaults
The following program fails; it produces the session shown below. Any
help greatly appreciated.
Dale
=PROGRAM==
#include
static void *do_guile (void *)
{
for (;;) ;
return nullptr;
}
static void *run_thread (void *)
{
return scm_with_guile (&do_guile, nullptr);
}
int main (int, char **)
{
pthread_t thread;
pthread_create (&thread, nullptr, run_thread, nullptr);
pthread_join (thread, nullptr);
return 0;
}
=/PROGRAM=
=SESSION==
$ cat /etc/debian_version
7.1
$ g++-4.6 --version
g++-4.6 (Debian 4.6.3-14) 4.6.3
$ guile --version
guile (GNU Guile) 2.0.5-deb+1-3
$ g++-4.6 --std=c++0x test.cc `pkg-config --libs --cflags guile-2.0` -g
$ gdb a.out
GNU gdb (GDB) 7.4.1-debian
This GDB was configured as "i486-linux-gnu".
Reading symbols from a.out...done.
(gdb) r
Starting program: a.out
warning: Could not load shared library symbols for linux-gate.so.1.
Do you need "set solib-search-path" or "set sysroot"?
[Thread debugging using libthread_db enabled]
Using host libthread_db library
"/lib/i386-linux-gnu/i686/cmov/libthread_db.so.1".
[New Thread 0xb7916b40 (LWP 4792)]
Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 0xb7916b40 (LWP 4792)]
0xb7e2854f in GC_push_all_eager () from /usr/lib/libgc.so.1
(gdb) info stack
#0 0xb7e2854f in GC_push_all_eager () from /usr/lib/libgc.so.1
#1 0xb7e285a3 in GC_push_all_stack () from /usr/lib/libgc.so.1
#2 0xb7e30b9b in GC_push_all_stacks () from /usr/lib/libgc.so.1
#3 0xb7e2b6e4 in GC_default_push_other_roots ()
from /usr/lib/libgc.so.1
#4 0xb7e29c45 in GC_push_roots () from /usr/lib/libgc.so.1
#5 0xb7e290b6 in GC_mark_some () from /usr/lib/libgc.so.1
#6 0xb7e1ffb5 in GC_stopped_mark () from /usr/lib/libgc.so.1
#7 0xb7e206ba in GC_try_to_collect_inner () from /usr/lib/libgc.so.1
#8 0xb7e2ae50 in GC_init_inner () from /usr/lib/libgc.so.1
#9 0xb7e2afa4 in GC_init () from /usr/lib/libgc.so.1
#10 0xb7eba7d0 in ?? () from /usr/lib/libguile-2.0.so.22
#11 0xb7ecbebd in ?? () from /usr/lib/libguile-2.0.so.22
#12 0xb7f29750 in ?? () from /usr/lib/libguile-2.0.so.22
#13 0xb7f29790 in ?? () from /usr/lib/libguile-2.0.so.22
#14 0xb7e2aa2e in GC_call_with_stack_base () from /usr/lib/libgc.so.1
#15 0xb7f2998f in scm_with_guile () from /usr/lib/libguile-2.0.so.22
#16 0x08048663 in run_thread () at test.cc:16
#17 0xb7cb2cf1 in start_thread ()
from /lib/i386-linux-gnu/i686/cmov/libpthread.so.0
#18 0xb7bebfee in clone () from /lib/i386-linux-gnu/i686/cmov/libc.so.6
(gdb) thr 1
[Switching to thread 1 (Thread 0xb7918700 (LWP 4789))]
#0 0xb7fde424 in __kernel_vsyscall ()
(gdb) info stack
#0 0xb7fde424 in __kernel_vsyscall ()
#1 0xb7cb3d8c in pthread_join ()
from /lib/i386-linux-gnu/i686/cmov/libpthread.so.0
#2 0x080486a6 in main () at test.cc:26
(gdb) quit
=/SESSION=
signature.asc
Description: This is a digitally signed message part
bug#40719: [PATCH 0/4] GNU Mcron and the (ice-9 getopt-long) module
/Mcron/ is a GNU package which runs unattended jobs in the operating system at dynamically computed times; it is 99% Guile but currently shrouded in a thin veneer of C code for historical reasons, which have by now vanished. The Guile /getopt-long/ module parses a command lineʼs arguments for options and their values according to a provided grammar. In the process of removing the thin veneer of C code from around the /GNU Mcron/ package, I am running up against niggles in the implementation of the /(ice-9 getopt-long)/ module. The intention with /mcron/ has always been that a command-line argument be provided which allows the user to request the display of the next eight jobs to run, or allows the user to specify the number of such jobs. Thus the intention was that command-lines like ‘mcron -s4 file’, ‘mcron -s 4 file’, and ‘mcron -s file’ would all work; alas, the last one, actually the most important case, doesnʼt with the current module, which issues a fatal exit on the grounds that ‘file’ fails to meet predicated requirements of the option for ‘-s’ that it should represent a decimal number. It is clear that /getopt-long/ can do better than this, especially if the consumer of the module provides predicates on values which options can take, e.g. value should be numerical. It can then objectively decide that an argument should be taken to be a value, an option itself, or a ‘loose’ argument. There are other problems which can be cleared up with the enhanced logic, as outlined in Point 2 below. The following patches clear up the situation. 1) The first patch introduces some 28 new tests of the existing /getopt-long/ module; these are non-controversial and the current code passes all the tests, but they exercise more of the corner cases and provide confidence that a new implementation does not break existing behaviour. 2) The second patch inverts one test which I disagree with (see Point 3, below), and introduces 18 more tests which represent currently indeterminate and unsupported behaviour, some nevertheless desired by /mcron/; all of these create either test FAIL cases with the current code-base, or total panic-escape from the calling application. Some specific test failures: 1. A command-line like ‘foo --test=’ produces a /test/ result with the empty string as value; I would expect /#t/ as the value (which indicates that the option is there but has no given value). 2. A command-line with a negative number always errors. According to the in-line documentation negative numbers canʼt ever appear loose on the command-line, but this seems like a case which might be realistic in real life and there is no reason to reject them. 3. A command like ‘foo -abc d’ in which /b/ takes a mandatory argument and /c/ is an allowed option, errors out, but in my opinion in this case /b/ should take “c” as its value and the command-line as a whole is *not* erroneous. If /b/ takes an optional value things are more tricky to deal with, but if there is a predicate on the values which /b/ can take, then the parser can make a clearer decision on taking /c/ as a value or another option. This might seem picky, but the problem is that command-lines are supplied by (possibly hostile) end-users, *not* by the /getopt-long/ module, and not by the application which consumes the module, either. Thus this might be regarded as a security issue. 4. The command ‘mcron -s file’, where /s/ takes an optional numeric value, errors out. 3) The third patch fixes up the /getopt-long/ module to pass all the new tests, as well as all of the existing ones (with the single exception outlined in Point 2.3 above). Considering that the entire Guile build also depends on /getopt-long/, we can have some confidence that the changes do not bring any incompatibility with existing code. 4) The final patch fixes up various commentary and doc-strings in the code to emphasise the importance of predicates on optional values, and generally make things more concrete.
bug#40721: [PATCH 1/4] test: augment testing of (ice-9 getopt-long) module
>From b08d1cc7dc03d5e69dfd1f93e50617b81230b5e3 Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Sun, 19 Apr 2020 18:00:04 +0100 Subject: [PATCH 1/4] test: augment testing of (ice-9 getopt-long) module Adding some 28 new tests which explore some undefined (or at least implied) behaviour of the module. These are all non-controversial, and the existing module passes all of the tests. * test-suite/tests/getopt-long.test: new code added, some slight re-arrangement of existing code but nothing which changes the original set of tests. --- test-suite/tests/getopt-long.test | 214 ++ 1 file changed, 188 insertions(+), 26 deletions(-) diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test index 4ae604883..a837b0799 100644 --- a/test-suite/tests/getopt-long.test +++ b/test-suite/tests/getopt-long.test @@ -1,7 +1,6 @@ getopt-long.test --- long options processing -*- scheme -*- - Thien-Thi Nguyen --- August 2001 - Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. + Copyright (C) 2001, 2006, 2011 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 @@ -17,6 +16,10 @@ License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;; Author: Thien-Thi Nguyen --- August 2001 +;;; Dale Mellor <> --- April 2020 + + (use-modules (test-suite lib) (ice-9 getopt-long) (ice-9 regex)) @@ -49,6 +52,31 @@ (deferr option-must-be-specified"option must be specified") (deferr option-must-have-arg"option must be specified with argument") + + +(define (symbol/>string a) + (if (symbol? a) (symbol->string a) "")) + +(define (output-sort out) + (sort out (lambda (a b) (stringstring (car a)) +(symbol/>string (car b)) + +(define* (A-TEST args option-specs expectation + #:key stop-at-first-non-option) + (let ((answer +(output-sort + (getopt-long + (cons "foo" (string-split args #\space)) + option-specs + #:stop-at-first-non-option stop-at-first-non-option +(cond ((equal? answer (output-sort expectation)) #t) + (else (format (current-output-port) + "Test result was \n‘~s’ --VS-- \n‘~s’.\n" + answer (output-sort expectation)) + #f + + + (with-test-prefix "exported procs" (pass-if "`option-ref' defined" (defined? 'option-ref)) (pass-if "`getopt-long' defined" (defined? 'getopt-long))) @@ -92,33 +120,39 @@ (with-test-prefix "value optional" - (define (test3 . args) -(getopt-long args '((foo (value optional) (single-char #\f)) -(bar + (define (test args expect) +(A-TEST args + '((foo (value optional) (single-char #\f)) + (bar)) + expect)) + + (pass-if "long option ‘foo’ w/ arg, long option ‘bar’" + (test "--foo fooval --bar" + '((()) (bar . #t) (foo . "fooval" - (pass-if "long option `foo' w/ arg, long option `bar'" - (equal? (test3 "prg" "--foo" "fooval" "--bar") - '((()) (bar . #t) (foo . "fooval" + (pass-if "short option ‘foo’ w/ arg, long option ‘bar’" + (test "-f fooval --bar" + '((()) (bar . #t) (foo . "fooval" - (pass-if "short option `foo' w/ arg, long option `bar'" - (equal? (test3 "prg" "-f" "fooval" "--bar") - '((()) (bar . #t) (foo . "fooval" + (pass-if "short option ‘foo’, long option ‘bar’, no args" + (test "-f --bar" + '((()) (bar . #t) (foo . #t - (pass-if "short option `foo', long option `bar', no args" - (equal? (test3 "prg" "-f" "--bar") - '((()) (bar . #t) (foo . #t + (pass-if "long option ‘foo’, long option ‘bar’, no args" + (test "--foo --bar" + '((()) (bar . #t) (foo . #t - (pass-if "long option `foo', long option `bar', no args" - (equal? (test3 "prg" "--foo" "--bar") - '((()) (bar . #t) (foo . #t + (pass-if "long option ‘bar’
bug#40722: [PATCH 2/4] test *broken*: augmented tests of (ice-9 getopt-long)
>From 57da5a3ae02008c4c66da21055749e51342fdd7e Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Sun, 19 Apr 2020 18:00:33 +0100 Subject: [PATCH 2/4] test *broken*: augmented tests of (ice-9 getopt-long) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is to prepare the ground for some test-driven development mainly to make the module satisfy the needs of the GNU Mcron project. The main requirement is for the module to be more intelligent when dealing with optional values to command-line options: if the following argument looks like a new option then treat it as such, otherwise treat it as the value of the current option. The particular case is mcronʼs -s option which needs to assume a default value of “8” if there is not one on the command line, but currently ‘mcron -s input_file’ fails badly. Other tests introduced involve allowing negative numbers as option values, and dealing with various cases of option-processing termination. * test-suite/tests/getopt-long.test: new code added. --- test-suite/tests/getopt-long.test | 88 ++- 1 file changed, 76 insertions(+), 12 deletions(-) diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test index a837b0799..b0530fe62 100644 --- a/test-suite/tests/getopt-long.test +++ b/test-suite/tests/getopt-long.test @@ -78,8 +78,8 @@ (with-test-prefix "exported procs" - (pass-if "`option-ref' defined" (defined? 'option-ref)) - (pass-if "`getopt-long' defined" (defined? 'getopt-long))) + (pass-if "‘option-ref’ defined" (defined? 'option-ref)) + (pass-if "‘getopt-long’ defined" (defined? 'getopt-long))) (with-test-prefix "specifying predicate" @@ -150,6 +150,15 @@ (test "--bar --foo" '((()) (foo . #t) (bar . #t + (pass-if "long option with equals and space" + (test "--foo= test" + '((() "test") (foo . #t + + (pass-if "long option with equals and space, not allowed a value" + (A-TEST "--foo= test" + '((foo (value #f))) + '((() "test") (foo . #t + (pass-if "--=" (test "--=" '((() "--=" @@ -167,16 +176,16 @@ (bar))) 'foo #f))) - (pass-if "option-ref `--foo 4'" + (pass-if "option-ref ‘--foo 4’" (test4 "4" "--foo" "4")) - (pass-if "option-ref `-f 4'" + (pass-if "option-ref ‘-f 4’" (test4 "4" "-f" "4")) - (pass-if "option-ref `-f4'" + (pass-if "option-ref ‘-f4’" (test4 "4" "-f4")) - (pass-if "option-ref `--foo=4'" + (pass-if "option-ref ‘--foo=4’" (test4 "4" "--foo=4")) ) @@ -262,8 +271,8 @@ (with-test-prefix "apples-blimps-catalexis example" (define spec '((apples(single-char #\a)) - (blimps(single-char #\b) (value #t)) - (catalexis (single-char #\c) (value #t + (blimps(single-char #\b) (value #t)) + (catalexis (single-char #\c) (value #t (define (test8 . args) (equal? (sort (getopt-long (cons "foo" args) spec) @@ -281,9 +290,38 @@ (pass-if "normal 2" (test8 "-ab" "bang" "-c" "couth")) (pass-if "normal 3" (test8 "-ac" "couth" "-b" "bang")) - (pass-if-fatal-exception "bad ordering causes missing option" - exception:option-must-have-arg - (test8 "-abc" "couth" "bang")) + + Dale Mellor 2020-04-14 + + I disagree with this test: to my mind 'c' is 'b's argument, and + the other two arguments are non-options which get passed + through; there should not be an exception. + + ;; (pass-if-fatal-exception "bad ordering causes missing option" + ;; exception:option-must-have-arg + ;; (test8 "-abc" "couth" "bang")) + + (pass-if "clumped options with trailing mandatory value" + (A-TEST "-abc couth bang" + spec + '((() "couth" "bang") (apples . #t) (blimps . "c" + + (pass-if "clumped options with trailing optional value" +(A-TEST "-abc cout
bug#40720: [PATCH 3/4] (ice-9 getopt-long): substantially re-written to pass all the new tests
>From 7d169c24c0fdbbaa56c646985dd2861b12e2bca5 Mon Sep 17 00:00:00 2001
From: Dale Mellor
Date: Sun, 19 Apr 2020 18:00:48 +0100
Subject: [PATCH 3/4] (ice-9 getopt-long): substantially re-written to pass all
the new tests
All of the original tests also still pass. Also the entire guile build
actually depends on the correct functioning of this module, so we can be
quite confident that nothing has been broken.
* module/ice-9/getopt-long.scm: Substantially re-written.
---
module/ice-9/getopt-long.scm | 476 +--
1 file changed, 339 insertions(+), 137 deletions(-)
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 14eaf8e23..4c920cbe5 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -158,12 +158,17 @@
(define-module (ice-9 getopt-long)
#:use-module ((ice-9 common-list) #:select (remove-if-not))
+ #:use-module (ice-9 control)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
#:export (getopt-long option-ref))
+;; Code makes more sense to human beings with this.
+(define return values)
+
(define %program-name (make-fluid "guile"))
(define (program-name)
(fluid-ref %program-name))
@@ -175,18 +180,13 @@
(exit 1))
(define-record-type option-spec
- (%make-option-spec name required? option-spec->single-char predicate
value-policy)
+ (%make-option-spec name required? single-char predicate value-policy)
option-spec?
- (name
- option-spec->name set-option-spec-name!)
- (required?
- option-spec->required? set-option-spec-required?!)
- (option-spec->single-char
- option-spec->single-char set-option-spec-single-char!)
- (predicate
- option-spec->predicate set-option-spec-predicate!)
- (value-policy
- option-spec->value-policy set-option-spec-value-policy!))
+ (name option-spec->name)
+ (required?option-spec->required?set-option-spec-required?!)
+ (single-char option-spec->single-char set-option-spec-single-char!)
+ (predicateoption-spec->predicateset-option-spec-predicate!)
+ (value-policy option-spec->value-policy set-option-spec-value-policy!))
(define (make-option-spec name)
(%make-option-spec name #f #f #f #f))
@@ -195,116 +195,331 @@
(let ((spec (make-option-spec (symbol->string (car desc)
(for-each (match-lambda
(('required? val)
-(set-option-spec-required?! spec val))
+(set-option-spec-required?! spec val))
(('value val)
-(set-option-spec-value-policy! spec val))
+(set-option-spec-value-policy! spec val))
(('single-char val)
-(or (char? val)
-(error "`single-char' value must be a char!"))
-(set-option-spec-single-char! spec val))
+(unless (char? val)
+(fatal-error "‘single-char’ value must be a char!"))
+(set-option-spec-single-char! spec val))
(('predicate pred)
-(set-option-spec-predicate!
- spec (lambda (name val)
-(or (not val)
-(pred val)
-(fatal-error "option predicate failed: --~a"
- name)
+(set-option-spec-predicate! spec pred))
((prop val)
-(error "invalid getopt-long option property:" prop)))
+(fatal-error "invalid getopt-long option property:" prop)))
(cdr desc))
spec))
-(define (split-arg-list argument-list)
- ;; Scan ARGUMENT-LIST for "--" and return (BEFORE-LS . AFTER-LS).
- ;; Discard the "--". If no "--" is found, AFTER-LS is empty.
- (let loop ((yes '()) (no argument-list))
-(cond ((null? no) (cons (reverse yes) no))
- ((string=? "--" (car no)) (cons (reverse yes) (cdr no)))
- (else (loop (cons (car no) yes) (cdr no))
-
-(define short-opt-rx (make-regexp "^-([a-zA-Z]+)(.*)"))
-(define long-opt-no-value-rx (make-regexp "^--([^=]+)$"))
-(define long-opt-with-value-rx (make-regexp "^--([^=]+)=(.*)"))
-
-(define (looks-like-an-option string)
- (or (regexp-exec short-opt-rx string)
- (regexp-exec long-opt-with-value-rx string)
- (regexp-exec long-opt-no-value-rx string)))
-
-(define (process-options specs argument-ls stop-at-first-non-option)
- ;; Use SPECS to scan ARGUMENT-LS; return (FOUND . ETC).
- ;; FOUND is an unordered list of option specs for found options, while ETC
- ;; is an order-maintained list of elements in ARGUMENT-LS th
bug#40723: [PATCH 4/4] (ice-9 getopt-long): update commentary and doc-strings
>From 6acbbb37a2f9a1968fcdbc8f3be3c805d28ef901 Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Sun, 19 Apr 2020 18:01:06 +0100 Subject: [PATCH 4/4] (ice-9 getopt-long): update commentary and doc-strings Emphasise importance of predicate part of specification of options with optional values. Minor clarifications elsewhere. Update copyright years and authorship. * module/ice-9/getopt-long.scm: Small changes only in non-code parts of source file. --- module/ice-9/getopt-long.scm | 117 +-- 1 file changed, 71 insertions(+), 46 deletions(-) diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm index 4c920cbe5..699e646c4 100644 --- a/module/ice-9/getopt-long.scm +++ b/module/ice-9/getopt-long.scm @@ -1,5 +1,8 @@ -;;; Copyright (C) 1998, 2001, 2006, 2009, 2011 Free Software Foundation, Inc. -;;; + getopt-long.scm --- long options processing -*- scheme -*- + + Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020 +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 @@ -12,54 +15,59 @@ 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 + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301 USA -;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen) +;;; Author: Russ McManus +;;; Rewritten by Thien-Thi Nguyen +;;; Rewritten by Dale Mellor 2020-04-14 ;;; Commentary: ;;; This module implements some complex command line option parsing, in -;;; the spirit of the GNU C library function `getopt_long'. Both long +;;; the spirit of the GNU C library function ‘getopt_long’. Both long ;;; and short options are supported. ;;; ;;; The theory is that people should be able to constrain the set of -;;; options they want to process using a grammar, rather than some arbitrary -;;; structure. The grammar makes the option descriptions easy to read. +;;; options they want to process using a grammar, rather than some ad +;;; hoc procedure. The grammar makes the option descriptions easy to +;;; read. ;;; -;;; `getopt-long' is a procedure for parsing command-line arguments in a -;;; manner consistent with other GNU programs. `option-ref' is a procedure -;;; that facilitates processing of the `getopt-long' return value. +;;; ‘getopt-long’ is a procedure for parsing command-line arguments in a +;;; manner consistent with other GNU programs. ‘option-ref’ is a procedure +;;; that facilitates processing of the ‘getopt-long’ return value. ;;; (getopt-long ARGS GRAMMAR) ;;; Parse the arguments ARGS according to the argument list grammar GRAMMAR. ;;; ;;; ARGS should be a list of strings. Its first element should be the -;;; name of the program; subsequent elements should be the arguments +;;; name of the program, and subsequent elements should be the arguments ;;; that were passed to the program on the command line. The -;;; `program-arguments' procedure returns a list of this form. +;;; ‘program-arguments’ procedure returns a list of this form. ;;; ;;; GRAMMAR is a list of the form: ;;; ((OPTION (PROPERTY VALUE) ...) ...) ;;; -;;; Each OPTION should be a symbol. `getopt-long' will accept a -;;; command-line option named `--OPTION'. +;;; Each OPTION should be a symbol. ‘getopt-long’ will accept a +;;; command-line option named ‘--OPTION’. ;;; Each option can have the following (PROPERTY VALUE) pairs: ;;; -;;; (single-char CHAR) --- Accept `-CHAR' as a single-character -;;;equivalent to `--OPTION'. This is how to specify traditional +;;; (single-char CHAR) --- Accept ‘-CHAR’ as a single-character +;;;equivalent to ‘--OPTION’. This is how to specify traditional ;;;Unix-style flags. ;;; (required? BOOL) --- If BOOL is true, the option is required. ;;;getopt-long will raise an error if it is not found in ARGS. ;;; (value BOOL) --- If BOOL is #t, the option accepts a value; if ;;;it is #f, it does not; and if it is the symbol -;;;`optional', the option may appear in ARGS with or +;;;‘optional’, the option may appear in ARGS with or ;;;without a value. ;;; (predicate FUNC) --- If the option accepts a value (i.e. you -;;;specified `(value #t)' for this option), then getopt -;;;will apply FUNC to the value, and throw an exception -;;;if it returns #f. FUNC should be a procedure which -;;;accepts a string and returns a boolean value; you may -;;;need to use qua
bug#41127: [PATCH 0/2] New (ice-9 command-line-processor).
Modelled after GNU libc's argp command-line parser, and building on (ice-9 getopt-long), this new module allows a one-stop specification of how the command line options should work, (process-command-line (command-line) application "my-app" version "1.0" usage"[OPTION]..." license GPLv3 option (--option=3 -o "demonstration option")) and then the program gets variables with names like --option which convey the state of the command line, (cond (--option => (lambda (o) (display "The option value is ") (display o) (newline))) and as a side-effect --help, --version and --usage are dealt with automatically!
bug#41126: [PATCH] doc: Added very minimal doc strings to (srfi srfi-9 gnu).
* module/srfi/srfi-9/gnu.scm: Added some doc strings. --- module/srfi/srfi-9/gnu.scm | 8 +++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/module/srfi/srfi-9/gnu.scm b/module/srfi/srfi-9/gnu.scm index 219bcdebb..0b9024e75 100644 --- a/module/srfi/srfi-9/gnu.scm +++ b/module/srfi/srfi-9/gnu.scm @@ -31,19 +31,25 @@ set-fields)) (define (set-record-type-printer! type proc) - "Set PROC as the custom printer for TYPE." + "- Scheme Procedure: set-record-type-printer! TYPE PROC + Set PROC as the custom printer for TYPE." (struct-set! type vtable-index-printer proc)) (define-syntax-rule (define-immutable-record-type name ctor pred fields ...) + "- Scheme Procedure: define-immutable-record-type NAME CTOR PRED (FIELD GETTER [SETTER]) ..." ((@@ (srfi srfi-9) %define-record-type) #t (define-immutable-record-type name ctor pred fields ...) name ctor pred fields ...)) (define-syntax-rule (set-field s (getter ...) expr) + "- Scheme Procedure: set-field RECORD (GETTER ...) EXPR + Set the field in RECORD with the GETTER, to the value of EXPR." (%set-fields #t (set-field s (getter ...) expr) () s ((getter ...) expr))) (define-syntax-rule (set-fields s . rest) + "- Scheme Procedure: set-fields RECORD ((GETTER ...) EXPR) ... + Set the fields in the RECORD with the given GETTERs to the corresponding EXPRessions." (%set-fields #t (set-fields s . rest) () s . rest)) -- 2.20.1
bug#41127: [PATCH 1/2] Introduce (ice-9 command-line-processor) module.
* modules/ice-9/command-line-processor.scm: new file * modules/Makefile.am: build command-line-processor.scm * test-suite/tests/command-line-processor.test: new file * test-suite/Makefile.am: run command-line-processor tests --- module/Makefile.am | 1 + module/ice-9/command-line-processor.scm | 646 +++ test-suite/Makefile.am | 1 + test-suite/tests/command-line-processor.test | 155 + 4 files changed, 803 insertions(+) create mode 100644 module/ice-9/command-line-processor.scm create mode 100644 test-suite/tests/command-line-processor.test diff --git a/module/Makefile.am b/module/Makefile.am index 7d3f3280a..48e8faca2 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -65,6 +65,7 @@ SOURCES = \ ice-9/futures.scm\ ice-9/gap-buffer.scm \ ice-9/getopt-long.scm\ + ice-9/command-line-processor.scm \ ice-9/hash-table.scm \ ice-9/hcons.scm \ ice-9/history.scm\ diff --git a/module/ice-9/command-line-processor.scm b/module/ice-9/command-line-processor.scm new file mode 100644 index 0..8bd5690cc --- /dev/null +++ b/module/ice-9/command-line-processor.scm @@ -0,0 +1,646 @@ + command-line-processor.scm --- command-line options processing +-*- scheme -*- + + Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020 +Free Software Foundation, Inc. + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 3 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301 USA + +;;; Author: Dale MellorMay, 2020 + +;;; Commentary: + +;;; Where the Guile (ice-9 getopt-long) module, modelled after the GNU C +;;; libraryʼs ‘getopt_long’ function, allows an application to construct +;;; a grammar prescribing the decomposition of the command-line options, +;;; this module, inspired by the C libraryʼs ‘argp’ parser, gives the +;;; application a higher-level paradigm in which the command-line +;;; processing is specified declaratively. This includes enough of the +;;; application meta-data and some fragmentary help strings for the +;;; completely automatic generation of responses to GNU-standard +;;; ‘--help’, ‘--version’ and ‘--usage’ options, thus alleviating the +;;; need of the application itself to deal with these things. +;;; +;;; The module has three specific aims. +;;; +;;;1) Provide higher-level declarative interface, easier to use. +;;; +;;;2) Automatically respond to --help, --version and --usage +;;; options. +;;; +;;;3) Allow amalgamation of specifications, so that an application +;;; can mix in requirements from modules into its own option +;;; specification--THIS IS NOT CURRENTLY IMPLEMENTED. +;;; +;;; There is just one function which needs to be called to get all of +;;; this functionality: it is ‘process-command-line’, and has the side +;;; effect that new variable bindings appear in the current module +;;; corresponding to all the options. For example, if a declared option +;;; is ‘--do-this’, then a variable called, literally, ‘--do-this’ will +;;; be injected in the current namespace and will have the value +;;; provided on the command-line, or simply #t or #f to indicate whether +;;; or not that option was present on the command line. +;;; +;;; Alternatively, it is possible to create and compose the +;;; specification in separate steps, and then call the above method with +;;; the results. The functions ‘command-line-specification’ and +;;; ‘merge-command-line-specifications’ are provided to this end. + +;;; (process-command-line COMMAND-LINE SPECIFICATION) +;;; Process the COMMAND-LINE according to the application SPECIFICATION. +;;; +;;; COMMAND-LINE is a list of strings, such as that returned from the +;;; core ‘command-line’ function. +;;; +;;; SPECIFICATION is a form holding a space-separated mix of selection +;;; words followed by their respective declarations. The selection +;;; words are ‘application’, ‘author’, ‘bug-address’, ‘copyright’, +;;; ‘help-preamble’, ‘help
bug#41127: [PATCH 2/2] doc: Explain the *command-line-processor* module in texinfo.
* doc/ref/Makefile.am: introduce mod-command-line-processor.texi
* doc/ref/mod-command-line-processor.texi: new file
* doc/ref/guile.texi: changed flow of docs
* doc/ref/mod-getopt-long.texi: changed flow of docs
* doc/ref/srfi-modules.texi: changed flow of docs
---
doc/ref/Makefile.am | 1 +
doc/ref/guile.texi | 4 +-
doc/ref/mod-command-line-processor.texi | 240
doc/ref/mod-getopt-long.texi| 2 +-
doc/ref/srfi-modules.texi | 2 +-
5 files changed, 245 insertions(+), 4 deletions(-)
create mode 100644 doc/ref/mod-command-line-processor.texi
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 2f4b8ca88..b4b1eda9c 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -90,6 +90,7 @@ guile_TEXINFOS = preface.texi \
libguile-extensions.texi \
api-init.texi \
mod-getopt-long.texi \
+mod-command-line-processor.texi\
statprof.texi \
sxml.texi \
texinfo.texi \
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index f91d08f63..9afd9b212 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -357,7 +357,7 @@ available through both Scheme and C interfaces.
* SLIB::Using the SLIB Scheme library.
* POSIX:: POSIX system calls and networking.
* Web:: HTTP, the web, and all that.
-* getopt-long:: Command line handling.
+* Command Line Processor:: Command line handling.
* SRFI Support::Support for various SRFIs.
* R6RS Support::Modules defined by the R6RS.
* R7RS Support::Modules defined by the R7RS.
@@ -381,7 +381,7 @@ available through both Scheme and C interfaces.
@include slib.texi
@include posix.texi
@include web.texi
-@include mod-getopt-long.texi
+@include mod-command-line-processor.texi
@include srfi-modules.texi
@include r6rs.texi
@include r7rs.texi
diff --git a/doc/ref/mod-command-line-processor.texi
b/doc/ref/mod-command-line-processor.texi
new file mode 100644
index 0..cced41fd5
--- /dev/null
+++ b/doc/ref/mod-command-line-processor.texi
@@ -0,0 +1,240 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C) 2020
+@c Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node Command Line Processor, SRFI Support, Web, Guile Modules
+@section The (ice-9 command-line-processor) Module
+
+As its name implies, the @code{(ice-9 command-line-processor)} facility
+is supposed to be a one-stop shop for dealing with the command line. It
+is inspired by the GNU libc's @code{argp} parser, and can be regarded as
+a high-level wrapper around the @xref{getopt-long} module. It is
+designed to provide two specific features.
+
+@itemize @bullet
+@item
+Higher-level (easier to use) abstraction of the command-line user
+interface to this application, including available options and program
+meta-data.
+
+@item
+Automatic handling of @code{--help}, @code{--version} and @code{--usage}
+flags. This means meeting GNU coding standards, and helping to
+‘regularize’ the output from these commands.
+@end itemize
+
+The module provides a single syntax extension to the guile language:
+@code{process-command-line}.
+
+@menu
+* Command Line Examples:: Examples of use.
+* Command Line Reference::Detailed specification of the procedure.
+@end menu
+
+Also see @xref{Command Line Format} for precise details of allowed
+command-line formats.
+
+@node Command Line Examples, Command Line Reference, Command Line Processor,
Command Line Processor
+@subsection A Simple Example
+
+A (silly) program which takes two options, the second of which may
+provide a numerical value, might include the following lines.
+
+@lisp
+(use-modules (ice-9 command-line-processor))
+
+(process-command-line (command-line)
+ application "my-app"
+ option (--option -o "the first option")
+ option (--test=3 -t "another option" string->number))
+
+(when --option (do-something))
+(when --test (display --test) (newline))
+@end lisp
+
+@noindent
+and then the program could be called with command lines like
+
+@example
+$ ./my-app -o
+@end example
+
+@noindent
+or
+
+@example
+$ ./my-app --option -t 4 file-1 file-2
+@end example
+
+@subsection GNU Mcron
+
+For realistic code, here is the first line of executable code GNU's
+@code{mcron} program has (the @code{%} tokens are filled in by the build
+system).
+
+@lisp
+(process-command-line (command-line)
+ application "mcron"
+ version "%VERSION%"
+ usage "[OPTIONS ...] [FILES ...]"
+ help-preamble
+ "Run unattended jobs according to instructions in the FILES... "
+ "(‘-’ for standard input
bug#40719: [PATCH 1/4] test: augment testing of (ice-9 getopt-long) module
Adding some 28 new tests which explore some undefined (or at least implied) behaviour of the module. These are all non-controversial, and the existing module passes all of the tests. * test-suite/tests/getopt-long.test: new code added, some slight re-arrangement of existing code but nothing which changes the original set of tests. --- test-suite/tests/getopt-long.test | 214 ++ 1 file changed, 188 insertions(+), 26 deletions(-) diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test index 4ae604883..a837b0799 100644 --- a/test-suite/tests/getopt-long.test +++ b/test-suite/tests/getopt-long.test @@ -1,7 +1,6 @@ getopt-long.test --- long options processing -*- scheme -*- - Thien-Thi Nguyen --- August 2001 - Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. + Copyright (C) 2001, 2006, 2011 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 @@ -17,6 +16,10 @@ License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;; Author: Thien-Thi Nguyen --- August 2001 +;;; Dale Mellor <> --- April 2020 + + (use-modules (test-suite lib) (ice-9 getopt-long) (ice-9 regex)) @@ -49,6 +52,31 @@ (deferr option-must-be-specified"option must be specified") (deferr option-must-have-arg"option must be specified with argument") + + +(define (symbol/>string a) + (if (symbol? a) (symbol->string a) "")) + +(define (output-sort out) + (sort out (lambda (a b) (stringstring (car a)) +(symbol/>string (car b)) + +(define* (A-TEST args option-specs expectation + #:key stop-at-first-non-option) + (let ((answer +(output-sort + (getopt-long + (cons "foo" (string-split args #\space)) + option-specs + #:stop-at-first-non-option stop-at-first-non-option +(cond ((equal? answer (output-sort expectation)) #t) + (else (format (current-output-port) + "Test result was \n‘~s’ --VS-- \n‘~s’.\n" + answer (output-sort expectation)) + #f + + + (with-test-prefix "exported procs" (pass-if "`option-ref' defined" (defined? 'option-ref)) (pass-if "`getopt-long' defined" (defined? 'getopt-long))) @@ -92,33 +120,39 @@ (with-test-prefix "value optional" - (define (test3 . args) -(getopt-long args '((foo (value optional) (single-char #\f)) -(bar + (define (test args expect) +(A-TEST args + '((foo (value optional) (single-char #\f)) + (bar)) + expect)) + + (pass-if "long option ‘foo’ w/ arg, long option ‘bar’" + (test "--foo fooval --bar" + '((()) (bar . #t) (foo . "fooval" - (pass-if "long option `foo' w/ arg, long option `bar'" - (equal? (test3 "prg" "--foo" "fooval" "--bar") - '((()) (bar . #t) (foo . "fooval" + (pass-if "short option ‘foo’ w/ arg, long option ‘bar’" + (test "-f fooval --bar" + '((()) (bar . #t) (foo . "fooval" - (pass-if "short option `foo' w/ arg, long option `bar'" - (equal? (test3 "prg" "-f" "fooval" "--bar") - '((()) (bar . #t) (foo . "fooval" + (pass-if "short option ‘foo’, long option ‘bar’, no args" + (test "-f --bar" + '((()) (bar . #t) (foo . #t - (pass-if "short option `foo', long option `bar', no args" - (equal? (test3 "prg" "-f" "--bar") - '((()) (bar . #t) (foo . #t + (pass-if "long option ‘foo’, long option ‘bar’, no args" + (test "--foo --bar" + '((()) (bar . #t) (foo . #t - (pass-if "long option `foo', long option `bar', no args" - (equal? (test3 "prg" "--foo" "--bar") - '((()) (bar . #t) (foo . #t + (pass-if "long option ‘bar’, short option ‘foo’, no args" + (test "--bar -f" + '((()) (foo . #t) (bar . #t - (pass-if "long option `bar', short option `foo', no args" - (equal?
bug#40719: [PATCH 2/4] test *broken*: augmented tests of (ice-9 getopt-long)
This is to prepare the ground for some test-driven development mainly to make the module satisfy the needs of the GNU Mcron project. The main requirement is for the module to be more intelligent when dealing with optional values to command-line options: if the following argument looks like a new option then treat it as such, otherwise treat it as the value of the current option. The particular case is mcronʼs -s option which needs to assume a default value of “8” if there is not one on the command line, but currently ‘mcron -s input_file’ fails badly. Other tests introduced involve allowing negative numbers as option values, and dealing with various cases of option-processing termination. * test-suite/tests/getopt-long.test: new code added. --- test-suite/tests/getopt-long.test | 88 ++- 1 file changed, 76 insertions(+), 12 deletions(-) diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test index a837b0799..b0530fe62 100644 --- a/test-suite/tests/getopt-long.test +++ b/test-suite/tests/getopt-long.test @@ -78,8 +78,8 @@ (with-test-prefix "exported procs" - (pass-if "`option-ref' defined" (defined? 'option-ref)) - (pass-if "`getopt-long' defined" (defined? 'getopt-long))) + (pass-if "‘option-ref’ defined" (defined? 'option-ref)) + (pass-if "‘getopt-long’ defined" (defined? 'getopt-long))) (with-test-prefix "specifying predicate" @@ -150,6 +150,15 @@ (test "--bar --foo" '((()) (foo . #t) (bar . #t + (pass-if "long option with equals and space" + (test "--foo= test" + '((() "test") (foo . #t + + (pass-if "long option with equals and space, not allowed a value" + (A-TEST "--foo= test" + '((foo (value #f))) + '((() "test") (foo . #t + (pass-if "--=" (test "--=" '((() "--=" @@ -167,16 +176,16 @@ (bar))) 'foo #f))) - (pass-if "option-ref `--foo 4'" + (pass-if "option-ref ‘--foo 4’" (test4 "4" "--foo" "4")) - (pass-if "option-ref `-f 4'" + (pass-if "option-ref ‘-f 4’" (test4 "4" "-f" "4")) - (pass-if "option-ref `-f4'" + (pass-if "option-ref ‘-f4’" (test4 "4" "-f4")) - (pass-if "option-ref `--foo=4'" + (pass-if "option-ref ‘--foo=4’" (test4 "4" "--foo=4")) ) @@ -262,8 +271,8 @@ (with-test-prefix "apples-blimps-catalexis example" (define spec '((apples(single-char #\a)) - (blimps(single-char #\b) (value #t)) - (catalexis (single-char #\c) (value #t + (blimps(single-char #\b) (value #t)) + (catalexis (single-char #\c) (value #t (define (test8 . args) (equal? (sort (getopt-long (cons "foo" args) spec) @@ -281,9 +290,38 @@ (pass-if "normal 2" (test8 "-ab" "bang" "-c" "couth")) (pass-if "normal 3" (test8 "-ac" "couth" "-b" "bang")) - (pass-if-fatal-exception "bad ordering causes missing option" - exception:option-must-have-arg - (test8 "-abc" "couth" "bang")) + + Dale Mellor 2020-04-14 + + I disagree with this test: to my mind 'c' is 'b's argument, and + the other two arguments are non-options which get passed + through; there should not be an exception. + + ;; (pass-if-fatal-exception "bad ordering causes missing option" + ;; exception:option-must-have-arg + ;; (test8 "-abc" "couth" "bang")) + + (pass-if "clumped options with trailing mandatory value" + (A-TEST "-abc couth bang" + spec + '((() "couth" "bang") (apples . #t) (blimps . "c" + + (pass-if "clumped options with trailing optional value" +(A-TEST "-abc couth bang" +'((apples (single-char #\a)) + (blimps (single-char #\b) + (value optional))) +'((() "couth" "bang") (apples . #t) (blimps . "c" + + (pass-if "clump
bug#40719: [PATCH 4/4] (ice-9 getopt-long): update commentary and doc-strings
Emphasise importance of predicate part of specification of options with optional values. Minor clarifications elsewhere. Update copyright years and authorship. * module/ice-9/getopt-long.scm: Small changes only in non-code parts of source file. --- module/ice-9/getopt-long.scm | 117 +-- 1 file changed, 71 insertions(+), 46 deletions(-) diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm index 4c920cbe5..699e646c4 100644 --- a/module/ice-9/getopt-long.scm +++ b/module/ice-9/getopt-long.scm @@ -1,5 +1,8 @@ -;;; Copyright (C) 1998, 2001, 2006, 2009, 2011 Free Software Foundation, Inc. -;;; + getopt-long.scm --- long options processing -*- scheme -*- + + Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020 +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 @@ -12,54 +15,59 @@ 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 + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301 USA -;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen) +;;; Author: Russ McManus +;;; Rewritten by Thien-Thi Nguyen +;;; Rewritten by Dale Mellor 2020-04-14 ;;; Commentary: ;;; This module implements some complex command line option parsing, in -;;; the spirit of the GNU C library function `getopt_long'. Both long +;;; the spirit of the GNU C library function ‘getopt_long’. Both long ;;; and short options are supported. ;;; ;;; The theory is that people should be able to constrain the set of -;;; options they want to process using a grammar, rather than some arbitrary -;;; structure. The grammar makes the option descriptions easy to read. +;;; options they want to process using a grammar, rather than some ad +;;; hoc procedure. The grammar makes the option descriptions easy to +;;; read. ;;; -;;; `getopt-long' is a procedure for parsing command-line arguments in a -;;; manner consistent with other GNU programs. `option-ref' is a procedure -;;; that facilitates processing of the `getopt-long' return value. +;;; ‘getopt-long’ is a procedure for parsing command-line arguments in a +;;; manner consistent with other GNU programs. ‘option-ref’ is a procedure +;;; that facilitates processing of the ‘getopt-long’ return value. ;;; (getopt-long ARGS GRAMMAR) ;;; Parse the arguments ARGS according to the argument list grammar GRAMMAR. ;;; ;;; ARGS should be a list of strings. Its first element should be the -;;; name of the program; subsequent elements should be the arguments +;;; name of the program, and subsequent elements should be the arguments ;;; that were passed to the program on the command line. The -;;; `program-arguments' procedure returns a list of this form. +;;; ‘program-arguments’ procedure returns a list of this form. ;;; ;;; GRAMMAR is a list of the form: ;;; ((OPTION (PROPERTY VALUE) ...) ...) ;;; -;;; Each OPTION should be a symbol. `getopt-long' will accept a -;;; command-line option named `--OPTION'. +;;; Each OPTION should be a symbol. ‘getopt-long’ will accept a +;;; command-line option named ‘--OPTION’. ;;; Each option can have the following (PROPERTY VALUE) pairs: ;;; -;;; (single-char CHAR) --- Accept `-CHAR' as a single-character -;;;equivalent to `--OPTION'. This is how to specify traditional +;;; (single-char CHAR) --- Accept ‘-CHAR’ as a single-character +;;;equivalent to ‘--OPTION’. This is how to specify traditional ;;;Unix-style flags. ;;; (required? BOOL) --- If BOOL is true, the option is required. ;;;getopt-long will raise an error if it is not found in ARGS. ;;; (value BOOL) --- If BOOL is #t, the option accepts a value; if ;;;it is #f, it does not; and if it is the symbol -;;;`optional', the option may appear in ARGS with or +;;;‘optional’, the option may appear in ARGS with or ;;;without a value. ;;; (predicate FUNC) --- If the option accepts a value (i.e. you -;;;specified `(value #t)' for this option), then getopt -;;;will apply FUNC to the value, and throw an exception -;;;if it returns #f. FUNC should be a procedure which -;;;accepts a string and returns a boolean value; you may -;;;need to use quasiquotes to get it into GRAMMAR. +;;;specified ‘(value #t)’ or ‘(value 'optional)’ for this +;;;option), then getopt will apply FUNC to the value, and +;;;will not take t
bug#40719: [PATCH 3/4] (ice-9 getopt-long): substantially re-written to pass all the new tests
All of the original tests also still pass. Also the entire guile build
actually depends on the correct functioning of this module, so we can be
quite confident that nothing has been broken.
* module/ice-9/getopt-long.scm: Substantially re-written.
---
module/ice-9/getopt-long.scm | 476 +--
1 file changed, 339 insertions(+), 137 deletions(-)
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 14eaf8e23..4c920cbe5 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -158,12 +158,17 @@
(define-module (ice-9 getopt-long)
#:use-module ((ice-9 common-list) #:select (remove-if-not))
+ #:use-module (ice-9 control)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
#:export (getopt-long option-ref))
+;; Code makes more sense to human beings with this.
+(define return values)
+
(define %program-name (make-fluid "guile"))
(define (program-name)
(fluid-ref %program-name))
@@ -175,18 +180,13 @@
(exit 1))
(define-record-type option-spec
- (%make-option-spec name required? option-spec->single-char predicate
value-policy)
+ (%make-option-spec name required? single-char predicate value-policy)
option-spec?
- (name
- option-spec->name set-option-spec-name!)
- (required?
- option-spec->required? set-option-spec-required?!)
- (option-spec->single-char
- option-spec->single-char set-option-spec-single-char!)
- (predicate
- option-spec->predicate set-option-spec-predicate!)
- (value-policy
- option-spec->value-policy set-option-spec-value-policy!))
+ (name option-spec->name)
+ (required?option-spec->required?set-option-spec-required?!)
+ (single-char option-spec->single-char set-option-spec-single-char!)
+ (predicateoption-spec->predicateset-option-spec-predicate!)
+ (value-policy option-spec->value-policy set-option-spec-value-policy!))
(define (make-option-spec name)
(%make-option-spec name #f #f #f #f))
@@ -195,116 +195,331 @@
(let ((spec (make-option-spec (symbol->string (car desc)
(for-each (match-lambda
(('required? val)
-(set-option-spec-required?! spec val))
+(set-option-spec-required?! spec val))
(('value val)
-(set-option-spec-value-policy! spec val))
+(set-option-spec-value-policy! spec val))
(('single-char val)
-(or (char? val)
-(error "`single-char' value must be a char!"))
-(set-option-spec-single-char! spec val))
+(unless (char? val)
+(fatal-error "‘single-char’ value must be a char!"))
+(set-option-spec-single-char! spec val))
(('predicate pred)
-(set-option-spec-predicate!
- spec (lambda (name val)
-(or (not val)
-(pred val)
-(fatal-error "option predicate failed: --~a"
- name)
+(set-option-spec-predicate! spec pred))
((prop val)
-(error "invalid getopt-long option property:" prop)))
+(fatal-error "invalid getopt-long option property:" prop)))
(cdr desc))
spec))
-(define (split-arg-list argument-list)
- ;; Scan ARGUMENT-LIST for "--" and return (BEFORE-LS . AFTER-LS).
- ;; Discard the "--". If no "--" is found, AFTER-LS is empty.
- (let loop ((yes '()) (no argument-list))
-(cond ((null? no) (cons (reverse yes) no))
- ((string=? "--" (car no)) (cons (reverse yes) (cdr no)))
- (else (loop (cons (car no) yes) (cdr no))
-
-(define short-opt-rx (make-regexp "^-([a-zA-Z]+)(.*)"))
-(define long-opt-no-value-rx (make-regexp "^--([^=]+)$"))
-(define long-opt-with-value-rx (make-regexp "^--([^=]+)=(.*)"))
-
-(define (looks-like-an-option string)
- (or (regexp-exec short-opt-rx string)
- (regexp-exec long-opt-with-value-rx string)
- (regexp-exec long-opt-no-value-rx string)))
-
-(define (process-options specs argument-ls stop-at-first-non-option)
- ;; Use SPECS to scan ARGUMENT-LS; return (FOUND . ETC).
- ;; FOUND is an unordered list of option specs for found options, while ETC
- ;; is an order-maintained list of elements in ARGUMENT-LS that are neither
- ;; options nor their values.
- (let ((idx (map (lambda (spec)
-(cons (option-spec->name spec) spec))
- specs))
-(sc-idx (map (lambda (spec)
- (cons (make-string 1 (option-spec->single-char spec))
- spec))
- (remove-if-not option-spec->single-char specs
-(let loop ((unclumped 0) (argument-ls argument-ls
bug#32154: This patch breaks tests and is irrelevant now
Note that this patch breaks an existing test (since 2001), namely (option-ref (getopt-long (list "prog" "-f4") '((foo (value optional) (single-char #\f)) (bar))) 'foo #f) bails out with prog: no such option: -4 The only way to deal with this is to give getopt-long more intelligence in determining where command-line arguments are option values or otherwise; this is the subject of #40719 which also allows numerical short options, but doesn't break the test suite. My suggestion would be to dismiss (close) this bug report at this time.
bug#41127: GIT and GUIX downloads available
For information, all these patches are applied in the GIT repository and GUIX channel described at https://rdmp.org/dmbcs/guile#download.
bug#42669: [PATCH 0/4] GNU Mcron and the (ice-9 getopt-long) module
/Mcron/ is a GNU package which runs unattended jobs in the operating system at dynamically computed times; it is 99% Guile but currently shrouded in a thin veneer of C code for historical reasons, which have by now vanished. The Guile /getopt-long/ module parses a command lineʼs arguments for options and their values according to a provided grammar. In the process of removing the thin veneer of C code from around the /GNU Mcron/ package, I am running up against niggles in the implementation of the /(ice-9 getopt-long)/ module. The intention with /mcron/ has always been that a command-line argument be provided which allows the user to request the display of the next eight jobs to run, or allows the user to specify the number of such jobs. Thus the intention was that command-lines like ‘mcron -s4 file’, ‘mcron -s 4 file’, and ‘mcron -s file’ would all work; alas, the last one, actually the most important case, doesnʼt with the current module, which issues a fatal exit on the grounds that ‘file’ fails to meet predicated requirements of the option for ‘-s’ that it should represent a decimal number. It is clear that /getopt-long/ can do better than this, especially if the consumer of the module provides predicates on values which options can take, e.g. value should be numerical. It can then objectively decide that an argument should be taken to be a value, an option itself, or a ‘loose’ argument. There are other problems which can be cleared up with the enhanced logic, as outlined in Point 2 below. The following patches clear up the situation. 1) The first patch introduces some 28 new tests of the existing /getopt-long/ module; these are non-controversial and the current code passes all the tests, but they exercise more of the corner cases and provide confidence that a new implementation does not break existing behaviour. 2) The second patch inverts one test which I disagree with (see Point 3, below), and introduces 18 more tests which represent currently indeterminate and unsupported behaviour, some nevertheless desired by /mcron/; all of these create either test FAIL cases with the current code-base, or total panic-escape from the calling application. Some specific test failures: 1. A command-line like ‘foo --test=’ produces a /test/ result with the empty string as value; I would expect /#t/ as the value (which indicates that the option is there but has no given value). 2. A command-line with a negative number always errors. According to the in-line documentation negative numbers canʼt ever appear loose on the command-line, but this seems like a case which might be realistic in real life and there is no reason to reject them. 3. A command like ‘foo -abc d’ in which /b/ takes a mandatory argument and /c/ is an allowed option, errors out, but in my opinion in this case /b/ should take “c” as its value and the command-line as a whole is *not* erroneous. If /b/ takes an optional value things are more tricky to deal with, but if there is a predicate on the values which /b/ can take, then the parser can make a clearer decision on taking /c/ as a value or another option. This might seem picky, but the problem is that command-lines are supplied by (possibly hostile) end-users, *not* by the /getopt-long/ module, and not by the application which consumes the module, either. Thus this might be regarded as a security issue. 4. The command ‘mcron -s file’, where /s/ takes an optional numeric value, errors out. 3) The third patch fixes up the /getopt-long/ module to pass all the new tests, as well as all of the existing ones (with the single exception outlined in Point 2.3 above). Considering that the entire Guile build also depends on /getopt-long/, we can have some confidence that the changes do not bring any incompatibility with existing code. 4) The final patch fixes up various commentary and doc-strings in the code to emphasise the importance of predicates on optional values, and generally make things more concrete.
bug#42669: [PATCH 1/4] test: augment testing of (ice-9 getopt-long) module
Adding some 28 new tests which explore some undefined (or at least
implied) behaviour of the module. These are all non-controversial, and
the existing module passes all of the tests.
* test-suite/tests/getopt-long.test: new code added, some slight
re-arrangement of existing code but nothing which changes the original
set of tests.
---
test-suite/tests/getopt-long.test | 184 +-
1 file changed, 182 insertions(+), 2 deletions(-)
diff --git a/test-suite/tests/getopt-long.test
b/test-suite/tests/getopt-long.test
index 4ae604883..d66de0e56 100644
--- a/test-suite/tests/getopt-long.test
+++ b/test-suite/tests/getopt-long.test
@@ -1,5 +1,4 @@
getopt-long.test --- long options processing -*- scheme -*-
- Thien-Thi Nguyen --- August 2001
Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc.
@@ -17,10 +16,17 @@
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;; Author: Thien-Thi Nguyen --- August 2001
+;;; Dale Mellor --- April 2020
+
+
(use-modules (test-suite lib)
(ice-9 getopt-long)
(ice-9 regex))
+
+;; Test infrastructure *
+
(define-syntax pass-if-fatal-exception
(syntax-rules ()
((_ name exn exp)
@@ -49,6 +55,44 @@
(deferr option-must-be-specified"option must be specified")
(deferr option-must-have-arg"option must be specified with argument")
+
+
+;;* Newer test infrastructure ***
+
+;; Many tests here are somewhat flakey as they depend on a precise
+;; internal representation of the options analysis, which isn't really
+;; defined or necessary. In the newer tests below we sort that
+;; structure into alphabetical order, so we know exactly in advance how
+;; to specify the expected results. We also make the test inputs
+;; strings of command-line options, rather than lists, as these are
+;; clearer and easier for us and closer to the real world.
+
+(define* (A-TEST args option-specs expectation
+ #:key stop-at-first-non-option)
+
+ (define (symbol/>string a)
+(if (symbol? a) (symbol->string a) ""))
+
+ (define (output-sort out)
+(sort out (λ (a b) (stringstring (car a))
+ (symbol/>string (car b))
+
+ (let ((answer
+ (output-sort
+ (getopt-long
+ (cons "foo" (string-split args #\space))
+ option-specs
+ #:stop-at-first-non-option stop-at-first-non-option
+(cond ((equal? answer (output-sort expectation)) #t)
+ (else (format (current-output-port)
+"Test result was \n‘~s’ --VS-- \n‘~s’.\n"
+answer (output-sort expectation))
+#f
+
+
+
+;; The tests **
+
(with-test-prefix "exported procs"
(pass-if "`option-ref' defined" (defined? 'option-ref))
(pass-if "`getopt-long' defined" (defined? 'getopt-long)))
@@ -120,7 +164,12 @@
(equal? (test3 "prg" "--bar" "--foo")
'((()) (foo . #t) (bar . #t
- )
+ (pass-if "--="
+ (equal? (test3 "prg" "--=")
+ '((() "--="
+
+ )
+
(with-test-prefix "option-ref"
@@ -299,4 +348,135 @@
)
+
+
+(with-test-prefix "stop at end-of-options marker"
+
+ (define* (test args expectation #:key stop-at-first-non-option)
+(A-TEST args
+'((abby) (ben) (charles))
+expectation
+#:stop-at-first-non-option stop-at-first-non-option))
+
+ (pass-if "stop at start" (test "-- --abby" '((() "--abby"
+
+ (pass-if "stop in middle" (test "--abby dave -- --ben"
+ '((() "dave" "--ben") (abby . #t
+
+ (pass-if "stop at end" (test "--abby dave --ben --"
+ '((() "dave") (abby . #t) (ben . #t
+
+ (pass-if "marker before first non-option"
+(test "--abby -- --ben dave --charles"
+ '((() "--ben" "dave" "--charles") (abby . #t))
+ #:stop-at-first-non-option #t))
+
+ (pass-if "double end marker"
+(test "--abby -- -- --ben"
+ '((() "--" "--ben") (abby . #t
+
+ (pass-if "separated double end markers"
+(test "--abby dave -- --ben -- --charles"
+ '((() "dave" "--ben" "--" "--charles")
+(abby . #t
bug#42669: [PATCH 2/4 (v2)] test *broken*: augmented tests of (ice-9 getopt-long)
This is to prepare the ground for some test-driven development mainly to
make the module satisfy the needs of the GNU Mcron project. The main
requirement is for the module to be more intelligent when dealing with
optional values to command-line options: if the following argument looks
like a new option then treat it as such, otherwise treat it as the value
of the current option. The particular case is mcronʼs -s option which
needs to assume a default value of “8” if there is not one on the
command line, but currently ‘mcron -s input_file’ fails badly.
Other tests introduced involve allowing negative numbers as option
values, and dealing with various cases of option-processing termination.
* test-suite/tests/getopt-long.test: new code added.
---
test-suite/tests/getopt-long.test | 114 --
1 file changed, 109 insertions(+), 5 deletions(-)
diff --git a/test-suite/tests/getopt-long.test
b/test-suite/tests/getopt-long.test
index d66de0e56..589982381 100644
--- a/test-suite/tests/getopt-long.test
+++ b/test-suite/tests/getopt-long.test
@@ -164,6 +164,14 @@
(equal? (test3 "prg" "--bar" "--foo")
'((()) (foo . #t) (bar . #t
+ (pass-if "long option with equals and space"
+ (equal? (test3 "prg" "--foo=" "test")
+ '((() "test") (foo . #t
+
+ (pass-if "long option with equals and space, not allowed a value"
+ (equal? (test3 "prg" "--foo=" "test")
+ '((() "test") (foo . #t
+
(pass-if "--="
(equal? (test3 "prg" "--=")
'((() "--="
@@ -295,9 +303,40 @@
(pass-if "normal 2" (test8 "-ab" "bang" "-c" "couth"))
(pass-if "normal 3" (test8 "-ac" "couth" "-b" "bang"))
- (pass-if-fatal-exception "bad ordering causes missing option"
- exception:option-must-have-arg
- (test8 "-abc" "couth" "bang"))
+
+ Dale Mellor 2020-04-14
+
+ I disagree with this test: to my mind 'c' is 'b's argument, and
+ the other two arguments are non-options which get passed
+ through; there should not be an exception.
+
+ ;; (pass-if-fatal-exception "bad ordering causes missing option"
+ ;; exception:option-must-have-arg
+ ;; (test8 "-abc" "couth" "bang"))
+
+ (pass-if "clumped options with trailing mandatory value"
+ (A-TEST "-abc couth bang"
+ '((apples(single-char #\a))
+ (blimps(single-char #\b) (value #t))
+ (catalexis (single-char #\c) (value #t)))
+ '((() "couth" "bang") (apples . #t) (blimps . "c"
+
+ (pass-if "clumped options with trailing optional value"
+(A-TEST "-abc couth bang"
+'((apples (single-char #\a))
+ (blimps (single-char #\b)
+ (value optional)))
+'((() "couth" "bang") (apples . #t) (blimps . "c"
+
+ (pass-if "clumped options with trailing optional value"
+(A-TEST "-abc couth bang"
+'((apples (single-char #\a))
+ (blimps (single-char #\b)
+ (value optional))
+ (catalexis (single-char #\c)
+ (value #t)))
+'((() "bang")
+ (apples . #t) (blimps . #t) (catalexis . "couth"
)
@@ -346,6 +385,12 @@
#:stop-at-first-non-option #t)
'((() "compile" "-Wformat" "eval.scm" "-o" "eval.go"
+ (pass-if "stop after option"
+(equal? (getopt-long '("foo" "-a" "3" "4" "-b" "4")
+ '((about (single-char #\a) (value #t))
+ (breathe (single-char #\b) (value #t)))
+ #:stop-at-first-non-option #t)
+'((() "4" "-b" "4") (about . "3"
)
@@ -371,6 +416,11 @@
'((() "--ben" "dave" "--charles") (abby . #t))
#:stop-at-first-non-option #t))
+ (pass-if "first non-option before marker"
+ (test "--abby dave --b
bug#42669: [PATCH 3/4 (v2)] (ice-9 getopt-long): substantially re-written to pass all the new tests
All of the original tests also still pass. Also the entire guile build
actually depends on the correct functioning of this module, so we can be
quite confident that nothing has been broken.
* module/ice-9/getopt-long.scm: Substantially re-written.
---
module/ice-9/getopt-long.scm | 459 +++
1 file changed, 309 insertions(+), 150 deletions(-)
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 14eaf8e23..06aa1a879 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -157,16 +157,15 @@
;;; Code:
(define-module (ice-9 getopt-long)
- #:use-module ((ice-9 common-list) #:select (remove-if-not))
+ #:use-module (ice-9 control)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
- #:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
#:export (getopt-long option-ref))
-(define %program-name (make-fluid "guile"))
-(define (program-name)
- (fluid-ref %program-name))
+(define program-name (make-parameter "guile"))
(define (fatal-error fmt . args)
(format (current-error-port) "~a: " (program-name))
@@ -174,19 +173,16 @@
(newline (current-error-port))
(exit 1))
+;; name: string, required?: bool, single-char: char or #f, predicate:
+;; procedure or #f, value-policy: bool or 'optional.
(define-record-type option-spec
- (%make-option-spec name required? option-spec->single-char predicate
value-policy)
+ (%make-option-spec name required? single-char predicate value-policy)
option-spec?
- (name
- option-spec->name set-option-spec-name!)
- (required?
- option-spec->required? set-option-spec-required?!)
- (option-spec->single-char
- option-spec->single-char set-option-spec-single-char!)
- (predicate
- option-spec->predicate set-option-spec-predicate!)
- (value-policy
- option-spec->value-policy set-option-spec-value-policy!))
+ (name option-spec->name)
+ (required?option-spec->required?set-option-spec-required?!)
+ (single-char option-spec->single-char set-option-spec-single-char!)
+ (predicateoption-spec->predicateset-option-spec-predicate!)
+ (value-policy option-spec->value-policy set-option-spec-value-policy!))
(define (make-option-spec name)
(%make-option-spec name #f #f #f #f))
@@ -194,117 +190,292 @@
(define (parse-option-spec desc)
(let ((spec (make-option-spec (symbol->string (car desc)
(for-each (match-lambda
- (('required? val)
-(set-option-spec-required?! spec val))
- (('value val)
-(set-option-spec-value-policy! spec val))
- (('single-char val)
-(or (char? val)
-(error "`single-char' value must be a char!"))
-(set-option-spec-single-char! spec val))
- (('predicate pred)
-(set-option-spec-predicate!
- spec (lambda (name val)
-(or (not val)
-(pred val)
-(fatal-error "option predicate failed: --~a"
- name)
- ((prop val)
-(error "invalid getopt-long option property:" prop)))
- (cdr desc))
+(('required? val)
+ (set-option-spec-required?! spec val))
+(('value val)
+ (set-option-spec-value-policy! spec val))
+(('single-char val)
+ (unless (char? val)
+ (fatal-error "‘single-char’ value must be a char!"))
+ (set-option-spec-single-char! spec val))
+(('predicate pred)
+ (set-option-spec-predicate! spec pred))
+((prop val)
+ (fatal-error "invalid getopt-long option property: " prop)))
+ (cdr desc))
spec))
-(define (split-arg-list argument-list)
- ;; Scan ARGUMENT-LIST for "--" and return (BEFORE-LS . AFTER-LS).
- ;; Discard the "--". If no "--" is found, AFTER-LS is empty.
- (let loop ((yes '()) (no argument-list))
-(cond ((null? no) (cons (reverse yes) no))
- ((string=? "--" (car no)) (cons (reverse yes) (cdr no)))
- (else (loop (cons (car no) yes) (cdr no))
-
-(define short-opt-rx (make-regexp "^-([a-zA-Z]+)(.*)"))
-(define long-opt-no-value-rx (make-regexp "^--([^=]+)$"))
-(define long-opt-with-value-rx (make-regexp "^--([^=]+)=(.*)"))
-
-(define (looks-like-an-option string)
- (or (regexp-exec short-opt-rx string)
- (regexp-exec long-opt-with-value-rx string)
- (regexp-exec long-opt-no-value-rx string)))
-
-(define (process-options specs argument-ls stop-at-first-non-option)
- ;; Use SPECS to scan ARGUMENT-LS; return (FOUND . ETC).
- ;; FOUND is an unordered list of option specs for found options, while ETC
- ;; is an order-maintained list of elements
bug#42669: [PATCH 4/4 (v2)] (ice-9 getopt-long): update commentary and doc-strings
Emphasise importance of predicate part of specification of options with optional values. Minor clarifications elsewhere. Update copyright years and authorship. * module/ice-9/getopt-long.scm: Small changes only in non-code parts of source file. --- module/ice-9/getopt-long.scm | 108 +-- 1 file changed, 65 insertions(+), 43 deletions(-) diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm index 06aa1a879..5726fb5eb 100644 --- a/module/ice-9/getopt-long.scm +++ b/module/ice-9/getopt-long.scm @@ -1,5 +1,8 @@ -;;; Copyright (C) 1998, 2001, 2006, 2009, 2011 Free Software Foundation, Inc. -;;; + getopt-long.scm --- long options processing -*- scheme -*- + + Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020 +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 @@ -12,54 +15,59 @@ 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 + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301 USA -;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen) +;;; Author: Russ McManus +;;; Rewritten by Thien-Thi Nguyen +;;; Rewritten by Dale Mellor 2020-04-14 ;;; Commentary: ;;; This module implements some complex command line option parsing, in -;;; the spirit of the GNU C library function `getopt_long'. Both long +;;; the spirit of the GNU C library function ‘getopt_long’. Both long ;;; and short options are supported. ;;; ;;; The theory is that people should be able to constrain the set of -;;; options they want to process using a grammar, rather than some arbitrary -;;; structure. The grammar makes the option descriptions easy to read. +;;; options they want to process using a grammar, rather than some ad +;;; hoc procedure. The grammar makes the option descriptions easy to +;;; read. ;;; -;;; `getopt-long' is a procedure for parsing command-line arguments in a -;;; manner consistent with other GNU programs. `option-ref' is a procedure -;;; that facilitates processing of the `getopt-long' return value. +;;; ‘getopt-long’ is a procedure for parsing command-line arguments in a +;;; manner consistent with other GNU programs. ‘option-ref’ is a procedure +;;; that facilitates processing of the ‘getopt-long’ return value. ;;; (getopt-long ARGS GRAMMAR) ;;; Parse the arguments ARGS according to the argument list grammar GRAMMAR. ;;; ;;; ARGS should be a list of strings. Its first element should be the -;;; name of the program; subsequent elements should be the arguments +;;; name of the program, and subsequent elements should be the arguments ;;; that were passed to the program on the command line. The -;;; `program-arguments' procedure returns a list of this form. +;;; ‘program-arguments’ procedure returns a list of this form. ;;; ;;; GRAMMAR is a list of the form: ;;; ((OPTION (PROPERTY VALUE) ...) ...) ;;; -;;; Each OPTION should be a symbol. `getopt-long' will accept a -;;; command-line option named `--OPTION'. +;;; Each OPTION should be a symbol. ‘getopt-long’ will accept a +;;; command-line option named ‘--OPTION’. ;;; Each option can have the following (PROPERTY VALUE) pairs: ;;; -;;; (single-char CHAR) --- Accept `-CHAR' as a single-character -;;;equivalent to `--OPTION'. This is how to specify traditional +;;; (single-char CHAR) --- Accept ‘-CHAR’ as a single-character +;;;equivalent to ‘--OPTION’. This is how to specify traditional ;;;Unix-style flags. ;;; (required? BOOL) --- If BOOL is true, the option is required. ;;;getopt-long will raise an error if it is not found in ARGS. ;;; (value BOOL) --- If BOOL is #t, the option accepts a value; if ;;;it is #f, it does not; and if it is the symbol -;;;`optional', the option may appear in ARGS with or +;;;‘optional’, the option may appear in ARGS with or ;;;without a value. ;;; (predicate FUNC) --- If the option accepts a value (i.e. you -;;;specified `(value #t)' for this option), then getopt -;;;will apply FUNC to the value, and throw an exception -;;;if it returns #f. FUNC should be a procedure which -;;;accepts a string and returns a boolean value; you may -;;;need to use quasiquotes to get it into GRAMMAR. +;;;specified ‘(value #t)’ or ‘(value 'optional)’ for this +;;;option), then getopt will apply FUNC to the value, and +;;;will not take t
bug#40719: Patch set superseded by 42669
bug#32154: This issue is now dealt with by #42669
bug#74871: [PATCH] When socket bind or connect fails with a string address, display that address in the error message.
Too often the message 'connect: no such file or directory' appears deep
in network code, and it is very hard to figure out where it is coming
from. At least seeing the path (for example, in the case of a UNIX
socket) will help the user to debug their code.
* libguile/socket.c: extra error handling in scm_bind and scm_connect
functions.
---
libguile/socket.c | 28 ++--
1 file changed, 26 insertions(+), 2 deletions(-)
diff --git a/libguile/socket.c b/libguile/socket.c
index 101afd80d..9deecb48c 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -932,7 +932,19 @@ SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
errno = save_errno;
if (errno == EINPROGRESS || errno == EAGAIN)
return SCM_BOOL_F;
- SCM_SYSERROR;
+ if (scm_is_string (address))
+ {
+ SCM_SYSERROR_MSG
+ ("'~A': ~A",
+ scm_cons (address,
+ scm_cons (scm_strerror (scm_from_int (errno)),
+ SCM_EOL)),
+ errno);
+ }
+ else
+ {
+ SCM_SYSERROR;
+ }
}
free (soka);
return SCM_BOOL_T;
@@ -1002,7 +1014,19 @@ SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
free (soka);
errno = save_errno;
- SCM_SYSERROR;
+ if (scm_is_string (address))
+ {
+ SCM_SYSERROR_MSG
+ ("'~A': ~A",
+ scm_cons (address,
+ scm_cons (scm_strerror (scm_from_int (errno)),
+ SCM_EOL)),
+ errno);
+ }
+ else
+ {
+ SCM_SYSERROR;
+ }
}
free (soka);
return SCM_UNSPECIFIED;
--
2.46.0
