Commit 32d99e68 by Janus Weil Committed by François-Xavier Coudert

gfortran.h (struct gfc_symbol): Moving "interface" member to gfc_typespec (plus…

gfortran.h (struct gfc_symbol): Moving "interface" member to gfc_typespec (plus fixing a small docu error).

	* gfortran.h (struct gfc_symbol): Moving "interface" member to
	gfc_typespec (plus fixing a small docu error).
	* interface.c (gfc_procedure_use): Ditto.
	* decl.c (match_procedure_decl): Ditto.
	* resolve.c (resolve_specific_f0,
	resolve_specific_f0, resolve_symbol): Ditto.

From-SVN: r134867
parent ca873b0e
2008-05-01 Janus Weil <jaydub66@gmail.com>
* gfortran.h (struct gfc_symbol): Moving "interface" member to
gfc_typespec (plus fixing a small docu error).
* interface.c (gfc_procedure_use): Ditto.
* decl.c (match_procedure_decl): Ditto.
* resolve.c (resolve_specific_f0,
resolve_specific_f0, resolve_symbol): Ditto.
2008-04-30 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2008-04-30 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic. * intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.
......
...@@ -4060,8 +4060,8 @@ match_procedure_decl (void) ...@@ -4060,8 +4060,8 @@ match_procedure_decl (void)
/* Resolve interface if possible. That way, attr.procedure is only set /* Resolve interface if possible. That way, attr.procedure is only set
if it is declared by a later procedure-declaration-stmt, which is if it is declared by a later procedure-declaration-stmt, which is
invalid per C1212. */ invalid per C1212. */
while (proc_if->interface) while (proc_if->ts.interface)
proc_if = proc_if->interface; proc_if = proc_if->ts.interface;
if (proc_if->generic) if (proc_if->generic)
{ {
...@@ -4147,16 +4147,16 @@ got_ts: ...@@ -4147,16 +4147,16 @@ got_ts:
/* Set interface. */ /* Set interface. */
if (proc_if != NULL) if (proc_if != NULL)
{ {
sym->interface = proc_if; sym->ts.interface = proc_if;
sym->attr.untyped = 1; sym->attr.untyped = 1;
} }
else if (current_ts.type != BT_UNKNOWN) else if (current_ts.type != BT_UNKNOWN)
{ {
sym->interface = gfc_new_symbol ("", gfc_current_ns); sym->ts = current_ts;
sym->interface->ts = current_ts; sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
sym->interface->attr.function = 1; sym->ts.interface->ts = current_ts;
sym->ts = sym->interface->ts; sym->ts.interface->attr.function = 1;
sym->attr.function = sym->interface->attr.function; sym->attr.function = sym->ts.interface->attr.function;
} }
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
......
...@@ -778,6 +778,7 @@ typedef struct ...@@ -778,6 +778,7 @@ typedef struct
int kind; int kind;
struct gfc_symbol *derived; struct gfc_symbol *derived;
gfc_charlen *cl; /* For character types only. */ gfc_charlen *cl; /* For character types only. */
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop; int is_c_interop;
int is_iso_c; int is_iso_c;
bt f90_type; bt f90_type;
...@@ -980,7 +981,7 @@ typedef struct gfc_symbol ...@@ -980,7 +981,7 @@ typedef struct gfc_symbol
gfc_typespec ts; gfc_typespec ts;
symbol_attribute attr; symbol_attribute attr;
/* The interface member points to the formal argument list if the /* The formal member points to the formal argument list if the
symbol is a function or subroutine name. If the symbol is a symbol is a function or subroutine name. If the symbol is a
generic name, the generic member points to the list of generic name, the generic member points to the list of
interfaces. */ interfaces. */
...@@ -996,8 +997,6 @@ typedef struct gfc_symbol ...@@ -996,8 +997,6 @@ typedef struct gfc_symbol
struct gfc_symbol *result; /* function result symbol */ struct gfc_symbol *result; /* function result symbol */
gfc_component *components; /* Derived type components */ gfc_component *components; /* Derived type components */
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
/* Defined only for Cray pointees; points to their pointer. */ /* Defined only for Cray pointees; points to their pointer. */
struct gfc_symbol *cp_pointer; struct gfc_symbol *cp_pointer;
......
...@@ -2405,13 +2405,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) ...@@ -2405,13 +2405,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
gfc_warning ("Procedure '%s' called with an implicit interface at %L", gfc_warning ("Procedure '%s' called with an implicit interface at %L",
sym->name, where); sym->name, where);
if (sym->interface && sym->interface->attr.intrinsic) if (sym->ts.interface && sym->ts.interface->attr.intrinsic)
{ {
gfc_intrinsic_sym *isym; gfc_intrinsic_sym *isym;
isym = gfc_find_function (sym->interface->name); isym = gfc_find_function (sym->ts.interface->name);
if (isym != NULL) if (isym != NULL)
{ {
if (compare_actual_formal_intr (ap, sym->interface)) if (compare_actual_formal_intr (ap, sym->ts.interface))
return; return;
gfc_error ("Type/rank mismatch in argument '%s' at %L", gfc_error ("Type/rank mismatch in argument '%s' at %L",
sym->name, where); sym->name, where);
......
...@@ -1563,10 +1563,10 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr) ...@@ -1563,10 +1563,10 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
/* See if we have an intrinsic interface. */ /* See if we have an intrinsic interface. */
if (sym->interface != NULL && sym->interface->attr.intrinsic) if (sym->ts.interface != NULL && sym->ts.interface->attr.intrinsic)
{ {
gfc_intrinsic_sym *isym; gfc_intrinsic_sym *isym;
isym = gfc_find_function (sym->interface->name); isym = gfc_find_function (sym->ts.interface->name);
/* Existance of isym should be checked already. */ /* Existance of isym should be checked already. */
gcc_assert (isym); gcc_assert (isym);
...@@ -2636,12 +2636,12 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym) ...@@ -2636,12 +2636,12 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
match m; match m;
/* See if we have an intrinsic interface. */ /* See if we have an intrinsic interface. */
if (sym->interface != NULL && !sym->interface->attr.abstract if (sym->ts.interface != NULL && !sym->ts.interface->attr.abstract
&& !sym->interface->attr.subroutine) && !sym->ts.interface->attr.subroutine)
{ {
gfc_intrinsic_sym *isym; gfc_intrinsic_sym *isym;
isym = gfc_find_function (sym->interface->name); isym = gfc_find_function (sym->ts.interface->name);
/* Existance of isym should be checked already. */ /* Existance of isym should be checked already. */
gcc_assert (isym); gcc_assert (isym);
...@@ -7735,26 +7735,27 @@ resolve_symbol (gfc_symbol *sym) ...@@ -7735,26 +7735,27 @@ resolve_symbol (gfc_symbol *sym)
} }
} }
if (sym->attr.procedure && sym->interface if (sym->attr.procedure && sym->ts.interface
&& sym->attr.if_source != IFSRC_DECL) && sym->attr.if_source != IFSRC_DECL)
{ {
if (sym->interface->attr.procedure) if (sym->ts.interface->attr.procedure)
gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared " gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared "
"in a later PROCEDURE statement", sym->interface->name, "in a later PROCEDURE statement", sym->ts.interface->name,
sym->name,&sym->declared_at); sym->name,&sym->declared_at);
/* Get the attributes from the interface (now resolved). */ /* Get the attributes from the interface (now resolved). */
if (sym->interface->attr.if_source || sym->interface->attr.intrinsic) if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
{ {
sym->ts = sym->interface->ts; sym->ts.type = sym->ts.interface->ts.type;
sym->attr.function = sym->interface->attr.function; sym->ts.kind = sym->ts.interface->ts.kind;
sym->attr.subroutine = sym->interface->attr.subroutine; sym->attr.function = sym->ts.interface->attr.function;
copy_formal_args (sym, sym->interface); sym->attr.subroutine = sym->ts.interface->attr.subroutine;
copy_formal_args (sym, sym->ts.interface);
} }
else if (sym->interface->name[0] != '\0') else if (sym->ts.interface->name[0] != '\0')
{ {
gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit", gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
sym->interface->name, sym->name, &sym->declared_at); sym->ts.interface->name, sym->name, &sym->declared_at);
return; return;
} }
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment