PR fortran/31587

	* lib/gcc-dg.exp (scan-module): New function.
	* gfortran.dg/module_md5_1.f90: New test.

	* module.c (write_char): Add character to the MD5 buffer.
	(read_md5_from_module_file): New function.
	(gfc_dump_module): Compute MD5 for new module file. Call
	read_md5_from_module_file. Only overwrite old module file
	if the new MD5 is different.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@124126 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 70919a4..1364967 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-04-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/31587
+       * module.c (write_char): Add character to the MD5 buffer.
+       (read_md5_from_module_file): New function.
+       (gfc_dump_module): Compute MD5 for new module file. Call
+       read_md5_from_module_file. Only overwrite old module file
+       if the new MD5 is different.
+
 2007-04-23  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/31630

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index af52ca9..03ad1a5 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -72,6 +72,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "arith.h"
 #include "match.h"
 #include "parse.h" /* FIXME */
+#include "md5.h"
 
 #define MODULE_EXTENSION ".mod"
 
@@ -170,6 +171,9 @@ gfc_use_rename;
 /* The FILE for the module we're reading or writing.  */
 static FILE *module_fp;
 
+/* MD5 context structure.  */
+static struct md5_ctx ctx;
+
 /* The name of the module we're reading (USE'ing) or writing.  */
 static char module_name[GFC_MAX_SYMBOL_LEN + 1];
 
@@ -1275,6 +1279,9 @@ write_char (char out)
   if (fputc (out, module_fp) == EOF)
     gfc_fatal_error ("Error writing modules file: %s", strerror (errno));
 
+  /* Add this to our MD5.  */
+  md5_process_bytes (&out, sizeof (out), &ctx);
+  
   if (out != '\n')
     module_column++;
   else
@@ -3916,6 +3923,49 @@ write_module (void)
 }
 
 
+/* Read a MD5 sum from the header of a module file.  If the file cannot
+   be opened, or we have any other error, we return -1.  */
+
+static int
+read_md5_from_module_file (const char * filename, unsigned char md5[16])
+{
+  FILE *file;
+  char buf[1024];
+  int n;
+
+  /* Open the file.  */
+  if ((file = fopen (filename, "r")) == NULL)
+    return -1;
+
+  /* Read two lines.  */
+  if (fgets (buf, sizeof (buf) - 1, file) == NULL
+      || fgets (buf, sizeof (buf) - 1, file) == NULL)
+    {
+      fclose (file);
+      return -1;
+    }
+
+  /* Close the file.  */
+  fclose (file);
+
+  /* If the header is not what we expect, or is too short, bail out.  */
+  if (strncmp (buf, "MD5:", 4) != 0 || strlen (buf) < 4 + 16)
+    return -1;
+
+  /* Now, we have a real MD5, read it into the array.  */
+  for (n = 0; n < 16; n++)
+    {
+      unsigned int x;
+
+      if (sscanf (&(buf[4+2*n]), "%02x", &x) != 1)
+       return -1;
+
+      md5[n] = x;
+    }
+
+  return 0;
+}
+
 /* Given module, dump it to disk.  If there was an error while
    processing the module, dump_flag will be set to zero and we delete
    the module file, even if it was already there.  */
@@ -3924,13 +3974,16 @@ void
 gfc_dump_module (const char *name, int dump_flag)
 {
   int n;
-  char *filename, *p;
+  char *filename, *filename_tmp, *p;
   time_t now;
+  fpos_t md5_pos;
+  unsigned char md5_new[16], md5_old[16];
 
   n = strlen (name) + strlen (MODULE_EXTENSION) + 1;
   if (gfc_option.module_dir != NULL)
     {
-      filename = (char *) alloca (n + strlen (gfc_option.module_dir));
+      n += strlen (gfc_option.module_dir);
+      filename = (char *) alloca (n);
       strcpy (filename, gfc_option.module_dir);
       strcat (filename, name);
     }
@@ -3941,26 +3994,41 @@ gfc_dump_module (const char *name, int dump_flag)
     }
   strcat (filename, MODULE_EXTENSION);
 
+  /* Name of the temporary file used to write the module.  */
+  filename_tmp = (char *) alloca (n + 1);
+  strcpy (filename_tmp, filename);
+  strcat (filename_tmp, "0");
+
+  /* There was an error while processing the module.  We delete the
+     module file, even if it was already there.  */
   if (!dump_flag)
     {
       unlink (filename);
       return;
     }
 
-  module_fp = fopen (filename, "w");
+  /* Write the module to the temporary file.  */
+  module_fp = fopen (filename_tmp, "w");
   if (module_fp == NULL)
     gfc_fatal_error ("Can't open module file '%s' for writing at %C: %s",
-                    filename, strerror (errno));
+                    filename_tmp, strerror (errno));
 
+  /* Write the header, including space reserved for the MD5 sum.  */
   now = time (NULL);
   p = ctime (&now);
 
   *strchr (p, '\n') = '\0';
 
-  fprintf (module_fp, "GFORTRAN module created from %s on %s\n", 
+  fprintf (module_fp, "GFORTRAN module created from %s on %s\nMD5:", 
           gfc_source_file, p);
-  fputs ("If you edit this, you'll get what you deserve.\n\n", module_fp);
+  fgetpos (module_fp, &md5_pos);
+  fputs ("00000000000000000000000000000000 -- "
+        "If you edit this, you'll get what you deserve.\n\n", module_fp);
 
+  /* Initialize the MD5 context that will be used for output.  */
+  md5_init_ctx (&ctx);
+
+  /* Write the module itself.  */
   iomode = IO_OUTPUT;
   strcpy (module_name, name);
 
@@ -3973,9 +4041,26 @@ gfc_dump_module (const char *name, int dump_flag)
 
   write_char ('\n');
 
+  /* Write the MD5 sum to the header of the module file.  */
+  md5_finish_ctx (&ctx, md5_new);
+  fsetpos (module_fp, &md5_pos);
+  for (n = 0; n < 16; n++)
+    fprintf (module_fp, "%02x", md5_new[n]);
+
   if (fclose (module_fp))
     gfc_fatal_error ("Error writing module file '%s' for writing: %s",
-                    filename, strerror (errno));
+                    filename_tmp, strerror (errno));
+
+  /* Read the MD5 from the header of the old module file and compare.  */
+  if (read_md5_from_module_file (filename, md5_old) != 0
+      || memcmp (md5_old, md5_new, sizeof (md5_old)) != 0)
+    {
+      /* Module file have changed, replace the old one.  */
+      unlink (filename);
+      rename (filename_tmp, filename);
+    }
+  else
+    unlink (filename_tmp);
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 32fc7f3..3195c15 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-04-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/31587
+       * lib/gcc-dg.exp (scan-module): New function.
+       * gfortran.dg/module_md5_1.f90: New test.
+
 2007-04-24  Douglas Gregor  <doug.gregor@gmail.com>
 
        * g++.old-deja/g++.pt/defarg6.C: Only run with

diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
new file mode 100644 (file)
index 0000000..7081804
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_md5_1.f90
@@ -0,0 +1,14 @@
+! Check that we can write a module file, that it has a correct MD5 sum,
+! and that we can read it back.
+!
+! { dg-do compile }
+module foo
+  integer(kind=4), parameter :: pi = 3_4
+end module foo
+
+program test
+  use foo
+  print *, pi
+end program test
+! { dg-final { scan-module "foo" "MD5:18a257e13c90e3872b7b9400c2fc6e4b" } }
+! { dg-final { cleanup-modules "foo" } }

diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp
index 98690ff..98be07f 100644 (file)
--- a/gcc/testsuite/lib/gcc-dg.exp
+++ b/gcc/testsuite/lib/gcc-dg.exp
@@ -455,6 +455,24 @@ proc cleanup-modules { modlist } {
     }
 }
 
+# Scan Fortran modules for a given regexp.
+#
+# Argument 0 is the module name
+# Argument 1 is the regexp to match
+proc scan-module { args } {
+    set modfilename [string tolower [lindex $args 0]].mod
+    set fd [open $modfilename r]
+    set text [read $fd]
+    close $fd
+
+    upvar 2 name testcase
+    if [regexp -- [lindex $args 1] $text] {
+      pass "$testcase scan-module [lindex $args 1]"
+    } else {
+      fail "$testcase scan-module [lindex $args 1]"
+    }
+}
+
 # Verify that the compiler output file exists, invoked via dg-final.
 proc output-exists { args } {
     # Process an optional target or xfail list.