re PR fortran/30239 (duplicate data type assignment not detected)

2008-08-22  Daniel Kraft  <d@domob.eu>

	PR fortran/30239
	* symbol.c (gfc_add_type): Warn on -Wsurprising if a function-result
	type is re-declared but neither -pedantic nor -std=f* is given and so
	this is no error.
	* invoke.texi (-Wsurprising): Document this new behaviour.

From-SVN: r139499

6 files changed, 68 insertions, 2 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1b588cd..67c1fac 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2008-08-22  Daniel Kraft  <d@domob.eu>
 
+	PR fortran/30239
+	* symbol.c (gfc_add_type): Warn on -Wsurprising if a function-result
+	type is re-declared but neither -pedantic nor -std=f* is given and so
+	this is no error.
+	* invoke.texi (-Wsurprising): Document this new behaviour.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
 	* gfortran.h (in_prefix): Removed from this header.
 	* match.h (gfc_matching_prefix): Moved and renamed from `in_prefix'.
 	* decl.c (in_prefix): Removed from here.
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index b2370d4..b854ce4 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -757,6 +757,10 @@ A LOGICAL SELECT construct has three CASE statements.
 
 @item
 A TRANSFER specifies a source that is shorter than the destination.
+
+@item
+The type of a function result is declared more than once with the same type.  If
+@option{-pedantic} or standard-conforming mode is enabled, this is an error.
 @end itemize
 
 @item -Wtabs
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index f49f773..e16406d 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1540,9 +1540,11 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
 	  gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
 	  return FAILURE;
 	}
-      else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
-			       gfc_basic_typename (sym->ts.type)) == FAILURE)
+      if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
+	      		  gfc_basic_typename (sym->ts.type)) == FAILURE)
 	return FAILURE;
+      if (gfc_option.warn_surprising)
+	gfc_warning (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
     }
 
   flavor = sym->attr.flavor;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bf4d14e..4ee805b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/30239
+	* gfortran.dg/duplicate_type_1.f90: New test.
+	* gfortran.dg/duplicate_type_2.f90: New test.
+
 2008-08-22  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gcc.dg/tree-ssa/pr21658.c (dg-options): Use -fdump-tree-ccp1-details.
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_1.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_1.f90
new file mode 100644
index 0000000..c76c45d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+  IMPLICIT NONE
+  INTEGER :: foo ! { dg-error "basic type of" }
+  INTEGER :: foo ! { dg-error "basic type of" }
+  foo = 42
+END FUNCTION foo
+
+INTEGER FUNCTION bar () RESULT (x)
+  IMPLICIT NONE
+  INTEGER :: x ! { dg-error "basic type of" }
+
+  INTEGER :: y
+  INTEGER :: y ! { dg-error "basic type of" }
+
+  x = 42
+END FUNCTION bar
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_2.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_2.f90
new file mode 100644
index 0000000..5b86dc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_2.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=gnu -Wsurprising" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+  IMPLICIT NONE
+  INTEGER :: foo ! { dg-warning "basic type of" }
+  INTEGER :: foo ! { dg-warning "basic type of" }
+  foo = 42
+END FUNCTION foo
+
+INTEGER FUNCTION bar () RESULT (x)
+  IMPLICIT NONE
+  INTEGER :: x ! { dg-warning "basic type of" }
+
+  INTEGER :: y
+  INTEGER :: y ! { dg-error "basic type of" }
+
+  x = 42
+END FUNCTION bar