This is the mail archive of the 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


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?


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,
 	    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]