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 6e37b804d8e50b178fd1ae285e1b6519121f91dd..ca2c2cde770bc424dc0e09798b0275657ef51692 100644 (file)
--- 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 2b4bda1fa7ff29e8409dcc8d4f8293d77d9e59ab..12497808a4ea9811679b954487583956139d237a 100644 (file)
--- 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 e315cdece82b3b5678667f7f7cb980fa04431ae6..ccd2c0305caccf2f137b5b78b8b7c158ff198a45 100644 (file)
--- 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 bf709fae5c4073ee54b6de91bdc12925e5db33fc..6b64bcf4353c8a922c8d88ce2634216c4897aa0b 100644 (file)
--- 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)