Changeset 35670 in project

Timestamp:

06/22/18 02:27:13 (3 years ago)

Author:

Ivan Raikov

Message:

added useful function try-compile to compile-file

Location:

release/5/compile-file/trunk

Files:

• compile-file.scm (modified) (2 diffs)
• compile-file.wiki (modified) (3 diffs)
• tests (added)
• tests/run.scm (added)

release/5/compile-file/trunk/compile-file.scm

@@ -6 +6 @@
 
 (module compile-file
-  (compile-file compile-file-options)
+  (compile-file compile-file-options try-compile)
 
 (import (chicken base)
@@ -54 +54 @@
                        (load-file f)
                        f))))
-                (else #f))))))))
+                (else #f)))))))
+
+(define default-cxx (foreign-value "C_TARGET_CXX" c-string))
+(define default-cc (foreign-value "C_TARGET_CC" c-string))
+(define default-cflags (foreign-value "C_TARGET_CFLAGS" c-string))
+(define default-ldflags (foreign-value "C_TARGET_LDFLAGS" c-string))
+(define default-libdir (foreign-value "C_TARGET_LIB_HOME" c-string))
+(define default-libs (foreign-value "C_TARGET_MORE_LIBS" c-string))
+
+(define remove-file-command
+  (case (software-type)
+    ((unix) "rm -f")
+    ((windows) "del /f /q")
+    (else "rm -f")))
+
+(define (shellpath str)
+  (qs (normalize-pathname str)))
+
+(define (try-compile code #!key c++ (cc (if c++ default-cxx default-cc)) (cflags "") (ldflags "") 
+                     (verbose #f) (compile-only #f))
+  (let* ((fname (create-temporary-file "c"))
+         (oname (pathname-replace-extension fname "o"))
+         (r (begin
+              (with-output-to-file fname (cut display code))
+              (system 
+               (let ((cmd (conc
+                           cc " "
+                           (if compile-only "-c" "") " "
+                           cflags " " default-cflags " "
+                           (shellpath fname) " -o " (shellpath oname) " "
+                           (if compile-only
+                               "" 
+                               (conc "-L" default-libdir " " ldflags " " default-libs) )
+                           (case (software-type) ((windows) " >nul: " " >/dev/null ") (else ""))
+                           (if verbose "" "2>&1") ) ) )
+                 (when verbose (print cmd " ..."))
+                 cmd) ) ) ) )
+    (when verbose (print (if (zero? r) "succeeded." "failed.")))
+    (system (sprintf "~A ~A" remove-file-command (shellpath fname)))
+    (system (sprintf "~A ~A" remove-file-command (shellpath oname)))
+    (zero? r) ) )
+
+)

release/5/compile-file/trunk/compile-file.wiki

@@ -5 +5 @@
 [[toc:]]
 
-{{compile-file}} provides a way to compile Scheme files
-programmatically.
+{{compile-file}} provides a way to compile Scheme and C/C++ files programmatically.
 
 ==== compile-file
@@ -40 +39 @@
 default options are {{-O2 -d2}}.
 
+==== try-compile
+
+<procedure>(try-compile CODE #!key cc cflags ldflags compile-only c++)</procedure>
+
+Returns {{#t}} if the C code in {{CODE}} compiles and links successfully, or {{#f}} otherwise.
+The keyword parameters {{cc}} (compiler name, defaults to the C compiler used to build this system),
+{{cflags}} and {{ldflags}} accept additional compilation and
+linking options. If {{compile-only}} is true, then no linking step takes place.
+If the keyword argument {{c++}} is given and true, then the code will be compiled in C++ mode.
+
 === Author
 
@@ -46 +55 @@
 === License
 
-  Copyright (c) 2017, The CHICKEN Team
+  Copyright (c) 2017-2018, The CHICKEN Team
   All rights reserved.