diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2019-06-08 15:52:38 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2019-06-08 15:52:38 +0000 |
| commit | 8e73afcf40a43a88c9e2ca5406570f0189e6d903 (patch) | |
| tree | 6366e9a41b1377422463f779226690bbc0b348d1 /gcc/fortran/trans-expr.c | |
| parent | ec332875f8e2456bd104c16a553ac5ecad9024b3 (diff) | |
| download | gcc-8e73afcf40a43a88c9e2ca5406570f0189e6d903.zip gcc-8e73afcf40a43a88c9e2ca5406570f0189e6d903.tar.gz gcc-8e73afcf40a43a88c9e2ca5406570f0189e6d903.tar.bz2 | |
re PR fortran/90786 (ICE on procedure pointer assignment to function with class pointer result)
2019-06-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/90786
* trans-expr.c (pointer_assignment_is_proc_pointer) Remove as
it is very simple and only called from one place.
(gfc_trans_pointer_assignment): Rename non_proc_pointer_assign
as non_proc_ptr_assign. Assign to it directly, rather than call
to above, deleted function and use gfc_expr_attr instead of
only checking the reference chain.
2019-06-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/90786
* gfortran.dg/proc_ptr_51.f90 : New test.
From-SVN: r272084
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 29 |
1 files changed, 7 insertions, 22 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d23520f..dc173a0 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4881,7 +4881,7 @@ class_array_fcn: parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr); /* Basically make this into - + if (present) { if (contiguous) @@ -8979,23 +8979,6 @@ trans_caf_token_assign (gfc_se *lse, gfc_se *rse, gfc_expr *expr1, } } -/* Indentify class valued proc_pointer assignments. */ - -static bool -pointer_assignment_is_proc_pointer (gfc_expr * expr1, gfc_expr * expr2) -{ - gfc_ref * ref; - - ref = expr1->ref; - while (ref && ref->next) - ref = ref->next; - - return ref && ref->type == REF_COMPONENT - && ref->u.c.component->attr.proc_pointer - && expr2->expr_type == EXPR_VARIABLE - && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE; -} - /* Do everything that is needed for a CLASS function expr2. */ @@ -9048,7 +9031,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) tree desc; tree tmp; tree expr1_vptr = NULL_TREE; - bool scalar, non_proc_pointer_assign; + bool scalar, non_proc_ptr_assign; gfc_ss *ss; gfc_start_block (&block); @@ -9056,7 +9039,9 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_init_se (&lse, NULL); /* Usually testing whether this is not a proc pointer assignment. */ - non_proc_pointer_assign = !pointer_assignment_is_proc_pointer (expr1, expr2); + non_proc_ptr_assign = !(gfc_expr_attr (expr1).proc_pointer + && expr2->expr_type == EXPR_VARIABLE + && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE); /* Check whether the expression is a scalar or not; we cannot use expr1->rank as it can be nonzero for proc pointers. */ @@ -9066,7 +9051,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_free_ss_chain (ss); if (expr1->ts.type == BT_DERIVED && expr2->ts.type == BT_CLASS - && expr2->expr_type != EXPR_FUNCTION && non_proc_pointer_assign) + && expr2->expr_type != EXPR_FUNCTION && non_proc_ptr_assign) { gfc_add_data_component (expr2); /* The following is required as gfc_add_data_component doesn't @@ -9086,7 +9071,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) else gfc_conv_expr (&rse, expr2); - if (non_proc_pointer_assign && expr1->ts.type == BT_CLASS) + if (non_proc_ptr_assign && expr1->ts.type == BT_CLASS) { trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL, NULL); |