From: Paul Thomas <pault@gcc.gnu.org>
Date: Fri, 8 Aug 2008 23:22:51 +0000 (+0000)
Subject: re PR fortran/37011 (F2003, type extension: multiple inheritence not rejected)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=63a3341a9d1f760b1761b365f57a27523bfb548b;p=gcc.git

re PR fortran/37011 (F2003, type extension: multiple inheritence not rejected)

2008-08-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/37011
	* symbol.c (gfc_add_extension): New function.
	* decl.c (gfc_get_type_attr_spec): Call it.
	(gfc_match_derived_decl): Set symbol extension attribute from
	attr.extension.
	* gfortran.h : Add prototype for gfc_add_extension.

From-SVN: r138891
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6e37b804d8e..ca2c2cde770 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2008-08-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37011
+	* symbol.c (gfc_add_extension): New function.
+	* decl.c (gfc_get_type_attr_spec): Call it.
+	(gfc_match_derived_decl): Set symbol extension attribute from
+	attr.extension.
+	* gfortran.h : Add prototype for gfc_add_extension.
+
 2008-08-08  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
 	PR 28875
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2b4bda1fa7f..12497808a4e 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6340,8 +6340,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
     }
   else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
     {
-      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: derived type "
-	    "extended at %C") == FAILURE)
+      if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE)
 	return MATCH_ERROR;
     }
   else
@@ -6385,7 +6384,9 @@ gfc_match_derived_decl (void)
 	seen_attr = true;
     } while (is_type_attr_spec == MATCH_YES);
 
-  /* Deal with derived type extensions.  */
+  /* Deal with derived type extensions.  The extension attribute has
+     been added to 'attr' but now the parent type must be found and
+     checked.  */
   if (parent[0])
     extended = check_extended_derived_type (parent);
 
@@ -6457,7 +6458,7 @@ gfc_match_derived_decl (void)
 
       /* Add the extended derived type as the first component.  */
       gfc_add_component (sym, parent, &p);
-      sym->attr.extension = 1;
+      sym->attr.extension = attr.extension;
       extended->refs++;
       gfc_set_sym_referenced (extended);
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e315cdece82..ccd2c0305ca 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2170,7 +2170,8 @@ gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
 gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
 
 gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
-gfc_try gfc_add_is_bind_c(symbol_attribute *, const char *, locus *, int);
+gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
+gfc_try gfc_add_extension (symbol_attribute *, locus *);
 gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
 gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
 gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index bf709fae5c4..6b64bcf4353 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1468,6 +1468,27 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
 }
 
 
+/* Set the extension field for the given symbol_attribute.  */
+
+gfc_try
+gfc_add_extension (symbol_attribute *attr, locus *where)
+{
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (attr->extension)
+    gfc_error_now ("Duplicate EXTENDS attribute specified at %L", where);
+  else
+    attr->extension = 1;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: EXTENDS at %L", where)
+	== FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
 gfc_try
 gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
 			    gfc_formal_arglist * formal, locus *where)