re PR fortran/29539 (ICE in variable_decl)

2006-11-07 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29539
	PR fortran/29634
	* decl.c (variable_decl): Add test for presence of proc_name.
	* error.c (gfc_error_flag_test): New function.
	* gfortran.h : Prototype for gfc_error_flag_test.

2006-11-07 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29539
	* gfortran.dg/gfortran.dg/blockdata_3.f90: New test.

	PR fortran/29634
	* gfortran.dg/gfortran.dg/derived_function_interface_1.f90: New
	test.

From-SVN: r118553

gcc/fortran/ChangeLog

@@ -1,3 +1,11 @@
+2006-11-07 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29539
+	PR fortran/29634
+	* decl.c (variable_decl): Add test for presence of proc_name.
+	* error.c (gfc_error_flag_test): New function.
+	* gfortran.h : Prototype for gfc_error_flag_test.
+
 2006-11-07  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/29601

gcc/fortran/decl.c

@@ -1218,6 +1218,7 @@ variable_decl (int elem)
      that the interface may specify a procedure that is not pure if the procedure
      is defined to be pure(12.3.2).  */
   if (current_ts.type == BT_DERIVED
+	&& gfc_current_ns->proc_name
 	&& gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
 	&& current_ts.derived->ns != gfc_current_ns)
     {
@@ -2397,7 +2398,8 @@ ok:
 	break;
     }
 
-  gfc_error ("Syntax error in data declaration at %C");
+  if (gfc_error_flag_test () == 0)
+    gfc_error ("Syntax error in data declaration at %C");
   m = MATCH_ERROR;
 
   gfc_free_data_all (gfc_current_ns);

gcc/fortran/error.c

@@ -699,6 +699,15 @@ gfc_clear_error (void)
 }
 
 
+/* Tests the state of error_flag.  */
+
+int
+gfc_error_flag_test (void)
+{
+  return error_buffer.flag;
+}
+
+
 /* Check to see if any errors have been saved.
    If so, print the error.  Returns the state of error_flag.  */
 

gcc/fortran/gfortran.h

@@ -1788,6 +1788,7 @@ void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,
 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
 void gfc_clear_error (void);
 int gfc_error_check (void);
+int gfc_error_flag_test (void);
 
 notification gfc_notification_std (int);
 try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);

gcc/testsuite/ChangeLog

@@ -1,3 +1,12 @@
+2006-11-07 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29539
+	* gfortran.dg/gfortran.dg/blockdata_3.f90: New test.
+
+	PR fortran/29634
+	* gfortran.dg/gfortran.dg/derived_function_interface_1.f90: New
+	test.
+
 2006-11-07  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/29601

gcc/testsuite/gfortran.dg/blockdata_3.f90

@@ -0,0 +1,28 @@
+! { dg-compile }
+! { dg-options "-W -Wall" }
+! Tests the fix for PR29539, in which the derived type in a blockdata
+! cause an ICE.  With the fix for PR29565, this now compiles and runs
+! correctly.
+!
+! Contributed by Bernhard Fischer  <aldot@gcc.gnu.org>
+!
+block data
+  common /c/ d(5), cc
+  type c_t
+    sequence
+    integer i
+  end type c_t
+  type (c_t) :: cc
+  data d /5*1./
+  data cc%i /5/
+end
+
+  common /c/ d(5), cc
+  type c_t
+    sequence
+    integer i
+  end type c_t
+  type (c_t) :: cc
+  print *, d
+  print *, cc
+end

gcc/testsuite/gfortran.dg/derived_function_interface_1.f90

@@ -0,0 +1,40 @@
+! { dg-compile }
+! Tests the fix for PR29634, in which an ICE would occur in the
+! interface declaration of a function with an 'old-style' type
+! declaration.  When fixed, it was found that the error message
+! was not very helpful - this was fixed.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+type(foo) function ext_fun()
+  type foo
+    integer :: i
+  end type foo
+  ext_fun%i = 1
+end function ext_fun
+
+  type foo
+    integer :: i
+  end type foo
+
+  interface fun_interface
+    type(foo) function fun()
+    end function fun
+  end interface
+
+  interface ext_fun_interface
+    type(foo) function ext_fun()
+    end function ext_fun
+  end interface
+
+  type(foo) :: x
+
+  x = ext_fun ()
+  print *, x%i
+
+contains
+
+  type(foo) function fun() ! { dg-error "already has an explicit interface" }
+  end function fun  ! { dg-error "Expecting END PROGRAM" }
+
+end