From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Dale Mellor Newsgroups: gmane.lisp.guile.bugs Subject: bug#40722: [PATCH 2/4] test *broken*: augmented tests of (ice-9 getopt-long) Date: Sun, 19 Apr 2020 18:47:37 +0100 Organization: DM Bespoke Computer Solutions Ltd Message-ID: <1ffc667b08c617c0082720db5b0105a64b79ce40.camel@rdmp.org> Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="71472"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Evolution 3.30.5-1.1 To: 40722@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Sun Apr 19 21:02:13 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 1jQFCm-000ITw-EX for guile-bugs@m.gmane-mx.org; Sun, 19 Apr 2020 21:02:12 +0200 Original-Received: from localhost ([::1]:46648 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jQFCl-0001jG-ED for guile-bugs@m.gmane-mx.org; Sun, 19 Apr 2020 15:02:11 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:42818 helo=eggs1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jQFCf-0001ht-FH for bug-guile@gnu.org; Sun, 19 Apr 2020 15:02:06 -0400 Original-Received: from Debian-exim by eggs1p.gnu.org with spam-scanned (Exim 4.90_1) (envelope-from ) id 1jQFCe-0000NK-GE for bug-guile@gnu.org; Sun, 19 Apr 2020 15:02:05 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:34430) by eggs1p.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jQFCe-0000MP-3H for bug-guile@gnu.org; Sun, 19 Apr 2020 15:02:04 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jQFCd-0005zE-Qt for bug-guile@gnu.org; Sun, 19 Apr 2020 15:02:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Dale Mellor Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sun, 19 Apr 2020 19:02:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 40722 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-guile@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.158732287322916 (code B ref -1); Sun, 19 Apr 2020 19:02:03 +0000 Original-Received: (at submit) by debbugs.gnu.org; 19 Apr 2020 19:01:13 +0000 Original-Received: from localhost ([127.0.0.1]:45970 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jQFBp-0005xR-17 for submit@debbugs.gnu.org; Sun, 19 Apr 2020 15:01:13 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:43171) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jQEVc-0004op-PT for submit@debbugs.gnu.org; Sun, 19 Apr 2020 14:17:37 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:34074 helo=eggs1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jQEVc-0005rh-7h for bug-guile@gnu.org; Sun, 19 Apr 2020 14:17:36 -0400 Original-Received: from Debian-exim by eggs1p.gnu.org with spam-scanned (Exim 4.90_1) (envelope-from ) id 1jQEVb-0006bc-Q9 for bug-guile@gnu.org; Sun, 19 Apr 2020 14:17:36 -0400 Original-Received: from ec2-52-19-174-175.eu-west-1.compute.amazonaws.com ([52.19.174.175]:45790 helo=rdmp.org) by eggs1p.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jQEVb-0006Xd-9M for bug-guile@gnu.org; Sun, 19 Apr 2020 14:17:35 -0400 Original-Received: from [127.0.0.1] (helo=localhost) by rdmp.org with esmtp (Exim 4.92) (envelope-from ) id 1jQE2b-0002Xd-Hm for bug-guile@gnu.org; Sun, 19 Apr 2020 17:47:37 +0000 Received-SPF: softfail client-ip=52.19.174.175; envelope-from=guile-qf1qmg@rdmp.org; helo=rdmp.org X-detected-operating-system: by eggs1p.gnu.org: Genre and OS details not recognized. X-Mailman-Approved-At: Sun, 19 Apr 2020 15:01:09 -0400 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Received-From: 209.51.188.43 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:9721 Archived-At: >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 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")))) ) @@ -326,12 +364,19 @@ (with-test-prefix "stop-at-first-non-option" (pass-if "guile-tools compile example" - (equal? (getopt-long '("guile-tools" "compile" "-Wformat" "eval.scm" "-o" "eval.go") + (equal? (getopt-long '("guile-tools" "compile" "-Wformat" + "eval.scm" "-o" "eval.go") '((help (single-char #\h)) (version (single-char #\v))) #: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")))) ) @@ -356,6 +401,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)))) @@ -409,6 +459,14 @@ (pass-if "non-predicated -o-1" (test "-c-1" '((()) (charles . "-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")))) @@ -444,9 +502,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.20.1