symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive): Allow prefixes only...

2007-09-13  Tobias Burnus  <burnus@net-b.de>

	* symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive):
	Allow prefixes only to be specified once.

2007-09-13  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/recursive_check_3.f90: New.

From-SVN: r128472

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0b1eca4e5829a185629dd132b4ab422c22f888a8..73dcbf87d8e94c2a058ec12e256b9ec5b782b25a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2007-09-13  Tobias Burnus  <burnus@net-b.de>
+
+       * symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive):
+       Allow prefixes only to be specified once.
+
 2007-09-13  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/33412

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 01f64e277ed5ad461f2586316520381dd92707de..6ed366f607f632d9da6078a6338a4e2d5fa8ad23 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1144,6 +1144,12 @@ gfc_add_elemental (symbol_attribute *attr, locus *where)
   if (check_used (attr, NULL, where))
     return FAILURE;
 
+  if (attr->elemental)
+    {
+      duplicate_attr ("ELEMENTAL", where);
+      return FAILURE;
+    }
+
   attr->elemental = 1;
   return check_conflict (attr, NULL, where);
 }
@@ -1156,6 +1162,12 @@ gfc_add_pure (symbol_attribute *attr, locus *where)
   if (check_used (attr, NULL, where))
     return FAILURE;
 
+  if (attr->pure)
+    {
+      duplicate_attr ("PURE", where);
+      return FAILURE;
+    }
+
   attr->pure = 1;
   return check_conflict (attr, NULL, where);
 }
@@ -1168,6 +1180,12 @@ gfc_add_recursive (symbol_attribute *attr, locus *where)
   if (check_used (attr, NULL, where))
     return FAILURE;
 
+  if (attr->recursive)
+    {
+      duplicate_attr ("RECURSIVE", where);
+      return FAILURE;
+    }
+
   attr->recursive = 1;
   return check_conflict (attr, NULL, where);
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fd4a00cb299e3515fe6d2d1959eefae87ecdfcba..9df45f8f49da86faa0c61185adabdb0bee6edbc2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2007-09-13  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/recursive_check_3.f90: New.
+
 2007-09-13  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/33412

diff --git a/gcc/testsuite/gfortran.dg/recursive_check_3.f90 b/gcc/testsuite/gfortran.dg/recursive_check_3.f90
new file mode 100644 (file)
index 0000000..23904a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+module m1
+contains
+pure pure subroutine a1(b) ! { dg-error "Duplicate PURE attribute specified" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a1          ! { dg-error "Expecting END MODULE" }
+end module m1 ! { dg-warning "CONTAINS statement without FUNCTION" }
+
+module m2
+contains
+elemental elemental subroutine a2(b) ! { dg-error "Duplicate ELEMENTAL attribute" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a2          ! { dg-error "Expecting END MODULE" }
+end module m2 ! { dg-warning "CONTAINS statement without FUNCTION" }
+
+module m3
+contains
+recursive recursive subroutine a3(b) ! { dg-error "Duplicate RECURSIVE attribute" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a3          ! { dg-error "Expecting END MODULE" }
+end module m3 ! { dg-warning "CONTAINS statement without FUNCTION" }