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

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>

	* 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

gcc/fortran/ChangeLog

 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
 	* symbol.c (check_conflict): Add conflict of ELEMENTAL with Bind(C).
 

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);
 }

gcc/testsuite/ChangeLog

 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
 	* gfortran.dg/elemental_bind_c.f90: New.
 

gcc/testsuite/gfortran.dg/recursive_check_3.f90

+! { 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" }