|
 |
3db796 |
From f96f2f273741ea19311c6e7a6f556c09b6ff9415 Mon Sep 17 00:00:00 2001
|
|
|
3db796 |
From: Mark Doffman <mark.doffman@codethink.co.uk>
|
|
|
3db796 |
Date: Tue, 23 Jun 2015 22:59:08 +0000
|
|
|
3db796 |
Subject: [PATCH 01/23] Allow repeated compatible type specifications.
|
|
|
3db796 |
|
|
|
3db796 |
Add a check to see if a repeated type specification is compatible
|
|
|
3db796 |
with the previous specification. Only create an error on incompatible
|
|
|
3db796 |
type specifications for the same symbol.
|
|
|
3db796 |
|
|
|
3db796 |
Some fixes by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
3db796 |
---
|
|
|
3db796 |
|
|
|
3db796 |
0001-Allow-repeated-compatible-type-specifications.patch
|
|
|
3db796 |
|
|
|
3db796 |
0015-Allow-redefinition-of-types-for-procedures.patch
|
|
|
3db796 |
|
|
|
3db796 |
0021-Correct-internal-fault-in-select_type_9.f90.patch
|
|
|
3db796 |
|
|
|
3db796 |
|
|
|
3db796 |
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
|
|
|
3db796 |
index ec43e63..67ad504 100644
|
|
|
3db796 |
--- a/gcc/fortran/symbol.c
|
|
|
3db796 |
+++ b/gcc/fortran/symbol.c
|
|
|
3db796 |
@@ -1877,6 +1877,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
|
|
|
3db796 |
if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
|
|
|
3db796 |
type = sym->ns->proc_name->ts.type;
|
|
|
3db796 |
|
|
|
3db796 |
+ flavor = sym->attr.flavor;
|
|
|
3db796 |
+
|
|
|
3db796 |
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)
|
|
|
3db796 |
&& !(gfc_state_stack->previous && gfc_state_stack->previous->previous
|
|
|
3db796 |
&& gfc_state_stack->previous->previous->state == COMP_SUBMODULE)
|
|
|
3db796 |
@@ -1886,6 +1888,20 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
|
|
|
3db796 |
gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, "
|
|
|
3db796 |
"use-associated at %L", sym->name, where, sym->module,
|
|
|
3db796 |
&sym->declared_at);
|
|
|
3db796 |
+ else if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
|
|
|
3db796 |
+ {
|
|
|
3db796 |
+ /* Ignore temporaries and class/procedure names */
|
|
|
3db796 |
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS || sym->ts.type == BT_PROCEDURE)
|
|
|
3db796 |
+ return false;
|
|
|
3db796 |
+
|
|
|
3db796 |
+ if (gfc_compare_types (&sym->ts, ts)
|
|
|
3db796 |
+ && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE || flavor == FL_PROCEDURE))
|
|
|
3db796 |
+ {
|
|
|
3db796 |
+ return gfc_notify_std (GFC_STD_LEGACY,
|
|
|
3db796 |
+ "Symbol '%qs' at %L already has basic type of %s", sym->name,
|
|
|
3db796 |
+ where, gfc_basic_typename (type));
|
|
|
3db796 |
+ }
|
|
|
3db796 |
+ }
|
|
|
3db796 |
else
|
|
|
3db796 |
gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
|
|
|
3db796 |
where, gfc_basic_typename (type));
|
|
|
3db796 |
@@ -1899,8 +1915,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
|
|
|
3db796 |
return false;
|
|
|
3db796 |
}
|
|
|
3db796 |
|
|
|
3db796 |
- flavor = sym->attr.flavor;
|
|
|
3db796 |
-
|
|
|
3db796 |
if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
|
|
|
3db796 |
|| flavor == FL_LABEL
|
|
|
3db796 |
|| (flavor == FL_PROCEDURE && sym->attr.subroutine)
|
|
|
3db796 |
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
|
|
|
3db796 |
new file mode 100644
|
|
|
3db796 |
index 0000000..cdd29ea
|
|
|
3db796 |
--- /dev/null
|
|
|
3db796 |
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
|
|
|
3db796 |
@@ -0,0 +1,13 @@
|
|
|
3db796 |
+! { dg-do compile }
|
|
|
3db796 |
+! { dg-options "-std=f95" }
|
|
|
3db796 |
+
|
|
|
3db796 |
+! PR fortran/30239
|
|
|
3db796 |
+! Check for errors when a symbol gets declared a type twice, even if it
|
|
|
3db796 |
+! is the same.
|
|
|
3db796 |
+
|
|
|
3db796 |
+INTEGER FUNCTION foo ()
|
|
|
3db796 |
+ IMPLICIT NONE
|
|
|
3db796 |
+ INTEGER :: x
|
|
|
3db796 |
+ INTEGER :: x ! { dg-error "basic type of" }
|
|
|
3db796 |
+ x = 42
|
|
|
3db796 |
+END FUNCTION foo
|