re PR fortran/35831 ([F95] Shape mismatch check missing for dummy procedure argument)

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

	PR fortran/35831
	* interface.c (check_dummy_characteristics): Add checks for several
	attributes.


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

	PR fortran/35831
	* gfortran.dg/c_by_val_5.f90: Modified.
	* gfortran.dg/dummy_procedure_10.f90: New.

From-SVN: r205873
This commit is contained in:
Janus Weil 2013-12-10 22:41:43 +01:00
parent 61063a2a69
commit 688974a346
5 changed files with 100 additions and 3 deletions

View File

@ -1,3 +1,9 @@
2013-12-10 Janus Weil <janus@gcc.gnu.org>
PR fortran/35831
* interface.c (check_dummy_characteristics): Add checks for several
attributes.
2013-12-10 Janus Weil <janus@gcc.gnu.org>
* gfortran.texi: Add possible kind values (and default) for

View File

@ -1114,8 +1114,37 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
return false;
}
/* FIXME: Do more comprehensive testing of attributes, like e.g.
ASYNCHRONOUS, CONTIGUOUS, VALUE, VOLATILE, etc. */
/* Check ASYNCHRONOUS attribute. */
if (s1->attr.asynchronous != s2->attr.asynchronous)
{
snprintf (errmsg, err_len, "ASYNCHRONOUS mismatch in argument '%s'",
s1->name);
return false;
}
/* Check CONTIGUOUS attribute. */
if (s1->attr.contiguous != s2->attr.contiguous)
{
snprintf (errmsg, err_len, "CONTIGUOUS mismatch in argument '%s'",
s1->name);
return false;
}
/* Check VALUE attribute. */
if (s1->attr.value != s2->attr.value)
{
snprintf (errmsg, err_len, "VALUE mismatch in argument '%s'",
s1->name);
return false;
}
/* Check VOLATILE attribute. */
if (s1->attr.volatile_ != s2->attr.volatile_)
{
snprintf (errmsg, err_len, "VOLATILE mismatch in argument '%s'",
s1->name);
return false;
}
/* Check interface of dummy procedures. */
if (s1->attr.flavor == FL_PROCEDURE)

View File

@ -1,3 +1,9 @@
2013-12-10 Janus Weil <janus@gcc.gnu.org>
PR fortran/35831
* gfortran.dg/c_by_val_5.f90: Modified.
* gfortran.dg/dummy_procedure_10.f90: New.
2013-12-10 Yury Gribov <y.gribov@samsung.com>
* gcc-dg/tsan/tsan.exp: Added missing call to torture-finish.

View File

@ -23,7 +23,7 @@ module x
! "external" only.
interface
subroutine bmp_write(nx)
integer :: nx
integer, value :: nx
end subroutine bmp_write
end interface
contains

View File

@ -0,0 +1,56 @@
! { dg-do compile }
!
! PR 35831: [F95] Shape mismatch check missing for dummy procedure argument
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
program test_attributes
call tester1 (a1) ! { dg-error "ASYNCHRONOUS mismatch in argument" }
call tester2 (a2) ! { dg-error "CONTIGUOUS mismatch in argument" }
call tester3 (a1) ! { dg-error "VALUE mismatch in argument" }
call tester4 (a1) ! { dg-error "VOLATILE mismatch in argument" }
contains
subroutine a1(aa)
real :: aa
end subroutine
subroutine a2(bb)
real :: bb(:)
end subroutine
subroutine tester1 (f1)
interface
subroutine f1 (a)
real, asynchronous :: a
end subroutine
end interface
end subroutine
subroutine tester2 (f2)
interface
subroutine f2 (b)
real, contiguous :: b(:)
end subroutine
end interface
end subroutine
subroutine tester3 (f3)
interface
subroutine f3 (c)
real, value :: c
end subroutine
end interface
end subroutine
subroutine tester4 (f4)
interface
subroutine f4 (d)
real, volatile :: d
end subroutine
end interface
end subroutine
end