diff mbox

[Fortran,OOP] PR 60232: The rank of the element in the structure constructor does not match that of the component

Message ID CAKwh3qhMPL2mp9mA3NzXzWQ_VfvKkeRyv5TNeFgFUs5AE1qy2g@mail.gmail.com
State New
Headers show

Commit Message

Janus Weil Feb. 19, 2014, 9:37 a.m. UTC 
Hi all,

here is a small patch for an OOP-related rejects-valid problem, which
is technically not a regression, but I hope the patch is simple enough
to still make it into trunk.

The problem is this: When using a dimensionful function as an
EXPR_VARIABLE (e.g. as the target in a procedure pointer assignment),
we wrongly add a REF_ARRAY, because we are tricked to believe that the
expression is dimensionful (which is not the case). In the test case
at hand this problem appears in an OOP context, where we have a
dimensionful type-bound procedure, which then appears as the target to
the corresponding procedure-pointer component in the vtab.

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2014-02-19  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/60232
    * expr.c (gfc_get_variable_expr): Don't add REF_ARRAY for dimensionful
    functions, which are used as procedure pointer target.


2014-02-19  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/60232
    * gfortran.dg/typebound_proc_33.f90: New.
diff mbox

Patch

Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 207846)
+++ gcc/fortran/expr.c	(working copy)
@@ -3962,9 +3962,10 @@  gfc_get_variable_expr (gfc_symtree *var)
   e->symtree = var;
   e->ts = var->n.sym->ts;
 
-  if ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS)
-      || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym)
-	  && CLASS_DATA (var->n.sym)->as))
+  if (var->n.sym->attr.flavor != FL_PROCEDURE
+      && ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS)
+	   || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym)
+	       && CLASS_DATA (var->n.sym)->as)))
     {
       e->rank = var->n.sym->ts.type == BT_CLASS
 		? CLASS_DATA (var->n.sym)->as->rank : var->n.sym->as->rank;