re PR fortran/20880 (USE association of procedure's own interface)
2006-11-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/20880 * parse.c (parse_interface): Error if procedure name is that of encompassing scope. * resolve.c (resolve_fl_procedure): Error if procedure is ambiguous. PR fortran/29387 * interface.c (compare_actual_formal): Add missing condition that 'where' be present for error that asserts that actual arguments be definable. 2006-11-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/20880 * gfortran.dg/interface_3.f90: New test. PR fortran/29387 * gfortran.dg/generic_8.f90: New test. From-SVN: r119173
This commit is contained in:
parent
e7c1c8d1a1
commit
536afc35bc
7 changed files with 119 additions and 3 deletions
|
@ -1,3 +1,16 @@
|
|||
2006-11-24 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/20880
|
||||
* parse.c (parse_interface): Error if procedure name is that of
|
||||
encompassing scope.
|
||||
* resolve.c (resolve_fl_procedure): Error if procedure is
|
||||
ambiguous.
|
||||
|
||||
PR fortran/29387
|
||||
* interface.c (compare_actual_formal): Add missing condition
|
||||
that 'where' be present for error that asserts that actual
|
||||
arguments be definable.
|
||||
|
||||
2006-11-24 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
|
||||
* resolve.c (resolve_actual_arglist): Remove the special case for
|
||||
|
|
|
@ -1379,8 +1379,9 @@ compare_actual_formal (gfc_actual_arglist ** ap,
|
|||
&& (f->sym->attr.intent == INTENT_OUT
|
||||
|| f->sym->attr.intent == INTENT_INOUT))
|
||||
{
|
||||
gfc_error ("Actual argument at %L must be definable to "
|
||||
"match dummy INTENT = OUT/INOUT", &a->expr->where);
|
||||
if (where)
|
||||
gfc_error ("Actual argument at %L must be definable to "
|
||||
"match dummy INTENT = OUT/INOUT", &a->expr->where);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
|
@ -1694,6 +1694,7 @@ parse_interface (void)
|
|||
gfc_interface_info save;
|
||||
gfc_state_data s1, s2;
|
||||
gfc_statement st;
|
||||
locus proc_locus;
|
||||
|
||||
accept_statement (ST_INTERFACE);
|
||||
|
||||
|
@ -1781,6 +1782,7 @@ loop:
|
|||
accept_statement (st);
|
||||
prog_unit = gfc_new_block;
|
||||
prog_unit->formal_ns = gfc_current_ns;
|
||||
proc_locus = gfc_current_locus;
|
||||
|
||||
decl:
|
||||
/* Read data declaration statements. */
|
||||
|
@ -1796,8 +1798,15 @@ decl:
|
|||
|
||||
current_interface = save;
|
||||
gfc_add_interface (prog_unit);
|
||||
|
||||
pop_state ();
|
||||
|
||||
if (current_interface.ns
|
||||
&& current_interface.ns->proc_name
|
||||
&& strcmp (current_interface.ns->proc_name->name,
|
||||
prog_unit->name) == 0)
|
||||
gfc_error ("INTERFACE procedure '%s' at %L has the same name as the "
|
||||
"enclosing procedure", prog_unit->name, &proc_locus);
|
||||
|
||||
goto loop;
|
||||
|
||||
done:
|
||||
|
|
|
@ -5516,11 +5516,20 @@ static try
|
|||
resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
|
||||
{
|
||||
gfc_formal_arglist *arg;
|
||||
gfc_symtree *st;
|
||||
|
||||
if (sym->attr.function
|
||||
&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
st = gfc_find_symtree (gfc_current_ns->sym_root, sym->name);
|
||||
if (st && st->ambiguous && !sym->attr.generic)
|
||||
{
|
||||
gfc_error ("Procedure %s at %L is ambiguous",
|
||||
sym->name, &sym->declared_at);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if (sym->ts.type == BT_CHARACTER)
|
||||
{
|
||||
gfc_charlen *cl = sym->ts.cl;
|
||||
|
|
|
@ -1,3 +1,11 @@
|
|||
2006-11-24 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/20880
|
||||
* gfortran.dg/interface_3.f90: New test.
|
||||
|
||||
PR fortran/29387
|
||||
* gfortran.dg/generic_8.f90: New test.
|
||||
|
||||
2006-11-24 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
|
||||
* gfortran.dg/specifics_1.f90: Remove check for CHAR.
|
||||
|
|
31
gcc/testsuite/gfortran.dg/generic_8.f90
Normal file
31
gcc/testsuite/gfortran.dg/generic_8.f90
Normal file
|
@ -0,0 +1,31 @@
|
|||
! { dg-do compile }
|
||||
! Tests the fix for PR29837, in which the following valid code
|
||||
! would emit an error because of mistaken INTENT; the wrong
|
||||
! specific interface would be used for the comparison.
|
||||
!
|
||||
! Contributed by
|
||||
!
|
||||
MODULE M
|
||||
IMPLICIT NONE
|
||||
INTERFACE A
|
||||
MODULE PROCEDURE A1,A2
|
||||
END INTERFACE
|
||||
CONTAINS
|
||||
|
||||
SUBROUTINE A2(X)
|
||||
INTEGER, INTENT(INOUT) :: X
|
||||
END SUBROUTINE A2
|
||||
|
||||
SUBROUTINE A1(X,Y)
|
||||
INTEGER, INTENT(IN) :: X
|
||||
INTEGER, INTENT(OUT) :: Y
|
||||
Y=X
|
||||
END SUBROUTINE A1
|
||||
|
||||
SUBROUTINE T(X)
|
||||
INTEGER, INTENT(IN) :: X(:)
|
||||
INTEGER Y
|
||||
CALL A(MAXVAL(X),Y)
|
||||
END SUBROUTINE T
|
||||
END MODULE M
|
||||
! { dg-final { cleanup-modules "M" } }
|
45
gcc/testsuite/gfortran.dg/interface_3.f90
Normal file
45
gcc/testsuite/gfortran.dg/interface_3.f90
Normal file
|
@ -0,0 +1,45 @@
|
|||
! { dg-do compile }
|
||||
! Tests the fix for PR20880, which was due to failure to the failure
|
||||
! to detect the USE association of a nameless interface for a
|
||||
! procedure with the same name as the encompassing scope.
|
||||
!
|
||||
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
||||
!
|
||||
module test_mod
|
||||
interface
|
||||
subroutine my_sub (a)
|
||||
real a
|
||||
end subroutine
|
||||
end interface
|
||||
interface
|
||||
function my_fun (a)
|
||||
real a, my_fun
|
||||
end function
|
||||
end interface
|
||||
end module
|
||||
|
||||
! This is the original PR
|
||||
subroutine my_sub (a) ! { dg-error "is ambiguous" }
|
||||
use test_mod
|
||||
real a
|
||||
print *, a
|
||||
end subroutine
|
||||
|
||||
integer function my_fun (a) ! { dg-error "is ambiguous" }
|
||||
use test_mod
|
||||
real a
|
||||
print *, a
|
||||
my_fun = 1 ! { dg-error "ambiguous reference" }
|
||||
end function
|
||||
|
||||
! This was found whilst investigating => segfault
|
||||
subroutine thy_sub (a)
|
||||
interface
|
||||
subroutine thy_sub (a) ! { dg-error "enclosing procedure" }
|
||||
real a
|
||||
end subroutine
|
||||
end interface
|
||||
real a
|
||||
print *, a
|
||||
end subroutine
|
||||
! { dg-final { cleanup-modules "test_mod" } }
|
Loading…
Add table
Reference in a new issue