Make sure that there is a valid pathname directory before taking its
authorJason Wilson <edu/mit/csail/zurich/jawilson>
Wed, 9 Jun 1993 09:28:43 +0000 (09:28 +0000)
committerJason Wilson <edu/mit/csail/zurich/jawilson>
Wed, 9 Jun 1993 09:28:43 +0000 (09:28 +0000)
last component.

v7/src/compiler/machines/C/cout.scm

index 1766427abba95a58f62825b55d0a35bb3c0e8b87..bceb296de25ce932b8dc29cd03cfbba9e6240ecb 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cout.scm,v 1.1 1993/06/08 06:13:32 gjr Exp $
+$Id: cout.scm,v 1.2 1993/06/09 09:28:43 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -93,9 +93,10 @@ MIT in each case. |#
 
   (define (choose-proc-name default midfix time-stamp)
     (let ((path (and info-output-pathname
-                    (if (pair? info-output-pathname)
-                        (car info-output-pathname)
-                        info-output-pathname))))
+                    (merge-pathnames
+                     (if (pair? info-output-pathname)
+                         (car info-output-pathname)
+                         info-output-pathname)))))
     
       (cond ((not *C-procedure-name*)
             (string-append default suffix time-stamp))
@@ -106,11 +107,14 @@ MIT in each case. |#
            ((not path)
             (string-append default suffix time-stamp))
            (else
-            (string-append (car (last-pair (pathname-directory path)))
-                           "_"
-                           (pathname-name path)
-                           midfix
-                           suffix)))))
+            (let ((dir (pathname-directory path)))
+              (string-append (if (null? dir)
+                                 default
+                                 (car (last-pair dir)))
+                             "_"
+                             (pathname-name path)
+                             midfix
+                             suffix))))))
 \f
   (define (subroutine-information-1)
     (cond ((eq? *invoke-interface* 'INFINITY)