15
15
16
16
(defun write-tmp-file (fname send-lst)
17
17
` (with-open-file (test-file , fname :direction :output :if-exists :supersede )
18
- (princ-line " (lisp::install-error-handler #'(lambda (&rest args) (exit 1)))" test-file)
18
+ (princ-line " (defun exit-on-error (&rest args) (exit 1))" test-file)
19
+ (princ-line " (lisp::install-error-handler 'exit-on-error)" test-file)
19
20
(princ-line " (require :argparse \" lib/llib/argparse.l\" )" test-file)
20
21
(terpri test-file)
21
22
(princ-line " (setq argparse (instantiate argparse:argument-parser))" test-file)
42
43
(resf (tmp " tmp-argparse-result-" name)))
43
44
` (deftest , name
44
45
, (write-tmp-file testf send-lst)
45
- (assert (= 0 (unix :system , (format nil " eus ~A ~A 2>/dev/null 1>~A " testf command resf))))
46
+ (assert (= 0 (unix :system , (format nil " ~A ~A ~A 2>/dev/null 1>~A "
47
+ *program-name* testf command resf))))
46
48
(let ((alst (read-file , resf)))
47
49
,@ (mapcar #' (lambda (res)
48
50
` (assert (and (assoc , (car res) alst)
54
56
(resf (tmp " tmp-argparse-result-" name)))
55
57
` (deftest , name
56
58
, (write-tmp-file testf send-lst)
57
- (assert (= 0 (unix :system , (format nil " eus ~A --help 2>/dev/null 1>~A " testf resf))))
59
+ (assert (= 0 (unix :system , (format nil " ~A ~A --help 2>/dev/null 1>~A "
60
+ *program-name* testf resf))))
58
61
(let ((str1 , result)
59
62
(str2 (string-right-trim ' (#\Space #\Newline ) (read-binary-file , resf))))
60
63
(assert (string= str1 str2))))))
63
66
(let ((testf (tmp " tmp-argparse-test-" name)))
64
67
` (deftest , name
65
68
, (write-tmp-file testf send-lst)
66
- (assert (= 256 (unix :system , (format nil " eus ~A ~A 2>/dev/null 1>/dev/null" testf command)))))))
69
+ (assert (= 256 (unix :system , (format nil " ~A ~A ~A 2>/dev/null 1>/dev/null"
70
+ *program-name* testf command)))))))
67
71
68
72
69
73
; ; HELP TESTS
@@ -336,7 +340,7 @@ optional arguments:
336
340
(:add-argument " -cc" :help " Callback with compiled function"
337
341
:action #' print )
338
342
(:add-argument " -ccf" :help " Callback with compiled function"
339
- :action #' lisp-implementation-version )
343
+ :action #' lisp-implementation-type )
340
344
(:add-argument " --count" :action :count )
341
345
(:add-argument ' (" --append" " -a" ) :action :append :read t :choices (list 1 2 3 ))
342
346
(:add-argument " --const" :const 10 :action :store-const ))
@@ -530,15 +534,15 @@ optional arguments:
530
534
(:add-argument " -cc" :help " Callback with compiled function"
531
535
:action #' print )
532
536
(:add-argument " -ccf" :help " Callback with compiled function"
533
- :action #' lisp-implementation-version )
537
+ :action #' lisp-implementation-type )
534
538
(:add-argument " --count" :action :count )
535
539
(:add-argument ' (" --append" " -a" ) :action :append :read t :choices (list 1 2 3 ))
536
540
(:add-argument " --const" :const 10 :action :store-const ))
537
541
538
542
(defargparse-test parse-overall.2
539
543
" --arg=a --req=3 --def=2 -ff --dest=b -ccf --count"
540
544
((:arg " a" ) (:req 3 ) (:def 2 ) (:remap " b" ) (:flag nil ) (:flag-false nil )
541
- (:ca nil ) (:cf nil ) (:cc nil ) (:ccf #. (lisp-implementation-version )) (:count 1 )
545
+ (:ca nil ) (:cf nil ) (:cc nil ) (:ccf #. (lisp-implementation-type )) (:count 1 )
542
546
(:append nil ) (:const nil ))
543
547
(:init :description " Program Description" :prog " test.l" )
544
548
(:add-argument " --arg" :help " The 'arg' argument" :required t )
@@ -554,7 +558,7 @@ optional arguments:
554
558
(:add-argument " -cc" :help " Callback with compiled function"
555
559
:action #' print )
556
560
(:add-argument " -ccf" :help " Callback with compiled function"
557
- :action #' lisp-implementation-version )
561
+ :action #' lisp-implementation-type )
558
562
(:add-argument " --count" :action :count )
559
563
(:add-argument ' (" --append" " -a" ) :action :append :read t :choices (list 1 2 3 ))
560
564
(:add-argument " --const" :const 10 :action :store-const ))
0 commit comments