0.8.17.17:
[sbcl.git] / contrib / sb-executable / sb-executable.lisp
index f785a98..90d39d4 100644 (file)
@@ -30,7 +30,9 @@ exec sbcl --noinform ~{~A ~}--eval \"(with-open-file (i \\\"$0\\\" :element-type
                                              "--sysinit /dev/null"))
                        initial-function)
   "Write an executable called OUTPUT-FILE which can be run from the shell, by 'linking' together code from FASLS.  Actually works by concatenating them and prepending a #! header"
-  (with-open-file (out output-file :direction :output
+  (with-open-file (out output-file
+                      :direction :output
+                      :if-exists :supersede
                       :element-type '(unsigned-byte 8))
     (write-sequence (map 'vector #'char-code
                         (format nil *exec-header* runtime-flags
@@ -40,13 +42,16 @@ exec sbcl --noinform ~{~A ~}--eval \"(with-open-file (i \\\"$0\\\" :element-type
                                           (make-pathname :type "fasl"))
                          :element-type '(unsigned-byte 8))
        (copy-stream in out))))
-  (let* ((out-name (namestring output-file))
+  (let* (;; FIXME: use OUT as the pathname designator
+        (out-name (namestring (translate-logical-pathname output-file)))
         (prot (elt (multiple-value-list (sb-unix:unix-stat out-name)) 3)))
-    (sb-unix::void-syscall ("chmod" c-string int)
-                          out-name
-                          (logior prot
-                                  (if (logand prot #o400) #o100)
-                                  (if (logand prot  #o40)  #o10)
-                                  (if (logand prot   #o4)   #o1)))))
+    (if prot
+       (sb-unix::void-syscall ("chmod" c-string int)
+                              out-name
+                              (logior prot
+                                      (if (logand prot #o400) #o100)
+                                      (if (logand prot  #o40)  #o10)
+                                      (if (logand prot   #o4)   #o1)))
+       (error "stat() call failed"))))
                         
 (provide 'sb-executable)