[patch,fortran] Fix border case where consecutive calls to date_and_time can return times out of sequence (PR30015)

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

As found (and fixed) by Mat Cross:

In libgfortran's date_and_time(...), we currently have:

  lt = time (NULL);
  [...]
      local_time = *localtime (&lt);
      UTC_time = *gmtime (&lt);
  [...]
      values[6] = local_time.tm_sec;
      values[7] = 0;
  [...]
      gettimeofday (&tp)
      values[7] = tp.tv_usec / 1000;


Example for the border case:

First call to date_and_time(...)
     lt = time() // assume time 19.0s
     values[7] = tp.tv_usec / 1000; // assume time 19.4s
gives 19.4s

Second call to date_and_time(...)
     lt = time() // assume time 19.8s
     values[7] = tp.tv_usec / 1000; // assume time 20.1s
gives 19.1s
Thus we produced a time machine!

The suggested fix is use:
   lt = time (NULL);
   [...]
      gettimeofday (&tp)
      lt = tp.tv_sec
      values[7] = tp.tv_usec / 1000;

The change by Mat Cross is therefore:
- Moving the  gettimeofday() block up in the file
- Using the result of gettimeofday() for lt and value[7], instead of
using time() for lt and gettimeofday() for value[7]
 date_and_time.c |   61
+++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 25 deletions(-)

As it was mostly moving things around and changing
   value[7] = 0;  // at one place
into
     lt = tp.tv_sec; // at another place
#   else
      value[7] = 0;
I think it is copyright-wise ok, isn't it?

Ok for the trunk and after a week or so for 4.2 and 4.1 (which are
identical)?


Build and regression tested on the trunk with x86_64-unknown-linux-gnu.

The PR contains also an example, but I failed to trigger the error.
If you think it makes sense, we can also add the example to our test suite.

Tobias


2006-11-29  Mat Cross  <mathewc@nag.co.uk>

    PR fortran/30015
    * intrinsics/date_and_time.c (date_and_time): Fix case where time
can go backwards.

Index: libgfortran/intrinsics/date_and_time.c
===================================================================
--- libgfortran/intrinsics/date_and_time.c	(Revision 119312)
+++ libgfortran/intrinsics/date_and_time.c	(Arbeitskopie)
@@ -158,6 +158,42 @@
 
   if (lt != (time_t) -1)
     {
+#if HAVE_GETTIMEOFDAY
+      {
+        struct timeval tp;
+
+#if GETTIMEOFDAY_ONE_ARGUMENT
+        if (!gettimeofday (&tp))
+#else
+
+#if HAVE_STRUCT_TIMEZONE
+          struct timezone tzp;
+
+        /* Some systems such as HP-UX, do have struct timezone, but
+           gettimeofday takes void* as the 2nd arg.  However, the
+           effect of passing anything other than a null pointer is
+           unspecified on HP-UX.  Configure checks if gettimeofday
+           actually fails with a non-NULL arg and pretends that
+           struct timezone is missing if it does fail.  */
+        if (!gettimeofday (&tp, &tzp))
+#else
+        if (!gettimeofday (&tp, (void *) 0))
+#endif /* HAVE_STRUCT_TIMEZONE  */
+
+#endif /* GETTIMEOFDAY_ONE_ARGUMENT  */
+
+        /* All arguments can be derived from tp.  */
+        lt = tp.tv_sec;
+        values[7] = tp.tv_usec / 1000;
+      }
+#else
+      {
+        /* All arguments can be derived from lt.  */
+        values[7] = 0;
+      }
+
+#endif /* HAVE_GETTIMEOFDAY */
+
       local_time = *localtime (&lt);
       UTC_time = *gmtime (&lt);
 
@@ -171,31 +207,6 @@
       values[4] = local_time.tm_hour;
       values[5] = local_time.tm_min;
       values[6] = local_time.tm_sec;
-      values[7] = 0;
-
-#if HAVE_GETTIMEOFDAY
-      {
-	struct timeval tp;
-#  if GETTIMEOFDAY_ONE_ARGUMENT
-	if (!gettimeofday (&tp))
-#  else
-#    if HAVE_STRUCT_TIMEZONE
-	struct timezone tzp;
-
-      /* Some systems such as HP-UX, do have struct timezone, but
-	 gettimeofday takes void* as the 2nd arg.  However, the
-	 effect of passing anything other than a null pointer is
-	 unspecified on HP-UX.  Configure checks if gettimeofday
-	 actually fails with a non-NULL arg and pretends that
-	 struct timezone is missing if it does fail.  */
-	if (!gettimeofday (&tp, &tzp))
-#    else
-	if (!gettimeofday (&tp, (void *) 0))
-#    endif /* HAVE_STRUCT_TIMEZONE  */
-#  endif /* GETTIMEOFDAY_ONE_ARGUMENT  */
-	values[7] = tp.tv_usec / 1000;
-      }
-#endif /* HAVE_GETTIMEOFDAY */
 
 #if HAVE_SNPRINTF
       if (__date)