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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1b588cd..67c1fac 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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