re PR fortran/29601 (VOLATILE attribute and statement)

fortran/
2006-11-06  Tobias Burnus  <burnus@net-b.de>

    PR fortran/29601
    * symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
    * decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
    * gfortran.h (symbol_attribute): Add volatile_ to struct.
    * resolve.c (was_declared): Add volatile support.
    * trans-decl.c (gfc_finish_var_decl): Add volatile support.
    * match.h: Declare gfc_match_volatile.
    * parse.c (decode_statement): Recognize volatile.
    * modules.c (ab_attribute, attr_bits, mio_symbol_attribute):
      Add volatile support.
    * dump-parse-tree.c (gfc_show_attr): Add volatile support.


testsuite/
2006-11-06  Tobias Burnus  <burnus@net-b.de>

    PR fortran/29601
    * gfortran.dg/volatile.f90: Add.
    * gfortran.dg/volatile2.f90: Add.
    * gfortran.dg/volatile3.f90: Add.
    * gfortran.dg/volatile4.f90: Add.
    * gfortran.dg/volatile5.f90: Add.
    * gfortran.dg/volatile6.f90: Add.
    * gfortran.dg/volatile7.f90: Add.

From-SVN: r118545

10 files changed, 144 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cec70a..d31bb14 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2006-11-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29601
+	* symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
+	* decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
+	* gfortran.h (symbol_attribute): Add volatile_ to struct.
+	* resolve.c (was_declared): Add volatile support.
+	* trans-decl.c (gfc_finish_var_decl): Add volatile support.
+	* match.h: Declare gfc_match_volatile.
+	* parse.c (decode_statement): Recognize volatile.
+	* modules.c (ab_attribute, attr_bits, mio_symbol_attribute):
+	  Add volatile support.
+	* dump-parse-tree.c (gfc_show_attr): Add volatile support.
+
 2006-11-06  Tobias Burnus  <burnus@net-b.de>
 
 	* decl.c (match_attr_spec, gfc_match_enum): Unify gfc_notify_std
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index e326b94..a476c64 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2025,7 +2025,7 @@ match_attr_spec (void)
     DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
     DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
     DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
-    DECL_TARGET, DECL_COLON, DECL_NONE,
+    DECL_TARGET, DECL_VOLATILE, DECL_COLON, DECL_NONE,
     GFC_DECL_END /* Sentinel */
   }
   decl_types;
@@ -2048,6 +2048,7 @@ match_attr_spec (void)
     minit (", public", DECL_PUBLIC),
     minit (", save", DECL_SAVE),
     minit (", target", DECL_TARGET),
+    minit (", volatile", DECL_VOLATILE),
     minit ("::", DECL_COLON),
     minit (NULL, DECL_NONE)
   };
@@ -2168,6 +2169,9 @@ match_attr_spec (void)
 	  case DECL_TARGET:
 	    attr = "TARGET";
 	    break;
+	  case DECL_VOLATILE:
+	    attr = "VOLATILE";
+	    break;
 	  default:
 	    attr = NULL;	/* This shouldn't happen */
 	  }
@@ -2282,6 +2286,15 @@ match_attr_spec (void)
 	  t = gfc_add_target (&current_attr, &seen_at[d]);
 	  break;
 
+	case DECL_VOLATILE:
+	  if (gfc_notify_std (GFC_STD_F2003,
+                              "Fortran 2003: VOLATILE attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_volatile (&current_attr, NULL, &seen_at[d]);
+	  break;
+
 	default:
 	  gfc_internal_error ("match_attr_spec(): Bad attribute");
 	}
@@ -3944,6 +3957,59 @@ syntax:
 }
 
 
+match
+gfc_match_volatile (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, 
+		      "Fortran 2003: VOLATILE statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_volatile (&sym->attr, sym->name,
+  			        &gfc_current_locus) == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in VOLATILE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+
 /* Match a module procedure statement.  Note that we have to modify
    symbols in the parent's namespace because the current one was there
    to receive symbols that are in an interface's formal argument list.  */
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8a7eab5..dd08d1f 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -552,6 +552,8 @@ gfc_show_attr (symbol_attribute * attr)
     gfc_status (" POINTER");
   if (attr->save)
     gfc_status (" SAVE");
+  if (attr->volatile_)
+    gfc_status (" VOLATILE");
   if (attr->threadprivate)
     gfc_status (" THREADPRIVATE");
   if (attr->target)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 89d8e2ff..0559054 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -477,7 +477,7 @@ typedef struct
 {
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
-    optional:1, pointer:1, save:1, target:1,
+    optional:1, pointer:1, save:1, target:1, volatile_:1,
     dummy:1, result:1, assign:1, threadprivate:1;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
@@ -1866,6 +1866,7 @@ try gfc_add_pure (symbol_attribute *, locus *);
 try gfc_add_recursive (symbol_attribute *, locus *);
 try gfc_add_function (symbol_attribute *, const char *, locus *);
 try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+try gfc_add_volatile (symbol_attribute *, const char *, locus *);
 
 try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
 try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 19340ce..db4f1b8 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -146,6 +146,7 @@ match gfc_match_public (gfc_statement *);
 match gfc_match_save (void);
 match gfc_match_modproc (void);
 match gfc_match_target (void);
+match gfc_match_volatile (void);
 
 /* primary.c */
 match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index f525ab6..77ac0e9 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1435,7 +1435,7 @@ typedef enum
   AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, 
   AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
   AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
-  AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP
+  AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_VOLATILE
 }
 ab_attribute;
 
@@ -1448,6 +1448,7 @@ static const mstring attr_bits[] =
     minit ("OPTIONAL", AB_OPTIONAL),
     minit ("POINTER", AB_POINTER),
     minit ("SAVE", AB_SAVE),
+    minit ("VOLATILE", AB_VOLATILE),
     minit ("TARGET", AB_TARGET),
     minit ("THREADPRIVATE", AB_THREADPRIVATE),
     minit ("DUMMY", AB_DUMMY),
@@ -1518,6 +1519,8 @@ mio_symbol_attribute (symbol_attribute * attr)
 	MIO_NAME(ab_attribute) (AB_POINTER, attr_bits);
       if (attr->save)
 	MIO_NAME(ab_attribute) (AB_SAVE, attr_bits);
+      if (attr->volatile_)
+	MIO_NAME(ab_attribute) (AB_VOLATILE, attr_bits);
       if (attr->target)
 	MIO_NAME(ab_attribute) (AB_TARGET, attr_bits);
       if (attr->threadprivate)
@@ -1596,6 +1599,9 @@ mio_symbol_attribute (symbol_attribute * attr)
 	    case AB_SAVE:
 	      attr->save = 1;
 	      break;
+	    case AB_VOLATILE:
+	      attr->volatile_ = 1;
+	      break;
 	    case AB_TARGET:
 	      attr->target = 1;
 	      break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 8861e16..aedf292 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -282,6 +282,10 @@ decode_statement (void)
       match ("use% ", gfc_match_use, ST_USE);
       break;
 
+    case 'v':
+      match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
+      break;
+
     case 'w':
       match ("write", gfc_match_write, ST_WRITE);
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0206915..8cf9678 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -677,7 +677,7 @@ was_declared (gfc_symbol * sym)
     return 1;
 
   if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
-      || a.optional || a.pointer || a.save || a.target
+      || a.optional || a.pointer || a.save || a.target || a.volatile_
       || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
     return 1;
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index cd38ef8..07bf265 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -265,14 +265,15 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
 {
   static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
     *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
-    *intrinsic = "INTRINSIC", *allocatable = "ALLOCATABLE",
-    *elemental = "ELEMENTAL", *private = "PRIVATE", *recursive = "RECURSIVE",
+    *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+    *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
+    *private = "PRIVATE", *recursive = "RECURSIVE",
     *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
     *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
     *function = "FUNCTION", *subroutine = "SUBROUTINE",
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
-    *cray_pointee = "CRAY POINTEE", *data = "DATA";
+    *cray_pointee = "CRAY POINTEE", *data = "DATA", *volatile_ = "VOLATILE";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -399,6 +400,16 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (data, allocatable);
   conf (data, use_assoc);
 
+  conf (volatile_, intrinsic)
+  conf (volatile_, external)
+
+  if (attr->volatile_ && attr->intent == INTENT_IN)
+    {
+      a1 = volatile_;
+      a2 = intent_in;
+      goto conflict;
+    }
+
   a1 = gfc_code2string (flavors, attr->flavor);
 
   if (attr->in_namelist
@@ -508,6 +519,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (dummy);
       conf2 (in_common);
       conf2 (save);
+      conf2 (volatile_);
       conf2 (threadprivate);
       break;
 
@@ -812,6 +824,26 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
   return check_conflict (attr, name, where);
 }
 
+try
+gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->volatile_)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate VOLATILE attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->volatile_ = 1;
+  return check_conflict (attr, name, where);
+}
+
 
 try
 gfc_add_threadprivate (symbol_attribute * attr, const char *name, locus * where)
@@ -1249,6 +1281,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
   if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
     goto fail;
+  if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
+    goto fail;
   if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->target && gfc_add_target (dest, where) == FAILURE)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d81b829..262c1a0 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -513,7 +513,15 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
   if ((sym->attr.save || sym->attr.data || sym->value)
       && !sym->attr.use_assoc)
     TREE_STATIC (decl) = 1;
-  
+
+  if (sym->attr.volatile_)
+    {
+      tree new;
+      TREE_THIS_VOLATILE (decl) = 1;
+      new = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE);
+      TREE_TYPE (decl) = new;
+    } 
+
   /* Keep variables larger than max-stack-var-size off stack.  */
   if (!sym->ns->proc_name->attr.recursive
       && INTEGER_CST_P (DECL_SIZE_UNIT (decl))