| Message ID | CAGkQGiLZaogJSoL7S2T_JKfMU=NAmEee15064K2aktPGttvUow@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
| Series | {Patch, fortran] PR112834 - Class array function selector causes chain of syntax and other spurious errors | expand |
On 12/6/23 8:09 AM, Paul Richard Thomas wrote: > Dear All, > > This patch was rescued from my ill-fated and long winded attempt to > provide a fix-up for function selector references, where the function is > parsed after the procedure containing the associate/select type > construct (PRs 89645 and 99065). The fix-ups broke down completely once > these constructs were enclosed by another associate construct, where the > selector is a derived type or class function. My inclination now is to > introduce two pass parsing for contained procedures. > > Returning to PR112834, the patch is simple enough and is well described > by the change logs. PR111853 was fixed as a side effect of the bigger > patch. Steve Kargl had also posted the same fix on the PR. > > Regression tests - OK for trunk and 13-branch? > > Paul > Hi Paul, I am taking a crack at this. It looks reasonable to me. Certainly OK for trunk, and then, if no fallout, 13 at your discretion. Regards, Jerry
Hi Paul, On 12/6/23 17:09, Paul Richard Thomas wrote: > Dear All, > > This patch was rescued from my ill-fated and long winded attempt to provide > a fix-up for function selector references, where the function is parsed > after the procedure containing the associate/select type construct (PRs > 89645 and 99065). The fix-ups broke down completely once these constructs > were enclosed by another associate construct, where the selector is a > derived type or class function. My inclination now is to introduce two pass > parsing for contained procedures. > > Returning to PR112834, the patch is simple enough and is well described by > the change logs. PR111853 was fixed as a side effect of the bigger patch. > Steve Kargl had also posted the same fix on the PR. the patch looks good, but could you please check the coding style? @@ -6550,7 +6551,19 @@ select_type_set_tmp (gfc_typespec *ts) sym = tmp->n.sym; gfc_add_type (sym, ts, NULL); - if (selector->ts.type == BT_CLASS && selector->attr.class_ok + /* If the SELECT TYPE selector is a function we might be able to obtain + a typespec from the result. Since the function might not have been + parsed yet we have to check that there is indeed a result symbol. */ + if (selector->ts.type == BT_UNKNOWN + && gfc_state_stack->construct + && (expr2 = gfc_state_stack->construct->expr2) + && expr2->expr_type == EXPR_FUNCTION + && expr2->symtree + && expr2->symtree->n.sym && expr2->symtree->n.sym->result) Adding a line break before the second '&&' makes it more readable. + selector->ts = expr2->symtree->n.sym->result->ts; @@ -2037,7 +2038,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* 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) + if (sym->ts.type == BT_CLASS && e->expr_type ==EXPR_FUNCTION) There should be whitespace before AND after '=='. + { + gfc_conv_expr (&se, e); + se.expr = gfc_evaluate_now (se.expr, &se.pre); + } + else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension) > Regression tests - OK for trunk and 13-branch? > > Paul > Thanks for the patch! Harald
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index 9e3571d3dbe..cecd2940dcf 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -6436,9 +6436,9 @@ build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2) sym = expr1->symtree->n.sym; if (expr2->ts.type == BT_UNKNOWN) - sym->attr.untyped = 1; + sym->attr.untyped = 1; else - copy_ts_from_selector_to_associate (expr1, expr2); + copy_ts_from_selector_to_associate (expr1, expr2); sym->attr.flavor = FL_VARIABLE; sym->attr.referenced = 1; @@ -6527,6 +6527,7 @@ select_type_set_tmp (gfc_typespec *ts) gfc_symtree *tmp = NULL; gfc_symbol *selector = select_type_stack->selector; gfc_symbol *sym; + gfc_expr *expr2; if (!ts) { @@ -6550,7 +6551,19 @@ select_type_set_tmp (gfc_typespec *ts) sym = tmp->n.sym; gfc_add_type (sym, ts, NULL); - if (selector->ts.type == BT_CLASS && selector->attr.class_ok + /* If the SELECT TYPE selector is a function we might be able to obtain + a typespec from the result. Since the function might not have been + parsed yet we have to check that there is indeed a result symbol. */ + if (selector->ts.type == BT_UNKNOWN + && gfc_state_stack->construct + && (expr2 = gfc_state_stack->construct->expr2) + && expr2->expr_type == EXPR_FUNCTION + && expr2->symtree + && expr2->symtree->n.sym && expr2->symtree->n.sym->result) + selector->ts = expr2->symtree->n.sym->result->ts; + + if (selector->ts.type == BT_CLASS + && selector->attr.class_ok && selector->ts.u.derived && CLASS_DATA (selector)) { sym->attr.pointer diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index abd3a424f38..c1fa751d0e8 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -5131,7 +5131,7 @@ parse_associate (void) gfc_current_ns = my_ns; for (a = new_st.ext.block.assoc; a; a = a->next) { - gfc_symbol* sym; + gfc_symbol *sym, *tsym; gfc_expr *target; int rank; @@ -5195,6 +5195,16 @@ parse_associate (void) sym->ts.type = BT_DERIVED; sym->ts.u.derived = derived; } + else if (target->symtree && (tsym = target->symtree->n.sym)) + { + sym->ts = tsym->result ? tsym->result->ts : tsym->ts; + if (sym->ts.type == BT_CLASS) + { + if (CLASS_DATA (sym)->as) + target->rank = CLASS_DATA (sym)->as->rank; + sym->attr.class_ok = 1; + } + } } rank = target->rank; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 166b702cd9a..92678b816a1 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5669,7 +5669,7 @@ gfc_expression_rank (gfc_expr *e) if (ref->type != REF_ARRAY) continue; - if (ref->u.ar.type == AR_FULL) + if (ref->u.ar.type == AR_FULL && ref->u.ar.as) { rank = ref->u.ar.as->rank; break; diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 50b71e67234..b70c079fc55 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -1746,6 +1746,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) e = sym->assoc->target; class_target = (e->expr_type == EXPR_VARIABLE) + && e->ts.type == BT_CLASS && (gfc_is_class_scalar_expr (e) || gfc_is_class_array_ref (e, NULL)); @@ -2037,7 +2038,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* 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) + if (sym->ts.type == BT_CLASS && e->expr_type ==EXPR_FUNCTION) + { + gfc_conv_expr (&se, e); + se.expr = gfc_evaluate_now (se.expr, &se.pre); + } + else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension) { tree target_expr; /* For a class array we need a descriptor for the selector. */