gcc/testsuite/gfortran.dg/secnds.f

   1 C { dg-do run }
   2 C { dg-options "-O0" }
   3 C Tests fix for PR14994 - SECNDS intrinsic not supported.
   4 C Note1: The test uses +/-20ms accuracy in the check that
   5 C date_and_time and secnds give the same values.
   6 C
   7 C Contributed by Paul Thomas  <pault@gcc.gnu.org>
   8 C
   9       character*20 dum1, dum2, dum3
  10       real t1, t2
  11       real dat1, dat2
  12       real dt
  13       integer i, j, values(8)
  14       dt = 40e-3
  15       t1 = secnds (0.0)
  16       call date_and_time (dum1, dum2, dum3, values)
  17       dat1 = 0.001*real (values(8)) + real (values(7)) +
  18      &        60.0*real (values(6)) + 3600.0* real (values(5))
  19       if (int ((dat1 - t1 + dt * 0.5) / dt) .ne. 0) call abort ()
  20       do j=1,10000
  21         do i=1,10000
  22         end do
  23       end do
  24       call date_and_time (dum1, dum2, dum3, values)
  25       dat2 = 0.001*real (values(8)) + real (values(7)) +
  26      &        60.0*real (values(6)) + 3600.0* real (values(5))
  27       t2 = secnds (t1)
  28       if (int ((dat1-dat2 + t2 + dt * 0.5) / dt) .ne. 0.0) call abort ()
  29       end