This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: OpenACC declare directive updates

Jakub,

The attached patch and ChangeLog reflect the updates from your
review: https://gcc.gnu.org/ml/gcc-patches/2015-11/msg00714.html.
All of the issues pointed out, have been address.

With the changes made in this patch I think I'm handling the
situation that you pointed out here correctly:

On Fri, Nov 06, 2015 at 01:45:09PM -0600, James Norris wrote:

Also, wonder about BLOCK stmt in Fortran, that can give you variables that
don't live through the whole function, but only a portion of it even in
Fortran.

OK to commit to trunk?

Thanks!
Jim

Attachment: ChangeLog
Description: Text document

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 83ecbaa..48476af 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -2570,12 +2570,16 @@ show_namespace (gfc_namespace *ns)
   for (eq = ns->equiv; eq; eq = eq->next)
     show_equiv (eq);
 
-  if (ns->oacc_declare_clauses)
+  if (ns->oacc_declare)
     {
+      struct gfc_oacc_declare *decl;
       /* Dump !$ACC DECLARE clauses.  */
-      show_indent ();
-      fprintf (dumpfile, "!$ACC DECLARE");
-      show_omp_clauses (ns->oacc_declare_clauses);
+      for (decl = ns->oacc_declare; decl; decl = decl->next)
+	{
+	  show_indent ();
+	  fprintf (dumpfile, "!$ACC DECLARE");
+	  show_omp_clauses (decl->clauses);
+	}
     }
 
   fputc ('\n', dumpfile);
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 2e91470..a8458b0 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -99,6 +99,8 @@ static const struct attribute_spec gfc_attribute_table[] =
        affects_type_identity } */
   { "omp declare target", 0, 0, true,  false, false,
     gfc_handle_omp_declare_target_attribute, false },
+  { "oacc declare", 0, 0, true,  false, false,
+    gfc_handle_omp_declare_target_attribute, false },
   { NULL,		  0, 0, false, false, false, NULL, false }
 };
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e13b4d4..3965b08 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -841,6 +841,13 @@ typedef struct
   /* Mentioned in OMP DECLARE TARGET.  */
   unsigned omp_declare_target:1;
 
+  /* Mentioned in OACC DECLARE.  */
+  unsigned oacc_declare_create:1;
+  unsigned oacc_declare_copyin:1;
+  unsigned oacc_declare_deviceptr:1;
+  unsigned oacc_declare_device_resident:1;
+  unsigned oacc_declare_link:1;
+
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
@@ -1106,7 +1113,9 @@ enum gfc_omp_map_op
   OMP_MAP_FORCE_FROM,
   OMP_MAP_FORCE_TOFROM,
   OMP_MAP_FORCE_PRESENT,
-  OMP_MAP_FORCE_DEVICEPTR
+  OMP_MAP_FORCE_DEVICEPTR,
+  OMP_MAP_DEVICE_RESIDENT,
+  OMP_MAP_LINK
 };
 
 /* For use in OpenMP clauses in case we need extra information
@@ -1148,6 +1157,7 @@ enum
   OMP_LIST_FROM,
   OMP_LIST_REDUCTION,
   OMP_LIST_DEVICE_RESIDENT,
+  OMP_LIST_LINK,
   OMP_LIST_USE_DEVICE,
   OMP_LIST_CACHE,
   OMP_LIST_NUM
@@ -1234,6 +1244,19 @@ gfc_omp_clauses;
 #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
 
 
+/* Node in the linked list used for storing !$oacc declare constructs.  */
+
+typedef struct gfc_oacc_declare
+{
+  struct gfc_oacc_declare *next;
+  bool module_var;
+  gfc_omp_clauses *clauses;
+}
+gfc_oacc_declare;
+
+#define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare)
+
+
 /* Node in the linked list used for storing !$omp declare simd constructs.  */
 
 typedef struct gfc_omp_declare_simd
@@ -1645,8 +1668,8 @@ typedef struct gfc_namespace
      this namespace.  */
   struct gfc_data *data, *old_data;
 
-  /* !$ACC DECLARE clauses.  */
-  gfc_omp_clauses *oacc_declare_clauses;
+  /* !$ACC DECLARE.  */
+  gfc_oacc_declare *oacc_declare;
 
   gfc_charlen *cl_list, *old_cl_list;
 
@@ -2324,6 +2347,7 @@ enum gfc_exec_op
   EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
   EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
   EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC,
+  EXEC_OACC_DECLARE,
   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2405,6 +2429,7 @@ typedef struct gfc_code
     struct gfc_code *which_construct;
     int stop_code;
     gfc_entry_list *entry;
+    gfc_oacc_declare *oacc_declare;
     gfc_omp_clauses *omp_clauses;
     const char *omp_name;
     gfc_omp_namelist *omp_namelist;
@@ -2907,6 +2932,7 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
 /* openmp.c */
 struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
 void gfc_free_omp_clauses (gfc_omp_clauses *);
+void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
 void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
 void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
 void gfc_free_omp_udr (gfc_omp_udr *);
@@ -3224,4 +3250,8 @@ gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 
 bool gfc_is_reallocatable_lhs (gfc_expr *);
 
+/* trans-decl.c */
+
+void finish_oacc_declare (gfc_namespace *, enum sym_flavor);
+
 #endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 91d2bd6..76fb3bc 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1987,7 +1987,9 @@ enum ab_attribute
   AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
   AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
   AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
-  AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE
+  AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
+  AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
+  AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
 };
 
 static const mstring attr_bits[] =
@@ -2044,6 +2046,11 @@ static const mstring attr_bits[] =
     minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
     minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
     minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
+    minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE),
+    minit ("OACC_DECLARE_COPYIN", AB_OACC_DECLARE_COPYIN),
+    minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR),
+    minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT),
+    minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK),
     minit (NULL, -1)
 };
 
@@ -2231,6 +2238,16 @@ mio_symbol_attribute (symbol_attribute *attr)
 	MIO_NAME (ab_attribute) (AB_MODULE_PROCEDURE, attr_bits);
 	  no_module_procedures = false;
 	}
+      if (attr->oacc_declare_create)
+	MIO_NAME (ab_attribute) (AB_OACC_DECLARE_CREATE, attr_bits);
+      if (attr->oacc_declare_copyin)
+	MIO_NAME (ab_attribute) (AB_OACC_DECLARE_COPYIN, attr_bits);
+      if (attr->oacc_declare_deviceptr)
+	MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICEPTR, attr_bits);
+      if (attr->oacc_declare_device_resident)
+	MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits);
+      if (attr->oacc_declare_link)
+	MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits);
 
       mio_rparen ();
 
@@ -2403,6 +2420,21 @@ mio_symbol_attribute (symbol_attribute *attr)
 	    case AB_MODULE_PROCEDURE:
 	      attr->module_procedure =1;
 	      break;
+	    case AB_OACC_DECLARE_CREATE:
+	      attr->oacc_declare_create = 1;
+	      break;
+	    case AB_OACC_DECLARE_COPYIN:
+	      attr->oacc_declare_copyin = 1;
+	      break;
+	    case AB_OACC_DECLARE_DEVICEPTR:
+	      attr->oacc_declare_deviceptr = 1;
+	      break;
+	    case AB_OACC_DECLARE_DEVICE_RESIDENT:
+	      attr->oacc_declare_device_resident = 1;
+	      break;
+	    case AB_OACC_DECLARE_LINK:
+	      attr->oacc_declare_link = 1;
+	      break;
 	    }
 	}
     }
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a7c7a19..17a62a4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -90,6 +90,25 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
   free (c);
 }
 
+/* Free oacc_declare structures.  */
+
+void
+gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc)
+{
+  struct gfc_oacc_declare *decl = oc;
+
+  do
+    {
+      struct gfc_oacc_declare *next;
+
+      next = decl->next;
+      gfc_free_omp_clauses (decl->clauses);
+      free (decl);
+      decl = next;
+    }
+  while (decl);
+}
+
 /* Free expression list. */
 void
 gfc_free_expr_list (gfc_expr_list *list)
@@ -453,6 +472,7 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
 #define OMP_CLAUSE_DELETE		((uint64_t) 1 << 55)
 #define OMP_CLAUSE_AUTO			((uint64_t) 1 << 56)
 #define OMP_CLAUSE_TILE			((uint64_t) 1 << 57)
+#define OMP_CLAUSE_LINK			((uint64_t) 1 << 58)
 
 /* Helper function for OpenACC and OpenMP clauses involving memory
    mapping.  */
@@ -691,6 +711,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 					  true)
 	     == MATCH_YES)
 	continue;
+      if ((mask & OMP_CLAUSE_LINK)
+	  && gfc_match_omp_variable_list ("link (",
+					  &c->lists[OMP_LIST_LINK],
+					  true)
+	     == MATCH_YES)
+	continue;
       if ((mask & OMP_CLAUSE_OACC_DEVICE)
 	  && gfc_match ("device ( ") == MATCH_YES
 	  && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1176,7 +1202,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
    | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT    \
    | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY                          \
    | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT             \
-   | OMP_CLAUSE_PRESENT_OR_CREATE)
+   | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK)
 #define OACC_UPDATE_CLAUSES \
   (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \
    | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT)
@@ -1293,12 +1319,86 @@ match
 gfc_match_oacc_declare (void)
 {
   gfc_omp_clauses *c;
+  gfc_omp_namelist *n;
+  gfc_namespace *ns = gfc_current_ns;
+  gfc_oacc_declare *new_oc;
+  bool module_var = false;
+
   if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
       != MATCH_YES)
     return MATCH_ERROR;
 
-  new_st.ext.omp_clauses = c;
-  new_st.ext.omp_clauses->loc = gfc_current_locus;
+  for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next)
+    n->sym->attr.oacc_declare_device_resident = 1;
+
+  for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next)
+    n->sym->attr.oacc_declare_link = 1;
+
+  for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next)
+    {
+      gfc_symbol *s = n->sym;
+      locus where = gfc_current_locus;
+
+      if (s->ns->proc_name && s->ns->proc_name->attr.proc == PROC_MODULE)
+	{
+	  if (n->u.map_op != OMP_MAP_FORCE_ALLOC
+	      && n->u.map_op != OMP_MAP_FORCE_TO)
+	    {
+	      gfc_error ("Invalid clause in module with $!ACC DECLARE at %L",
+			 &where);
+	      return MATCH_ERROR;
+	    }
+
+	  module_var = true;
+	}
+
+      if (s->attr.in_common)
+	{
+	  gfc_error ("Variable in a common block with $!ACC DECLARE at %L",
+		     &where);
+	  return MATCH_ERROR;
+	}
+
+      if (s->attr.use_assoc)
+	{
+	  gfc_error ("Variable is USE-associated with $!ACC DECLARE at %L",
+		     &where);
+	  return MATCH_ERROR;
+	}
+
+      if ((s->attr.dimension || s->attr.codimension)
+	  && s->attr.dummy && s->as->type != AS_EXPLICIT)
+	{
+	  gfc_error ("Assumed-size dummy array with $!ACC DECLARE at %L",
+		     &where);
+	  return MATCH_ERROR;
+	}
+
+      switch (n->u.map_op)
+	{
+	  case OMP_MAP_FORCE_ALLOC:
+	    s->attr.oacc_declare_create = 1;
+	    break;
+
+	  case OMP_MAP_FORCE_TO:
+	    s->attr.oacc_declare_copyin = 1;
+	    break;
+
+	  case OMP_MAP_FORCE_DEVICEPTR:
+	    s->attr.oacc_declare_deviceptr = 1;
+	    break;
+
+	  default:
+	    break;
+	}
+    }
+
+  new_oc = gfc_get_oacc_declare ();
+  new_oc->next = ns->oacc_declare;
+  new_oc->module_var = module_var;
+  new_oc->clauses = c;
+  ns->oacc_declare = new_oc;
+
   return MATCH_YES;
 }
 
@@ -4613,44 +4713,80 @@ resolve_oacc_loop (gfc_code *code)
   resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
 }
 
-
 void
 gfc_resolve_oacc_declare (gfc_namespace *ns)
 {
   int list;
   gfc_omp_namelist *n;
   locus loc;
+  gfc_oacc_declare *oc;
 
-  if (ns->oacc_declare_clauses == NULL)
+  if (ns->oacc_declare == NULL)
     return;
 
-  loc = ns->oacc_declare_clauses->loc;
+  loc = gfc_current_locus;
 
-  for (list = OMP_LIST_DEVICE_RESIDENT;
-       list <= OMP_LIST_DEVICE_RESIDENT; list++)
-    for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
-      {
-	n->sym->mark = 0;
-	if (n->sym->attr.flavor == FL_PARAMETER)
-	  gfc_error ("PARAMETER object %qs is not allowed at %L", n->sym->name, &loc);
-      }
+  for (oc = ns->oacc_declare; oc; oc = oc->next)
+    {
+      for (list = OMP_LIST_DEVICE_RESIDENT;
+	   list <= OMP_LIST_DEVICE_RESIDENT; list++)
+	for (n = oc->clauses->lists[list]; n; n = n->next)
+	  {
+	    n->sym->mark = 0;
+	    if (n->sym->attr.flavor == FL_PARAMETER)
+	      gfc_error ("PARAMETER object %qs is not allowed at %L",
+			 n->sym->name, &loc);
+	  }
 
-  for (list = OMP_LIST_DEVICE_RESIDENT;
-       list <= OMP_LIST_DEVICE_RESIDENT; list++)
-    for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
-      {
-	if (n->sym->mark)
-	  gfc_error ("Symbol %qs present on multiple clauses at %L",
-		     n->sym->name, &loc);
-	else
-	  n->sym->mark = 1;
-      }
+      for (list = OMP_LIST_DEVICE_RESIDENT;
+	    list <= OMP_LIST_DEVICE_RESIDENT; list++)
+	for (n = oc->clauses->lists[list]; n; n = n->next)
+	  {
+	    if (n->sym->mark)
+	      gfc_error ("Symbol %qs present on multiple clauses at %L",
+			 n->sym->name, &loc);
+	    else
+	      n->sym->mark = 1;
+	  }
 
-  for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
-       n = n->next)
-    check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT");
-}
+      for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next)
+	check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT");
+
+      for (n = oc->clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+	{
+	  if (n->expr && n->expr->ref->type == REF_ARRAY)
+	      gfc_error ("Array sections: %qs not allowed in"
+			 " $!ACC DECLARE at %L", n->sym->name, &loc);
+	}
+    }
+
+  for (oc = ns->oacc_declare; oc; oc = oc->next)
+    {
+      for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+	for (n = oc->clauses->lists[list]; n; n = n->next)
+	  n->sym->mark = 0;
+    }
 
+  for (oc = ns->oacc_declare; oc; oc = oc->next)
+    {
+      for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+	for (n = oc->clauses->lists[list]; n; n = n->next)
+	  {
+	    if (n->sym->mark)
+	      gfc_error ("Symbol %qs present on multiple clauses at %L",
+			 n->sym->name, &loc);
+	    else
+	      n->sym->mark = 1;
+	  }
+    }
+
+  for (oc = ns->oacc_declare; oc; oc = oc->next)
+    {
+      for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+	for (n = oc->clauses->lists[list]; n; n = n->next)
+	  n->sym->mark = 0;
+    }
+}
 
 void
 gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index b98dda1..b1c5034 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1386,7 +1386,7 @@ next_statement (void)
   case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
   case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \
   case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \
-  case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE
+  case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
 
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
@@ -2450,7 +2450,6 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
     case ST_PUBLIC:
     case ST_PRIVATE:
     case ST_DERIVED_DECL:
-    case ST_OACC_DECLARE:
     case_decl:
       if (p->state >= ORDER_EXEC)
 	goto order;
@@ -3362,19 +3361,6 @@ declSt:
       st = next_statement ();
       goto loop;
 
-    case ST_OACC_DECLARE:
-      if (!verify_st_order(&ss, st, false))
-	{
-	  reject_statement ();
-	  st = next_statement ();
-	  goto loop;
-	}
-      if (gfc_state_stack->ext.oacc_declare_clauses == NULL)
-	gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses;
-      accept_statement (st);
-      st = next_statement ();
-      goto loop;
-
     default:
       break;
     }
@@ -5214,13 +5200,6 @@ contains:
 
 done:
   gfc_current_ns->code = gfc_state_stack->head;
-  if (gfc_state_stack->state == COMP_PROGRAM
-      || gfc_state_stack->state == COMP_MODULE
-      || gfc_state_stack->state == COMP_SUBROUTINE
-      || gfc_state_stack->state == COMP_FUNCTION
-      || gfc_state_stack->state == COMP_BLOCK)
-    gfc_current_ns->oacc_declare_clauses
-      = gfc_state_stack->ext.oacc_declare_clauses;
 }
 
 
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index bcd714d..94b2ada 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -48,7 +48,7 @@ typedef struct gfc_state_data
   union
   {
     gfc_st_label *end_do_label;
-    gfc_omp_clauses *oacc_declare_clauses;
+    gfc_oacc_declare *oacc_declare_clauses;
   }
   ext;
 }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bf2837c..7719201 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10646,6 +10646,7 @@ start:
 	case EXEC_OACC_ENTER_DATA:
 	case EXEC_OACC_EXIT_DATA:
 	case EXEC_OACC_ATOMIC:
+	case EXEC_OACC_DECLARE:
 	  gfc_resolve_oacc_directive (code, ns);
 	  break;
 
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 629b51d..d0a11aa 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -185,6 +185,11 @@ gfc_free_statement (gfc_code *p)
       gfc_free_forall_iterator (p->ext.forall_iterator);
       break;
 
+    case EXEC_OACC_DECLARE:
+      if (p->ext.oacc_declare)
+	gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
+      break;
+
     case EXEC_OACC_PARALLEL_LOOP:
     case EXEC_OACC_PARALLEL:
     case EXEC_OACC_KERNELS_LOOP:
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index bd7758b..43fd25d 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -375,6 +375,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
     *contiguous = "CONTIGUOUS", *generic = "GENERIC";
   static const char *threadprivate = "THREADPRIVATE";
   static const char *omp_declare_target = "OMP DECLARE TARGET";
+  static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
+  static const char *oacc_declare_create = "OACC DECLARE CREATE";
+  static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR";
+  static const char *oacc_declare_device_resident =
+						"OACC DECLARE DEVICE_RESIDENT";
 
   const char *a1, *a2;
   int standard;
@@ -511,6 +516,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (in_equivalence, allocatable);
   conf (in_equivalence, threadprivate);
   conf (in_equivalence, omp_declare_target);
+  conf (in_equivalence, oacc_declare_create);
+  conf (in_equivalence, oacc_declare_copyin);
+  conf (in_equivalence, oacc_declare_deviceptr);
+  conf (in_equivalence, oacc_declare_device_resident);
 
   conf (dummy, result);
   conf (entry, result);
@@ -560,6 +569,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (cray_pointee, in_equivalence);
   conf (cray_pointee, threadprivate);
   conf (cray_pointee, omp_declare_target);
+  conf (cray_pointee, oacc_declare_create);
+  conf (cray_pointee, oacc_declare_copyin);
+  conf (cray_pointee, oacc_declare_deviceptr);
+  conf (cray_pointee, oacc_declare_device_resident);
 
   conf (data, dummy);
   conf (data, function);
@@ -614,6 +627,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (proc_pointer, abstract)
 
   conf (entry, omp_declare_target)
+  conf (entry, oacc_declare_create)
+  conf (entry, oacc_declare_copyin)
+  conf (entry, oacc_declare_deviceptr)
+  conf (entry, oacc_declare_device_resident)
 
   a1 = gfc_code2string (flavors, attr->flavor);
 
@@ -651,6 +668,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (subroutine);
       conf2 (threadprivate);
       conf2 (omp_declare_target);
+      conf2 (oacc_declare_create);
+      conf2 (oacc_declare_copyin);
+      conf2 (oacc_declare_deviceptr);
+      conf2 (oacc_declare_device_resident);
 
       if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE)
 	{
@@ -733,6 +754,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (threadprivate);
       conf2 (result);
       conf2 (omp_declare_target);
+      conf2 (oacc_declare_create);
+      conf2 (oacc_declare_copyin);
+      conf2 (oacc_declare_deviceptr);
+      conf2 (oacc_declare_device_resident);
 
       if (attr->intent != INTENT_UNKNOWN)
 	{
@@ -1244,6 +1269,62 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
 
 
 bool
+gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_declare_create)
+    return true;
+
+  attr->oacc_declare_create = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_declare_copyin)
+    return true;
+
+  attr->oacc_declare_copyin = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_declare_deviceptr)
+    return true;
+
+  attr->oacc_declare_deviceptr = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_declare_device_resident)
+    return true;
+
+  attr->oacc_declare_device_resident = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
 gfc_add_target (symbol_attribute *attr, locus *where)
 {
 
@@ -1820,6 +1901,18 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
   if (src->omp_declare_target
       && !gfc_add_omp_declare_target (dest, NULL, where))
     goto fail;
+  if (src->oacc_declare_create
+      && !gfc_add_oacc_declare_create (dest, NULL, where))
+    goto fail;
+  if (src->oacc_declare_copyin
+      && !gfc_add_oacc_declare_copyin (dest, NULL, where))
+    goto fail;
+  if (src->oacc_declare_deviceptr
+      && !gfc_add_oacc_declare_deviceptr (dest, NULL, where))
+    goto fail;
+  if (src->oacc_declare_device_resident
+      && !gfc_add_oacc_declare_device_resident (dest, NULL, where))
+    goto fail;
   if (src->target && !gfc_add_target (dest, where))
     goto fail;
   if (src->dummy && !gfc_add_dummy (dest, NULL, where))
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 098a327..545d80f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1307,6 +1307,15 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
     list = tree_cons (get_identifier ("omp declare target"),
 		      NULL_TREE, list);
 
+  if (sym_attr.oacc_declare_create
+      || sym_attr.oacc_declare_copyin
+      || sym_attr.oacc_declare_deviceptr
+      || sym_attr.oacc_declare_device_resident
+      || sym_attr.oacc_declare_link)
+    {
+      list = tree_cons (get_identifier ("oacc declare"),
+			NULL_TREE, list);
+    }
   return list;
 }
 
@@ -5761,6 +5770,258 @@ is_ieee_module_used (gfc_namespace *ns)
   return seen_ieee_symbol;
 }
 
+static struct oacc_return
+{
+  gfc_code *code;
+  struct oacc_return *next;
+} *oacc_returns;
+
+static void
+find_oacc_return (gfc_code *code)
+{
+  if (code->next)
+    {
+      if (code->next->op == EXEC_RETURN
+	  || code->next->op == EXEC_END_PROCEDURE)
+	{
+	  struct oacc_return *r;
+
+	  r = XCNEW (struct oacc_return);
+	  r->code = code;
+	  r->next = NULL;
+
+	  if (oacc_returns)
+	    r->next = oacc_returns;
+
+	  oacc_returns = r;
+	}
+      else
+	{
+	  find_oacc_return (code->next);
+	}
+    }
+  else if (code->block)
+    find_oacc_return (code->block);
+  else
+    {
+      struct oacc_return *r;
+
+      r = XCNEW (struct oacc_return);
+      r->code = code;
+      r->next = NULL;
+
+      if (oacc_returns)
+	    r->next = oacc_returns;
+
+      oacc_returns = r;
+    }
+
+  return;
+}
+
+static gfc_omp_clauses *module_oacc_clauses;
+
+static void
+add_clause (gfc_symbol *sym, gfc_omp_map_op map_op)
+{
+  gfc_omp_namelist *n;
+
+  n = gfc_get_omp_namelist ();
+  n->sym = sym;
+  n->u.map_op = map_op;
+
+  if (!module_oacc_clauses)
+    module_oacc_clauses = gfc_get_omp_clauses ();
+
+  if (module_oacc_clauses->lists[OMP_LIST_MAP])
+    n->next = module_oacc_clauses->lists[OMP_LIST_MAP];
+
+  module_oacc_clauses->lists[OMP_LIST_MAP] = n;
+}
+
+
+static void
+find_module_oacc_declare_clauses (gfc_symbol *sym)
+{
+  if (sym->attr.use_assoc)
+    {
+      gfc_omp_map_op map_op;
+
+      if (sym->attr.oacc_declare_create)
+	map_op = OMP_MAP_FORCE_ALLOC;
+
+      if (sym->attr.oacc_declare_copyin)
+	map_op = OMP_MAP_FORCE_TO;
+
+      if (sym->attr.oacc_declare_deviceptr)
+	map_op = OMP_MAP_FORCE_DEVICEPTR;
+
+      if (sym->attr.oacc_declare_device_resident)
+	map_op = OMP_MAP_DEVICE_RESIDENT;
+
+      if (sym->attr.oacc_declare_create
+	  || sym->attr.oacc_declare_copyin
+	  || sym->attr.oacc_declare_deviceptr
+	  || sym->attr.oacc_declare_device_resident)
+	{
+	  sym->attr.referenced = 1;
+	  add_clause (sym, map_op);
+	}
+    }
+}
+
+void
+finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor)
+{
+  gfc_code *code;
+  gfc_oacc_declare *oc;
+  gfc_omp_namelist *n;
+  locus where = gfc_current_locus;
+  gfc_omp_clauses *ret_clauses = NULL;
+
+  gfc_traverse_ns (ns, find_module_oacc_declare_clauses);
+
+  if (module_oacc_clauses && flavor == FL_PROGRAM)
+    {
+      gfc_oacc_declare *new_oc;
+
+      new_oc = gfc_get_oacc_declare ();
+      new_oc->next = ns->oacc_declare;
+      new_oc->clauses = module_oacc_clauses;
+
+      ns->oacc_declare = new_oc;
+      module_oacc_clauses = NULL;
+    }
+
+  if (!ns->oacc_declare)
+    return;
+
+  for (oc = ns->oacc_declare; oc; oc = oc->next)
+    {
+      gfc_omp_clauses *omp_clauses;
+
+      if (oc->module_var)
+	continue;
+
+      if (oc->clauses)
+	{
+	   code = XCNEW (gfc_code);
+	   code->op = EXEC_OACC_DECLARE;
+	   code->loc = where;
+
+	   omp_clauses = oc->clauses;
+
+	   for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+	     {
+		bool ret = false;
+		gfc_omp_map_op new_op;
+
+		switch (n->u.map_op)
+		  {
+		    case OMP_MAP_ALLOC:
+		    case OMP_MAP_FORCE_ALLOC:
+		      new_op = OMP_MAP_FORCE_DEALLOC;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_DEVICE_RESIDENT:
+		      n->u.map_op = OMP_MAP_FORCE_ALLOC;
+		      new_op = OMP_MAP_FORCE_DEALLOC;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_FORCE_FROM:
+		      n->u.map_op = OMP_MAP_FORCE_ALLOC;
+		      new_op = OMP_MAP_FORCE_FROM;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_FORCE_TO:
+		      new_op = OMP_MAP_FORCE_DEALLOC;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_FORCE_TOFROM:
+		      n->u.map_op = OMP_MAP_FORCE_TO;
+		      new_op = OMP_MAP_FORCE_FROM;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_FROM:
+		      n->u.map_op = OMP_MAP_FORCE_ALLOC;
+		      new_op = OMP_MAP_FROM;
+		      ret = true;
+		      break;
+
+		    case OMP_MAP_FORCE_DEVICEPTR:
+		    case OMP_MAP_FORCE_PRESENT:
+		    case OMP_MAP_LINK:
+		    case OMP_MAP_TO:
+		      break;
+
+		    case OMP_MAP_TOFROM:
+		      n->u.map_op = OMP_MAP_TO;
+		      new_op = OMP_MAP_FROM;
+		      ret = true;
+		      break;
+
+		    default:
+		      gcc_unreachable ();
+		      break;
+		  }
+
+		if (ret)
+		  {
+		    gfc_omp_namelist *new_n;
+
+		    new_n = gfc_get_omp_namelist ();
+		    new_n->sym = n->sym;
+		    new_n->u.map_op = new_op;
+
+		    if (!ret_clauses)
+		      ret_clauses = gfc_get_omp_clauses ();
+
+		    if (ret_clauses->lists[OMP_LIST_MAP])
+		      new_n->next = ret_clauses->lists[OMP_LIST_MAP];
+
+		    ret_clauses->lists[OMP_LIST_MAP] = new_n;
+		    ret = false;
+		  }
+	     }
+
+	   code->ext.oacc_declare = gfc_get_oacc_declare ();
+	   code->ext.oacc_declare->clauses = omp_clauses;
+
+	   if (ns->code)
+	     code->next = ns->code;
+	   ns->code = code;
+	}
+    }
+
+    find_oacc_return (ns->code);
+
+    while (oacc_returns)
+      {
+	struct oacc_return *r;
+
+	r = oacc_returns;
+
+	code = XCNEW (gfc_code);
+	code->op = EXEC_OACC_DECLARE;
+	code->loc = where;
+
+	code->ext.oacc_declare = gfc_get_oacc_declare ();
+	code->ext.oacc_declare->clauses = ret_clauses;
+	code->next = r->code->next;
+	r->code->next = code;
+
+	oacc_returns = r->next;
+	free (r);
+      }
+
+  return;
+}
+
 
 /* Generate code for a function.  */
 
@@ -5899,11 +6160,7 @@ gfc_generate_function_code (gfc_namespace * ns)
     add_argument_checking (&body, sym);
 
   /* Generate !$ACC DECLARE directive. */
-  if (ns->oacc_declare_clauses)
-    {
-      tree tmp = gfc_trans_oacc_declare (&body, ns);
-      gfc_add_expr_to_block (&body, tmp);
-    }
+  finish_oacc_declare  (ns, sym->attr.flavor);
 
   tmp = gfc_trans_code (ns->code);
   gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 9f0d533..57d63ae 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1925,6 +1925,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (!n->sym->attr.referenced)
 		continue;
 
+	      if (n->sym->attr.use_assoc && n->sym->attr.oacc_declare_link)
+		continue;
+
 	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
 	      tree node2 = NULL_TREE;
 	      tree node3 = NULL_TREE;
@@ -4423,13 +4426,24 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
 }
 
 tree
-gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+gfc_trans_oacc_declare (gfc_code *code)
 {
-  tree oacc_clauses;
-  oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses,
-					ns->oacc_declare_clauses->loc);
-  return build1_loc (ns->oacc_declare_clauses->loc.lb->location,
-		     OACC_DECLARE, void_type_node, oacc_clauses);
+  stmtblock_t block;
+  tree stmt, c;
+  enum tree_code construct_code;
+
+  gfc_start_block (&block);
+
+  construct_code = OACC_DECLARE;
+
+  gfc_start_block (&block);
+  c = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
+			     code->loc);
+
+  stmt = build1_loc (input_location, construct_code, void_type_node, c);
+  gfc_add_expr_to_block (&block, stmt);
+
+  return gfc_finish_block (&block);
 }
 
 tree
@@ -4457,6 +4471,8 @@ gfc_trans_oacc_directive (gfc_code *code)
       return gfc_trans_oacc_wait_directive (code);
     case EXEC_OACC_ATOMIC:
       return gfc_trans_omp_atomic (code);
+    case EXEC_OACC_DECLARE:
+      return gfc_trans_oacc_declare (code);
     default:
       gcc_unreachable ();
     }
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1c61606..321cd80 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1579,11 +1579,7 @@ gfc_trans_block_construct (gfc_code* code)
   code->exit_label = exit_label;
 
   /* Generate !$ACC DECLARE directive. */
-  if (ns->oacc_declare_clauses)
-    {
-      tree tmp = gfc_trans_oacc_declare (&body, ns);
-      gfc_add_expr_to_block (&body, tmp);
-    }
+  finish_oacc_declare (ns, FL_UNKNOWN);
 
   gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
   gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 2f2a0b3..0ff93c4 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -67,7 +67,7 @@ void gfc_trans_omp_declare_simd (gfc_namespace *);
 
 /* trans-openacc.c */
 tree gfc_trans_oacc_directive (gfc_code *);
-tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+tree gfc_trans_oacc_declare (gfc_namespace *);
 
 /* trans-io.c */
 tree gfc_trans_open (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 9495450..880c309 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1904,6 +1904,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OACC_ENTER_DATA:
 	case EXEC_OACC_EXIT_DATA:
 	case EXEC_OACC_ATOMIC:
+	case EXEC_OACC_DECLARE:
 	  res = gfc_trans_oacc_directive (code);
 	  break;
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
index 5cf737f..3129f04 100644
--- a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -15,5 +15,4 @@ contains
     END BLOCK
   end function foo
 end program test
-! { dg-prune-output "unimplemented" }
-! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } } 
+! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_to:i\\)" 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95
index e69de29..9450c8b 100644
--- a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95
@@ -0,0 +1,44 @@
+
+module amod
+
+contains
+
+subroutine asubr (b)
+  implicit none
+  integer :: b(8)
+
+  !$acc declare copy (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare copyout (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare present (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare present_or_copy (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare present_or_copyin (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare present_or_copyout (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare present_or_create (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare deviceptr (b) ! { dg-error "Invalid clause in module" }
+  !$acc declare create (b) copyin (b) ! { dg-error "present on multiple clauses" }
+
+end subroutine
+
+end module
+
+subroutine bsubr (foo)
+  implicit none
+
+  integer, dimension (:) :: foo
+
+  !$acc declare copy (foo) ! { dg-error "assumed-size dummy array" }
+  !$acc declare copy (foo(1:2)) ! { dg-error "assumed-size dummy array" }
+
+end subroutine
+
+program test
+  integer :: a(8)
+  integer :: b(8)
+  integer :: c(8)
+
+  !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" }
+  !$acc declare copyin (b)
+  !$acc declare copyin (b) ! { dg-error "present on multiple clauses" }
+  !$acc declare copy (c(1:2)) ! { dg-error "Array sections: 'c' not allowed" }
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
index e69de29..18dd1bb 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
@@ -0,0 +1,236 @@
+! { dg-do run  { target openacc_nvidia_accel_selected } }
+
+module vars
+  integer z
+  !$acc declare create (z)
+end module vars
+
+subroutine subr6 (a, d)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare deviceptr (a)
+  integer :: d(N)
+
+  i = 0
+
+  !$acc parallel copy (d)
+    do i = 1, N
+      d(i) = a(i) + a(i)
+    end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine subr5 (a, b, c, d)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare present_or_copyin (a)
+  integer :: b(N)
+  !$acc declare present_or_create (b)
+  integer :: c(N)
+  !$acc declare present_or_copyout (c)
+  integer :: d(N)
+  !$acc declare present_or_copy (d)
+
+  i = 0
+
+  !$acc parallel
+    do i = 1, N
+      b(i) = a(i)
+      c(i) = b(i)
+      d(i) = d(i) + b(i)
+    end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine subr4 (a, b)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare present (a)
+  integer :: b(N)
+  !$acc declare copyout (b)
+
+  i = 0
+
+  !$acc parallel
+  do i = 1, N
+    b(i) = a(i)
+  end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine subr3 (a, c)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare present (a)
+  integer :: c(N)
+  !$acc declare copyin (c)
+
+  i = 0
+
+  !$acc parallel
+  do i = 1, N
+    a(i) = c(i)
+    c(i) = 0
+  end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine subr2 (a, b, c)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare present (a)
+  integer :: b(N)
+  !$acc declare create (b)
+  integer :: c(N)
+  !$acc declare copy (c)
+
+  i = 0
+
+  !$acc parallel
+  do i = 1, N
+    b(i) = a(i)
+    c(i) = b(i) + c(i) + 1
+  end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine subr1 (a)
+  integer, parameter :: N = 8
+  integer :: i
+  integer :: a(N)
+  !$acc declare present (a)
+
+  i = 0
+
+  !$acc parallel
+  do i = 1, N
+    a(i) = a(i) + 1
+  end do
+  !$acc end parallel
+
+end subroutine
+
+subroutine test (a, e)
+  use openacc
+  logical :: e
+  integer, parameter :: N = 8
+  integer :: a(N)
+
+  if (acc_is_present (a) .neqv. e) call abort
+
+end subroutine
+
+subroutine subr0 (a, b, c, d)
+  integer, parameter :: N = 8
+  integer :: a(N)
+  !$acc declare copy (a)
+  integer :: b(N)
+  integer :: c(N)
+  integer :: d(N)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+
+  call subr1 (a)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+
+  call subr2 (a, b, c)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+
+  do i = 1, N
+    if (c(i) .ne. 8) call abort
+  end do
+
+  call subr3 (a, c)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+
+  do i = 1, N
+    if (a(i) .ne. 2) call abort
+    if (c(i) .ne. 8) call abort
+  end do
+
+  call subr4 (a, b)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+
+  do i = 1, N
+    if (b(i) .ne. 8) call abort
+  end do
+
+  call subr5 (a, b, c, d)
+
+  call test (a, .true.)
+  call test (b, .false.)
+  call test (c, .false.)
+  call test (d, .false.)
+
+  do i = 1, N
+    if (c(i) .ne. 8) call abort
+    if (d(i) .ne. 13) call abort
+  end do
+
+  call subr6 (a, d)
+
+  call test (a, .true.)
+  call test (d, .false.)
+
+  do i = 1, N
+    if (d(i) .ne. 16) call abort
+  end do
+
+end subroutine
+
+program main
+  use vars
+  use openacc
+  integer, parameter :: N = 8
+  integer :: a(N)
+  integer :: b(N)
+  integer :: c(N)
+  integer :: d(N)
+
+  a(:) = 2
+  b(:) = 3
+  c(:) = 4
+  d(:) = 5
+
+  if (acc_is_present (z) .neqv. .true.) call abort
+
+  call subr0 (a, b, c, d)
+
+  call test (a, .false.)
+  call test (b, .false.)
+  call test (c, .false.)
+  call test (d, .false.)
+
+  do i = 1, N
+    if (a(i) .ne. 8) call abort
+    if (b(i) .ne. 8) call abort
+    if (c(i) .ne. 8) call abort
+    if (d(i) .ne. 16) call abort
+  end do
+
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90
index e69de29..9b75aa1 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90
@@ -0,0 +1,14 @@
+! { dg-do run  { target openacc_nvidia_accel_selected } }
+
+module globalvars
+  integer a
+  !$acc declare create (a)
+end module globalvars
+
+program test
+  use globalvars
+  use openacc
+
+  if (acc_is_present (a) .neqv. .true.) call abort
+
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90
index e69de29..79fc011 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90
@@ -0,0 +1,65 @@
+! { dg-do run  { target openacc_nvidia_accel_selected } }
+
+module globalvars
+  real b
+  !$acc declare link (b)
+end module globalvars
+
+program test
+  use openacc
+
+  real a
+  real c
+  !$acc declare link (c)
+
+  if (acc_is_present (b) .neqv. .false.) call abort
+  if (acc_is_present (c) .neqv. .false.) call abort
+
+  a = 0.0
+  b = 1.0
+
+  !$acc parallel copy (a) copyin (b)
+    b = b + 4.0
+    a = b
+  !$acc end parallel
+
+  if (a .ne. 5.0) call abort
+
+  if (acc_is_present (b) .neqv. .false.) call abort
+
+  a = 0.0
+
+  !$acc parallel copy (a) create (b)
+    b = 4.0
+    a = b
+  !$acc end parallel
+
+  if (a .ne. 4.0) call abort
+
+  if (acc_is_present (b) .neqv. .false.) call abort
+
+  a = 0.0
+
+  !$acc parallel copy (a) copy (b)
+    b = 4.0
+    a = b
+  !$acc end parallel
+
+  if (a .ne. 4.0) call abort
+  if (b .ne. 4.0) call abort
+
+  if (acc_is_present (b) .neqv. .false.) call abort
+
+  a = 0.0
+
+  !$acc parallel copy (a) copy (b) copy (c)
+    b = 4.0
+    c = b
+    a = c
+  !$acc end parallel
+
+  if (a .ne. 4.0) call abort
+
+  if (acc_is_present (b) .neqv. .false.) call abort
+
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90
index e69de29..997c8ac 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90
@@ -0,0 +1,27 @@
+! { dg-do run  { target openacc_nvidia_accel_selected } }
+
+module vars
+  real b
+ !$acc declare create (b)
+end module vars
+
+program test
+  use vars
+  use openacc
+  real a
+
+  if (acc_is_present (b) .neqv. .true.) call abort
+
+  a = 2.0
+
+  !$acc parallel copy (a)
+    b = a
+    a = 1.0
+    a = a + b
+   !$acc end parallel
+
+  if (acc_is_present (b) .neqv. .true.) call abort
+
+  if (a .ne. 3.0) call abort
+
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90
index e69de29..d7c9bac 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90
@@ -0,0 +1,28 @@
+! { dg-do run  { target openacc_nvidia_accel_selected } }
+
+module vars
+  implicit none
+  real b
+ !$acc declare device_resident (b)
+end module vars
+
+program test
+  use vars
+  use openacc
+  real a
+
+  if (acc_is_present (b) .neqv. .true.) call abort
+
+  a = 2.0
+
+  !$acc parallel copy (a)
+    b = a
+    a = 1.0
+    a = a + b
+   !$acc end parallel
+
+  if (acc_is_present (b) .neqv. .true.) call abort
+
+  if (a .ne. 3.0) call abort
+
+end program test
Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]