dump-runlisp-image.c (finish_job): Prevent fresh images from junking!

[runlisp] / dump-runlisp-image.c

diff --git a/dump-runlisp-image.c b/dump-runlisp-image.c
index 97f854d..836dc54 100644 (file)
--- a/dump-runlisp-image.c
+++ b/dump-runlisp-image.c
@@ -702,7 +702,10 @@ static void add_job(unsigned f, struct config_section *sect)
   config_subst_split_var(&config, sect, runvar, &av_version);
   if (!av_version.n)
     lose("empty `run-script' command for Lisp implementation `%s'", name);
-  argv_append(&av_version, xstrdup("?(lisp-implementation-version)"));
+  argv_append(&av_version,
+             config_subst_string_alloc
+               (&config, sect, "<internal>",
+                "?${lisp-version?(lisp-implementation-version)}"));
   config_subst_split_var(&config, sect, dumpvar, &av_dump);
   if (!av_dump.n)
     lose("empty `dump-image' command for Lisp implementation `%s'", name);
@@ -915,7 +918,7 @@ static void finish_job(struct job *job)
            job->exit);
 
   /* What happens next depends on the state of the job.  This is the main
-   * place which advanced the job state machine.
+   * place which advances the job state machine.
    */
   if (ok) switch (job->st) {
 
@@ -982,6 +985,9 @@ static void finish_job(struct job *job)
        * job, because the chances are good that it failed to produce the
        * image properly.
        */
+      if (verbose >= 3)
+       moan("rename completed Lisp `%s' image `%s' to `%s'",
+            JOB_NAME(job), job->imgnew, job->imghash);
       if (rename(job->imgnew, job->imghash)) {
        fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
                          "output image `%s' to `%s': %s",
@@ -990,6 +996,12 @@ static void finish_job(struct job *job)
        ok = 0; break;
       }
 
+      /* Notice the image so that it doesn't get junked. */
+      if (flags&AF_JUNK) {
+       p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+       notice_filename(p, strlen(p));
+      }
+
       /* Determine the basename of the final image. */
       p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
 
@@ -1001,6 +1013,9 @@ static void finish_job(struct job *job)
            JOB_NAME(job), job->imgnewlink, strerror(errno));
        break;
       }
+      if (verbose >= 3)
+       moan("establish Lisp `%s' image link `%s' referring to `%s'",
+            JOB_NAME(job), job->imglink, job->imghash);
       if (symlink(p, job->imgnewlink)) {
        bad("failed to create Lisp `%s' image link `%s': %s",
            JOB_NAME(job), job->imgnewlink, strerror(errno));
@@ -1011,11 +1026,15 @@ static void finish_job(struct job *job)
            JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno));
        break;
       }
-      if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash) &&
-         unlink(job->oldimg) && errno != ENOENT) {
-       if (verbose >= 1)
-         moan("failed to delete old Lisp `%s' image `%s': %s",
-              JOB_NAME(job), job->oldimg, strerror(errno));
+      if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash)) {
+       if (verbose >= 3)
+         moan("remove old Lisp `%s' image `%s'",
+              JOB_NAME(job), job->oldimg);
+       if (unlink(job->oldimg) && errno != ENOENT) {
+         if (verbose >= 1)
+           moan("failed to delete old Lisp `%s' image `%s': %s",
+                JOB_NAME(job), job->oldimg, strerror(errno));
+       }
       }
 
       /* I think we're all done. */
@@ -1318,7 +1337,7 @@ static void version(FILE *fp)
 static void usage(FILE *fp)
 {
   fprintf(fp, "\
-usage: %s [-RUadfinqrv] [+RUdfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+usage: %s [-RUafinqrv] [+RUfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
        [-O FILE|DIR] [-j NJOBS] [LISP ...]\n",
          progname);
 }
@@ -1345,7 +1364,6 @@ Image dumping:\n\
   -R, --remove-other           Delete image files for other Lisp systems.\n\
   -U, --remove-unknown         Delete unrecognized files in image dir.\n\
   -a, --all-configured         Select all configured implementations.\n\
-  -d, --cleanup                        Delete images which are no longer wanted.\n\
   -f, --force                  Dump images even if they already exist.\n\
   -i, --check-installed                Check Lisp systems exist before dumping.\n\
   -j, --jobs=NJOBS             Run up to NJOBS jobs in parallel.\n\
@@ -1422,7 +1440,7 @@ int main(int argc, char *argv[])
     break
 
   for (;;) {
-    i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:d+f+i+j:n+o:qr+v", opts, 0, 0,
+    i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:f+i+j:n+o:qr+v", opts, 0, 0,
               OPTF_NEGATION | OPTF_NOPROGNAME);
     if (i < 0) break;
     switch (i) {
@@ -1649,7 +1667,7 @@ int main(int argc, char *argv[])
             JOB_NAME(job), job->oldimg);
     } else {
       if (verbose >= 2)
-       moan("deleting `%s' image `%s' (dry run)",
+       moan("deleting `%s' image `%s'",
             JOB_NAME(job), job->imglink);
       if (unlink(job->imglink) && errno != ENOENT)
        bad("failed to delete `%s' image link `%s': %s",