The patch in class.c for PR50640 makes the default initializer
("__def_init_)TREE_READONLY. I also set attr.subroutine for __copy_,
which is not needed but its lacking irritated me once when stepping
through trans*.c.
The patch in trans-decl.c/trans.h fixes a 4.7 regressions (P1), which
causes gfortran.dg/select_type_12.f03 to fail. The actual regression is
due to a middle-end change, but it can be easier fixed on the front-end
side. The problem occurs for a derived type that is declared in a
procedure, but only used in a nested procedure. The vtable is
consequently generated in the scope of the parent procedure.
As Michael suggested, a solution is to place the vtable at the top
level. However, that is not sufficient, one also needs to place the
default member function __copy_<dt name> in the top level as its address
is used in the vtable. Fortunately, user type-bound procedures are only
allowed for derived-types declared in the specification part of a
module. Hence, those are by construction in the toplevel.
The patch has been bootstrapped and regtested on x86-64-linux.
OK for the trunk?
Tobias
PS: I see the following unrelated test-suite failures:
- gfortran.fortran-torture/execute/arrayarg.f90 (PR middle-end/51134,
memset is misoptimized, P1 [4.7], wrong-code)
- gfortran.fortran-torture/execute/entry_4.f90 (PR middle-end/50628, P1
[4.7], wrong-code)
- gfortran.dg/realloc_on_assign_5.f03 (PR fortran/47674, wrong-code)
2011-11-18 Tobias Burnus <bur...@net-b.de>
PR fortran/51207
* class.c (gfc_find_derived_vtab): Mark __def_init as PARAMETER
and hence as TREE_READONLY; add subroutine attribute to
__copy_ procedure.
PR fortran/50640
* trans.h (GFC_DECL_PUSH_TOPLEVEL): New DECL_LANG_FLAG_7.
* trans-decl.c (gfc_get_symbol_decl): Mark __def_init and vtab as
GFC_DECL_PUSH_TOPLEVEL.
(gfc_generate_function_code): If GFC_DECL_PUSH_TOPLEVEL, push it there.
(build_function_decl): Push __copy_ procedure to the toplevel.
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index dc76ad1..bcb2d0b 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -522,7 +522,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
def_init->attr.target = 1;
def_init->attr.save = SAVE_IMPLICIT;
def_init->attr.access = ACCESS_PUBLIC;
- def_init->attr.flavor = FL_VARIABLE;
+ def_init->attr.flavor = FL_PARAMETER;
gfc_set_sym_referenced (def_init);
def_init->ts.type = BT_DERIVED;
def_init->ts.u.derived = derived;
@@ -552,6 +552,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
+ copy->attr.subroutine = 1;
copy->attr.if_source = IFSRC_DECL;
if (ns->proc_name->attr.flavor == FL_MODULE)
copy->module = ns->proc_name->name;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 02c0ed7..fc8a9ed 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1471,6 +1471,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
&& !sym->attr.proc_pointer)
DECL_BY_REFERENCE (decl) = 1;
+ if (sym->attr.vtab
+ || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0))
+ GFC_DECL_PUSH_TOPLEVEL (decl) = 1;
+
return decl;
}
@@ -1891,7 +1895,8 @@ build_function_decl (gfc_symbol * sym, bool global)
/* Layout the function declaration and put it in the binding level
of the current function. */
- if (global)
+ if (global
+ || (sym->name[0] == '_' && strncmp ("__copy", sym->name, 6) == 0))
pushdecl_top_level (fndecl);
else
pushdecl (fndecl);
@@ -5316,7 +5321,10 @@ gfc_generate_function_code (gfc_namespace * ns)
next = DECL_CHAIN (decl);
DECL_CHAIN (decl) = NULL_TREE;
- pushdecl (decl);
+ if (GFC_DECL_PUSH_TOPLEVEL (decl))
+ pushdecl_top_level (decl);
+ else
+ pushdecl (decl);
decl = next;
}
saved_function_decls = NULL_TREE;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 22033d3..8fc7599 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -802,6 +802,7 @@ struct GTY((variable_size)) lang_decl {
#define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node)
#define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node)
#define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node)
+#define GFC_DECL_PUSH_TOPLEVEL(node) DECL_LANG_FLAG_7(node)
/* An array descriptor. */
#define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node)