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

5 files changed, 100 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eff0a0f..cb87dd0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 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
 	DOUBLE PRECISION.
 	* invoke.texi: Correct documentation of -fdefault-integer-8,
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index da3db7e..1cd1c2b 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 7c7409d..5477f3f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
index 069d817..3a8bc3b 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 0000000..2720b8f
--- /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 <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