OSDN Git Service

* gfortran.h (struct gfc_symbol): Moving "interface" member to
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 1 May 2008 19:38:04 +0000 (19:38 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 1 May 2008 19:38:04 +0000 (19:38 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134867 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/interface.c
gcc/fortran/resolve.c

index 2abc96d..f9ae961 100644 (file)
@@ -1,3 +1,12 @@
+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>
 
        * intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.
index d6a5633..f52c2f1 100644 (file)
@@ -4060,8 +4060,8 @@ match_procedure_decl (void)
       /* Resolve interface if possible. That way, attr.procedure is only set
         if it is declared by a later procedure-declaration-stmt, which is
         invalid per C1212.  */
-      while (proc_if->interface)
-       proc_if = proc_if->interface;
+      while (proc_if->ts.interface)
+       proc_if = proc_if->ts.interface;
 
       if (proc_if->generic)
        {
@@ -4147,16 +4147,16 @@ got_ts:
       /* Set interface.  */
       if (proc_if != NULL)
        {
-         sym->interface = proc_if;
+         sym->ts.interface = proc_if;
          sym->attr.untyped = 1;
        }
       else if (current_ts.type != BT_UNKNOWN)
        {
-         sym->interface = gfc_new_symbol ("", gfc_current_ns);
-         sym->interface->ts = current_ts;
-         sym->interface->attr.function = 1;
-         sym->ts = sym->interface->ts;
-         sym->attr.function = sym->interface->attr.function;
+         sym->ts = current_ts;
+         sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
+         sym->ts.interface->ts = current_ts;
+         sym->ts.interface->attr.function = 1;
+         sym->attr.function = sym->ts.interface->attr.function;
        }
 
       if (gfc_match_eos () == MATCH_YES)
index 855305c..168f078 100644 (file)
@@ -778,6 +778,7 @@ typedef struct
   int kind;
   struct gfc_symbol *derived;
   gfc_charlen *cl;     /* For character types only.  */
+  struct gfc_symbol *interface;        /* For PROCEDURE declarations.  */
   int is_c_interop;
   int is_iso_c;
   bt f90_type; 
@@ -980,7 +981,7 @@ typedef struct gfc_symbol
   gfc_typespec ts;
   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
      generic name, the generic member points to the list of
      interfaces.  */
@@ -996,8 +997,6 @@ typedef struct gfc_symbol
   struct gfc_symbol *result;   /* function result symbol */
   gfc_component *components;   /* Derived type components */
 
-  struct gfc_symbol *interface;        /* For PROCEDURE declarations.  */
-
   /* Defined only for Cray pointees; points to their pointer.  */
   struct gfc_symbol *cp_pointer;
 
index 09f7238..f5746bf 100644 (file)
@@ -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",
                 sym->name, where);
 
-  if (sym->interface && sym->interface->attr.intrinsic)
+  if (sym->ts.interface && sym->ts.interface->attr.intrinsic)
     {
       gfc_intrinsic_sym *isym;
-      isym = gfc_find_function (sym->interface->name);
+      isym = gfc_find_function (sym->ts.interface->name);
       if (isym != NULL)
        {
-         if (compare_actual_formal_intr (ap, sym->interface))
+         if (compare_actual_formal_intr (ap, sym->ts.interface))
            return;
          gfc_error ("Type/rank mismatch in argument '%s' at %L",
                     sym->name, where);
index 65d1a16..4244205 100644 (file)
@@ -1563,10 +1563,10 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
 
   /* 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;
-      isym = gfc_find_function (sym->interface->name);
+      isym = gfc_find_function (sym->ts.interface->name);
 
       /* Existance of isym should be checked already.  */
       gcc_assert (isym);
@@ -2636,12 +2636,12 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
   match m;
 
   /* See if we have an intrinsic interface.  */
-  if (sym->interface != NULL && !sym->interface->attr.abstract
-      && !sym->interface->attr.subroutine)
+  if (sym->ts.interface != NULL && !sym->ts.interface->attr.abstract
+      && !sym->ts.interface->attr.subroutine)
     {
       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.  */
       gcc_assert (isym);
@@ -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)
     {
-      if (sym->interface->attr.procedure)
+      if (sym->ts.interface->attr.procedure)
        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);
 
       /* 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->attr.function = sym->interface->attr.function;
-         sym->attr.subroutine = sym->interface->attr.subroutine;
-         copy_formal_args (sym, sym->interface);
+         sym->ts.type = sym->ts.interface->ts.type;
+         sym->ts.kind = sym->ts.interface->ts.kind;
+         sym->attr.function = sym->ts.interface->attr.function;
+         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",
-                   sym->interface->name, sym->name, &sym->declared_at);
+                   sym->ts.interface->name, sym->name, &sym->declared_at);
          return;
        }
     }