Changeset 15305

Timestamp:

Apr 8, 2012, 2:41:32 PM (13 years ago)

Author:

Gary Byers

Message:

Recognize and suppress SHADOWED-TYPECASE-CLAUSE warnings again.

File:

• trunk/source/lib/compile-ccl.lisp (modified) (2 diffs)

trunk/source/lib/compile-ccl.lisp

@@ -823 +823 @@
             (cwd "ccl:")
             (multiple-value-bind (status exit-code)
-              (external-process-status
-               (run-program *svn-program* (list "checkout" url "tests")
-                            :output s :error s))
+                (external-process-status
+                 (run-program *svn-program* (list "checkout" url "tests")
+                              :output s :error s))
               (unless (and (eq status :exited)
                            (eql exit-code 0))
@@ -836 +836 @@
     ;; it without making the test suite non-portable across platforms...
     (handler-bind ((warning (lambda (c)
-                              (when (let ((w (or (and (typep c 'compiler-warning)
-                                                      (eq (compiler-warning-warning-type c) :program-error)
-                                                      (car (compiler-warning-args c)))
-                                                 c)))
-                                      (and (typep w 'simple-warning)
-                                           (or 
-                                            (string-equal
-                                             (simple-condition-format-control w)
-                                             "Clause ~S ignored in ~S form - shadowed by ~S .")
-                                            ;; Might as well ignore these as well, they're intentional.
-                                            (string-equal
-                                             (simple-condition-format-control w)
-                                             "Duplicate keyform ~s in ~s statement."))))
-                                (muffle-warning c)))))
+                              (if (typep c 'shadowed-typecase-clause)
+                                (muffle-warning c)
+                                (when (let ((w (or (and (typep c 'compiler-warning)
+                                                        (eq (compiler-warning-warning-type c) :program-error)
+                                                        (car (compiler-warning-args c)))
+                                                   c)))
+                                        (or (typep (car (compiler-warning-args c))
+                                                        'shadowed-typecase-clause)
+                                            (and (typep w 'simple-warning)
+                                                 (or 
+                                                  (string-equal
+                                                   (simple-condition-format-control w)
+                                                   "Clause ~S ignored in ~S form - shadowed by ~S .")
+                                                  ;; Might as well ignore these as well, they're intentional.
+                                                  (string-equal
+                                                   (simple-condition-format-control w)
+                                                   "Duplicate keyform ~s in ~s statement.")))))
+                                  (muffle-warning c))))))
       ;; This loads the infrastructure
       (load "ccl:tests;ansi-tests;gclload1.lsp")