1 files changed, 156 insertions, 22 deletions

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 9c0bae4..28f1cc2 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -182,6 +182,8 @@ cleanup:
 #define OMP_CLAUSE_SCHEDULE	(1 << 9)
 #define OMP_CLAUSE_DEFAULT	(1 << 10)
 #define OMP_CLAUSE_ORDERED	(1 << 11)
+#define OMP_CLAUSE_COLLAPSE	(1 << 12)
+#define OMP_CLAUSE_UNTIED	(1 << 13)
 
 /* Match OpenMP directive clauses. MASK is a bitmask of
    clauses that are allowed for a particular directive.  */
@@ -335,6 +337,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
 	    c->default_sharing = OMP_DEFAULT_PRIVATE;
 	  else if (gfc_match ("default ( none )") == MATCH_YES)
 	    c->default_sharing = OMP_DEFAULT_NONE;
+	  else if (gfc_match ("default ( firstprivate )") == MATCH_YES)
+	    c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
 	  if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
 	    continue;
 	}
@@ -351,10 +355,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
 	    c->sched_kind = OMP_SCHED_GUIDED;
 	  else if (gfc_match ("runtime") == MATCH_YES)
 	    c->sched_kind = OMP_SCHED_RUNTIME;
+	  else if (gfc_match ("auto") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_AUTO;
 	  if (c->sched_kind != OMP_SCHED_NONE)
 	    {
 	      match m = MATCH_NO;
-	      if (c->sched_kind != OMP_SCHED_RUNTIME)
+	      if (c->sched_kind != OMP_SCHED_RUNTIME
+		  && c->sched_kind != OMP_SCHED_AUTO)
 		m = gfc_match (" , %e )", &c->chunk_size);
 	      if (m != MATCH_YES)
 		m = gfc_match_char (')');
@@ -372,6 +379,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
 	  c->ordered = needs_space = true;
 	  continue;
 	}
+      if ((mask & OMP_CLAUSE_UNTIED) && !c->untied
+	  && gfc_match ("untied") == MATCH_YES)
+	{
+	  c->untied = needs_space = true;
+	  continue;
+	}
+      if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse)
+	{
+	  gfc_expr *cexpr = NULL;
+	  match m = gfc_match ("collapse ( %e )", &cexpr);
+
+	  if (m == MATCH_YES)
+	    {
+	      int collapse;
+	      const char *p = gfc_extract_int (cexpr, &collapse);
+	      if (p)
+		{
+		  gfc_error (p);
+		  collapse = 1;
+		}
+	      else if (collapse <= 0)
+		{
+		  gfc_error ("COLLAPSE clause argument not constant positive integer at %C");
+		  collapse = 1;
+		}
+	      c->collapse = collapse;
+	      gfc_free_expr (cexpr);
+	      continue;
+	    }
+	}
 
       break;
     }
@@ -393,10 +430,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
 #define OMP_DO_CLAUSES \
   (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE				\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION			\
-   | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED)
+   | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
 #define OMP_SECTIONS_CLAUSES \
   (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE				\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TASK_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED	\
+   | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED)
 
 match
 gfc_match_omp_parallel (void)
@@ -411,6 +451,29 @@ gfc_match_omp_parallel (void)
 
 
 match
+gfc_match_omp_task (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_TASK;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_taskwait (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_TASKWAIT;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
 gfc_match_omp_critical (void)
 {
   char n[GFC_MAX_SYMBOL_LEN+1];
@@ -809,9 +872,6 @@ resolve_omp_clauses (gfc_code *code)
 		if (!n->sym->attr.threadprivate)
 		  gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
 			     " at %L", n->sym->name, &code->loc);
-		if (n->sym->attr.allocatable)
-		  gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
-			     n->sym->name, &code->loc);
 		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
 		  gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
 			     n->sym->name, &code->loc);
@@ -823,9 +883,6 @@ resolve_omp_clauses (gfc_code *code)
 		if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
 		  gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
 			     "at %L", n->sym->name, &code->loc);
-		if (n->sym->attr.allocatable)
-		  gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE "
-			     "at %L", n->sym->name, &code->loc);
 		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
 		  gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
 			     n->sym->name, &code->loc);
@@ -856,9 +913,6 @@ resolve_omp_clauses (gfc_code *code)
 		    if (n->sym->attr.pointer)
 		      gfc_error ("POINTER object '%s' in %s clause at %L",
 				 n->sym->name, name, &code->loc);
-		    if (n->sym->attr.allocatable)
-		      gfc_error ("%s clause object '%s' is ALLOCATABLE at %L",
-				 name, n->sym->name, &code->loc);
 		    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
 		    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
 		        n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
@@ -1246,15 +1300,34 @@ struct omp_context
   struct pointer_set_t *private_iterators;
   struct omp_context *previous;
 } *omp_current_ctx;
-gfc_code *omp_current_do_code;
-
+static gfc_code *omp_current_do_code;
+static int omp_current_do_collapse;
 
 void
 gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
 {
   if (code->block->next && code->block->next->op == EXEC_DO)
-    omp_current_do_code = code->block->next;
+    {
+      int i;
+      gfc_code *c;
+
+      omp_current_do_code = code->block->next;
+      omp_current_do_collapse = code->ext.omp_clauses->collapse;
+      for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
+	{
+	  c = c->block;
+	  if (c->op != EXEC_DO || c->next == NULL)
+	    break;
+	  c = c->next;
+	  if (c->op != EXEC_DO)
+	    break;
+	}
+      if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
+	omp_current_do_collapse = 1;
+    }
   gfc_resolve_blocks (code->block, ns);
+  omp_current_do_collapse = 0;
+  omp_current_do_code = NULL;
 }
 
 
@@ -1294,6 +1367,8 @@ void
 gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
 {
   struct omp_context *ctx;
+  int i = omp_current_do_collapse;
+  gfc_code *c = omp_current_do_code;
 
   if (sym->attr.threadprivate)
     return;
@@ -1301,8 +1376,14 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
   /* !$omp do and !$omp parallel do iteration variable is predetermined
      private just in the !$omp do resp. !$omp parallel do construct,
      with no implications for the outer parallel constructs.  */
-  if (code == omp_current_do_code)
-    return;
+
+  while (i-- >= 1)
+    {
+      if (code == c)
+	return;
+
+      c = c->block->next;
+    }
 
   for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
     {
@@ -1326,8 +1407,8 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
 static void
 resolve_omp_do (gfc_code *code)
 {
-  gfc_code *do_code;
-  int list;
+  gfc_code *do_code, *c;
+  int list, i, collapse;
   gfc_namelist *n;
   gfc_symbol *dovar;
 
@@ -1335,11 +1416,17 @@ resolve_omp_do (gfc_code *code)
     resolve_omp_clauses (code);
 
   do_code = code->block->next;
-  if (do_code->op == EXEC_DO_WHILE)
-    gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control "
-	       "at %L", &do_code->loc);
-  else
+  collapse = code->ext.omp_clauses->collapse;
+  if (collapse <= 0)
+    collapse = 1;
+  for (i = 1; i <= collapse; i++)
     {
+      if (do_code->op == EXEC_DO_WHILE)
+	{
+	  gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control "
+		     "at %L", &do_code->loc);
+	  break;
+	}
       gcc_assert (do_code->op == EXEC_DO);
       if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
 	gfc_error ("!$OMP DO iteration variable must be of type integer at %L",
@@ -1359,6 +1446,53 @@ resolve_omp_do (gfc_code *code)
 			     &do_code->loc);
 		  break;
 		}
+      if (i > 1)
+	{
+	  gfc_code *do_code2 = code->block->next;
+	  int j;
+
+	  for (j = 1; j < i; j++)
+	    {
+	      gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+	      if (dovar == ivar
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+		{
+		  gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L",
+			     &do_code->loc);
+		  break;
+		}
+	      if (j < i)
+		break;
+	      do_code2 = do_code2->block->next;
+	    }
+	}
+      if (i == collapse)
+	break;
+      for (c = do_code->next; c; c = c->next)
+	if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+	  {
+	    gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L",
+		       &c->loc);
+	    break;
+	  }
+      if (c)
+	break;
+      do_code = do_code->block;
+      if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+	{
+	  gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
+		     &code->loc);
+	  break;
+	}
+      do_code = do_code->next;
+      if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+	{
+	  gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
+		     &code->loc);
+	  break;
+	}
     }
 }