From e10f52d09976c17ebd5fadeb4a0e09a854d3814d Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Wed, 4 Aug 2010 21:49:19 +0200 Subject: [PATCH] re PR fortran/42207 ([OOP] Compile-time errors on typed allocation and pointer function result assignment) 2010-08-04 Janus Weil PR fortran/42207 PR fortran/44064 PR fortran/44065 * class.c (gfc_find_derived_vtab): Do not generate vtabs for class container types. Do not artificially increase refs. Commit symbols one by one. * interface.c (compare_parameter): Make sure vtabs are present before generating module variables. * resolve.c (resolve_allocate_expr): Ditto. 2010-08-04 Janus Weil PR fortran/42207 PR fortran/44064 PR fortran/44065 * gfortran.dg/class_25.f03: New. * gfortran.dg/class_26.f03: New. From-SVN: r162879 --- gcc/fortran/ChangeLog | 12 +++++++++++ gcc/fortran/class.c | 23 +++++++++++++------- gcc/fortran/interface.c | 5 +++++ gcc/fortran/resolve.c | 12 +++++++++++ gcc/testsuite/ChangeLog | 8 +++++++ gcc/testsuite/gfortran.dg/class_25.f03 | 28 +++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/class_26.f03 | 29 ++++++++++++++++++++++++++ 7 files changed, 109 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_25.f03 create mode 100644 gcc/testsuite/gfortran.dg/class_26.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7504f491af3..752b187c6f6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2010-08-04 Janus Weil + + PR fortran/42207 + PR fortran/44064 + PR fortran/44065 + * class.c (gfc_find_derived_vtab): Do not generate vtabs for class + container types. Do not artificially increase refs. Commit symbols one + by one. + * interface.c (compare_parameter): Make sure vtabs are present before + generating module variables. + * resolve.c (resolve_allocate_expr): Ditto. + 2010-08-04 Tobias Burnus PR fortran/45183 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 558fda2fcf3..7dc934452ef 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -322,13 +322,16 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_namespace *ns; gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL; char name[2 * GFC_MAX_SYMBOL_LEN + 8]; - - ns = gfc_current_ns; - - for (; ns; ns = ns->parent) + + /* Find the top-level namespace (MODULE or PROGRAM). */ + for (ns = gfc_current_ns; ns; ns = ns->parent) if (!ns->parent) break; + /* If the type is a class container, use the underlying derived type. */ + if (derived->attr.is_class) + derived = gfc_get_derived_super_type (derived); + if (ns) { sprintf (name, "vtab$%s", derived->name); @@ -338,12 +341,13 @@ gfc_find_derived_vtab (gfc_symbol *derived) { gfc_get_symbol (name, ns, &vtab); vtab->ts.type = BT_DERIVED; - vtab->attr.flavor = FL_VARIABLE; + if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, + &gfc_current_locus) == FAILURE) + goto cleanup; vtab->attr.target = 1; vtab->attr.save = SAVE_EXPLICIT; vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; - vtab->refs++; gfc_set_sym_referenced (vtab); sprintf (name, "vtype$%s", derived->name); @@ -358,7 +362,6 @@ gfc_find_derived_vtab (gfc_symbol *derived) NULL, &gfc_current_locus) == FAILURE) goto cleanup; vtype->attr.access = ACCESS_PUBLIC; - vtype->refs++; gfc_set_sym_referenced (vtype); /* Add component '$hash'. */ @@ -421,7 +424,11 @@ cleanup: /* It is unexpected to have some symbols added at resolution or code generation time. We commit the changes in order to keep a clean state. */ if (found_sym) - gfc_commit_symbols (); + { + gfc_commit_symbol (vtab); + if (vtype) + gfc_commit_symbol (vtype); + } else gfc_undo_symbols (); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 4ffe5ee33fb..f37f1bdebd7 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1423,6 +1423,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c) return 1; + if (formal->ts.type == BT_CLASS) + /* Make sure the vtab symbol is present when + the module variables are generated. */ + gfc_find_derived_vtab (formal->ts.u.derived); + if (actual->ts.type == BT_PROCEDURE) { char err[200]; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c422eebc27f..69a003657d9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6569,6 +6569,18 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) } } + if (e->ts.type == BT_CLASS) + { + /* Make sure the vtab symbol is present when + the module variables are generated. */ + gfc_typespec ts = e->ts; + if (code->expr3) + ts = code->expr3->ts; + else if (code->ext.alloc.ts.type == BT_DERIVED) + ts = code->ext.alloc.ts; + gfc_find_derived_vtab (ts.u.derived); + } + if (pointer || (dimension == 0 && codimension == 0)) goto success; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1f6f826396f..8f38f78d3c9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2010-08-04 Janus Weil + + PR fortran/42207 + PR fortran/44064 + PR fortran/44065 + * gfortran.dg/class_25.f03: New. + * gfortran.dg/class_26.f03: New. + 2010-08-04 Daniel Gutson * g++.dg/warn/miss-format-1.C: Update line number. diff --git a/gcc/testsuite/gfortran.dg/class_25.f03 b/gcc/testsuite/gfortran.dg/class_25.f03 new file mode 100644 index 00000000000..3588b7759e5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_25.f03 @@ -0,0 +1,28 @@ +! { dg-do run } +! +! PR [OOP] Compile-time errors on typed allocation and pointer function result assignment +! +! Contributed by Damian Rouson + +module m + + implicit none + + type foo + end type + + type ,extends(foo) :: bar + end type + +contains + + function new_bar() + class(foo) ,pointer :: new_bar + allocate(bar :: new_bar) + end function + +end module + +end + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/class_26.f03 b/gcc/testsuite/gfortran.dg/class_26.f03 new file mode 100644 index 00000000000..629c9c98e4c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_26.f03 @@ -0,0 +1,29 @@ +! { dg-do run } +! +! PR 44065: [OOP] Undefined reference to vtab$... +! +! Contributed by Salvatore Filippone + +module s_mat_mod + implicit none + type :: s_sparse_mat + end type +contains + subroutine s_set_triangle(a) + class(s_sparse_mat), intent(inout) :: a + end subroutine +end module + +module s_tester +implicit none +contains + subroutine s_ussv_2 + use s_mat_mod + type(s_sparse_mat) :: a + call s_set_triangle(a) + end subroutine +end module + +end + +! { dg-final { cleanup-modules "s_mat_mod s_tester" } }