+2006-10-03 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29284
+ PR fortran/29321
+ PR fortran/29322
+ * trans-expr.c (gfc_conv_function_call): Check the expression
+ and the formal symbol are present when testing the actual
+ argument.
+
+ PR fortran/25091
+ PR fortran/25092
+ * resolve.c (resolve_entries): It is an error if the entries
+ of an array-valued function do not have the same shape.
+
2006-10-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR middle-end/27478
{
gfc_symbol *sym;
gfc_typespec *ts, *fts;
-
+ gfc_array_spec *as, *fas;
gfc_add_function (&proc->attr, proc->name, NULL);
proc->result = proc;
+ fas = ns->entries->sym->as;
+ fas = fas ? fas : ns->entries->sym->result->as;
fts = &ns->entries->sym->result->ts;
if (fts->type == BT_UNKNOWN)
fts = gfc_get_default_type (ns->entries->sym->result, NULL);
for (el = ns->entries->next; el; el = el->next)
{
ts = &el->sym->result->ts;
+ as = el->sym->as;
+ as = as ? as : el->sym->result->as;
if (ts->type == BT_UNKNOWN)
ts = gfc_get_default_type (el->sym->result, NULL);
+
if (! gfc_compare_types (ts, fts)
|| (el->sym->result->attr.dimension
!= ns->entries->sym->result->attr.dimension)
|| (el->sym->result->attr.pointer
!= ns->entries->sym->result->attr.pointer))
break;
+
+ else if (as && fas && gfc_compare_array_spec (as, fas) == 0)
+ gfc_error ("Procedure %s at %L has entries with mismatched "
+ "array specifications", ns->entries->sym->name,
+ &ns->entries->sym->declared_at);
}
if (el == NULL)
}
}
- /* If an optional argument is itself an optional dummy argument,
- check its presence and substitute a null if absent. */
- if (e && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional
- && fsym && fsym->attr.optional)
- gfc_conv_missing_dummy (&parmse, e, fsym->ts);
-
- if (fsym && need_interface_mapping)
- gfc_add_interface_mapping (&mapping, fsym, &parmse);
+ if (fsym)
+ {
+ if (e)
+ {
+ /* If an optional argument is itself an optional dummy
+ argument, check its presence and substitute a null
+ if absent. */
+ if (e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.optional
+ && fsym->attr.optional)
+ gfc_conv_missing_dummy (&parmse, e, fsym->ts);
+
+ /* If an INTENT(OUT) dummy of derived type has a default
+ initializer, it must be (re)initialized here. */
+ if (fsym->attr.intent == INTENT_OUT
+ && fsym->ts.type == BT_DERIVED
+ && fsym->value)
+ {
+ gcc_assert (!fsym->attr.allocatable);
+ tmp = gfc_trans_assignment (e, fsym->value);
+ gfc_add_expr_to_block (&se->pre, tmp);
+ }
- gfc_add_block_to_block (&se->pre, &parmse.pre);
- gfc_add_block_to_block (&post, &parmse.post);
+ /* Obtain the character length of an assumed character
+ length procedure from the typespec. */
+ if (fsym->ts.type == BT_CHARACTER
+ && parmse.string_length == NULL_TREE
+ && e->ts.type == BT_PROCEDURE
+ && e->symtree->n.sym->ts.type == BT_CHARACTER
+ && e->symtree->n.sym->ts.cl->length != NULL)
+ {
+ gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
+ parmse.string_length
+ = e->symtree->n.sym->ts.cl->backend_decl;
+ }
+ }
- /* If an INTENT(OUT) dummy of derived type has a default
- initializer, it must be (re)initialized here. */
- if (fsym && fsym->attr.intent == INTENT_OUT && fsym->ts.type == BT_DERIVED
- && fsym->value)
- {
- gcc_assert (!fsym->attr.allocatable);
- tmp = gfc_trans_assignment (e, fsym->value);
- gfc_add_expr_to_block (&se->pre, tmp);
+ if (need_interface_mapping)
+ gfc_add_interface_mapping (&mapping, fsym, &parmse);
}
- if (fsym && fsym->ts.type == BT_CHARACTER
- && parmse.string_length == NULL_TREE
- && e->ts.type == BT_PROCEDURE
- && e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.cl->length != NULL)
- {
- gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
- parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
- }
+ gfc_add_block_to_block (&se->pre, &parmse.pre);
+ gfc_add_block_to_block (&post, &parmse.post);
/* Character strings are passed as two parameters, a length and a
pointer. */
+2006-10-03 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29284
+ * gfortran.dg/optional_assumed_charlen_1.f90: New test.
+
+ PR fortran/29321
+ PR fortran/29322
+ * gfortran.dg/missing_optional_dummy_2.f90: New test.
+
+ PR fortran/25091
+ PR fortran/25092
+ * gfortran.dg/entry_array_specs_1.f90: New test.
+
2006-10-03 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/nearest_1.f90: Add -O0 because -ffloat-store is
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR25091 and PR25092 in which mismatched array
+! specifications between entries of the same procedure were not diagnosed.
+
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+
+! This was PR25091 - no diagnostic given on error
+ FUNCTION F1() RESULT(RES_F1) ! { dg-error "mismatched array specifications" }
+ INTEGER RES_F1(2,2)
+ INTEGER RES_E1(4)
+ ENTRY E1() RESULT(RES_E1)
+ END FUNCTION
+
+! This was PR25092 - no diagnostic given on error
+ FUNCTION F2() RESULT(RES_F2) ! { dg-error "mismatched array specifications" }
+ INTEGER :: RES_F2(4)
+ INTEGER :: RES_E2(3)
+ ENTRY E2() RESULT(RES_E2)
+ END FUNCTION
+
+! Check that the versions without explicit results give the error
+ FUNCTION F3() ! { dg-error "mismatched array specifications" }
+ INTEGER :: F3(4)
+ INTEGER :: E3(2,2)
+ ENTRY E3()
+ END FUNCTION
+
+ FUNCTION F4() ! { dg-error "mismatched array specifications" }
+ INTEGER :: F4(4)
+ INTEGER :: E4(3)
+ ENTRY E4()
+ END FUNCTION
+
+! Check that conforming entries are OK.
+ FUNCTION F5()
+ INTEGER :: F5(4,5,6)
+ INTEGER :: E5(4,5,6)
+ ENTRY E5()
+ END FUNCTION
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29321 and PR29322, in which ICEs occurred for the
+! lack of proper attention to checking pointers in gfc_conv_function_call.
+!
+! Contributed by Olav Vahtras <vahtras@pdc.kth.se>
+! and Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+MODULE myint
+ TYPE NUM
+ INTEGER :: R = 0
+ END TYPE NUM
+ CONTAINS
+ FUNCTION FUNC(A,B) RESULT(E)
+ IMPLICIT NONE
+ TYPE(NUM) A,B,E
+ INTENT(IN) :: A,B
+ OPTIONAL B
+ E%R=A%R
+ CALL SUB(A,E)
+ END FUNCTION FUNC
+
+ SUBROUTINE SUB(A,E,B,C)
+ IMPLICIT NONE
+ TYPE(NUM) A,E,B,C
+ INTENT(IN) A,B
+ INTENT(OUT) E,C
+ OPTIONAL B,C
+ E%R=A%R
+ END SUBROUTINE SUB
+END MODULE myint
+
+ if (isscan () /= 0) call abort
+contains
+ integer function isscan (substr)
+ character(*), optional :: substr
+ if (.not.present(substr)) isscan = myscan ("foo", "over")
+ end function isscan
+end
+! { dg-final { cleanup-modules "myint" } }
+
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29284 in which an ICE would occur in converting
+! the call to a suboutine with an assumed character length, optional
+! dummy that is not present.
+!
+! Contributed by Rakuen Himawari <rakuen_himawari@yahoo.co.jp>
+!
+ MODULE foo
+ CONTAINS
+ SUBROUTINE sub1(a)
+ CHARACTER (LEN=*), OPTIONAL :: a
+ WRITE(*,*) 'foo bar'
+ END SUBROUTINE sub1
+
+ SUBROUTINE sub2
+ CALL sub1()
+ END SUBROUTINE sub2
+
+ END MODULE foo
+! { dg-final { cleanup-modules "foo" } }
projects / gcc.git / commitdiff