chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH] always use temporary filenames in csc


From: Felix
Subject: [Chicken-hackers] [PATCH] always use temporary filenames in csc
Date: Wed, 07 Nov 2012 20:15:32 +0100 (CET)

The attached patch modifies csc to use temporary files (as created
by "create-temporary-file") for intermediate .c and .o files. This
is actually trickier than it sounds. The tests succeed so far,
but there may be corner cases that are not covered yet.

This fixes #946, which was reported by Alan Post.


cheers,
felix
>From 9ddf370a73a8e6df3e71ffbf6d3df09c314a7477 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Tue, 6 Nov 2012 21:29:33 +0100
Subject: [PATCH] use temporary files in csc where possible

---
 csc.scm |   46 +++++++++++++++++++++++++++++-----------------
 1 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/csc.scm b/csc.scm
index 21c416e..7bc2a48 100644
--- a/csc.scm
+++ b/csc.scm
@@ -802,13 +802,15 @@ EOF
 (define (run-translation)
   (for-each
    (lambda (f)
-     (let ([fc (pathname-replace-extension
-               (if (= 1 (length scheme-files))
-                   target-filename
-                   f)
-               (cond (cpp-mode "cpp")
+     (let ((ext (cond (cpp-mode "cpp")
                      (objc-mode "m")
-                     (else "c") ) ) ] )
+                     (else "c") ) ) 
+          (fc #f))
+       (cond (translate-only 
+             (set! fc (pathname-replace-extension f ext)))
+            (else 
+             (set! fc (create-temporary-file ext))
+             (set! generated-c-files (cons fc generated-c-files))))
        (command
        (string-intersperse 
         (cons* translator (quotewrap f) 
@@ -827,9 +829,7 @@ EOF
                             (objc-mode '("-feature" "chicken-scheme-to-objc"))
                             (else '()))
                       translation-optimization-options)) ) )
-        " ") )
-       (set! c-files (append (list fc) c-files))
-       (set! generated-c-files (append (list fc) generated-c-files))))
+        " ") )))
    scheme-files))
 
 
@@ -838,8 +838,19 @@ EOF
 (define (run-compilation)
   (let ((ofiles '()))
     (for-each
-     (lambda (f)
-       (let ([fo (pathname-replace-extension f object-extension)])
+     (lambda (p)
+       (let ((f (car p))
+            (fo #f))
+        (cond (compile-only
+               (set! fo 
+                 (pathname-replace-extension
+                  (if (cdr p)
+                      f
+                      target-filename)
+                  object-extension)))
+              (else
+               (set! fo (create-temporary-file object-extension))
+               (set! generated-object-files (cons fo generated-object-files))))
         (command
          (string-intersperse
           (list (cond (cpp-mode c++-compiler)
@@ -850,10 +861,10 @@ EOF
                 (if (and cpp-mode (string=? "g++" c++-compiler))
                     "-Wno-write-strings"
                     "")
-                (compiler-options) ) ) )
-        (set! generated-object-files (cons fo generated-object-files))
-        (set! ofiles (cons fo ofiles))))
-     c-files)
+                (compiler-options) ) ) )))
+     (append 
+      (map (cut cons <> #f) generated-c-files)
+      (map (cut cons <> #t) c-files)))
     (when (and generate-manifest (eq? 'windows (software-type)))
       (let ((rcf (pathname-replace-extension target-filename "rc")))
        (create-win-manifest (pathname-file target-filename) rcf)
@@ -885,7 +896,7 @@ EOF
 ;;; Link object files and libraries:
 
 (define (run-linking)
-  (let* ((files (map quotewrap object-files))
+  (let* ((files (map quotewrap (append generated-object-files object-files)))
         (target (quotewrap target-filename))
         (targetdir #f))
     (when deploy
@@ -938,7 +949,8 @@ EOF
        (create-mac-bundle
         (pathname-file target-filename)
         targetdir)))
-    (unless keep-files (for-each $delete-file generated-object-files)) ) )
+    (unless keep-files
+      (for-each $delete-file generated-object-files)) ) )
 
 (define (lib-path)
   (prefix "" 
-- 
1.7.0.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]