FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
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> 2008-08-08 Manuel Lopez-Ibanez <manu@gcc.gnu.org>
PR 28875 PR 28875

9
gcc/fortran/decl.c
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) else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
{ {
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: derived type " if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE)
"extended at %C") == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
} }
else else
@ -6385,7 +6384,9 @@ gfc_match_derived_decl (void)
seen_attr = true; seen_attr = true;
} while (is_type_attr_spec == MATCH_YES); } 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]) if (parent[0])
extended = check_extended_derived_type (parent); extended = check_extended_derived_type (parent);
@ -6457,7 +6458,7 @@ gfc_match_derived_decl (void)
/* Add the extended derived type as the first component. */ /* Add the extended derived type as the first component. */
gfc_add_component (sym, parent, &p); gfc_add_component (sym, parent, &p);
sym->attr.extension = 1; sym->attr.extension = attr.extension;
extended->refs++; extended->refs++;
gfc_set_sym_referenced (extended); gfc_set_sym_referenced (extended);

3
gcc/fortran/gfortran.h
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_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_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_value (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, 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 *); gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);

21
gcc/fortran/symbol.c
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_try
gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
gfc_formal_arglist * formal, locus *where) gfc_formal_arglist * formal, locus *where)