From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Dale Mellor Newsgroups: gmane.lisp.guile.bugs Subject: bug#42669: [PATCH 2/4 (v2)] test *broken*: augmented tests of (ice-9 getopt-long) Date: Sun, 02 Aug 2020 11:34:10 +0100 Organization: DM Bespoke Computer Solutions Ltd Message-ID: <842cf4149fa52b03ebcfd3d202968f873e920efe.camel@rdmp.org> References: Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="28417"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Evolution 3.30.5-1.1 To: 42669@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Sun Aug 02 12:35:07 2020 Return-path: Envelope-to: guile-bugs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1k2BKc-0007HK-J7 for guile-bugs@m.gmane-mx.org; Sun, 02 Aug 2020 12:35:06 +0200 Original-Received: from localhost ([::1]:58706 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k2BKb-0000ar-Ah for guile-bugs@m.gmane-mx.org; Sun, 02 Aug 2020 06:35:05 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46650) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k2BKY-0000ak-6g for bug-guile@gnu.org; Sun, 02 Aug 2020 06:35:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58450) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1k2BKX-0004Jf-UT for bug-guile@gnu.org; Sun, 02 Aug 2020 06:35:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1k2BKX-0001IE-Sq for bug-guile@gnu.org; Sun, 02 Aug 2020 06:35:01 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: Resent-From: Dale Mellor Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sun, 02 Aug 2020 10:35:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42669 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch Original-Received: via spool by 42669-submit@debbugs.gnu.org id=B42669.15963644584908 (code B ref 42669); Sun, 02 Aug 2020 10:35:01 +0000 Original-Received: (at 42669) by debbugs.gnu.org; 2 Aug 2020 10:34:18 +0000 Original-Received: from localhost ([127.0.0.1]:41763 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k2BJq-0001H5-B7 for submit@debbugs.gnu.org; Sun, 02 Aug 2020 06:34:18 -0400 Original-Received: from rdmp.org ([52.19.174.175]:36124) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k2BJo-0001Gr-M7 for 42669@debbugs.gnu.org; Sun, 02 Aug 2020 06:34:17 -0400 Original-Received: from [127.0.0.1] (helo=localhost) by rdmp.org with esmtp (Exim 4.92) (envelope-from ) id 1k2BJi-0005u8-TV for 42669@debbugs.gnu.org; Sun, 02 Aug 2020 10:34:11 +0000 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.io gmane.lisp.guile.bugs:9851 Archived-At: 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 --ben -- --charles" + '((() "dave" "--ben" "--" "--charles") (abby . #t)) + #:stop-at-first-non-option #t)) + (pass-if "double end marker" (test "--abby -- -- --ben" '((() "--" "--ben") (abby . #t)))) @@ -431,16 +481,64 @@ (pass-if "non-predicated -m-1" (test "-d-1" '((()) (dave . "-1")))) +(pass-if-fatal-exception "non-predicated --optional -1" + exception:no-such-option + (test "--charles -1" '((()) (charles . "-1")))) + + (pass-if-fatal-exception "non-predicated -o -1" + exception:no-such-option + (test "-c -1" '((()) (charles . "-1")))) + + (pass-if "non-predicated --mandatory=-1" + (test "--dave=-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 "negative numbers as short options" + + (define (test args expectation) + (A-TEST args + `((zero (single-char #\0) (value #f)) + (one (single-char #\1) (value #t) + (predicate ,string->number)) + (two (single-char #\2) (value optional) + (predicate ,string->number)) + (three (single-char #\3) (value #t) + (predicate ,(λ (in) (not (string->number in))))) + (four (single-char #\4) (value optional) + (predicate ,(λ (in) (not (string->number in))))) + ) + expectation)) + + (pass-if "-0 -2" (test "-0 -2" '((()) (zero . #t) (two . #t)))) + (pass-if "-1 -2" (test "-1 -2" '((()) (one . "-2")))) + (pass-if "-2 -3" (test "-2 -3" '((()) (two . "-3")))) + (pass-if "-0 -4 test" (test "-0 -4 test" + '((()) (zero . #t) (four . "test")))) + (pass-if "-4 -2" (test "-4 -2" '((()) (four . #t) (two . #t)))) + (pass-if-fatal-exception "-4 -3" exception:option-must-have-arg + (test "-4 -3" '((())))) + (pass-if "-3a" (test "-3a" '((()) (three . "a")))) + (pass-if "-13" (test "-13" '((()) (one . "3")))) + (pass-if "-03a" (test "-03a" '((()) (zero . #t) (three . "a")))) + (pass-if "-023" (test "-023" '((()) (zero . #t) (two . "3")))) + (pass-if "-025" (test "-025" '((()) (zero . #t) (two . "5")))) + (pass-if-fatal-exception "-025a" exception:no-such-option + (test "-025a" '((()) (zero . #t) (two . "5")))) + (pass-if "-02 a" (test "-02 a" '((() "a") (zero . #t) (two . #t)))) + (pass-if-fatal-exception "-02a" exception:no-such-option + (test "-02a" '((())))) + ) + + (with-test-prefix "mcron backwards compatibility" (define (test args expectation) @@ -461,9 +559,15 @@ (pass-if "-s 8" (test "-s 8 file" '((() "file") (schedule . "8")))) + (pass-if "-s file" + (test "-s file" '((() "file") (schedule . #t)))) + (pass-if "-sd file" (test "-sd file" '((() "file") (daemon . #t) (schedule . #t)))) + (pass-if "-ds file" + (test "-ds file" '((() "file") (daemon . #t) (schedule . #t)))) + (pass-if "--schedule=8" (test "--schedule=8 file" '((() "file") (schedule . "8")))) -- 2.27.0