From 535fb833b34dfc3cc11a679d39390b06fd7e9180 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 5 Jun 2009 10:51:21 +0200
Subject: [PATCH] stamp .go with timestamp of .scm; a fresh go has same mtime
 of .scm

* libguile/load.c (compiled_is_fresh): Rename from compiled_is_newer.
  Check that the mtines of the .go and .scm match exactly, so we don't
  get fooled by rsync-like modifications of the filesystem.

* module/system/base/compile.scm (call-with-output-file/atomic): Add
  optional arg, a reference file. If present we utime the output file to
  match the source file, before the rename.
  (compile-file): Stamp the .go file with the timestamp of the .scm.
---
 libguile/load.c                | 8 ++++----
 module/system/base/compile.scm | 8 ++++++--
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index 6c2cd92be..9656359e5 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -556,7 +556,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
 
 
 static int
-compiled_is_newer (SCM full_filename, SCM compiled_filename)
+compiled_is_fresh (SCM full_filename, SCM compiled_filename)
 {
   char *source, *compiled;
   struct stat stat_source, stat_compiled;
@@ -567,7 +567,7 @@ compiled_is_newer (SCM full_filename, SCM compiled_filename)
     
   if (stat (source, &stat_source) == 0
       && stat (compiled, &stat_compiled) == 0
-      && stat_source.st_mtime <= stat_compiled.st_mtime) 
+      && stat_source.st_mtime == stat_compiled.st_mtime) 
     {
       res = 1;
     }
@@ -707,7 +707,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0,
 
   if (scm_is_false (full_filename)
       || (scm_is_true (compiled_filename)
-          && compiled_is_newer (full_filename, compiled_filename)))
+          && compiled_is_fresh (full_filename, compiled_filename)))
     return scm_load_compiled_with_vm (compiled_filename);
 
   /* Perhaps there was the installed .go that was stale, but our fallback is
@@ -723,7 +723,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0,
                      full_filename,
                      scm_car (*scm_loc_load_compiled_extensions)));
       if (scm_is_true (scm_stat (fallback, SCM_BOOL_F))
-          && compiled_is_newer (full_filename, fallback))
+          && compiled_is_fresh (full_filename, fallback))
         {
           scm_puts (";;; found fresh local cache at ", scm_current_error_port ());
           scm_display (fallback, scm_current_error_port ());
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index b0c20cfff..9f0ff2f3d 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -73,7 +73,7 @@
         thunk
         (lambda () #t))))
 
-(define (call-with-output-file/atomic filename proc)
+(define* (call-with-output-file/atomic filename proc #:optional reference)
   (let* ((template (string-append filename ".XXXXXX"))
          (tmp (mkstemp! template)))
     (call-once
@@ -83,6 +83,9 @@
            (proc tmp)
            (chmod tmp (logand #o0666 (lognot (umask))))
            (close-port tmp)
+           (if reference
+               (let ((st (stat reference)))
+                 (utime template (stat:atime st) (stat:mtime st))))
            (rename-file template filename))
          (lambda args
            (delete-file template)))))))
@@ -145,7 +148,8 @@
       (lambda (port)
         ((language-printer (ensure-language to))
          (read-and-compile in #:env env #:from from #:to to #:opts opts)
-         port)))
+         port))
+      file)
     comp))
 
 (define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
-- 
2.20.1