mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

stamp .go with timestamp of .scm; a fresh go has same mtime of .scm

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-06-05 10:51:21 +02:00
parent 822aacbcf4
commit 535fb833b3
2 changed files with 10 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/load.c
View file

@ -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 ());

8
module/system/base/compile.scm
View file

@ -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 '()))