This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR50981 absent polymorphic scalar actual arguments


Hello,

this is the next PR50981 fix:
when passing polymorphic scalar actual arguments to elemental procedures, we were not adding the "_data" component reference.
The fix is straightforward; checking that the expression's type is BT_CLASS was introducing regressions, so this patch uses a helper function to check the type without impacting the testsuite.


Regression tested on x86_64-unknown-freebsd9.0. OK for trunk?

Mikael


Attachment: elemental_optional_scalar_class-1.CL
Description: Text document

diff --git a/trans-expr.c b/trans-expr.c
index 18ce1a7..ff4360e 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -3362,6 +3362,39 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
 }
 
 
+/* Tells whether the expression E is a reference to a (scalar) class container.
+   Scalar because array class containers usually have an array reference after
+   them, and gfc_fix_class_refs will add the missing "_data" component reference
+   in that case.  */
+
+static bool
+is_class_container_ref (gfc_expr *e)
+{
+  gfc_ref *ref;
+  bool result;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return e->ts.type == BT_CLASS;
+
+  if (e->symtree->n.sym->ts.type == BT_CLASS)
+    result = true;
+  else
+    result = false;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type != REF_COMPONENT)
+	result = false;
+      else if (ref->u.c.component->ts.type == BT_CLASS)
+	result = true; 
+      else
+	result = false;
+    }
+
+  return result;
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -3542,6 +3575,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  else
 	    gfc_conv_expr_reference (&parmse, e);
 
+	  if (fsym && fsym->ts.type == BT_DERIVED && is_class_container_ref (e))
+	    parmse.expr = gfc_class_data_get (parmse.expr);
+
 	  /* If we are passing an absent array as optional dummy to an
 	     elemental procedure, make sure that we pass NULL when the data
 	     pointer is NULL.  We need this extra conditional because of

Attachment: elemental_optional_scalar_class-tests.CL
Description: Text document

Attachment: elemental_optional_scalar_class-test.diff
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]