Fix :bug-309448 test for faster CPUs.
[sbcl.git] / contrib / sb-grovel / def-to-lisp.lisp
index 585a84a..d87d7c2 100644 (file)
@@ -120,7 +120,7 @@ code:
            (when (eql type :errno)
              (printf "(cl:setf (get '~A 'errno) t)" lispname))
            (as-c "#else")
-           (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname)
+           (printf "(sb-int:style-warn \"Couldn't grovel for ~~A (unknown to the C compiler).\" \"~A\")" cname)
            (as-c "#endif"))
           (:enum
            (c-for-enum lispname cname export))
@@ -153,28 +153,31 @@ code:
              (definitions (read i)))
         (print-c-source  f headers definitions package)))))
 
-(defclass grovel-constants-file (asdf:cl-source-file)
+(defclass grovel-constants-file (cl-source-file)
   ((package :accessor constants-package :initarg :package)
    (do-not-grovel :accessor do-not-grovel
                   :initform nil
                   :initarg :do-not-grovel)))
+(defclass asdf::sb-grovel-constants-file (grovel-constants-file) ())
 
-(define-condition c-compile-failed (compile-failed) ()
-  (:report (lambda (c s)
-             (format s "~@<C compiler failed when performing ~A on ~A.~@:>"
-                     (error-operation c) (error-component c)))))
-(define-condition a-dot-out-failed (compile-failed) ()
-  (:report (lambda (c s)
-             (format s "~@<a.out failed when performing ~A on ~A.~@:>"
-                     (error-operation c) (error-component c)))))
-
-(defmethod asdf:perform ((op asdf:compile-op)
-                         (component grovel-constants-file))
+(define-condition c-compile-failed (compile-file-error)
+  ((description :initform "C compiler failed")))
+(define-condition a-dot-out-failed (compile-file-error)
+  ((description :initform "a.out failed")))
+
+(defmethod perform ((op compile-op)
+                    (component grovel-constants-file))
   ;; we want to generate all our temporary files in the fasl directory
   ;; because that's where we have write permission.  Can't use /tmp;
   ;; it's insecure (these files will later be owned by root)
-  (let* ((output-file (car (output-files op component)))
+  (let* ((output-files (output-files op component))
+         (output-file (first output-files))
+         (warnings-file (second output-files))
          (filename (component-pathname component))
+         (context-format "~/asdf-action::format-action/")
+         (context-arguments `((,op . ,component)))
+         (condition-arguments `(:context-format ,context-format
+                                :context-arguments ,context-arguments))
          (real-output-file
           (if (typep output-file 'logical-pathname)
               (translate-logical-pathname output-file)
@@ -192,10 +195,12 @@ code:
     (unless (do-not-grovel component)
       (let* ((cc (or (and (string/= (sb-ext:posix-getenv "CC") "")
                           (sb-ext:posix-getenv "CC"))
-                     ;; It might be nice to include a CONTINUE or
-                     ;; USE-VALUE restart here, but ASDF seems to insist
-                     ;; on handling the errors itself.
-                     (error "The CC environment variable has not been set in SB-GROVEL. Since this variable should always be set during the SBCL build process, this might indicate an SBCL with a broken contrib installation.")))
+                     (if (member :sb-building-contrib *features*)
+                         (error "~@<The CC environment variable not set during ~
+                                 SB-GROVEL build.~:@>")
+                         (sb-int:style-warn
+                          "CC environment variable not set, SB-GROVEL falling back to \"cc\"."))
+                     "cc"))
              (code (sb-ext:process-exit-code
                     (sb-ext:run-program
                      cc
@@ -205,8 +210,18 @@ code:
                       '("-D_LARGEFILE_SOURCE"
                         "-D_LARGEFILE64_SOURCE"
                         "-D_FILE_OFFSET_BITS=64")
-                      #+(and x86-64 darwin)
-                      '("-arch" "x86_64")
+                      #+(and (or x86 ppc) linux) '("-m32")
+                      #+(and x86-64 darwin inode64)
+                      '("-arch" "x86_64"
+                        "-mmacosx-version-min=10.5"
+                        "-D_DARWIN_USE_64_BIT_INODE")
+                      #+(and x86-64 darwin (not inode64))
+                      '("-arch" "x86_64"
+                        "-mmacosx-version-min=10.4")
+                      #+(and x86 darwin)
+                      '("-arch" "i386"
+                        "-mmacosx-version-min=10.4")
+                      #+(and x86-64 sunos) '("-m64")
                       (list "-o"
                             (namestring tmp-a-dot-out)
                             (namestring tmp-c-source)))
@@ -214,11 +229,7 @@ code:
                      :input nil
                      :output *trace-output*))))
         (unless (= code 0)
-          (case (operation-on-failure op)
-            (:warn (warn "~@<C compiler failure when performing ~A on ~A.~@:>"
-                         op component))
-            (:error
-             (error 'c-compile-failed :operation op :component component)))))
+          (apply 'error 'c-compile-failed condition-arguments)))
       (let ((code (sb-ext:process-exit-code
                    (sb-ext:run-program (namestring tmp-a-dot-out)
                                        (list (namestring tmp-constants))
@@ -226,29 +237,7 @@ code:
                                        :input nil
                                        :output *trace-output*))))
         (unless (= code 0)
-          (case (operation-on-failure op)
-            (:warn (warn "~@<a.out failure when performing ~A on ~A.~@:>"
-                         op component))
-            (:error
-             (error 'a-dot-out-failed :operation op :component component))))))
+          (apply 'error 'a-dot-out-failed condition-arguments)))
     (multiple-value-bind (output warnings-p failure-p)
-        (compile-file tmp-constants :output-file output-file)
-      (when warnings-p
-        (case (operation-on-warnings op)
-          (:warn (warn
-                  (formatter "~@<COMPILE-FILE warned while ~
-                              performing ~A on ~A.~@:>")
-                  op component))
-          (:error (error 'compile-warned :component component :operation op))
-          (:ignore nil)))
-      (when failure-p
-        (case (operation-on-failure op)
-          (:warn (warn
-                  (formatter "~@<COMPILE-FILE failed while ~
-                              performing ~A on ~A.~@:>")
-                  op component))
-          (:error (error 'compile-failed :component component :operation op))
-          (:ignore nil)))
-      (unless output
-        (error 'compile-error :component component :operation op)))))
-
+        (compile-file* tmp-constants :output-file output-file :warnings-file warnings-file)
+      (check-lisp-compile-results output warnings-p failure-p context-format context-arguments)))))