git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/40453 ([F95] Enhanced (recursive) argument checking) 

2012-10-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40453
	* interface.c (check_dummy_characteristics): Recursively check dummy
	procedures.

2012-10-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40453
	* gfortran.dg/dummy_procedure_9.f90: New.

From-SVN: r192391
This commit is contained in:
Janus Weil 2012-10-12 10:16:17 +02:00
parent 60b95d28c0
commit f2f8171fb1
4 changed files with 61 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2012-10-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/40453
* interface.c (check_dummy_characteristics): Recursively check dummy
procedures.
2012-10-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/54784

13
gcc/fortran/interface.c
View File

@ -1063,6 +1063,19 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
/* FIXME: Do more comprehensive testing of attributes, like e.g.
ASYNCHRONOUS, CONTIGUOUS, VALUE, VOLATILE, etc. */
/* Check interface of dummy procedures. */
if (s1->attr.flavor == FL_PROCEDURE)
{
char err[200];
if (!gfc_compare_interfaces (s1, s2, s2->name, 0, 1, err, sizeof(err),
NULL, NULL))
{
snprintf (errmsg, err_len, "Interface mismatch in dummy procedure "
"'%s': %s", s1->name, err);
return FAILURE;
}
}
/* Check string length. */
if (s1->ts.type == BT_CHARACTER
&& s1->ts.u.cl && s1->ts.u.cl->length

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2012-10-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/40453
* gfortran.dg/dummy_procedure_9.f90: New.
2012-10-12 Richard Biener <rguenther@suse.de>
PR tree-optimization/54894

37
gcc/testsuite/gfortran.dg/dummy_procedure_9.f90 Normal file
View File

@ -0,0 +1,37 @@
! { dg-do compile }
!
! PR 40453: [F95] Enhanced (recursive) argument checking
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
program RecursiveInterface
call c(b2) ! { dg-error "Interface mismatch in dummy procedure" }
contains
subroutine a1(x)
real :: x
end subroutine
subroutine a2(i)
integer :: i
end subroutine
!!!!!!!!!!!!!!!
subroutine b1 (f1)
procedure(a1) :: f1
end subroutine
subroutine b2 (f2)
procedure(a2) :: f2
end subroutine
!!!!!!!!!!!!!!!
subroutine c(g)
procedure(b1) :: g
end subroutine
end