mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-12-24 11:35:31 +08:00
re PR fortran/29284 (ICE for optional subroutine argument)
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 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. From-SVN: r117413
This commit is contained in:
Paul Thomas
parent
b7bf91917a
commit
5be382734d
@ -1,3 +1,17 @@
|
||||
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
|
||||
|
||||
@ -419,23 +419,33 @@ resolve_entries (gfc_namespace * ns)
|
||||
{
|
||||
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)
|
||||
|
||||
@ -2006,39 +2006,50 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
|
||||
}
|
||||
}
|
||||
|
||||
/* 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)
|
||||
{
|
||||
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 (fsym && need_interface_mapping)
|
||||
gfc_add_interface_mapping (&mapping, fsym, &parmse);
|
||||
/* 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);
|
||||
}
|
||||
|
||||
/* 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 (need_interface_mapping)
|
||||
gfc_add_interface_mapping (&mapping, fsym, &parmse);
|
||||
}
|
||||
|
||||
gfc_add_block_to_block (&se->pre, &parmse.pre);
|
||||
gfc_add_block_to_block (&post, &parmse.post);
|
||||
|
||||
/* 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 (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;
|
||||
}
|
||||
|
||||
/* Character strings are passed as two parameters, a length and a
|
||||
pointer. */
|
||||
if (parmse.string_length != NULL_TREE)
|
||||
|
||||
@ -1,3 +1,16 @@
|
||||
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
|
||||
|
||||
39
gcc/testsuite/gfortran.dg/entry_array_specs_1.f90
Normal file
39
gcc/testsuite/gfortran.dg/entry_array_specs_1.f90
Normal file
@ -0,0 +1,39 @@
|
||||
! { 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
|
||||
40
gcc/testsuite/gfortran.dg/missing_optional_dummy_2.f90
Normal file
40
gcc/testsuite/gfortran.dg/missing_optional_dummy_2.f90
Normal file
@ -0,0 +1,40 @@
|
||||
! { 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" } }
|
||||
|
||||
20
gcc/testsuite/gfortran.dg/optional_assumed_charlen_1.f90
Normal file
20
gcc/testsuite/gfortran.dg/optional_assumed_charlen_1.f90
Normal file
@ -0,0 +1,20 @@
|
||||
! { 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" } }
|
||||
Loading…
Reference in New Issue
Block a user