--- Comment #3 from pault at gcc dot gnu dot org 2007-05-04 07:29 ---
This fixes it but needs some cleaning up:
Index: gcc/fortran/trans-expr.c
===
*** gcc/fortran/trans-expr.c(revision 124354)
--- gcc/fortran/trans-expr.c(working copy)
*** conv_arglist_function (gfc_se *se, gfc_e
*** 1987,1992
--- 1987,2068
}
+ /* Convert an array valued actual argument expression. */
+
+ static void
+ gfc_conv_array_arg (gfc_se *se, gfc_se *parmse, gfc_ss *argss,
+ gfc_expr *e, gfc_symbol *sym, gfc_symbol *fsym)
+ {
+ /* If the procedure requires an explicit interface, the actual argument
+ is passed according to the corresponding formal argument. If the
+ corresponding formal argument is a POINTER, ALLOCATABLE or assumed
+ shape, we do not use g77's calling convention, and pass the address
+ of the array descriptor instead. Otherwise we use g77's calling
+ convention. */
+ tree tmp;
+ tree parent;
+ gfc_symbol *psym;
+ int f;
+
+ if (e-expr_type == EXPR_VARIABLE)
+ psym = e-symtree-n.sym;
+ else
+ psym = NULL;
+
+ parent = DECL_CONTEXT (current_function_decl);
+
+ f = (fsym != NULL)
+!(fsym-attr.pointer || fsym-attr.allocatable)
+fsym-as-type != AS_ASSUMED_SHAPE;
+ f = f || !sym-attr.always_explicit;
+
+ /* The actual argument is a component reference to an array of derived
+ types. In this case, the argument is converted to a temporary,
+ which is passed and then written back after the procedure call. */
+ if (e-expr_type == EXPR_VARIABLE is_aliased_array (e))
+ gfc_conv_aliased_arg (parmse, e, f,
+ fsym ? fsym-attr.intent : INTENT_INOUT);
+
+ /* The actual argument is a reference to the procedure containing the
+ call, when it does not have an explicit result. */
+ else if (psym psym-attr.flavor == FL_PROCEDURE
+(psym-backend_decl == current_function_decl
+ ||
+ psym-backend_decl == parent))
+ {
+ int b = (parent == psym-backend_decl) ? 1 : 0;
+ parmse-expr = gfc_get_fake_result_decl (psym, b);
+
+ /* Pass a descriptor if required. */
+ if (f == 0 GFC_ARRAY_TYPE_P (TREE_TYPE (parmse-expr)))
+ {
+ tmp = gfc_conv_array_data (parmse-expr);
+ gfc_conv_expr_descriptor (parmse, e, argss);
+ parmse-expr = build_fold_addr_expr (parmse-expr);
+ }
+ else if (f == 1 GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE
(parmse-expr
+ parmse-expr = gfc_conv_array_data (build_fold_indirect_ref
(parmse-expr));
+
+ if (psym-ts.type == BT_CHARACTER)
+ parmse-string_length = psym-ts.cl-backend_decl;
+ }
+
+ /* The actual argument is an ordinary, honest-to-goodness array. */
+ else
+ gfc_conv_array_parameter (parmse, e, argss, f);
+
+ /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated
+ on entry, it must be deallocated. */
+ if (fsym fsym-attr.allocatable
+ fsym-attr.intent == INTENT_OUT)
+ {
+ tmp = build_fold_indirect_ref (parmse-expr);
+ tmp = gfc_trans_dealloc_allocated (tmp);
+ gfc_add_expr_to_block (se-pre, tmp);
+ }
+ }
+
+
/* 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. */
*** gfc_conv_function_call (gfc_se * se, gfc
*** 2132,2172
}
}
else
! {
! /* If the procedure requires an explicit interface, the actual
! argument is passed according to the corresponding formal
! argument. If the corresponding formal argument is a
POINTER,
! ALLOCATABLE or assumed shape, we do not use g77's calling
! convention, and pass the address of the array descriptor
! instead. Otherwise we use g77's calling convention. */
! int f;
! f = (fsym != NULL)
! !(fsym-attr.pointer || fsym-attr.allocatable)
! fsym-as-type != AS_ASSUMED_SHAPE;
! f = f || !sym-attr.always_explicit;
!
! if (e-expr_type == EXPR_VARIABLE
!is_aliased_array (e))
! /* The actual argument is a component reference to an
! array of derived types. In this case, the argument
! is converted to a temporary, which is passed and then
! written back after the procedure call. */
! gfc_conv_aliased_arg (parmse, e, f,
! fsym ? fsym-attr.intent : INTENT_INOUT);
! else
! gfc_conv_array_parameter (parmse, e, argss, f);
!
! /* If an ALLOCATABLE dummy argument
