* module.c (mio_f2k_derived): Use enumerator as initializer of

[pf3gnuchains/gcc-fork.git] / gcc / fortran / module.c

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 36095a2..c72cac1 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1,6 +1,7 @@
 /* Handle modules, which amounts to loading and saving symbols and
    their attendant structures.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -77,7 +78,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "3"
+#define MOD_VERSION "4"
 
 
 /* Structure that describes a position within a module file.  */
@@ -1671,13 +1672,14 @@ typedef enum
   AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
   AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
-  AB_EXTENSION, AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER
+  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS
 }
 ab_attribute;
 
 static const mstring attr_bits[] =
 {
     minit ("ALLOCATABLE", AB_ALLOCATABLE),
+    minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
     minit ("DIMENSION", AB_DIMENSION),
     minit ("EXTERNAL", AB_EXTERNAL),
     minit ("INTRINSIC", AB_INTRINSIC),
@@ -1711,7 +1713,6 @@ static const mstring attr_bits[] =
     minit ("ZERO_COMP", AB_ZERO_COMP),
     minit ("PROTECTED", AB_PROTECTED),
     minit ("ABSTRACT", AB_ABSTRACT),
-    minit ("EXTENSION", AB_EXTENSION),
     minit ("IS_CLASS", AB_IS_CLASS),
     minit ("PROCEDURE", AB_PROCEDURE),
     minit ("PROC_POINTER", AB_PROC_POINTER),
@@ -1771,7 +1772,7 @@ static void
 mio_symbol_attribute (symbol_attribute *attr)
 {
   atom_type t;
-  unsigned ext_attr;
+  unsigned ext_attr,extension_level;
 
   mio_lparen ();
 
@@ -1780,14 +1781,21 @@ mio_symbol_attribute (symbol_attribute *attr)
   attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
   attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
   attr->save = MIO_NAME (save_state) (attr->save, save_status);
+  
   ext_attr = attr->ext_attr;
   mio_integer ((int *) &ext_attr);
   attr->ext_attr = ext_attr;
 
+  extension_level = attr->extension;
+  mio_integer ((int *) &extension_level);
+  attr->extension = extension_level;
+
   if (iomode == IO_OUTPUT)
     {
       if (attr->allocatable)
        MIO_NAME (ab_attribute) (AB_ALLOCATABLE, attr_bits);
+      if (attr->asynchronous)
+       MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits);
       if (attr->dimension)
        MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
       if (attr->external)
@@ -1858,8 +1866,6 @@ mio_symbol_attribute (symbol_attribute *attr)
        MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
       if (attr->zero_comp)
        MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits);
-      if (attr->extension)
-       MIO_NAME (ab_attribute) (AB_EXTENSION, attr_bits);
       if (attr->is_class)
        MIO_NAME (ab_attribute) (AB_IS_CLASS, attr_bits);
       if (attr->procedure)
@@ -1885,6 +1891,9 @@ mio_symbol_attribute (symbol_attribute *attr)
            case AB_ALLOCATABLE:
              attr->allocatable = 1;
              break;
+           case AB_ASYNCHRONOUS:
+             attr->asynchronous = 1;
+             break;
            case AB_DIMENSION:
              attr->dimension = 1;
              break;
@@ -1984,9 +1993,6 @@ mio_symbol_attribute (symbol_attribute *attr)
            case AB_ZERO_COMP:
              attr->zero_comp = 1;
              break;
-           case AB_EXTENSION:
-             attr->extension = 1;
-             break;
            case AB_IS_CLASS:
              attr->is_class = 1;
              break;
@@ -3468,7 +3474,7 @@ mio_f2k_derived (gfc_namespace *f2k)
   else
     while (peek_atom () != ATOM_RPAREN)
       {
-       gfc_intrinsic_op op = 0; /* Silence GCC.  */
+       gfc_intrinsic_op op = GFC_INTRINSIC_BEGIN; /* Silence GCC.  */
 
        mio_lparen ();
        mio_intrinsic_op (&op);
@@ -3574,7 +3580,7 @@ mio_symbol (gfc_symbol *sym)
   mio_integer (&(sym->intmod_sym_id));
 
   if (sym->attr.flavor == FL_DERIVED)
-    mio_integer (&(sym->vindex));
+    mio_integer (&(sym->hash_value));
 
   mio_rparen ();
 }
@@ -3745,8 +3751,9 @@ load_generic_interfaces (void)
   const char *p;
   char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symbol *sym;
-  gfc_interface *generic = NULL;
+  gfc_interface *generic = NULL, *gen = NULL;
   int n, i, renamed;
+  bool ambiguous_set = false;
 
   mio_lparen ();
 
@@ -3831,9 +3838,13 @@ load_generic_interfaces (void)
              sym = st->n.sym;
 
              if (st && !sym->attr.generic
+                    && !st->ambiguous
                     && sym->module
                     && strcmp(module, sym->module))
-               st->ambiguous = 1;
+               {
+                 ambiguous_set = true;
+                 st->ambiguous = 1;
+               }
            }
 
          sym->attr.use_only = only_flag;
@@ -3849,6 +3860,26 @@ load_generic_interfaces (void)
              sym->generic = generic;
              sym->attr.generic_copy = 1;
            }
+
+         /* If a procedure that is not generic has generic interfaces
+            that include itself, it is generic! We need to take care
+            to retain symbols ambiguous that were already so.  */
+         if (sym->attr.use_assoc
+               && !sym->attr.generic
+               && sym->attr.flavor == FL_PROCEDURE)
+           {
+             for (gen = generic; gen; gen = gen->next)
+               {
+                 if (gen->sym == sym)
+                   {
+                     sym->attr.generic = 1;
+                     if (ambiguous_set)
+                       st->ambiguous = 0;
+                     break;
+                   }
+               }
+           }
+
        }
     }
 
@@ -4451,8 +4482,6 @@ read_module (void)
                 module_name);
     }
 
-  gfc_check_interfaces (gfc_current_ns);
-
   /* Now we should be in a position to fill f2k_derived with derived type
      extensions, since everything has been loaded.  */
   set_module_locus (&extensions);
@@ -4671,6 +4700,10 @@ write_equiv (void)
 static void
 write_dt_extensions (gfc_symtree *st)
 {
+  if (!gfc_check_access (st->n.sym->attr.access,
+                        st->n.sym->ns->default_access))
+    return;
+
   mio_lparen ();
   mio_pool_string (&st->n.sym->name);
   if (st->n.sym->module != NULL)
@@ -5488,9 +5521,9 @@ gfc_use_module (void)
 
          if (strcmp (atom_string, MOD_VERSION))
            {
-             gfc_fatal_error ("Wrong module version '%s' (expected '"
-                              MOD_VERSION "') for file '%s' opened"
-                              " at %C", atom_string, filename);
+             gfc_fatal_error ("Wrong module version '%s' (expected '%s') "
+                              "for file '%s' opened at %C", atom_string,
+                              MOD_VERSION, filename);
            }
        }