From 145bdc2cbc1237d3f3ab25f45d18f1fce7ecb2b5 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 7 Apr 2007 20:25:43 +0000 Subject: re PR fortran/30880 (Derived types with default value -- function with ENTRY: rejected at compile time) 2007-04-07 Paul Thomas PR fortran/30880 * resolve.c (resolve_fl_variable): Set flag to 2 for automatic arrays. Make condition for automatic array error explicit. If a dummy, no error on an INTENT(OUT) derived type. 2007-04-07 Paul Thomas PR fortran/30880 * gfortran.dg/used_dummy_types_8.f90: New test. From-SVN: r123645 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/resolve.c | 10 +++++-- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 | 35 ++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6fba5b3..66915c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,12 @@ 2007-04-07 Paul Thomas + PR fortran/30880 + * resolve.c (resolve_fl_variable): Set flag to 2 for automatic + arrays. Make condition for automatic array error explicit. + If a dummy, no error on an INTENT(OUT) derived type. + +2007-04-07 Paul Thomas + PR fortran/30872 * expr.c (find_array_element): Correct arithmetic for rank > 1. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 03e6360..f514e77 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5648,7 +5648,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) || sym->as->upper[i] == NULL || sym->as->upper[i]->expr_type != EXPR_CONSTANT) { - flag = 1; + flag = 2; break; } } @@ -5670,7 +5670,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) else if (sym->attr.external) gfc_error ("External '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); - else if (sym->attr.dummy) + else if (sym->attr.dummy + && !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT)) gfc_error ("Dummy '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); else if (sym->attr.intrinsic) @@ -5679,12 +5680,15 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) else if (sym->attr.result) gfc_error ("Function result '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); - else + else if (flag == 2) gfc_error ("Automatic array '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); + else + goto no_init_error; return FAILURE; } +no_init_error: /* Check to see if a derived type is blocked from being host associated by the presence of another class I symbol in the same namespace. 14.6.1.3 of the standard and the discussion on comp.lang.fortran. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fb1bbbe..bbcfcde 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2007-04-07 Paul Thomas + PR fortran/30880 + * gfortran.dg/used_dummy_types_8.f90: New test. + +2007-04-07 Paul Thomas + PR fortran/30872 * gfortran.dg/parameter_array_element_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 new file mode 100644 index 0000000..8a966a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! Tests the fix for PR30880, in which the variable d1 +! in module m1 would cause an error in the main program +! because it has an initializer and is a dummy. This +! came about because the function with multiple entries +! assigns the initializer earlier than for other cases. +! +! Contributed by Joost VandeVondele +! +MODULE M1 + TYPE T1 + INTEGER :: i=7 + END TYPE T1 +CONTAINS + FUNCTION F1(d1) RESULT(res) + INTEGER :: res + TYPE(T1), INTENT(OUT) :: d1 + TYPE(T1), INTENT(INOUT) :: d2 + res=d1%i + d1%i=0 + RETURN + ENTRY E1(d2) RESULT(res) + res=d2%i + d2%i=0 + END FUNCTION F1 +END MODULE M1 + + USE M1 + TYPE(T1) :: D1 + D1=T1(3) + write(6,*) F1(D1) + D1=T1(3) + write(6,*) E1(D1) +END +! { dg-final { cleanup-modules "m1" } } -- cgit v1.1