[cmucl-cvs] [git] CMU Common Lisp branch master updated. 822fd79aef8e3d85a05c3d9b7cea5e080b802184

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  822fd79aef8e3d85a05c3d9b7cea5e080b802184 (commit)
      from  54f8b21953569cd674e9ee8bd19f1d1690bad133 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 822fd79aef8e3d85a05c3d9b7cea5e080b802184
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Sep 24 22:48:26 2011 -0700

    Fix ticket:48.  Use Carl's idea to use git to insert the appropriate
    comment into the compiled file.  If git is not found or if some other
    error occurs, the file comment is whatever string was given.
    
    Need to update the file-comments of every file to remove erroneous
    dates and revisions.

diff --git a/compiler/main.lisp b/compiler/main.lisp
index e168ebb..08e8088 100644
--- a/compiler/main.lisp
+++ b/compiler/main.lisp
@@ -1101,13 +1101,46 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
   (unless (and (= (length form) 2) (stringp (second form)))
     (compiler-error _N"Bad FILE-COMMENT form: ~S." form))
   (let ((file (first (source-info-current-file *source-info*))))
-    (cond ((file-info-comment file)
-	   (compiler-warning _N"Ignoring extra file comment:~%  ~S." form))
-	  (t
-	   (let ((comment (coerce (second form) 'simple-string)))
-	     (setf (file-info-comment file) comment)
-	     (when *compile-verbose*
-	       (compiler-mumble (intl:gettext "~&; Comment: ~A~2&") comment)))))))
+    (labels
+	((run-git (path)
+	   (let ((cwd (default-directory))
+		 (new (make-pathname :directory (pathname-directory path))))
+	     (unwind-protect
+		  (progn
+		    ;; Cd to the directory containing the file so that
+		    ;; git can find the git repo, if available.
+		    (setf (default-directory) new)
+		    ;; Run git to get the info.  Don't signal any
+		    ;; errors if we can't find git and discard any
+		    ;; error messages from git.  We only use the
+		    ;; result if git returns a zero exit code, anyway.
+		    (handler-case
+			(run-program "git"
+				     (list "log"
+					   "-1"
+					   "--pretty=format:%h %ai %an"
+					   (namestring path))
+				     :output :stream
+				     :error nil)
+		      (error ()
+			nil)))
+	       (setf (default-directory) cwd))))
+	 (generate-comment (file-info)
+	   (let* ((name (pathname (source-info-stream file-info)))
+		  (proc (run-git name)))
+	     (if (and proc (zerop (process-exit-code proc)))
+		 (format nil "$Header: ~A ~A $"
+			 (enough-namestring name)
+			 (read-line (process-output proc)))
+		 (second form)))))
+      (cond ((file-info-comment file)
+	     (compiler-warning _N"Ignoring extra file comment:~%  ~S." form))
+	    (t
+	     (let ((comment (coerce (generate-comment *source-info*)
+				    'simple-string)))
+	       (setf (file-info-comment file) comment)
+	       (when *compile-verbose*
+		 (compiler-mumble (intl:gettext "~&; Comment: ~A~2&") comment))))))))
 
 
 ;;; PROCESS-COLD-LOAD-FORM  --  Internal

-----------------------------------------------------------------------

Summary of changes:
 compiler/main.lisp |   47 ++++++++++++++++++++++++++++++++++++++++-------
 1 files changed, 40 insertions(+), 7 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp