Fortran: Add OpenMP 'interop' directive parsing support

Parse OpenMP's 'interop' directive but stop with a 'sorry, unimplemented'
after resolving.

Additionally, it moves some clause dumping away from the end directive as
that lead to 'nowait' not being printed when it should as some cases were
missed.

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_namelist): Handle OMP_LIST_INIT.
	(show_omp_clauses): Handle OMP_LIST_{INIT,USE,DESTORY}; move 'nowait'
	from end-directive to the directive dump.
	(show_omp_node, show_code_node): Handle EXEC_OMP_INTEROP.
	* gfortran.h (enum gfc_statement): Add ST_OMP_INTEROP.
	(OMP_LIST_INIT, OMP_LIST_USE, OMP_LIST_DESTROY): Add.
	(enum gfc_exec_op): Add EXEC_OMP_INTEROP.
	(struct gfc_omp_namelist): Add interop items to union.
	(gfc_free_omp_namelist): Add boolean arg.
	* match.cc (gfc_free_omp_namelist): Update to free
	interop union members.
	* match.h (gfc_match_omp_interop): New.
	* openmp.cc (gfc_omp_directives): Uncomment 'interop' entry.
	(gfc_free_omp_clauses, gfc_match_omp_allocate,
	gfc_match_omp_flush, gfc_match_omp_clause_reduction): Update
	call.
	(enum omp_mask2): Add OMP_CLAUSE_{INIT,USE,DESTROY}.
	(OMP_INTEROP_CLAUSES): Use it.
	(gfc_match_omp_clauses): Match those clauses.
	(gfc_match_omp_prefer_type, gfc_match_omp_init,
	gfc_match_omp_interop): New.
	(resolve_omp_clauses): Handle interop clauses.
	(omp_code_to_statement): Add ST_OMP_INTEROP.
	(gfc_resolve_omp_directive): Add EXEC_OMP_INTEROP.
	* parse.cc (decode_omp_directive): Parse 'interop' directive.
	(next_statement, gfc_ascii_statement): Handle ST_OMP_INTEROP.
	* st.cc (gfc_free_statement): Likewise
	* resolve.cc (gfc_resolve_code): Handle EXEC_OMP_INTEROP.
	* trans.cc (trans_code): Likewise.
	* trans-openmp.cc (gfc_trans_omp_directive): Print 'sorry'
	for EXEC_OMP_INTEROP.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/interop-1.f90: New test.
	* gfortran.dg/gomp/interop-2.f90: New test.
	* gfortran.dg/gomp/interop-3.f90: New test.

1 files changed, 46 insertions, 15 deletions

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 80aa8ef..0971e6c 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1374,6 +1374,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	    }
 	  ns_iter = n->u2.ns;
 	}
+      else if (list_type == OMP_LIST_INIT && n != n2)
+	fputs (") INIT(", dumpfile);
       if (list_type == OMP_LIST_ALLOCATE)
 	{
 	  if (n->u2.allocator)
@@ -1525,6 +1527,39 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	    fputs (", ", dumpfile);
 	  continue;
 	}
+      else if (list_type == OMP_LIST_INIT)
+	{
+	  int i = 0;
+	  if (n->u.init.target)
+	    fputs ("target,", dumpfile);
+	  if (n->u.init.targetsync)
+	    fputs ("targetsync,", dumpfile);
+	  char *prefer_type = n->u.init.str;
+	  if (n->u.init.len)
+	    fputs ("prefer_type(", dumpfile);
+	  if (n->u.init.len)
+	    while (*prefer_type)
+	      {
+		fputc ('{', dumpfile);
+		if (n->u2.interop_int && n->u2.interop_int[i] != 0)
+		  fprintf (dumpfile, "fr(%d),", n->u2.interop_int[i]);
+		else if (prefer_type[0] != ' ' || prefer_type[1] != '\0')
+		  fprintf (dumpfile, "fr(\"%s\"),", prefer_type);
+		prefer_type += 1 + strlen (prefer_type);
+
+		while (*prefer_type)
+		  {
+		    fprintf (dumpfile, "attr(\"%s\"),", prefer_type);
+		    prefer_type += 1 + strlen (prefer_type);
+		  }
+		fputc ('}', dumpfile);
+		++prefer_type;
+		++i;
+	    }
+	  if (n->u.init.len)
+	    fputc (')', dumpfile);
+	  fputc (':', dumpfile);
+	}
       fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
       if (list_type == OMP_LIST_LINEAR && n->u.linear.op != OMP_LINEAR_DEFAULT)
 	fputc (')', dumpfile);
@@ -1806,11 +1841,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
     fputs (" UNTIED", dumpfile);
   if (omp_clauses->mergeable)
     fputs (" MERGEABLE", dumpfile);
+  if (omp_clauses->nowait)
+    fputs (" NOWAIT", dumpfile);
   if (omp_clauses->collapse)
     fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
   for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
-    if (omp_clauses->lists[list_type] != NULL
-	&& list_type != OMP_LIST_COPYPRIVATE)
+    if (omp_clauses->lists[list_type] != NULL)
       {
 	const char *type = NULL;
 	switch (list_type)
@@ -1855,6 +1891,9 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	  case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
 	  case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
 	  case OMP_LIST_USES_ALLOCATORS: type = "USES_ALLOCATORS"; break;
+	  case OMP_LIST_INIT: type = "INIT"; break;
+	  case OMP_LIST_USE: type = "USE"; break;
+	  case OMP_LIST_DESTROY: type = "DESTROY"; break;
 	  default:
 	    gcc_unreachable ();
 	  }
@@ -2186,6 +2225,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
     case EXEC_OMP_ERROR: name = "ERROR"; break;
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+    case EXEC_OMP_INTEROP: name = "INTEROP"; break;
     case EXEC_OMP_LOOP: name = "LOOP"; break;
     case EXEC_OMP_MASKED: name = "MASKED"; break;
     case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break;
@@ -2286,6 +2326,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_ERROR:
+    case EXEC_OMP_INTEROP:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_MASKED:
@@ -2379,6 +2420,7 @@ show_omp_node (int level, gfc_code *c)
       || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
       || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
       || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
+      || c->op == EXEC_OMP_INTEROP
       || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
     return;
   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -2401,19 +2443,7 @@ show_omp_node (int level, gfc_code *c)
   fputc ('\n', dumpfile);
   code_indent (level, 0);
   fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
-  if (omp_clauses != NULL)
-    {
-      if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
-	{
-	  fputs (" COPYPRIVATE(", dumpfile);
-	  show_omp_namelist (OMP_LIST_COPYPRIVATE,
-			     omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
-	  fputc (')', dumpfile);
-	}
-      else if (omp_clauses->nowait)
-	fputs (" NOWAIT", dumpfile);
-    }
-  else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
+  if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
     fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
 }
 
@@ -3529,6 +3559,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_ERROR:
+    case EXEC_OMP_INTEROP:
     case EXEC_OMP_FLUSH:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_MASKED: