diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d31bb140bbd..2298315de8e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2006-11-07 Paul Thomas + + 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 PR fortran/29601 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a476c64bf81..ec3ce2ee892 100644 --- a/gcc/fortran/decl.c +++ b/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); diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index dc4a6cf1fbc..ade361a69c5 100644 --- a/gcc/fortran/error.c +++ b/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. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 05590549070..970bda3c91f 100644 --- a/gcc/fortran/gfortran.h +++ b/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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e3cb936b84f..74f54970121 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2006-11-07 Paul Thomas + + 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 PR fortran/29601 diff --git a/gcc/testsuite/gfortran.dg/blockdata_3.f90 b/gcc/testsuite/gfortran.dg/blockdata_3.f90 new file mode 100644 index 00000000000..695cbee4832 --- /dev/null +++ b/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 +! +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 diff --git a/gcc/testsuite/gfortran.dg/derived_function_interface_1.f90 b/gcc/testsuite/gfortran.dg/derived_function_interface_1.f90 new file mode 100644 index 00000000000..2cee73c3c02 --- /dev/null +++ b/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 +! +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