weak: Kill race condition in ECL weak pointer implementation.

[lisp] / optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index 6e06fc0b11d9d49cfa78730d853e5a3c3bfdfd62..1322e109f919c34b41d6b5e82aae9e7bdf402b97 100644 (file)
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -74,7 +74,13 @@ (defstruct (option (:predicate optionp)
                    (lambda (o s k)
                      (declare (ignore k))
                      (format s
                    (lambda (o s k)
                      (declare (ignore k))
                      (format s

-          "#<option~@[ -~C,~]~@[ --~A~]~:[~2*~;~:[=~A~;[=~A]~]~]~@[ ~S~]>"
+                             #.(concatenate 'string
+                                            "#<option"
+                                            "~@[ -~C,~]"
+                                            "~@[ --~A~]"
+                                            "~:[~2*~;~:[=~A~;[=~A]~]~]"
+                                            "~@[ ~S~]"
+                                            ">")

                              (opt-short-name o)
                              (opt-long-name o)
                              (opt-arg-name o)
                              (opt-short-name o)
                              (opt-long-name o)
                              (opt-arg-name o)


@@ -289,8 +295,10 @@ (defun option-parse-next (op)
                      (option-parse-error "Unknown option `~A'" optname))
                     ((cdr matches)
                      (option-parse-error
                      (option-parse-error "Unknown option `~A'" optname))
                     ((cdr matches)
                      (option-parse-error

-                      "~
-Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
+                      #.(concatenate 'string
+                                     "Ambiguous long option `~A' -- "
+                                     "could be any of:"
+                                     "~{~%~8T--~A~}")

                       optname
                       (mapcar #'opt-long-name matches))))
               (process-option (car matches)
                       optname
                       (mapcar #'opt-long-name matches))))
               (process-option (car matches)


@@ -565,7 +573,9 @@ (defopthandler int (var arg) (&key radix min max)
     (when (or (and min (< v min))
              (and max (> v max)))
       (option-parse-error
     (when (or (and min (< v min))
              (and max (> v max)))
       (option-parse-error

-       "Integer ~A out of range (must have ~@[~D <= ~]x~@[ <= ~D~])"
+       #.(concatenate 'string
+                     "Integer ~A out of range "
+                     "(must have ~@[~D <= ~]x~@[ <= ~D~])")

        arg min max))
     (setf var v)))
 
        arg min max))
     (setf var v)))
 


@@ -596,14 +606,18 @@ (defopthandler keyword (var arg) (&optional (valid t))
                  (push k matches)))))
        (cond
         ((null matches)
                  (push k matches)))))
        (cond
         ((null matches)

-         (option-parse-error "Argument `~A' invalid: must be one of:~
-                              ~{~%~8T~(~A~)~}"
+         (option-parse-error #.(concatenate 'string
+                                            "Argument `~A' invalid: "
+                                            "must be one of:"
+                                            "~{~%~8T~(~A~)~}")

                              arg valid))
         ((null (cdr matches))
          (setf var (car matches)))
         (t
                              arg valid))
         ((null (cdr matches))
          (setf var (car matches)))
         (t

-         (option-parse-error "Argument `~A' ambiguous: may be any of:~
-                              ~{~%~8T~(~A~)~}"
+         (option-parse-error #.(concatenate 'string
+                                            "Argument `~A' ambiguous: "
+                                            "may be any of:"
+                                            "~{~%~8T~(~A~)~}")

                              arg matches)))))))
 
 (defopthandler list (var arg) (&optional handler &rest handler-args)
                              arg matches)))))))
 
 (defopthandler list (var arg) (&optional handler &rest handler-args)


@@ -845,7 +859,8 @@ (defun show-usage (prog usage &optional (stream *standard-output*))
    a single string is sufficient."
   (pprint-logical-block (stream nil :prefix "Usage: ")
     (dolist (u (listify usage))
    a single string is sufficient."
   (pprint-logical-block (stream nil :prefix "Usage: ")
     (dolist (u (listify usage))

-      (pprint-logical-block (stream nil :prefix (format nil "~A " prog))
+      (pprint-logical-block (stream nil
+                                   :prefix (concatenate 'string prog " "))

        (format stream "~{~A ~:_~}" (listify u)))
       (pprint-newline :mandatory stream))))
 
        (format stream "~{~A ~:_~}" (listify u)))
       (pprint-newline :mandatory stream))))
 


@@ -866,7 +881,6 @@ (defun show-options-help (opts &optional (stream *standard-output*))
              (t
               (setf newlinep t)
               (pprint-logical-block (stream nil :prefix "  ")
              (t
               (setf newlinep t)
               (pprint-logical-block (stream nil :prefix "  ")

-                (pprint-indent :block 30 stream)

                 (format stream "~:[   ~;-~:*~C,~] --~A"
                         (opt-short-name o)
                         (opt-long-name o))
                 (format stream "~:[   ~;-~:*~C,~] --~A"
                         (opt-short-name o)
                         (opt-long-name o))


@@ -876,6 +890,7 @@ (defun show-options-help (opts &optional (stream *standard-output*))
                           (opt-arg-name o)))
                 (write-string "  " stream)
                 (pprint-tab :line 30 1 stream)
                           (opt-arg-name o)))
                 (write-string "  " stream)
                 (pprint-tab :line 30 1 stream)

+                (pprint-indent :block 30 stream)

                 (print-text doc stream))
               (terpri stream)))))))
 
                 (print-text doc stream))
               (terpri stream)))))))