unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
From: Dale Mellor <guile-qf1qmg@rdmp.org>
To: 40719@debbugs.gnu.org
Subject: bug#40719: [PATCH 2/4] test *broken*: augmented tests of (ice-9 getopt-long)
Date: Thu, 07 May 2020 18:03:12 +0100	[thread overview]
Message-ID: <1d7a1ced8667b016f73af7fb2f709f2a7c40fe1c.camel@rdmp.org> (raw)
In-Reply-To: <c991d9c48eef80a68274ee28a0c1040b4eea4953.camel@rdmp.org>


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







  parent reply	other threads:[~2020-05-07 17:03 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-04-19 17:47 bug#40719: [PATCH 0/4] GNU Mcron and the (ice-9 getopt-long) module Dale Mellor
2020-05-07 17:01 ` bug#40719: [PATCH 1/4] test: augment testing of " Dale Mellor
2020-05-07 17:03 ` Dale Mellor [this message]
2020-05-07 17:04 ` bug#40719: [PATCH 3/4] (ice-9 getopt-long): substantially re-written to pass all the new tests Dale Mellor
2020-05-07 17:05 ` bug#40719: [PATCH 4/4] (ice-9 getopt-long): update commentary and doc-strings Dale Mellor
2020-08-02 10:41 ` bug#40719: Patch set superseded by 42669 Dale Mellor

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1d7a1ced8667b016f73af7fb2f709f2a7c40fe1c.camel@rdmp.org \
    --to=guile-qf1qmg@rdmp.org \
    --cc=40719@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).