From 36d3fb4cfe1c79915ed747b54f6a1aa2a471a833 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 15 Mar 2007 06:44:25 +0000 Subject: [PATCH] [multiple changes] 2007-03-15 Tobias Burnus Paul Thomas PR fortran/30922 * decl.c (gfc_match_import): If the parent of the current name- space is null, try looking for an imported symbol in the parent of the proc_name interface. * resolve.c (resolve_fl_variable): Do not check for blocking of host association by a same symbol, if the symbol is in an interface body. 2007-03-15 Paul Thomas PR fortran/30879 * decl.c (match_data_constant): Before going on to try to match a name, try to match a structure component. PR fortran/30870 * resolve.c (resolve_actual_arglist): Do not reject a generic actual argument if it has a same name specific interface. PR fortran/31163 * trans-array.c (parse_interface): Do not nullify allocatable components if the symbol has the saved attribute. 2007-03-15 Paul Thomas PR fortran/30922 * gfortran.dg/import5.f90.f90: New test. PR fortran/30879 * gfortran.dg/data_components_1.f90: New test. PR fortran/30870 * gfortran.dg/generic_13.f90: New test. PR fortran/31163 * gfortran.dg/alloc_comp_basics_5.f90: New test. From-SVN: r122944 --- gcc/fortran/ChangeLog | 26 ++++++++++ gcc/fortran/decl.c | 30 +++++++++++- gcc/fortran/resolve.c | 22 +++++++-- gcc/fortran/trans-array.c | 11 +++-- gcc/testsuite/ChangeLog | 16 +++++++ .../gfortran.dg/alloc_comp_basics_5.f90 | 47 +++++++++++++++++++ .../gfortran.dg/data_components_1.f90 | 23 +++++++++ gcc/testsuite/gfortran.dg/generic_13.f90 | 36 ++++++++++++++ gcc/testsuite/gfortran.dg/import5.f90 | 44 +++++++++++++++++ 9 files changed, 246 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/data_components_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/generic_13.f90 create mode 100644 gcc/testsuite/gfortran.dg/import5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 48d433494672..449f9b89d046 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,29 @@ +2007-03-15 Tobias Burnus + Paul Thomas + + PR fortran/30922 + * decl.c (gfc_match_import): If the parent of the current name- + space is null, try looking for an imported symbol in the parent + of the proc_name interface. + * resolve.c (resolve_fl_variable): Do not check for blocking of + host association by a same symbol, if the symbol is in an + interface body. + +2007-03-15 Paul Thomas + + PR fortran/30879 + * decl.c (match_data_constant): Before going on to try to match + a name, try to match a structure component. + + + PR fortran/30870 + * resolve.c (resolve_actual_arglist): Do not reject a generic + actual argument if it has a same name specific interface. + + PR fortran/31163 + * trans-array.c (parse_interface): Do not nullify allocatable + components if the symbol has the saved attribute. + 2007-03-14 Francois-Xavier Coudert * trans-array.c (gfc_trans_auto_array_allocation): Replace diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 173ad45eb214..09ded01d27c3 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -301,6 +301,7 @@ match_data_constant (gfc_expr **result) gfc_symbol *sym; gfc_expr *expr; match m; + locus old_loc; m = gfc_match_literal_constant (&expr, 1); if (m == MATCH_YES) @@ -316,6 +317,23 @@ match_data_constant (gfc_expr **result) if (m != MATCH_NO) return m; + old_loc = gfc_current_locus; + + /* Should this be a structure component, try to match it + before matching a name. */ + m = gfc_match_rvalue (result); + if (m == MATCH_ERROR) + return m; + + if (m == MATCH_YES && (*result)->expr_type == EXPR_STRUCTURE) + { + if (gfc_simplify_expr (*result, 0) == FAILURE) + m = MATCH_ERROR; + return m; + } + + gfc_current_locus = old_loc; + m = gfc_match_name (name); if (m != MATCH_YES) return m; @@ -2041,7 +2059,17 @@ gfc_match_import (void) switch (m) { case MATCH_YES: - if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym)) + if (gfc_current_ns->parent != NULL + && gfc_find_symbol (name, gfc_current_ns->parent, + 1, &sym)) + { + gfc_error ("Type name '%s' at %C is ambiguous", name); + return MATCH_ERROR; + } + else if (gfc_current_ns->proc_name->ns->parent != NULL + && gfc_find_symbol (name, + gfc_current_ns->proc_name->ns->parent, + 1, &sym)) { gfc_error ("Type name '%s' at %C is ambiguous", name); return MATCH_ERROR; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 987d73b2fb14..db55c0c5cc2a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -922,11 +922,24 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype) &e->where); } + /* Check if a generic interface has a specific procedure + with the same name before emitting an error. */ if (sym->attr.generic) { - gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not " - "allowed as an actual argument at %L", sym->name, - &e->where); + gfc_interface *p; + for (p = sym->generic; p; p = p->next) + if (strcmp (sym->name, p->sym->name) == 0) + { + e->symtree = gfc_find_symtree + (p->sym->ns->sym_root, sym->name); + sym = p->sym; + break; + } + + if (p == NULL || e->symtree == NULL) + gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not " + "allowed as an actual argument at %L", sym->name, + &e->where); } /* If the symbol is the function that names the current (or @@ -5663,7 +5676,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) /* 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. */ - if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns) + if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns + && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY) { gfc_symbol *s; gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5d4133107359..00e54c830ce4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5216,9 +5216,12 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable)) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank); - gfc_add_expr_to_block (&fnblock, tmp); + if (!sym->attr.save) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (!GFC_DESCRIPTOR_TYPE_P (type)) { @@ -5239,7 +5242,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) /* Allocatable arrays need to be freed when they go out of scope. The allocatable components of pointers must not be touched. */ if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result) - && !sym->attr.pointer) + && !sym->attr.pointer && !sym->attr.save) { int rank; rank = sym->as ? sym->as->rank : 0; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 991755e86d30..291295c34e4f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,19 @@ +2007-03-15 Paul Thomas + + PR fortran/30922 + * gfortran.dg/import5.f90.f90: New test. + + + PR fortran/30879 + * gfortran.dg/data_components_1.f90: New test. + + + PR fortran/30870 + * gfortran.dg/generic_13.f90: New test. + + PR fortran/31163 + * gfortran.dg/alloc_comp_basics_5.f90: New test. + 2007-03-14 Jerry DeLisle PR libgfortran/31051 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 new file mode 100644 index 000000000000..99cd9e08ce34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! This checks the correct functioning of derived types with the SAVE +! attribute and allocatable components - PR31163 +! +! Contributed by Salvatore Filippone +! +Module bar_mod + + type foo_type + integer, allocatable :: mv(:) + end type foo_type + + +contains + + + subroutine bar_foo_ab(info) + + integer, intent(out) :: info + Type(foo_type), save :: f_a + + if (allocated(f_a%mv)) then + info = size(f_a%mv) + else + allocate(f_a%mv(10),stat=info) + if (info /= 0) then + info = -1 + endif + end if + end subroutine bar_foo_ab + + +end module bar_mod + +program tsave + use bar_mod + + integer :: info + + call bar_foo_ab(info) + if (info .ne. 0) call abort () + call bar_foo_ab(info) + if (info .ne. 10) call abort () + +end program tsave + +! { dg-final { cleanup-modules "bar_mod" } } diff --git a/gcc/testsuite/gfortran.dg/data_components_1.f90 b/gcc/testsuite/gfortran.dg/data_components_1.f90 new file mode 100644 index 000000000000..2ce677e9f026 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_components_1.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! Check the fix for PR30879, in which the structure +! components in the DATA values would cause a syntax +! error. +! +! Contributed by Joost VandeVondele +! + TYPE T1 + INTEGER :: I + END TYPE T1 + + TYPE(T1), PARAMETER :: D1=T1(2) + TYPE(T1) :: D2(2) + + INTEGER :: a(2) + + DATA (a(i),i=1,D1%I) /D1%I*D1%I/ + + DATA (D2(i),i=1,D1%I) /D1%I*T1(4)/ + + print *, a + print *, D2 + END diff --git a/gcc/testsuite/gfortran.dg/generic_13.f90 b/gcc/testsuite/gfortran.dg/generic_13.f90 new file mode 100644 index 000000000000..56613451115f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_13.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! tests the patch for PR30870, in which the generic XX was rejected +! because the specific with the same name was not looked for. +! +! Contributed by Joost VandeVondele +! +MODULE TEST + INTERFACE xx + MODULE PROCEDURE xx + END INTERFACE + public :: xx +CONTAINS + SUBROUTINE xx(i) + INTEGER :: I + I=7 + END SUBROUTINE +END +MODULE TOO +CONTAINS + SUBROUTINE SUB(xx,I) + INTERFACE + SUBROUTINE XX(I) + INTEGER :: I + END SUBROUTINE + END INTERFACE + CALL XX(I) + END SUBROUTINE +END MODULE TOO +PROGRAM TT + USE TEST + USE TOO + INTEGER :: I + CALL SUB(xx,I) + IF (I.NE.7) CALL ABORT() +END PROGRAM +! { dg-final { cleanup-modules "test too" } } diff --git a/gcc/testsuite/gfortran.dg/import5.f90 b/gcc/testsuite/gfortran.dg/import5.f90 new file mode 100644 index 000000000000..0106c4ec1214 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/import5.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! Test for import in interfaces PR fortran/30922 +! +! Contributed by Tobias Burnus +! +module test_import + implicit none + + type :: my_type + integer :: data + end type my_type + integer, parameter :: n = 20 + + interface + integer function func1(param) + import + type(my_type) :: param(n) + end function func1 + + integer function func2(param) + import :: my_type + type(my_type), value :: param + end function func2 + end interface + +contains + + subroutine sub1 () + + interface + integer function func3(param) + import + type(my_type), dimension (n) :: param + end function func3 + + integer function func4(param) + import :: my_type, n + type(my_type), dimension (n) :: param + end function func4 + end interface + + end subroutine sub1 +end module test_import +! { dg-final { cleanup-modules "test_import" } } -- 2.43.5