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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eff0a0fa88b1bce1f84b98a2cca1b7575b55be6c..cb87dd05c1adfaca9e35517961ccbad0e198beb6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index da3db7e096c36196c35a26f428710317273f65e3..1cd1c2b0e3a66e965a9c8a0be5bac99cef37bd14 100644 (file)
--- 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 7c7409dbe3e6a752a9a99a6bf275ab718aef8251..5477f3f178dbcdbd78743132259524a40c560f1a 100644 (file)
--- 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 069d817117567429d5b2e00983569156a49f3bb5..3a8bc3bf750c90aa1200eb0cd62c9cb982be99f9 100644 (file)
--- 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 (file)
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