From dd2c3c5e8e8370d6e08a87b7122b8fbe4ddf7dde Mon Sep 17 00:00:00 2001

From: Mark Doffman <mark.doffman@codethink.co.uk>

Date: Tue, 23 Jun 2015 22:59:08 +0000

Subject: [PATCH 02/16] Allow duplicate declarations.

Enabled by -fdec-duplicates and -fdec.

Some fixes by Jim MacArthur <jim.macarthur@codethink.co.uk>

Addition of -fdec-duplicates by Mark Eggleston <mark.eggleston@codethink.com>

---

 gcc/fortran/lang.opt                           |  4 ++++

 gcc/fortran/options.c                          |  1 +

 gcc/fortran/symbol.c                           | 23 ++++++++++++++++++++---

 gcc/testsuite/gfortran.dg/duplicate_type_4.f90 | 13 +++++++++++++

 gcc/testsuite/gfortran.dg/duplicate_type_5.f90 | 13 +++++++++++++

 gcc/testsuite/gfortran.dg/duplicate_type_6.f90 | 13 +++++++++++++

 gcc/testsuite/gfortran.dg/duplicate_type_7.f90 | 13 +++++++++++++

 gcc/testsuite/gfortran.dg/duplicate_type_8.f90 | 12 ++++++++++++

 gcc/testsuite/gfortran.dg/duplicate_type_9.f90 | 12 ++++++++++++

 9 files changed, 101 insertions(+), 3 deletions(-)

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_4.f90

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_5.f90

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_6.f90

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_7.f90

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_8.f90

 create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_9.f90

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt

index 26e82601b62..491d81ccaa5 100644

--- a/gcc/fortran/lang.opt

+++ b/gcc/fortran/lang.opt

@@ -440,6 +440,10 @@ fdec

 Fortran Var(flag_dec)

 Enable all DEC language extensions.

+fdec-duplicates

+Fortran Var(flag_dec_duplicates)

+Allow varibles to be duplicated in the type specification matches.

+

 fdec-include

 Fortran Var(flag_dec_include)

 Enable legacy parsing of INCLUDE as statement.

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c

index 4f91486e977..f93db8b6d7c 100644

--- a/gcc/fortran/options.c

+++ b/gcc/fortran/options.c

@@ -75,6 +75,7 @@ set_dec_flags (int value)

   SET_BITFLAG (flag_dec_math, value, value);

   SET_BITFLAG (flag_dec_include, value, value);

   SET_BITFLAG (flag_dec_format_defaults, value, value);

+  SET_BITFLAG (flag_dec_duplicates, value, value);

 }

 /* Finalize DEC flags.  */

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c

index ec753229a98..4247b5b60c8 100644

--- a/gcc/fortran/symbol.c

+++ b/gcc/fortran/symbol.c

@@ -1995,6 +1995,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)

   if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)

     type = sym->ns->proc_name->ts.type;

+  flavor = sym->attr.flavor;

+

   if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)

       && !(gfc_state_stack->previous && gfc_state_stack->previous->previous

 	   && gfc_state_stack->previous->previous->state == COMP_SUBMODULE)

@@ -2004,9 +2006,26 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)

 	gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, "

 		   "use-associated at %L", sym->name, where, sym->module,

 		   &sym->declared_at);

+      else if (flag_dec_duplicates)

+	{

+	  /* Ignore temporaries and class/procedure names */

+	  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS

+	      || sym->ts.type == BT_PROCEDURE)

+	    return false;

+

+	  if (gfc_compare_types (&sym->ts, ts)

+	      && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE

+	      || flavor == FL_PROCEDURE))

+	    {

+	      return gfc_notify_std (GFC_STD_LEGACY,

+				     "Symbol '%qs' at %L already has "

+				     "basic type of %s", sym->name, where,

+				     gfc_basic_typename (type));

+	    }

+	}

       else

 	gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,

-		 where, gfc_basic_typename (type));

+		   where, gfc_basic_typename (type));

       return false;

     }

@@ -2017,8 +2036,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)

       return false;

     }

-  flavor = sym->attr.flavor;

-

   if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE

       || flavor == FL_LABEL

       || (flavor == FL_PROCEDURE && sym->attr.subroutine)

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90

new file mode 100644

index 00000000000..cdd29ea8846

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90

@@ -0,0 +1,13 @@

+! { 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 :: x

+  INTEGER :: x ! { dg-error "basic type of" }

+  x = 42

+END FUNCTION foo

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_5.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90

new file mode 100644

index 00000000000..00f931809aa

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90

@@ -0,0 +1,13 @@

+! { dg-do run }

+! { dg-options "-fdec" }

+!

+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+program test

+  implicit none

+  integer :: x

+  integer :: x

+  x = 42

+  if (x /= 42) stop 1

+end program test

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_6.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90

new file mode 100644

index 00000000000..f0df27e323c

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90

@@ -0,0 +1,13 @@

+! { dg-do run }

+! { dg-options "-std=legacy -fdec-duplicates" }

+!

+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+program test

+  implicit none

+  integer :: x

+  integer :: x

+  x = 42

+  if (x /= 42) stop 1

+end program test

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_7.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90

new file mode 100644

index 00000000000..f32472ff586

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90

@@ -0,0 +1,13 @@

+! { dg-do run }

+! { dg-options "-fdec-duplicates" }

+!

+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+program test

+  implicit none

+  integer :: x

+  integer :: x! { dg-warning "Legacy Extension" }

+  x = 42

+  if (x /= 42) stop 1

+end program test

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_8.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90

new file mode 100644

index 00000000000..23c94add179

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90

@@ -0,0 +1,12 @@

+! { dg-do compile }

+! { dg-options "-fdec -fno-dec-duplicates" }

+!

+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+integer function foo ()

+  implicit none

+  integer :: x

+  integer :: x ! { dg-error "basic type of" }

+  x = 42

+end function foo

diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_9.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90

new file mode 100644

index 00000000000..d5edee4d8ee

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90

@@ -0,0 +1,12 @@

+! { dg-do compile }

+! { dg-options "-fdec-duplicates -fno-dec-duplicates" }

+!

+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+integer function foo ()

+  implicit none

+  integer :: x

+  integer :: x ! { dg-error "basic type of" }

+  x = 42

+end function foo

-- 

2.11.0