2005-01-23 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/25901
	* decl.c (get_proc_name): Replace subroutine and function
	attributes in "already defined" test by the formal arglist
	pointer being non-NULL.

	Fix regression in testing of admissability of attributes.
	* symbol.c (gfc_add_attribute): If the current_attr has
	non-zero intent, do not do the check for a dummy being
	used.
	* decl.c (attr_decl1): Add current_attr.intent as the
	third argument in the call to gfc_add_attribute.
	* gfortran.h: Add the third argument to the prototype
	for gfc_add_attribute.


2005-01-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25901
	* gfortran.dg/internal references_2.f90: New test.

	Fix regression in testing of admissability of attributes.
	* gfortran.dg/intent_used_1.f90: New test.


git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@110106 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 71 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 12c848ad41a..9263d8aeb08 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2005-01-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25901
+	* decl.c (get_proc_name): Replace subroutine and function attributes
+	in "already defined" test by the formal arglist pointer being non-NULL.
+
+	Fix regression in testing of admissability of attributes.
+	* symbol.c (gfc_add_attribute): If the current_attr has non-zero
+	intent, do not do the check for a dummy being used.
+	* decl.c (attr_decl1): Add current_attr.intent as the third argument
+	in the call to gfc_add_attribute.
+	* gfortran.h: Add the third argument to the prototype for
+	gfc_add_attribute.
+
 2006-01-21  Joseph S. Myers  <joseph@codesourcery.com>
 
 	* gfortranspec.c (lang_specific_driver): Update copyright notice
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 282ca730aa4..7a80f81b30a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -611,10 +611,14 @@ get_proc_name (const char *name, gfc_symbol ** result)
 
   if (sym && !sym->new && gfc_current_state () != COMP_INTERFACE)
     {
-      /* Trap another encompassed procedure with the same name.  */
+      /* Trap another encompassed procedure with the same name.  All
+	 these conditions are necessary to avoid picking up an entry
+	 whose name clashes with that of the encompassing procedure;
+	 this is handled using gsymbols to register unique,globally
+	 accessible names.  */
       if (sym->attr.flavor != 0
 	    && sym->attr.proc != 0
-	    && (sym->attr.subroutine || sym->attr.function))
+	    && sym->formal)
 	gfc_error_now ("Procedure '%s' at %C is already defined at %L",
 		       name, &sym->declared_at);
 
@@ -3202,7 +3206,7 @@ attr_decl1 (void)
 	goto cleanup;
     }
 
-  if (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
+  if (gfc_add_attribute (&sym->attr, &var_locus, current_attr.intent) == FAILURE)
     {
       m = MATCH_ERROR;
       goto cleanup;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9e5d303afd2..a26eab07a9c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1701,7 +1701,7 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
 
 void gfc_set_sym_referenced (gfc_symbol * sym);
 
-try gfc_add_attribute (symbol_attribute *, locus *);
+try gfc_add_attribute (symbol_attribute *, locus *, uint);
 try gfc_add_allocatable (symbol_attribute *, locus *);
 try gfc_add_dimension (symbol_attribute *, const char *, locus *);
 try gfc_add_external (symbol_attribute *, locus *);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c4d2cf02649..9a28df64dc4 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -592,12 +592,14 @@ duplicate_attr (const char *attr, locus * where)
   gfc_error ("Duplicate %s attribute specified at %L", attr, where);
 }
 
+/* Called from decl.c (attr_decl1) to check attributes, when declared separately.  */
 
 try
-gfc_add_attribute (symbol_attribute * attr, locus * where)
+gfc_add_attribute (symbol_attribute * attr, locus * where, uint attr_intent)
 {
 
-  if (check_used (attr, NULL, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where)
+	|| (attr_intent == 0 && check_done (attr, where)))
     return FAILURE;
 
   return check_conflict (attr, NULL, where);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 271642d2a56..bcdea1b9314 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2005-01-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25901
+	* gfortran.dg/internal references_2.f90: New test.
+
+	Fix regression in testing of admissability of attributes.
+	* gfortran.dg/intent_used_1.f90: New test.
+
 2006-01-23  Ben Elliston  <bje@au.ibm.com>
 
 	* gcc.misc-tests/dectest.exp (TORTURE_OPTIONS): Include -Os.
diff --git a/gcc/testsuite/gfortran.dg/intent_used_1.f90 b/gcc/testsuite/gfortran.dg/intent_used_1.f90
new file mode 100644
index 00000000000..ecc06e989ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_used_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for the regression caused by the patch for PR20869
+! which itself is tested and described by intrinsic_external_1.f90
+!
+! reported to the fortran list by Dominique Dhumieres  dominiq@lps.ens.fr
+
+MODULE global
+   INTERFACE
+      SUBROUTINE foo(i, j)
+      IMPLICIT NONE
+      INTEGER :: j
+      integer, DIMENSION(j,*) :: i ! This constituted usage of j and so triggered....
+      INTENT (IN) j  ! Would give "Cannot change attributes of symbol at (1) after it has been used"
+      INTENT (INOUT) i
+      END SUBROUTINE foo
+   END INTERFACE
+END MODULE global
diff --git a/gcc/testsuite/gfortran.dg/internal_references_2.f90 b/gcc/testsuite/gfortran.dg/internal_references_2.f90
new file mode 100644
index 00000000000..bda8a6fcedb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_references_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This tests the fix for the regression caused by the internal references
+! patc, which is tested by internal_references_1.f90. Reported as PR25901.
+!
+! Based on test cases provided by Toon Moene  <toon@moene.indiv.nluug.nl>
+!                          and by Martin Reinecke <martin@mpa-garching.mpg.de>
+module aap
+  interface s
+    module procedure sub,sub1
+  end interface
+contains
+  subroutine sub1(i)
+    integer i
+    real a
+    call sub(a)      ! For the original test, this "defined" the procedure.
+  end subroutine sub1
+  subroutine sub(a)  ! Would give an error on "already defined" here
+    real a
+  end subroutine sub
+end module aap
\ No newline at end of file