Added a check after the FILE-ATTRIBUTES-DIRECT call. The attributes

will be #F if the file is a symlink to hyperspace.  Failure to check
was causing a SIGSEGV; now it print a warning.

This still leaves the problem of symbolic link loops.  I `fixed' this
in the one place it was occuring by altering the symlinks.

diff --git a/v7/src/rcs/logmer.scm b/v7/src/rcs/logmer.scm
index 6d59b399f6a46d802c7bf1493e15b51f851caab5..1b9209193f39a58e200a0f654b497a0fa1cb9466 100644 (file)
--- a/v7/src/rcs/logmer.scm
+++ b/v7/src/rcs/logmer.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: logmer.scm,v 1.14 1996/03/03 22:58:35 cph Exp $
+$Id: logmer.scm,v 1.15 1996/03/05 18:33:21 adams Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -183,25 +183,31 @@ MIT in each case. |#
 
     (define (scan-file pathname original-pathname)
       (let ((attributes (file-attributes-direct pathname)))
-       (let ((type (file-attributes/type attributes)))
-         (cond ((not type)
-                (if (not (or (ignored-file-name? pathname)
-                             (ignored-file-name? original-pathname)))
-                    (let ((control (rcs-control-file pathname)))
-                      (if control
-                          (begin
-                            (set! files
-                                  (cons (cons original-pathname control)
-                                        files))
-                            unspecific)))))
-               ((eq? type #t)
-                (if (not (member (file-namestring pathname)
-                                 '("." ".." "RCS")))
-                    (scan-directory pathname original-pathname)))
-               ((string? type)
-                (scan-file (merge-pathnames type
-                                            (directory-pathname pathname))
-                           original-pathname))))))
+       (if (not attributes)
+           (warn "Cannot get attributes.  Path might contain stale symlink."
+                 (error-irritant/noise "\n;   ")
+                 original-pathname
+                 (error-irritant/noise "\n; points to\n;   ")
+                 pathname)
+           (let ((type (file-attributes/type attributes)))
+             (cond ((not type)
+                    (if (not (or (ignored-file-name? pathname)
+                                 (ignored-file-name? original-pathname)))
+                        (let ((control (rcs-control-file pathname)))
+                          (if control
+                              (begin
+                                (set! files
+                                      (cons (cons original-pathname control)
+                                            files))
+                                unspecific)))))
+                   ((eq? type #t)
+                    (if (not (member (file-namestring pathname)
+                                     '("." ".." "RCS")))
+                        (scan-directory pathname original-pathname)))
+                   ((string? type)
+                    (scan-file (merge-pathnames type
+                                                (directory-pathname pathname))
+                               original-pathname)))))))
 
     (define (rcs-control-file pathname)
       (let ((directory (directory-pathname pathname))