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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cec70a8ff0491f86c4404f4fca62a2f2dd11314..d31bb140bbdce07ad94948111c4889e9c8f96e61 100644 (file)
--- 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 e326b94e8c8793327276222e596f31ec909be155..a476c64bf8127911e117f3994d189568e800fa64 100644 (file)
--- 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 8a7eab5262ab55363c647a66576f7a374391637c..dd08d1fc64de6a65df7e26c944e54e44433b4314 100644 (file)
--- 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 89d8e2ff1c0c22ef879ff4a45be4dcf6c708b2d0..05590549070939d37edcb4d8faefa3c2247b5e3e 100644 (file)
--- 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 19340cee0f185587378fab1c24f31de009d7d90a..db4f1b852e193848247f96eb875aef8ba0e776a9 100644 (file)
--- 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 f525ab644950466f09e6c1232fdcf84da739574b..77ac0e90d81c86dabaf17dd48dbac0974076567b 100644 (file)
--- 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 8861e161d6d9397a766a471e55fc70315363d830..aedf292acd6ffd770a10e33ab7d0a1138705ad42 100644 (file)
--- 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 02069156ab9f8c8c9463fe87fab9ec4928de8d87..8cf967808c606fa5784a60a12d12a200f03e221b 100644 (file)
--- 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 cd38ef8dae49786309d0d32a7bdaa5583bc035dd..07bf2650ad29f8cbb633b68e1ece50f4f5dd91bb 100644 (file)
--- 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 d81b829e5fa21c3da56bbf11768ce95baca155c9..262c1a03e42a42d2bbb43aef5cb408949b12034b 100644 (file)
--- 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))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b133c30ce6a63fc033e760e99d26313050e99b38..e3cb936b84f72eb1a03cfcdebba7b66657c985f1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2006-11-07  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.
+
 2006-11-06  Tobias Burnus  <burnus@net-b.de>
 
        * gfortran.dg/io_constraints_2.f90: Adjust pattern

diff --git a/gcc/testsuite/gfortran.dg/volatile.f90 b/gcc/testsuite/gfortran.dg/volatile.f90
new file mode 100644 (file)
index 0000000..7318425
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Test whether volatile statements and attributes are accepted
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real :: l,m
+  real, volatile :: r = 3.
+  volatile :: l
+  l = 4.0
+  m = 3.0
+end program volatile_test

diff --git a/gcc/testsuite/gfortran.dg/volatile2.f90 b/gcc/testsuite/gfortran.dg/volatile2.f90
new file mode 100644 (file)
index 0000000..60655df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-shouldfail "VOLATILE not part of F95" }
+! { dg-options "-std=f95" }
+! Test whether volatile statements and attributes are rejected
+! with -std=f95.
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real, volatile :: foo ! { dg-error "VOLATILE attribute" }
+  real :: l
+  volatile :: l         ! { dg-error "VOLATILE statement" }
+  l   = 4.0
+  foo = 3.0             ! { dg-error "no IMPLICIT type" }   
+end program volatile_test

diff --git a/gcc/testsuite/gfortran.dg/volatile3.f90 b/gcc/testsuite/gfortran.dg/volatile3.f90
new file mode 100644 (file)
index 0000000..46619eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid use of VOLATILE" }
+! Test whether volatile statements and attributes are
+! properly error checked.
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real, external,  volatile :: foo ! { dg-error "VOLATILE attribute conflicts with EXTERNAL attribute" }
+  real, intrinsic, volatile :: sin ! { dg-error "VOLATILE attribute conflicts with INTRINSIC attribute" }
+  real, parameter, volatile :: r = 5.5 ! { dg-error "PARAMETER attribute conflicts with VOLATILE attribute" }
+  real :: l,m
+  real,volatile :: n
+  real, volatile,volatile :: r = 3. ! { dg-error "Duplicate VOLATILE attribute" }
+  volatile :: l,n ! { dg-error "Duplicate VOLATILE attribute" }
+  volatile ! { dg-error "Syntax error in VOLATILE statement" }
+  l = 4.0
+  m = 3.0
+contains
+  subroutine foo(a) ! { dg-error "has no IMPLICIT type" } ! due to error below
+    integer, intent(in), volatile :: a ! { dg-error "VOLATILE attribute conflicts with INTENT\\(IN\\)" }
+  end subroutine
+end program volatile_test

diff --git a/gcc/testsuite/gfortran.dg/volatile4.f90 b/gcc/testsuite/gfortran.dg/volatile4.f90
new file mode 100644 (file)
index 0000000..f58a873
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works
+! PR fortran/29601
+logical, volatile :: t1
+logical :: t2
+integer :: i
+
+t2 = .false.
+t1 = .false.
+do i = 1, 2
+  if(t1) print *, 'VolatileNotOptimizedAway'
+  if(t2) print *, 'NonVolatileNotOptimizedAway'
+end do
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } } */
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } } */
+! { dg-final { cleanup-tree-dump "optimized" } } */

diff --git a/gcc/testsuite/gfortran.dg/volatile5.f90 b/gcc/testsuite/gfortran.dg/volatile5.f90
new file mode 100644 (file)
index 0000000..42607a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile5.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-O3 -fdump-tree-optimized" }
+! Tests whether volatile really works with modules
+! PR fortran/29601
+module volmod
+  implicit none
+  integer, volatile :: a
+  logical :: b,c
+  volatile :: b
+contains
+  subroutine sample
+    a = 33.
+    if(a /= 432) print *,'aPresent'
+
+    b = .false.
+    if(b) print *,'bPresent'
+
+    c = .false.
+    if(c) print *,'cPresent'
+  end subroutine sample
+end module volmod
+
+program main
+  use volmod
+  implicit none
+
+  a = 432
+  if(a /= 432) print *,'aStillPresent'
+
+  b = .false.
+  if(b)        print *,'bStillPresent'
+
+  c = .false.
+  if(c)        print *,'cStillPresent'
+end program main
+! { dg-final { scan-tree-dump "aPresent" "optimized" } }
+! { dg-final { scan-tree-dump "bPresent" "optimized" } }
+! { dg-final { scan-tree-dump "aStillPresent" "optimized" } }
+! { dg-final { scan-tree-dump "bStillPresent" "optimized" } }
+! { dg-final { scan-tree-dump-not "cPresent" "optimized" } }
+! { dg-final { scan-tree-dump-not "cStillPresent" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
+! { dg-final { cleanup-modules "volmod" } }

diff --git a/gcc/testsuite/gfortran.dg/volatile6.f90 b/gcc/testsuite/gfortran.dg/volatile6.f90
new file mode 100644 (file)
index 0000000..e42e3de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile6.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works for arrays
+! PR fortran/29601
+logical, allocatable, volatile :: t1(:)
+logical, allocatable :: t2(:)
+integer :: i
+
+allocate(t1(1),t2(1))
+t1 = .false.
+t2 = .false.
+do i = 1, 2
+  if(ubound(t1,1) /= 1) print *, 'VolatileNotOptimizedAway1'
+  if(ubound(t2,1) /= 1) print *, 'NonVolatileNotOptimizedAway1'
+end do
+
+t1 = .false.
+if(t1(1)) print *, 'VolatileNotOptimizedAway2'
+t2 = .false.
+if(t2(1)) print *, 'NonVolatileNotOptimizedAway2'
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway1" "optimized" } }
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway2" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway1" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway2" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }

diff --git a/gcc/testsuite/gfortran.dg/volatile7.f90 b/gcc/testsuite/gfortran.dg/volatile7.f90
new file mode 100644 (file)
index 0000000..237a08c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile7.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works for pointers
+! PR fortran/29601
+logical, pointer, volatile :: t1
+logical, pointer :: t2
+integer :: i
+
+t1 => NULL(t1)
+if(associated(t1)) print *, 'VolatileNotOptimizedAway'
+t2 => NULL(t2)
+if(associated(t2)) print *, 'NonVolatileNotOptimizedAway'
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } } 
+! { dg-final { cleanup-tree-dump "optimized" } }