re PR fortran/21565 (namelist in block data is illegal)

2005-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/21565
	* symbol.c (check_conflict): An object cannot be in a namelist and in
	block data.

	PR fortran/18737
	* resolve.c (resolve_symbol): Set the error flag to
	gfc_set_default_type, in the case of an external symbol, so that
	an error message is emitted if IMPLICIT NONE is set.

	PR fortran/14994
	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SECNDS to enum.
	* check.c (gfc_check_secnds): New function.
	* intrinsic.c (add_functions): Add call to secnds.
	* iresolve.c (gfc_resolve_secnds): New function.
	* trans-intrinsic (gfc_conv_intrinsic_function): Add call to
	secnds via case GFC_ISYM_SECNDS.
	* intrinsic.texi: Add documentation for secnds.

2005-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/14994
	* libgfortran/intrinsics/date_and_time.c: Add interface to
	the functions date_and_time for the intrinsic function secnds.

2005-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/21565
	gfortran.dg/namelist_blockdata.f90: New test.

	PR fortran/18737
	gfortran.dg/external_implicit_none.f90: New test.

	PR fortran/14994
	* gfortran.dg/secnds.f: New test.

From-SVN: r106317

14 files changed, 169 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d375793..e28464b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,23 @@
+2005-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21565
+	* symbol.c (check_conflict): An object cannot be in a namelist and in
+	block data.
+
+	PR fortran/18737
+	* resolve.c (resolve_symbol): Set the error flag to
+	gfc_set_default_type, in the case of an external symbol, so that
+	an error message is emitted if IMPLICIT NONE is set.
+
+	PR fortran/14994
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SECNDS to enum.
+	* check.c (gfc_check_secnds): New function.
+	* intrinsic.c (add_functions): Add call to secnds.
+	* iresolve.c (gfc_resolve_secnds): New function.
+	* trans-intrinsic (gfc_conv_intrinsic_function): Add call to
+	secnds via case GFC_ISYM_SECNDS.
+	* intrinsic.texi: Add documentation for secnds.
+
 2005-10-31  Andreas Schwab  <schwab@suse.de>
 
 	* Make-lang.in (GFORTRAN_TARGET_INSTALL_NAME): Define.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 6d2c65b..fe96ea4 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1832,6 +1832,23 @@ gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z)
 
 
 try
+gfc_check_secnds (gfc_expr * r)
+{
+
+  if (type_check (r, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check (r, 0, 4) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (r, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_selected_int_kind (gfc_expr * r)
 {
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 083fc33..46c5bd2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -389,6 +389,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_SCALE,
   GFC_ISYM_SCAN,
   GFC_ISYM_SECOND,
+  GFC_ISYM_SECNDS,
   GFC_ISYM_SET_EXPONENT,
   GFC_ISYM_SHAPE,
   GFC_ISYM_SI_KIND,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index e96ccbb..a577ed9 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1882,6 +1882,13 @@ add_functions (void)
 
   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
 
+  /* Added for G77 compatibility.  */
+  add_sym_1 ("secnds", 0, 1, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_secnds, NULL, gfc_resolve_secnds,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
+
   add_sym_1 ("selected_int_kind", 0, 1, BT_INTEGER, di,  GFC_STD_F95,
 	     gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL,
 	     r, BT_INTEGER, di, REQUIRED);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index eb25171..51334b4 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -104,6 +104,7 @@ try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_scale (gfc_expr *, gfc_expr *);
 try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_second_sub (gfc_expr *);
+try gfc_check_secnds (gfc_expr *);
 try gfc_check_selected_int_kind (gfc_expr *);
 try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *);
 try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
@@ -363,6 +364,7 @@ void gfc_resolve_rrspacing (gfc_expr *, gfc_expr *);
 void gfc_resolve_scale (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_second_sub (gfc_code *);
+void gfc_resolve_secnds (gfc_expr *, gfc_expr *);
 void gfc_resolve_set_exponent (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_shape (gfc_expr *, gfc_expr *);
 void gfc_resolve_sign (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 025b3f1a..dae94cc7 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -94,6 +94,7 @@ and editing.  All contributions and corrections are strongly encouraged.
 * @code{LOG10}:         LOG10,     Base 10 logarithm function 
 * @code{MALLOC}:        MALLOC,    Dynamic memory allocation function
 * @code{REAL}:          REAL,      Convert to real type 
+* @code{SECNDS}:        SECNDS,    Time function
 * @code{SIGNAL}:        SIGNAL,    Signal handling subroutine (or function)
 * @code{SIN}:           SIN,       Sine function
 * @code{SINH}:          SINH,      Hyperbolic sine function
@@ -3135,6 +3136,54 @@ end program test_signal
 
 
 
+
+@node SECNDS
+@section @code{SECNDS} --- Time subroutine
+@findex @code{SECNDS} intrinsic
+@cindex SECNDS
+
+@table @asis
+@item @emph{Description}:
+@code{SECNDS(X)} gets the time in seconds from the real-time system clock.
+@var{X} is a reference time, also in seconds. If this is zero, the time in
+seconds from midnight is returned. This function is non-standard and its
+use is discouraged.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+function
+
+@item @emph{Syntax}:
+@code{T = SECNDS (X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item Name        @tab Type
+@item @var{T}     @tab REAL(4)
+@item @var{X}     @tab REAL(4)
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+@smallexample
+program test_secnds
+    real(4) :: t1, t2
+    print *, secnds (0.0)   ! seconds since midnight
+    t1 = secnds (0.0)       ! reference time
+    do i = 1, 10000000      ! do something
+    end do
+    t2 = secnds (t1)        ! elapsed time
+    print *, "Something took ", t2, " seconds."
+end program test_secnds
+@end smallexample
+@end table
+
+
+
 @node SIN
 @section @code{SIN} --- Sine function 
 @findex @code{SIN} intrinsic
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 5650c0f..47a494d 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1367,6 +1367,15 @@ gfc_resolve_scan (gfc_expr * f, gfc_expr * string,
 
 
 void
+gfc_resolve_secnds (gfc_expr * t1, gfc_expr * t0)
+{
+  t1->ts = t0->ts;
+  t1->value.function.name =
+    gfc_get_string (PREFIX("secnds"));
+}
+
+
+void
 gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 {
   f->ts = x->ts;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f6fb2b0..5d5ca78 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4238,8 +4238,10 @@ resolve_symbol (gfc_symbol * sym)
 
       if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
 	{
+	  /* The specific case of an external procedure should emit an error
+	     in the case that there is no implicit type.  */
 	  if (!mp_flag)
-	    gfc_set_default_type (sym, 0, NULL);
+	    gfc_set_default_type (sym, sym->attr.external, NULL);
 	  else
 	    {
               /* Result may be in another namespace.  */
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 85ed70e..43209e4 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -283,6 +283,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     {
       a1 = NULL;
 
+      if (attr->in_namelist)
+	a1 = in_namelist;
       if (attr->allocatable)
 	a1 = allocatable;
       if (attr->external)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 93e8043..b81b543 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3101,6 +3101,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_RAND:
     case GFC_ISYM_RENAME:
     case GFC_ISYM_SECOND:
+    case GFC_ISYM_SECNDS:
     case GFC_ISYM_SIGNAL:
     case GFC_ISYM_STAT:
     case GFC_ISYM_SYMLNK:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 78bee86..388c59f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2005-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21565
+	gfortran.dg/namelist_blockdata.f90: New test.
+
+	PR fortran/18737
+	gfortran.dg/external_implicit_none.f90: New test.
+
+	PR fortran/14994
+	* gfortran.dg/secnds.f: New test.
+
 2005-10-31  Jan Hubicka  <jh@suse.cz>
 
 	PR target/20928
diff --git a/gcc/testsuite/gfortran.dg/external_implicit_none.f90 b/gcc/testsuite/gfortran.dg/external_implicit_none.f90
new file mode 100644
index 0000000..43cfb28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_implicit_none.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests fix for PR18737 - ICE on external symbol of unknown type.
+program test
+  implicit none
+  real(8) :: x
+  external bug  ! { dg-error "has no IMPLICIT type" }
+
+  x = 2
+  print *, bug(x)
+  
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/namelist_blockdata.f b/gcc/testsuite/gfortran.dg/namelist_blockdata.f
new file mode 100644
index 0000000..c1a7a5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_blockdata.f
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Tests fix for PR21565 - object cannot be in namelist and block data.
+      block data
+      common /foo/ a
+      namelist /foo_n/ a ! { dg-error "not allowed in BLOCK DATA" }
+      data a /1.0/
+      end
diff --git a/gcc/testsuite/gfortran.dg/secnds.f b/gcc/testsuite/gfortran.dg/secnds.f
new file mode 100644
index 0000000..d9a0f0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/secnds.f
@@ -0,0 +1,29 @@
+C { dg-do run }
+C { dg-options "-O0" }
+C Tests fix for PR14994 - SECNDS intrinsic not supported.
+C Note1: The test uses +/-20ms accuracy in the check that
+C date_and_time and secnds give the same values.
+C
+C Contributed by Paul Thomas  <pault@gcc.gnu.org>
+C
+      character*20 dum1, dum2, dum3
+      real*4 t1, t2
+      real*4 dat1, dat2
+      real*4 dt
+      integer*4 i, j, values(8)
+      dt = 40e-3
+      t1 = secnds (0.0)
+      call date_and_time (dum1, dum2, dum3, values)
+      dat1 = 0.001*real (values(8)) + real (values(7)) +
+     &        60.0*real (values(6)) + 3600.0* real (values(5))
+      if (int ((dat1 - t1 + dt * 0.5) / dt) .ne. 0) call abort ()
+      do j=1,10000
+        do i=1,10000
+        end do
+      end do
+      call date_and_time (dum1, dum2, dum3, values)
+      dat2 = 0.001*real (values(8)) + real (values(7)) +
+     &        60.0*real (values(6)) + 3600.0* real (values(5))
+      t2 = secnds (t1)
+      if (int ((dat1-dat2 + t2 + dt * 0.5) / dt) .ne. 0.0) call abort ()
+      end