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
This commit is contained in:
Paul Thomas 2008-08-08 23:22:51 +00:00
parent e73f7547c5
commit 63a3341a9d
4 changed files with 37 additions and 5 deletions

View File

@ -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

View File

@ -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);

View File

@ -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 *);

View File

@ -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)