gpgscm: Simplify hash tables.
[gnupg.git] / tests / gpgscm / tests.scm
1 ;; Common definitions for writing tests.
2 ;;
3 ;; Copyright (C) 2016 g10 Code GmbH
4 ;;
5 ;; This file is part of GnuPG.
6 ;;
7 ;; GnuPG is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 3 of the License, or
10 ;; (at your option) any later version.
11 ;;
12 ;; GnuPG is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 ;; GNU General Public License for more details.
16 ;;
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
19
20 ;; Trace displays and returns the given value.  A debugging aid.
21 (define (trace x)
22   (display x)
23   (newline)
24   x)
25
26 ;; Stringification.
27 (define (stringify expression)
28   (let ((p (open-output-string)))
29     (write expression p)
30     (get-output-string p)))
31
32 ;; Reporting.
33 (define (echo . msg)
34   (for-each (lambda (x) (display x) (display " ")) msg)
35   (newline))
36
37 (define (info . msg)
38   (apply echo msg)
39   (flush-stdio))
40
41 (define (log . msg)
42   (if (> (*verbose*) 0)
43       (apply info msg)))
44
45 (define (fail . msg)
46   (apply info msg)
47   (exit 1))
48
49 (define (skip . msg)
50   (apply info msg)
51   (exit 77))
52
53 (define (make-counter)
54   (let ((c 0))
55     (lambda ()
56       (let ((r c))
57         (set! c (+ 1 c))
58         r))))
59
60 (define *progress-nesting* 0)
61
62 (define (call-with-progress msg what)
63   (set! *progress-nesting* (+ 1 *progress-nesting*))
64   (if (= 1 *progress-nesting*)
65       (begin
66         (info msg)
67         (display "    > ")
68         (flush-stdio)
69         (what (lambda (item)
70               (display item)
71               (display " ")
72               (flush-stdio)))
73         (info "< "))
74       (begin
75         (what (lambda (item) (display ".") (flush-stdio)))
76         (display " ")
77         (flush-stdio)))
78   (set! *progress-nesting* (- *progress-nesting* 1)))
79
80 (define (for-each-p msg proc lst . lsts)
81   (apply for-each-p' `(,msg ,proc ,(lambda (x . xs) x) ,lst ,@lsts)))
82
83 (define (for-each-p' msg proc fmt lst . lsts)
84   (call-with-progress
85    msg
86    (lambda (progress)
87      (apply for-each
88             `(,(lambda args
89                  (progress (apply fmt args))
90                  (apply proc args))
91               ,lst ,@lsts)))))
92
93 ;; Process management.
94 (define CLOSED_FD -1)
95 (define (call-with-fds what infd outfd errfd)
96   (wait-process (stringify what) (spawn-process-fd what infd outfd errfd) #t))
97 (define (call what)
98   (call-with-fds what
99                  CLOSED_FD
100                  (if (< (*verbose*) 0) STDOUT_FILENO CLOSED_FD)
101                  (if (< (*verbose*) 0) STDERR_FILENO CLOSED_FD)))
102
103 ;; Accessor functions for the results of 'spawn-process'.
104 (define :stdin car)
105 (define :stdout cadr)
106 (define :stderr caddr)
107 (define :pid cadddr)
108
109 (define (call-with-io what in)
110   (let ((h (spawn-process what 0)))
111     (es-write (:stdin h) in)
112     (es-fclose (:stdin h))
113     (let* ((out (es-read-all (:stdout h)))
114            (err (es-read-all (:stderr h)))
115            (result (wait-process (car what) (:pid h) #t)))
116       (es-fclose (:stdout h))
117       (es-fclose (:stderr h))
118       (if (> (*verbose*) 2)
119           (begin
120             (echo (stringify what) "returned:" result)
121             (echo (stringify what) "wrote to stdout:" out)
122             (echo (stringify what) "wrote to stderr:" err)))
123       (list result out err))))
124
125 ;; Accessor function for the results of 'call-with-io'.  ':stdout' and
126 ;; ':stderr' can also be used.
127 (define :retcode car)
128
129 (define (call-check what)
130   (let ((result (call-with-io what "")))
131     (if (= 0 (:retcode result))
132         (:stdout result)
133         (throw (string-append (stringify what) " failed")
134                (:stderr result)))))
135
136 (define (call-popen command input-string)
137   (let ((result (call-with-io command input-string)))
138     (if (= 0 (:retcode result))
139         (:stdout result)
140         (throw (:stderr result)))))
141
142 ;;
143 ;; estream helpers.
144 ;;
145
146 (define (es-read-all stream)
147   (let loop
148       ((acc ""))
149     (if (es-feof stream)
150         acc
151         (loop (string-append acc (es-read stream 4096))))))
152
153 ;;
154 ;; File management.
155 ;;
156 (define (file-exists? name)
157   (call-with-input-file name (lambda (port) #t)))
158
159 (define (file=? a b)
160   (file-equal a b #t))
161
162 (define (text-file=? a b)
163   (file-equal a b #f))
164
165 (define (file-copy from to)
166   (catch '() (unlink to))
167   (letfd ((source (open from (logior O_RDONLY O_BINARY)))
168           (sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600)))
169     (splice source sink)))
170
171 (define (text-file-copy from to)
172   (catch '() (unlink to))
173   (letfd ((source (open from O_RDONLY))
174           (sink (open to (logior O_WRONLY O_CREAT) #o600)))
175     (splice source sink)))
176
177 (define (path-join . components)
178   (let loop ((acc #f) (rest (filter (lambda (s)
179                                       (not (string=? "" s))) components)))
180     (if (null? rest)
181         acc
182         (loop (if (string? acc)
183                   (string-append acc "/" (car rest))
184                   (car rest))
185               (cdr rest)))))
186 (assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
187 (assert (string=? (path-join "" "bar" "baz") "bar/baz"))
188
189 ;; Is PATH an absolute path?
190 (define (absolute-path? path)
191   (or (char=? #\/ (string-ref path 0))
192       (and *win32* (char=? #\\ (string-ref path 0)))
193       (and *win32*
194            (char-alphabetic? (string-ref path 0))
195            (char=? #\: (string-ref path 1))
196            (or (char=? #\/ (string-ref path 2))
197                (char=? #\\ (string-ref path 2))))))
198
199 ;; Make PATH absolute.
200 (define (canonical-path path)
201   (if (absolute-path? path) path (path-join (getcwd) path)))
202
203 (define (in-srcdir . names)
204   (canonical-path (apply path-join (cons (getenv "srcdir") names))))
205
206 ;; Try to find NAME in PATHS.  Returns the full path name on success,
207 ;; or raises an error.
208 (define (path-expand name paths)
209   (let loop ((path paths))
210     (if (null? path)
211         (throw "Could not find" name "in" paths)
212         (let* ((qualified-name (path-join (car path) name))
213                (file-exists (call-with-input-file qualified-name
214                               (lambda (x) #t))))
215           (if file-exists
216               qualified-name
217               (loop (cdr path)))))))
218
219 ;; Expand NAME using the gpgscm load path.  Use like this:
220 ;;   (load (with-path "library.scm"))
221 (define (with-path name)
222   (catch name
223          (path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*))))
224
225 (define (basename path)
226   (let ((i (string-index path #\/)))
227     (if (equal? i #f)
228         path
229         (basename (substring path (+ 1 i) (string-length path))))))
230
231 (define (basename-suffix path suffix)
232   (basename
233    (if (string-suffix? path suffix)
234        (substring path 0 (- (string-length path) (string-length suffix)))
235        path)))
236
237 ;; Helper for (pipe).
238 (define :read-end car)
239 (define :write-end cadr)
240
241 ;; let-like macro that manages file descriptors.
242 ;;
243 ;; (letfd <bindings> <body>)
244 ;;
245 ;; Bind all variables given in <bindings> and initialize each of them
246 ;; to the given initial value, and close them after evaluting <body>.
247 (define-macro (letfd bindings . body)
248   (let bind ((bindings' bindings))
249     (if (null? bindings')
250         `(begin ,@body)
251         (let* ((binding (car bindings'))
252                (name (car binding))
253                (initializer (cadr binding)))
254           `(let ((,name ,initializer))
255              (finally (close ,name)
256                       ,(bind (cdr bindings'))))))))
257
258 (define-macro (with-working-directory new-directory . expressions)
259   (let ((new-dir (gensym))
260         (old-dir (gensym)))
261     `(let* ((,new-dir ,new-directory)
262             (,old-dir (getcwd)))
263        (dynamic-wind
264            (lambda () (if ,new-dir (chdir ,new-dir)))
265            (lambda () ,@expressions)
266            (lambda () (chdir ,old-dir))))))
267
268 ;; Make a temporary directory.  If arguments are given, they are
269 ;; joined using path-join, and must end in a component ending in
270 ;; "XXXXXX".  If no arguments are given, a suitable location and
271 ;; generic name is used.  Returns an absolute path.
272 (define (mkdtemp . components)
273   (canonical-path (_mkdtemp (if (null? components)
274                                 (string-append "gpgscm-" (get-isotime) "-"
275                                                (basename-suffix *scriptname* ".scm")
276                                                "-XXXXXX")
277                                 (apply path-join components)))))
278
279 (define-macro (with-temporary-working-directory . expressions)
280   (let ((tmp-sym (gensym)))
281     `(let* ((,tmp-sym (mkdtemp)))
282        (finally (unlink-recursively ,tmp-sym)
283                 (with-working-directory ,tmp-sym
284                                         ,@expressions)))))
285
286 (define (make-temporary-file . args)
287   (canonical-path (path-join
288                    (mkdtemp)
289                    (if (null? args) "a" (car args)))))
290
291 (define (remove-temporary-file filename)
292   (catch '()
293     (unlink filename))
294   (let ((dirname (substring filename 0 (string-rindex filename #\/))))
295     (catch (echo "removing temporary directory" dirname "failed")
296       (rmdir dirname))))
297
298 ;; let-like macro that manages temporary files.
299 ;;
300 ;; (lettmp <bindings> <body>)
301 ;;
302 ;; Bind all variables given in <bindings>, initialize each of them to
303 ;; a string representing an unique path in the filesystem, and delete
304 ;; them after evaluting <body>.
305 (define-macro (lettmp bindings . body)
306   (let bind ((bindings' bindings))
307     (if (null? bindings')
308         `(begin ,@body)
309         (let ((name (car bindings'))
310               (rest (cdr bindings')))
311           `(let ((,name (make-temporary-file ,(symbol->string name))))
312              (finally (remove-temporary-file ,name)
313                       ,(bind rest)))))))
314
315 (define (check-execution source transformer)
316   (lettmp (sink)
317           (transformer source sink)))
318
319 (define (check-identity source transformer)
320   (lettmp (sink)
321           (transformer source sink)
322           (if (not (file=? source sink))
323               (fail "mismatch"))))
324
325 ;;
326 ;; Monadic pipe support.
327 ;;
328
329 (define pipeM
330   (package
331    (define (new procs source sink producer)
332      (package
333       (define (dump)
334         (write (list procs source sink producer))
335         (newline))
336       (define (add-proc command pid)
337         (new (cons (list command pid) procs) source sink producer))
338       (define (commands)
339         (map car procs))
340       (define (pids)
341         (map cadr procs))
342       (define (set-source source')
343         (new procs source' sink producer))
344       (define (set-sink sink')
345         (new procs source sink' producer))
346       (define (set-producer producer')
347         (if producer
348             (throw "producer already set"))
349         (new procs source sink producer'))))))
350
351
352 (define (pipe:do . commands)
353   (let loop ((M (pipeM::new '() CLOSED_FD CLOSED_FD #f)) (cmds commands))
354     (if (null? cmds)
355         (begin
356           (if M::producer (M::producer))
357           (if (not (null? M::procs))
358               (let* ((retcodes (wait-processes (map stringify (M::commands))
359                                                (M::pids) #t))
360                      (results (map (lambda (p r) (append p (list r)))
361                                    M::procs retcodes))
362                      (failed (filter (lambda (x) (not (= 0 (caddr x))))
363                                      results)))
364                 (if (not (null? failed))
365                     (throw failed))))) ; xxx nicer reporting
366         (if (and (= 2 (length cmds)) (number? (cadr cmds)))
367             ;; hack: if it's an fd, use it as sink
368             (let ((M' ((car cmds) (M::set-sink (cadr cmds)))))
369               (if (> M::source 2) (close M::source))
370               (if (> (cadr cmds) 2) (close (cadr cmds)))
371               (loop M' '()))
372             (let ((M' ((car cmds) M)))
373               (if (> M::source 2) (close M::source))
374               (loop M' (cdr cmds)))))))
375
376 (define (pipe:open pathname flags)
377   (lambda (M)
378     (M::set-source (open pathname flags))))
379
380 (define (pipe:defer producer)
381   (lambda (M)
382     (let* ((p (outbound-pipe))
383            (M' (M::set-source (:read-end p))))
384       (M'::set-producer (lambda ()
385                           (producer (:write-end p))
386                           (close (:write-end p)))))))
387 (define (pipe:echo data)
388  (pipe:defer (lambda (sink) (display data (fdopen sink "wb")))))
389
390 (define (pipe:spawn command)
391   (lambda (M)
392     (define (do-spawn M new-source)
393       (let ((pid (spawn-process-fd command M::source M::sink
394                                    (if (> (*verbose*) 0)
395                                        STDERR_FILENO CLOSED_FD)))
396             (M' (M::set-source new-source)))
397         (M'::add-proc command pid)))
398     (if (= CLOSED_FD M::sink)
399         (let* ((p (pipe))
400                (M' (do-spawn (M::set-sink (:write-end p)) (:read-end p))))
401           (close (:write-end p))
402           (M'::set-sink CLOSED_FD))
403         (do-spawn M CLOSED_FD))))
404
405 (define (pipe:splice sink)
406   (lambda (M)
407     (splice M::source sink)
408     (M::set-source CLOSED_FD)))
409
410 (define (pipe:write-to pathname flags mode)
411   (open pathname flags mode))
412
413 ;;
414 ;; Monadic transformer support.
415 ;;
416
417 (define (tr:do . commands)
418   (let loop ((tmpfiles '()) (source  #f) (cmds commands))
419     (if (null? cmds)
420         (for-each remove-temporary-file tmpfiles)
421         (let* ((v ((car cmds) tmpfiles source))
422                (tmpfiles' (car v))
423                (sink (cadr v))
424                (error (caddr v)))
425           (if error
426               (begin
427                 (for-each remove-temporary-file tmpfiles')
428                 (apply throw error)))
429           (loop tmpfiles' sink (cdr cmds))))))
430
431 (define (tr:open pathname)
432   (lambda (tmpfiles source)
433     (list tmpfiles pathname #f)))
434
435 (define (tr:spawn input command)
436   (lambda (tmpfiles source)
437     (if (and (member '**in** command) (not source))
438         (fail (string-append (stringify cmd) " needs an input")))
439     (let* ((t (make-temporary-file))
440            (cmd (map (lambda (x)
441                        (cond
442                         ((equal? '**in** x) source)
443                         ((equal? '**out** x) t)
444                         (else x))) command)))
445       (catch (list (cons t tmpfiles) t *error*)
446              (call-popen cmd input)
447              (if (and (member '**out** command) (not (file-exists? t)))
448                  (fail (string-append (stringify cmd)
449                                        " did not produce '" t "'.")))
450              (list (cons t tmpfiles) t #f)))))
451
452 (define (tr:write-to pathname)
453   (lambda (tmpfiles source)
454     (rename source pathname)
455     (list tmpfiles pathname #f)))
456
457 (define (tr:pipe-do . commands)
458   (lambda (tmpfiles source)
459     (let ((t (make-temporary-file)))
460       (apply pipe:do
461         `(,@(if source `(,(pipe:open source (logior O_RDONLY O_BINARY))) '())
462           ,@commands
463           ,(pipe:write-to t (logior O_WRONLY O_BINARY O_CREAT) #o600)))
464       (list (cons t tmpfiles) t #f))))
465
466 (define (tr:assert-identity reference)
467   (lambda (tmpfiles source)
468     (if (not (file=? source reference))
469         (fail "mismatch"))
470     (list tmpfiles source #f)))
471
472 (define (tr:assert-weak-identity reference)
473   (lambda (tmpfiles source)
474     (if (not (text-file=? source reference))
475         (fail "mismatch"))
476     (list tmpfiles source #f)))
477
478 (define (tr:call-with-content function . args)
479   (lambda (tmpfiles source)
480     (catch (list tmpfiles source *error*)
481            (apply function `(,(call-with-input-file source read-all) ,@args)))
482     (list tmpfiles source #f)))
483
484 ;;
485 ;; Developing and debugging tests.
486 ;;
487
488 ;; Spawn an os shell.
489 (define (interactive-shell)
490   (call-with-fds `(,(getenv "SHELL") -i) 0 1 2))
491
492 ;;
493 ;; The main test framework.
494 ;;
495
496 ;; A pool of tests.
497 (define test-pool
498   (package
499    (define (new procs)
500      (package
501       (define (add test)
502         (new (cons test procs)))
503       (define (wait)
504         (let ((unfinished (filter (lambda (t) (not t::retcode)) procs)))
505           (if (null? unfinished)
506               (package)
507               (let* ((names (map (lambda (t) t::name) unfinished))
508                      (pids (map (lambda (t) t::pid) unfinished))
509                      (results
510                       (map (lambda (pid retcode) (list pid retcode))
511                            pids
512                            (wait-processes (map stringify names) pids #t))))
513                 (new
514                  (map (lambda (t)
515                         (if t::retcode
516                             t
517                             (t::set-retcode (cadr (assoc t::pid results)))))
518                       procs))))))
519       (define (passed)
520         (filter (lambda (p) (= 0 p::retcode)) procs))
521       (define (skipped)
522         (filter (lambda (p) (= 77 p::retcode)) procs))
523       (define (hard-errored)
524         (filter (lambda (p) (= 99 p::retcode)) procs))
525       (define (failed)
526         (filter (lambda (p)
527                   (not (or (= 0 p::retcode) (= 77 p::retcode)
528                            (= 99 p::retcode))))
529                 procs))
530       (define (report)
531         (define (print-tests tests message)
532           (unless (null? tests)
533                   (apply echo (cons message
534                                     (map (lambda (t) t::name) tests)))))
535
536         (let ((failed' (failed)) (skipped' (skipped)))
537           (echo (length procs) "tests run,"
538                 (length (passed)) "succeeded,"
539                 (length failed') "failed,"
540                 (length skipped') "skipped.")
541           (print-tests failed' "Failed tests:")
542           (print-tests skipped' "Skipped tests:")
543           (length failed')))))))
544
545 (define (verbosity n)
546   (if (= 0 n) '() (cons '--verbose (verbosity (- n 1)))))
547
548 (define (locate-test path)
549   (if (absolute-path? path) path (in-srcdir path)))
550
551 ;; A single test.
552 (define test
553   (package
554    (define (scm setup name path . args)
555      ;; Start the process.
556      (define (spawn-scm args' in out err)
557        (spawn-process-fd `(,*argv0* ,@(verbosity (*verbose*))
558                                     ,(locate-test path)
559                                     ,@(if setup (force setup) '())
560                                     ,@args' ,@args) in out err))
561      (new name #f spawn-scm #f #f CLOSED_FD))
562
563    (define (binary setup name path . args)
564      ;; Start the process.
565      (define (spawn-binary args' in out err)
566        (spawn-process-fd `(,path ,@(if setup (force setup) '()) ,@args' ,@args)
567                          in out err))
568      (new name #f spawn-binary #f #f CLOSED_FD))
569
570    (define (new name directory spawn pid retcode logfd)
571      (package
572       (define (set-directory x)
573         (new name x spawn pid retcode logfd))
574       (define (set-retcode x)
575         (new name directory spawn pid x logfd))
576       (define (set-pid x)
577         (new name directory spawn x retcode logfd))
578       (define (set-logfd x)
579         (new name directory spawn pid retcode x))
580       (define (open-log-file)
581         (let ((filename (string-append (basename name) ".log")))
582           (catch '() (unlink filename))
583           (open filename (logior O_RDWR O_BINARY O_CREAT) #o600)))
584       (define (run-sync . args)
585         (letfd ((log (open-log-file)))
586           (with-working-directory directory
587             (let* ((p (inbound-pipe))
588                    (pid (spawn args 0 (:write-end p) (:write-end p))))
589               (close (:write-end p))
590               (splice (:read-end p) STDERR_FILENO log)
591               (close (:read-end p))
592               (let ((t' (set-retcode (wait-process name pid #t))))
593                 (t'::report)
594                 t')))))
595       (define (run-sync-quiet . args)
596         (with-working-directory directory
597           (set-retcode
598            (wait-process
599             name (spawn args CLOSED_FD CLOSED_FD CLOSED_FD) #t))))
600       (define (run-async . args)
601         (let ((log (open-log-file)))
602           (with-working-directory directory
603             (new name directory spawn
604                  (spawn args CLOSED_FD log log)
605                  retcode log))))
606       (define (status)
607         (let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR")))))
608           (if (not t) "FAIL" (cadr t))))
609       (define (report)
610         (unless (= logfd CLOSED_FD)
611                 (seek logfd 0 SEEK_SET)
612                 (splice logfd STDERR_FILENO)
613                 (close logfd))
614         (echo (string-append (status) ":") name))))))
615
616 ;; Run the setup target to create an environment, then run all given
617 ;; tests in parallel.
618 (define (run-tests-parallel tests)
619   (let loop ((pool (test-pool::new '())) (tests' tests))
620     (if (null? tests')
621         (let ((results (pool::wait)))
622           (for-each (lambda (t)
623                       (catch (echo "Removing" t::directory "failed:" *error*)
624                              (unlink-recursively t::directory))
625                       (t::report)) (reverse results::procs))
626           (exit (results::report)))
627         (let* ((wd (mkdtemp))
628                (test (car tests'))
629                (test' (test::set-directory wd)))
630           (loop (pool::add (test'::run-async))
631                 (cdr tests'))))))
632
633 ;; Run the setup target to create an environment, then run all given
634 ;; tests in sequence.
635 (define (run-tests-sequential tests)
636   (let loop ((pool (test-pool::new '())) (tests' tests))
637     (if (null? tests')
638         (let ((results (pool::wait)))
639           (for-each (lambda (t)
640                       (catch (echo "Removing" t::directory "failed:" *error*)
641                              (unlink-recursively t::directory)))
642                     results::procs)
643           (exit (results::report)))
644         (let* ((wd (mkdtemp))
645                (test (car tests'))
646                (test' (test::set-directory wd)))
647           (loop (pool::add (test'::run-sync))
648                 (cdr tests'))))))
649
650 ;; Helper to create environment caches from test functions.  SETUP
651 ;; must be a test implementing the producer side cache protocol.
652 ;; Returns a promise containing the arguments that must be passed to a
653 ;; test implementing the consumer side of the cache protocol.
654 (define (make-environment-cache setup)
655   (delay (let* ((tarball (make-temporary-file "environment-cache")))
656            (atexit (lambda () (remove-temporary-file tarball)))
657            (setup::run-sync '--create-tarball tarball)
658            `(--unpack-tarball ,tarball))))
659
660 ;; Command line flag handling.  Returns the elements following KEY in
661 ;; ARGUMENTS up to the next argument, or #f if KEY is not in
662 ;; ARGUMENTS.
663 (define (flag key arguments)
664   (cond
665    ((null? arguments)
666     #f)
667    ((string=? key (car arguments))
668     (let loop ((acc '())
669                (args (cdr arguments)))
670       (if (or (null? args) (string-prefix? (car args) "--"))
671           (reverse acc)
672           (loop (cons (car args) acc) (cdr args)))))
673    ((string=? "--" (car arguments))
674     #f)
675    (else
676     (flag key (cdr arguments)))))
677 (assert (equal? (flag "--xxx" '("--yyy")) #f))
678 (assert (equal? (flag "--xxx" '("--xxx")) '()))
679 (assert (equal? (flag "--xxx" '("--xxx" "yyy")) '("yyy")))
680 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz")) '("yyy" "zzz")))
681 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz" "--")) '("yyy" "zzz")))
682 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "--" "zzz")) '("yyy")))
683 (assert (equal? (flag "--" '("--" "xxx" "yyy" "--" "zzz")) '("xxx" "yyy")))