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 <t...@gnu.org> --- 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 <t...@gnu.org> --- 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) (string<? (symbol/>string (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)))) + ) + + + +(with-test-prefix "negative numbers for option values" + + (define (test args expectation) + (A-TEST args + `((arthur (single-char #\a) (value optional) + (predicate ,string->number)) + (beth (single-char #\b) (value #t) + (predicate ,string->number)) + (charles (single-char #\c) (value optional)) + (dave (single-char #\d) (value #t))) + expectation)) + + (pass-if "predicated --optional=-1" + (test "--arthur=-1" '((()) (arthur . "-1")))) + + (pass-if "predicated -o-1" + (test "-a-1" '((()) (arthur . "-1")))) + + (pass-if "predicated --optional -1" + (test "--arthur -1" '((()) (arthur . "-1")))) + + (pass-if "predicated -o -1" + (test "-a -1" '((()) (arthur . "-1")))) + + (pass-if "predicated --mandatory=-1" + (test "--beth=-1" '((()) (beth . "-1")))) + + (pass-if "predicated -m-1" + (test "-b-1" '((()) (beth . "-1")))) + + (pass-if "predicated --mandatory -1" + (test "--beth -1" '((()) (beth . "-1")))) + + (pass-if "predicated -m -1" + (test "-b -1" '((()) (beth . "-1")))) + + (pass-if "non-predicated --optional=-1" + (test "--charles=-1" '((()) (charles . "-1")))) + + (pass-if "non-predicated -o-1" + (test "-c-1" '((()) (charles . "-1")))) + + (pass-if "non-predicated --mandatory=-1" + (test "--dave=-1" '((()) (dave . "-1")))) + + (pass-if "non-predicated -m-1" + (test "-d-1" '((()) (dave . "-1")))) + + (pass-if "non-predicated --mandatory -1" + (test "--dave -1" '((()) (dave . "-1")))) + + (pass-if "non-predicated -m -1" + (test "-d -1" '((()) (dave . "-1")))) + + ) + + + +(with-test-prefix "mcron backwards compatibility" + + (define (test args expectation) + (A-TEST args + `((daemon (single-char #\d) (value #f)) + (stdin (single-char #\i) (value #t) + (predicate ,(λ (in) (or (string=? in "guile") + (string=? in "vixie"))))) + (schedule (single-char #\s) (value optional) + (predicate ,(λ (in) (or (eq? in #t) + (and (string? in) + (string->number in)))))) + (help (single-char #\?)) + (version (single-char #\V))) + expectation)) + + (pass-if "-s8" (test "-s8 file" '((() "file") (schedule . "8")))) + + (pass-if "-s 8" (test "-s 8 file" '((() "file") (schedule . "8")))) + + (pass-if "-sd file" + (test "-sd file" '((() "file") (daemon . #t) (schedule . #t)))) + + (pass-if "--schedule=8" (test "--schedule=8 file" + '((() "file") (schedule . "8")))) + + (pass-if "--schedule 8" (test "--schedule 8 file" + '((() "file") (schedule . "8")))) + + (pass-if "-ds8" (test "-ds8 file" + '((() "file") (daemon . #t) (schedule . "8")))) + + (pass-if "-ds 8" (test "-ds 8 file" + '((() "file") (daemon . #t) (schedule . "8")))) + + ) + + ;;; getopt-long.test ends here -- 2.27.0