diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 195 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 42 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 40 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 40 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 51 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 4 |
10 files changed, 346 insertions, 67 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a9b4195499d..a9f1cecc462 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,35 @@ +2012-05-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/41600 + * trans-array.c (build_array_ref): New static function. + (gfc_conv_array_ref, gfc_get_dataptr_offset): Call it. + * trans-expr.c (gfc_get_vptr_from_expr): New function. + (gfc_conv_derived_to_class): Add a new argument for a caller + supplied vptr and use it if it is not NULL. + (gfc_conv_procedure_call): Add NULL to call to above. + symbol.c (gfc_is_associate_pointer): Return true if symbol is + a class object. + * trans-stmt.c (trans_associate_var): Handle class associate- + names. + * expr.c (gfc_get_variable_expr): Supply the array-spec if + possible. + * trans-types.c (gfc_typenode_for_spec): Set GFC_CLASS_TYPE_P + for class types. + * trans.h : Add prototypes for gfc_get_vptr_from_expr and + gfc_conv_derived_to_class. Define GFC_CLASS_TYPE_P. + * resolve.c (resolve_variable): For class arrays, ensure that + the target expression has all the necessary _data references. + (resolve_assoc_var): Throw a "not yet implemented" error for + class array selectors that need a temporary. + * match.c (copy_ts_from_selector_to_associate, + select_derived_set_tmp, select_class_set_tmp): New functions. + (select_type_set_tmp): Call one of last two new functions. + (gfc_match_select_type): Copy_ts_from_selector_to_associate is + called if associate-name is typed. + + PR fortran/53191 + * resolve.c (resolve_ref): C614 applied to class expressions. + 2012-05-05 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/49010 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index d9614413e67..93d5df65455 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3821,6 +3821,9 @@ gfc_get_variable_expr (gfc_symtree *var) e->ref = gfc_get_ref (); e->ref->type = REF_ARRAY; e->ref->u.ar.type = AR_FULL; + e->ref->u.ar.as = gfc_copy_array_spec (var->n.sym->ts.type == BT_CLASS + ? CLASS_DATA (var->n.sym)->as + : var->n.sym->as); } return e; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 15edfc36db1..3d119180a73 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5112,6 +5112,78 @@ gfc_match_select (void) } +/* Transfer the selector typespec to the associate name. */ + +static void +copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) +{ + gfc_ref *ref; + gfc_symbol *assoc_sym; + + assoc_sym = associate->symtree->n.sym; + + /* Ensure that any array reference is resolved. */ + gfc_resolve_expr (selector); + + /* At this stage the expression rank and arrayspec dimensions have + not been completely sorted out. We must get the expr2->rank + right here, so that the correct class container is obtained. */ + ref = selector->ref; + while (ref && ref->next) + ref = ref->next; + + if (selector->ts.type == BT_CLASS + && CLASS_DATA (selector)->as + && ref && ref->type == REF_ARRAY) + { + if (ref->u.ar.type == AR_FULL) + selector->rank = CLASS_DATA (selector)->as->rank; + else if (ref->u.ar.type == AR_SECTION) + selector->rank = ref->u.ar.dimen; + else + selector->rank = 0; + } + + if (selector->ts.type != BT_CLASS) + { + /* The correct class container has to be available. */ + if (selector->rank) + { + assoc_sym->attr.dimension = 1; + assoc_sym->as = gfc_get_array_spec (); + assoc_sym->as->rank = selector->rank; + assoc_sym->as->type = AS_DEFERRED; + } + else + assoc_sym->as = NULL; + + assoc_sym->ts.type = BT_CLASS; + assoc_sym->ts.u.derived = selector->ts.u.derived; + assoc_sym->attr.pointer = 1; + gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, + &assoc_sym->as, false); + } + else + { + /* The correct class container has to be available. */ + if (selector->rank) + { + assoc_sym->attr.dimension = 1; + assoc_sym->as = gfc_get_array_spec (); + assoc_sym->as->rank = selector->rank; + assoc_sym->as->type = AS_DEFERRED; + } + else + assoc_sym->as = NULL; + assoc_sym->ts.type = BT_CLASS; + assoc_sym->ts.u.derived = CLASS_DATA (selector)->ts.u.derived; + assoc_sym->attr.pointer = 1; + gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, + &assoc_sym->as, false); + } +} + + /* Push the current selector onto the SELECT TYPE stack. */ static void @@ -5126,64 +5198,103 @@ select_type_push (gfc_symbol *sel) } -/* Set the temporary for the current SELECT TYPE selector. */ +/* Set the temporary for the current derived type SELECT TYPE selector. */ -static void -select_type_set_tmp (gfc_typespec *ts) +static gfc_symtree * +select_derived_set_tmp (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN]; gfc_symtree *tmp; - if (!ts) + sprintf (name, "__tmp_type_%s", ts->u.derived->name); + gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); + gfc_add_type (tmp->n.sym, ts, NULL); + + /* Copy across the array spec to the selector. */ + if (select_type_stack->selector->ts.type == BT_CLASS + && select_type_stack->selector->attr.class_ok + && (CLASS_DATA (select_type_stack->selector)->attr.dimension + || CLASS_DATA (select_type_stack->selector)->attr.codimension)) { - select_type_stack->tmp = NULL; - return; + tmp->n.sym->attr.dimension + = CLASS_DATA (select_type_stack->selector)->attr.dimension; + tmp->n.sym->attr.codimension + = CLASS_DATA (select_type_stack->selector)->attr.codimension; + tmp->n.sym->as + = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); } + + gfc_set_sym_referenced (tmp->n.sym); + gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL); + tmp->n.sym->attr.select_type_temporary = 1; + + return tmp; +} + + +/* Set the temporary for the current class SELECT TYPE selector. */ + +static gfc_symtree * +select_class_set_tmp (gfc_typespec *ts) +{ + char name[GFC_MAX_SYMBOL_LEN]; + gfc_symtree *tmp; - if (!gfc_type_is_extensible (ts->u.derived)) - return; + if (select_type_stack->selector->ts.type == BT_CLASS + && !select_type_stack->selector->attr.class_ok) + return NULL; - if (ts->type == BT_CLASS) - sprintf (name, "__tmp_class_%s", ts->u.derived->name); - else - sprintf (name, "__tmp_type_%s", ts->u.derived->name); + sprintf (name, "__tmp_class_%s", ts->u.derived->name); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); -/* Copy across the array spec to the selector, taking care as to - whether or not it is a class object or not. */ +/* Copy across the array spec to the selector. */ if (select_type_stack->selector->ts.type == BT_CLASS - && select_type_stack->selector->attr.class_ok && (CLASS_DATA (select_type_stack->selector)->attr.dimension || CLASS_DATA (select_type_stack->selector)->attr.codimension)) { - if (ts->type == BT_CLASS) - { - CLASS_DATA (tmp->n.sym)->attr.dimension + tmp->n.sym->attr.pointer = 1; + tmp->n.sym->attr.dimension = CLASS_DATA (select_type_stack->selector)->attr.dimension; - CLASS_DATA (tmp->n.sym)->attr.codimension + tmp->n.sym->attr.codimension = CLASS_DATA (select_type_stack->selector)->attr.codimension; - CLASS_DATA (tmp->n.sym)->as = gfc_get_array_spec (); - CLASS_DATA (tmp->n.sym)->as - = CLASS_DATA (select_type_stack->selector)->as; - } - else - { - tmp->n.sym->attr.dimension - = CLASS_DATA (select_type_stack->selector)->attr.dimension; - tmp->n.sym->attr.codimension - = CLASS_DATA (select_type_stack->selector)->attr.codimension; - tmp->n.sym->as = gfc_get_array_spec (); - tmp->n.sym->as = CLASS_DATA (select_type_stack->selector)->as; - } + tmp->n.sym->as + = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); } gfc_set_sym_referenced (tmp->n.sym); gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL); tmp->n.sym->attr.select_type_temporary = 1; + gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr, + &tmp->n.sym->as, false); + + return tmp; +} + + +static void +select_type_set_tmp (gfc_typespec *ts) +{ + gfc_symtree *tmp; + + if (!ts) + { + select_type_stack->tmp = NULL; + return; + } + + if (!gfc_type_is_extensible (ts->u.derived)) + return; + + /* Logic is a LOT clearer with separate functions for class and derived + type temporaries! There are not many more lines of code either. */ if (ts->type == BT_CLASS) - gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr, - &tmp->n.sym->as, false); + tmp = select_class_set_tmp (ts); + else + tmp = select_derived_set_tmp (ts); + + if (tmp == NULL) + return; /* Add an association for it, so the rest of the parser knows it is an associate-name. The target will be set during resolution. */ @@ -5194,7 +5305,7 @@ select_type_set_tmp (gfc_typespec *ts) select_type_stack->tmp = tmp; } - + /* Match a SELECT TYPE statement. */ match @@ -5204,6 +5315,7 @@ gfc_match_select_type (void) match m; char name[GFC_MAX_SYMBOL_LEN]; bool class_array; + gfc_symbol *sym; m = gfc_match_label (); if (m == MATCH_ERROR) @@ -5225,13 +5337,16 @@ gfc_match_select_type (void) m = MATCH_ERROR; goto cleanup; } + + sym = expr1->symtree->n.sym; if (expr2->ts.type == BT_UNKNOWN) - expr1->symtree->n.sym->attr.untyped = 1; + sym->attr.untyped = 1; else - expr1->symtree->n.sym->ts = expr2->ts; - expr1->symtree->n.sym->attr.flavor = FL_VARIABLE; - expr1->symtree->n.sym->attr.referenced = 1; - expr1->symtree->n.sym->attr.class_ok = 1; + copy_ts_from_selector_to_associate (expr1, expr2); + + sym->attr.flavor = FL_VARIABLE; + sym->attr.referenced = 1; + sym->attr.class_ok = 1; } else { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e15d6e12d7d..e5a49bcd561 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4904,14 +4904,19 @@ resolve_ref (gfc_expr *expr) { /* F03:C614. */ if (ref->u.c.component->attr.pointer - || ref->u.c.component->attr.proc_pointer) + || ref->u.c.component->attr.proc_pointer + || (ref->u.c.component->ts.type == BT_CLASS + && CLASS_DATA (ref->u.c.component)->attr.pointer)) { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the POINTER " "attribute at %L", &expr->where); return FAILURE; } - else if (ref->u.c.component->attr.allocatable) + else if (ref->u.c.component->attr.allocatable + || (ref->u.c.component->ts.type == BT_CLASS + && CLASS_DATA (ref->u.c.component)->attr.allocatable)) + { gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the ALLOCATABLE " @@ -5081,9 +5086,15 @@ resolve_variable (gfc_expr *e) } /* If this is an associate-name, it may be parsed with an array reference - in error even though the target is scalar. Fail directly in this case. */ - if (sym->assoc && !sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY) - return FAILURE; + in error even though the target is scalar. Fail directly in this case. + TODO Understand why class scalar expressions must be excluded. */ + if (sym->assoc && !(sym->ts.type == BT_CLASS && e->rank == 0)) + { + if (sym->ts.type == BT_CLASS) + gfc_fix_class_refs (e); + if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY) + return FAILURE; + } if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic) sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived); @@ -7941,7 +7952,7 @@ gfc_type_is_extensible (gfc_symbol *sym) } -/* Resolve an associate name: Resolve target and ensure the type-spec is +/* Resolve an associate-name: Resolve target and ensure the type-spec is correct as well as possibly the array-spec. */ static void @@ -7997,8 +8008,25 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) sym->attr.dimension = 0; return; } - if (target->rank > 0) + + /* We cannot deal with class selectors that need temporaries. */ + if (target->ts.type == BT_CLASS + && gfc_ref_needs_temporary_p (target->ref)) + { + gfc_error ("CLASS selector at %L needs a temporary which is not " + "yet implemented", &target->where); + return; + } + + if (target->ts.type != BT_CLASS && target->rank > 0) sym->attr.dimension = 1; + else if (target->ts.type == BT_CLASS) + gfc_fix_class_refs (target); + + /* The associate-name will have a correct type by now. Make absolutely + sure that it has not picked up a dimension attribute. */ + if (sym->ts.type == BT_CLASS) + sym->attr.dimension = 0; if (sym->attr.dimension) { diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 46e5f56feee..6ca4ca33014 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4882,6 +4882,9 @@ gfc_is_associate_pointer (gfc_symbol* sym) if (!sym->assoc) return false; + if (sym->ts.type == BT_CLASS) + return true; + if (!sym->assoc->variable) return false; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b54c95b4087..b24d1c323ed 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3068,6 +3068,36 @@ add_to_offset (tree *cst_offset, tree *offset, tree t) } } + +static tree +build_array_ref (tree desc, tree offset, tree decl) +{ + tree tmp; + + /* Class array references need special treatment because the assigned + type size needs to be used to point to the element. */ + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) + && TREE_CODE (desc) == COMPONENT_REF + && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0)))) + { + tree type = gfc_get_element_type (TREE_TYPE (desc)); + tmp = TREE_OPERAND (desc, 0); + tmp = gfc_get_class_array_ref (offset, tmp); + tmp = fold_convert (build_pointer_type (type), tmp); + tmp = build_fold_indirect_ref_loc (input_location, tmp); + } + else + { + tmp = gfc_conv_array_data (desc); + tmp = build_fold_indirect_ref_loc (input_location, tmp); + tmp = gfc_build_array_ref (tmp, offset, decl); + } + + return tmp; +} + + + /* Build an array reference. se->expr already holds the array descriptor. This should be either a variable, indirect variable reference or component reference. For arrays which do not have a descriptor, se->expr will be @@ -3195,10 +3225,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, offset, cst_offset); - /* Access the calculated element. */ - tmp = gfc_conv_array_data (se->expr); - tmp = build_fold_indirect_ref (tmp); - se->expr = gfc_build_array_ref (tmp, offset, sym->backend_decl); + se->expr = build_array_ref (se->expr, offset, sym->backend_decl); } @@ -6010,10 +6037,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, return; } - tmp = gfc_conv_array_data (desc); - tmp = build_fold_indirect_ref_loc (input_location, - tmp); - tmp = gfc_build_array_ref (tmp, offset, NULL); + tmp = build_array_ref (desc, offset, NULL); /* Offset the data pointer for pointer assignments from arrays with subreferences; e.g. my_integer => my_type(:)%integer_component. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7092bc2f153..8045b1f029b 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -147,11 +147,25 @@ gfc_vtable_copy_get (tree decl) #undef VTABLE_COPY_FIELD +/* Obtain the vptr of the last class reference in an expression. */ + +tree +gfc_get_vptr_from_expr (tree expr) +{ + tree tmp = expr; + while (tmp && !GFC_CLASS_TYPE_P (TREE_TYPE (tmp))) + tmp = TREE_OPERAND (tmp, 0); + tmp = gfc_class_vptr_get (tmp); + return tmp; +} + + /* Takes a derived type expression and returns the address of a temporary - class object of the 'declared' type. */ -static void + class object of the 'declared' type. If vptr is not NULL, this is + used for the temporary class object. */ +void gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, - gfc_typespec class_ts) + gfc_typespec class_ts, tree vptr) { gfc_symbol *vtab; gfc_ss *ss; @@ -167,11 +181,19 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, /* Set the vptr. */ ctree = gfc_class_vptr_get (var); - /* Remember the vtab corresponds to the derived type - not to the class declared type. */ - vtab = gfc_find_derived_vtab (e->ts.u.derived); - gcc_assert (vtab); - tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); + if (vptr != NULL_TREE) + { + /* Use the dynamic vptr. */ + tmp = vptr; + } + else + { + /* In this case the vtab corresponds to the derived type and the + vptr must point to it. */ + vtab = gfc_find_derived_vtab (e->ts.u.derived); + gcc_assert (vtab); + tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); + } gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp)); @@ -3531,7 +3553,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* The derived type needs to be converted to a temporary CLASS object. */ gfc_init_se (&parmse, se); - gfc_conv_derived_to_class (&parmse, e, fsym->ts); + gfc_conv_derived_to_class (&parmse, e, fsym->ts, NULL); } else if (se->ss && se->ss->info->useflags) { diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 12a1390e2aa..323fca382c3 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1140,6 +1140,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_expr *e; tree tmp; bool class_target; + tree desc; + tree offset; + tree dim; + int n; gcc_assert (sym->assoc); e = sym->assoc->target; @@ -1191,8 +1195,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_finish_block (&se.post)); } - /* CLASS arrays just need the descriptor to be directly assigned. */ - else if (class_target && sym->attr.dimension) + /* Derived type temporaries, arising from TYPE IS, just need the + descriptor of class arrays to be assigned directly. */ + else if (class_target && sym->ts.type == BT_DERIVED && sym->attr.dimension) { gfc_se se; @@ -1217,7 +1222,47 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gcc_assert (!sym->attr.dimension); gfc_init_se (&se, NULL); - gfc_conv_expr (&se, e); + + /* Class associate-names come this way because they are + unconditionally associate pointers and the symbol is scalar. */ + if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension) + { + /* For a class array we need a descriptor for the selector. */ + gfc_conv_expr_descriptor (&se, e, gfc_walk_expr (e)); + + /* Obtain a temporary class container for the result. */ + gfc_conv_class_to_class (&se, e, sym->ts, false); + se.expr = build_fold_indirect_ref_loc (input_location, se.expr); + + /* Set the offset. */ + desc = gfc_class_data_get (se.expr); + offset = gfc_index_zero_node; + for (n = 0; n < e->rank; n++) + { + dim = gfc_rank_cst[n]; + tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + gfc_conv_descriptor_stride_get (desc, dim), + gfc_conv_descriptor_lbound_get (desc, dim)); + offset = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + offset, tmp); + } + gfc_conv_descriptor_offset_set (&se.pre, desc, offset); + } + else if (sym->ts.type == BT_CLASS && e->ts.type == BT_CLASS + && CLASS_DATA (e)->attr.dimension) + { + /* This is bound to be a class array element. */ + gfc_conv_expr_reference (&se, e); + /* Get the _vptr component of the class object. */ + tmp = gfc_get_vptr_from_expr (se.expr); + /* Obtain a temporary class container for the result. */ + gfc_conv_derived_to_class (&se, e, sym->ts, tmp); + se.expr = build_fold_indirect_ref_loc (input_location, se.expr); + } + else + gfc_conv_expr (&se, e); tmp = TREE_TYPE (sym->backend_decl); tmp = gfc_build_addr_expr (tmp, se.expr); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 0f2912de1af..21a94fd6f06 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1106,6 +1106,9 @@ gfc_typenode_for_spec (gfc_typespec * spec) case BT_CLASS: basetype = gfc_get_derived_type (spec->u.derived); + if (spec->type == BT_CLASS) + GFC_CLASS_TYPE_P (basetype) = 1; + /* If we're dealing with either C_PTR or C_FUNPTR, we modified the type and kind to fit a (void *) and the basetype returned was a ptr_type_node. We need to pass up this new information to the diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 08a67325274..3b77281568a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -348,8 +348,10 @@ tree gfc_vtable_size_get (tree); tree gfc_vtable_extends_get (tree); tree gfc_vtable_def_init_get (tree); tree gfc_vtable_copy_get (tree); +tree gfc_get_vptr_from_expr (tree); tree gfc_get_class_array_ref (tree, tree); tree gfc_copy_class_to_class (tree, tree, tree); +void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_typespec, tree); void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool); /* Initialize an init/cleanup block. */ @@ -827,6 +829,8 @@ struct GTY((variable_size)) lang_decl { #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node) /* Fortran POINTER type. */ #define GFC_POINTER_TYPE_P(node) TYPE_LANG_FLAG_3(node) +/* Fortran CLASS type. */ +#define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node) /* The GFC_TYPE_ARRAY_* members are present in both descriptor and descriptorless array types. */ #define GFC_TYPE_ARRAY_LBOUND(node, dim) \ |