diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index eff0a0fa88b..cb87dd05c1a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-12-10 Janus Weil + + PR fortran/35831 + * interface.c (check_dummy_characteristics): Add checks for several + attributes. + 2013-12-10 Janus Weil * gfortran.texi: Add possible kind values (and default) for diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index da3db7e096c..1cd1c2b0e3a 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7c7409dbe3e..5477f3f178d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2013-12-10 Janus Weil + + PR fortran/35831 + * gfortran.dg/c_by_val_5.f90: Modified. + * gfortran.dg/dummy_procedure_10.f90: New. + 2013-12-10 Yury Gribov * gcc-dg/tsan/tsan.exp: Added missing call to torture-finish. diff --git a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 b/gcc/testsuite/gfortran.dg/c_by_val_5.f90 index 069d8171175..3a8bc3bf750 100644 --- a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 +++ b/gcc/testsuite/gfortran.dg/c_by_val_5.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_10.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_10.f90 new file mode 100644 index 00000000000..2720b8f2eb6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dummy_procedure_10.f90 @@ -0,0 +1,56 @@ +! { dg-do compile } +! +! PR 35831: [F95] Shape mismatch check missing for dummy procedure argument +! +! Contributed by Janus Weil + +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