~ chicken-core (chicken-5) af12fa157f79ee8b59b207eaf34addf52857c653

commit af12fa157f79ee8b59b207eaf34addf52857c653
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Oct 29 11:26:49 2017 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun Oct 29 23:57:44 2017 +1300

    Fix output file extension for `csc -c foo.c`
    
    This expands the changes in 3eaa4f4 to include the situation where the
    input file is a C source file. It also does some minor refactoring
    around the target filename handling in csc.scm, adding a helper
    procedure and changing [] to (), and adds a test for csc's handling of
    the "-c" and "-t" flags.

diff --git a/csc.scm b/csc.scm
index c24ec836..196aa4d5 100644
--- a/csc.scm
+++ b/csc.scm
@@ -528,6 +528,13 @@ EOF
   (define (use-private-repository)
     (set! compile-options (cons "-DC_PRIVATE_REPOSITORY" compile-options)))
 
+  (define (generate-target-filename source-filename)
+    (pathname-replace-extension
+     source-filename
+     (cond (shared shared-library-extension)
+	   (compile-only object-extension)
+	   (else executable-extension))))
+
   (let loop ((args args))
     (cond [(null? args)
 	   ;; Builtin search directory options do not override explicit options
@@ -543,25 +550,21 @@ EOF
 	   (when (pair? linked-extensions)
 	     (set! object-files ; add objects from linked extensions
 	       (append object-files (map find-object-file linked-extensions))))
-	   (cond [(null? scheme-files)
-		  (when (and (null? c-files) 
+	   (cond ((null? scheme-files)
+		  (when (and (null? c-files)
 			     (null? object-files))
 		    (stop "no source files specified") )
-		  (let ((f0 (last (if (null? c-files) object-files c-files))))
-		    (unless target-filename
-		      (set! target-filename 
-			(if shared
-			    (pathname-replace-extension f0 shared-library-extension)
-			    (pathname-replace-extension f0 executable-extension) ) ) ) ) ]
-		 [else
+		  (unless target-filename
+		    (set! target-filename
+		      (generate-target-filename
+		       (last (if (null? c-files) object-files c-files))))))
+		 (else
 		  (when (and shared (not embedded))
 		    (set! translate-options (cons "-dynamic" translate-options)) )
 		  (unless target-filename
 		    (set! target-filename
-		      (cond (shared (pathname-replace-extension (first scheme-files) shared-library-extension))
-			    (compile-only (pathname-replace-extension (first scheme-files) object-extension))
-			    (else (pathname-replace-extension (first scheme-files) executable-extension)) ) ) )
-		  (run-translation) ] )
+		      (generate-target-filename (first scheme-files))))
+		  (run-translation)))
 	   (unless translate-only 
 	     (run-compilation)
 	     (unless compile-only
diff --git a/distribution/manifest b/distribution/manifest
index 802a9a07..4a82b0b6 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -114,6 +114,7 @@ build-version.scm
 build-version.c
 buildid
 tests/clustering-tests.scm
+tests/csc-tests.scm
 tests/c-id-valid.scm
 tests/data-structures-tests.scm
 tests/environment-tests.scm
diff --git a/tests/csc-tests.scm b/tests/csc-tests.scm
new file mode 100644
index 00000000..52673407
--- /dev/null
+++ b/tests/csc-tests.scm
@@ -0,0 +1,19 @@
+;;; csc interface tests
+
+(import (chicken pathname)
+        (chicken process)
+        (chicken process-context)
+        (chicken string))
+
+(define (abs x) (make-pathname (current-directory) x))
+(define (run x . args) (system* (string-intersperse (cons (abs x) args))))
+(define (csc . args) (apply run "../csc" "-v" args))
+
+(csc "null.scm" "-t")
+(assert (file-exists? "null.c"))
+
+(csc "null.c" "-c")
+(assert (file-exists? "null.o"))
+
+(csc "null.o")
+(run "null")
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 4f558326..67f3a227 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -37,6 +37,10 @@ if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
 
+echo "======================================== csc tests ..."
+%interpret% -s csc-tests.scm
+if errorlevel 1 exit /b 1
+
 echo ======================================== compiler inlining tests  ...
 %compile% inlining-tests.scm -optimize-level 3
 if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 05748810..24dae5c1 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -69,6 +69,9 @@ echo "======================================== compiler tests ..."
 $compile compiler-tests.scm
 ./a.out
 
+echo "======================================== csc tests ..."
+$interpret -s csc-tests.scm
+
 echo "======================================== compiler inlining tests  ..."
 $compile inlining-tests.scm -optimize-level 3
 ./a.out