re PR fortran/42207 ([OOP] Compile-time errors on typed allocation and pointer function result assignment)

2010-08-04  Janus Weil  <janus@gcc.gnu.org>

	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  <janus@gcc.gnu.org>

	PR fortran/42207
	PR fortran/44064
	PR fortran/44065
	* gfortran.dg/class_25.f03: New.
	* gfortran.dg/class_26.f03: New.

From-SVN: r162879
This commit is contained in:
Janus Weil 2010-08-04 21:49:19 +02:00
parent 0e884a9464
commit e10f52d099
7 changed files with 109 additions and 8 deletions

View File

@ -1,3 +1,15 @@
2010-08-04 Janus Weil <janus@gcc.gnu.org>
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 <burnus@net-b.de>
PR fortran/45183

View File

@ -323,12 +323,15 @@ gfc_find_derived_vtab (gfc_symbol *derived)
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 ();

View File

@ -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];

View File

@ -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;

View File

@ -1,3 +1,11 @@
2010-08-04 Janus Weil <janus@gcc.gnu.org>
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 <dgutson@codesourcery.com>
* g++.dg/warn/miss-format-1.C: Update line number.

View File

@ -0,0 +1,28 @@
! { dg-do run }
!
! PR [OOP] Compile-time errors on typed allocation and pointer function result assignment
!
! Contributed by Damian Rouson <damian@rouson.net>
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" } }

View File

@ -0,0 +1,29 @@
! { dg-do run }
!
! PR 44065: [OOP] Undefined reference to vtab$...
!
! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
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" } }