Fortran: Add LOCALITY support for DO_CONCURRENT

	This patch provided by Anuj Mohite as part of the GSoC project.
	It is modified slightly by Jerry DeLisle for minor formatting.
	The patch provides front-end parsing of the LOCALITY specs in
	DO_CONCURRENT and adds numerous test cases.

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_code_node):  Updated to use
	c->ext.concur.forall_iterator instead of c->ext.forall_iterator.
	* frontend-passes.cc (index_interchange): Updated to
	use c->ext.concur.forall_iterator instead of c->ext.forall_iterator.
	(gfc_code_walker): Likewise.
	* gfortran.h (enum locality_type): Added new enum for locality types
	in DO CONCURRENT constructs.
	* match.cc (match_simple_forall): Updated to use
	new_st.ext.concur.forall_iterator instead of new_st.ext.forall_iterator.
	(gfc_match_forall): Likewise.
	(gfc_match_do):  Implemented support for matching DO CONCURRENT locality
	specifiers (LOCAL, LOCAL_INIT, SHARED, DEFAULT(NONE), and REDUCE).
	* parse.cc (parse_do_block): Updated to use
	new_st.ext.concur.forall_iterator instead of new_st.ext.forall_iterator.
	* resolve.cc (struct check_default_none_data): Added struct
	check_default_none_data.
	(do_concur_locality_specs_f2023): New function to check compliance
	with F2023's C1133 constraint for DO CONCURRENT.
	(check_default_none_expr): New function to check DEFAULT(NONE)
	compliance.
	(resolve_locality_spec): New function to resolve locality specs.
	(gfc_count_forall_iterators): Updated to use
	code->ext.concur.forall_iterator.
	(gfc_resolve_forall): Updated to use code->ext.concur.forall_iterator.
	* st.cc (gfc_free_statement): Updated to free locality specifications
	and use p->ext.concur.forall_iterator.
	* trans-stmt.cc (gfc_trans_forall_1): Updated to use
	code->ext.concur.forall_iterator.

gcc/testsuite/ChangeLog:

	* gfortran.dg/do_concurrent_10.f90: New test.
	* gfortran.dg/do_concurrent_8_f2018.f90: New test.
	* gfortran.dg/do_concurrent_8_f2023.f90: New test.
	* gfortran.dg/do_concurrent_9.f90: New test.
	* gfortran.dg/do_concurrent_all_clauses.f90: New test.
	* gfortran.dg/do_concurrent_basic.f90: New test.
	* gfortran.dg/do_concurrent_constraints.f90: New test.
	* gfortran.dg/do_concurrent_local_init.f90: New test.
	* gfortran.dg/do_concurrent_locality_specs.f90: New test.
	* gfortran.dg/do_concurrent_multiple_reduce.f90: New test.
	* gfortran.dg/do_concurrent_nested.f90: New test.
	* gfortran.dg/do_concurrent_parser.f90: New test.
	* gfortran.dg/do_concurrent_reduce_max.f90: New test.
	* gfortran.dg/do_concurrent_reduce_sum.f90: New test.
	* gfortran.dg/do_concurrent_shared.f90: New test.

Signed-off-by: Anuj <anujmohite001@gmail.com>

1 files changed, 110 insertions, 3 deletions

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index cf09e8d..0f983e9 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -3005,7 +3005,7 @@ show_code_node (int level, gfc_code *c)
 
     case EXEC_FORALL:
       fputs ("FORALL ", dumpfile);
-      for (fa = c->ext.forall_iterator; fa; fa = fa->next)
+      for (fa = c->ext.concur.forall_iterator; fa; fa = fa->next)
 	{
 	  show_expr (fa->var);
 	  fputc (' ', dumpfile);
@@ -3065,7 +3065,7 @@ show_code_node (int level, gfc_code *c)
 
     case EXEC_DO_CONCURRENT:
       fputs ("DO CONCURRENT ", dumpfile);
-      for (fa = c->ext.forall_iterator; fa; fa = fa->next)
+      for (fa = c->ext.concur.forall_iterator; fa; fa = fa->next)
         {
           show_expr (fa->var);
           fputc (' ', dumpfile);
@@ -3078,7 +3078,114 @@ show_code_node (int level, gfc_code *c)
           if (fa->next != NULL)
             fputc (',', dumpfile);
         }
-      show_expr (c->expr1);
+
+      if (c->expr1 != NULL)
+	{
+	  fputc (',', dumpfile);
+	  show_expr (c->expr1);
+	}
+
+      if (c->ext.concur.locality[LOCALITY_LOCAL])
+	{
+	  fputs (" LOCAL (", dumpfile);
+
+	  for (gfc_expr_list *el = c->ext.concur.locality[LOCALITY_LOCAL];
+	       el; el = el->next)
+	    {
+	      show_expr (el->expr);
+	      if (el->next)
+		fputc (',', dumpfile);
+	    }
+	  fputc (')', dumpfile);
+	}
+
+      if (c->ext.concur.locality[LOCALITY_LOCAL_INIT])
+	{
+	  fputs (" LOCAL_INIT (", dumpfile);
+	  for (gfc_expr_list *el = c->ext.concur.locality[LOCALITY_LOCAL_INIT];
+	       el; el = el->next)
+	  {
+	    show_expr (el->expr);
+	    if (el->next)
+	      fputc (',', dumpfile);
+	  }
+	  fputc (')', dumpfile);
+	}
+
+      if (c->ext.concur.locality[LOCALITY_SHARED])
+	{
+	  fputs (" SHARED (", dumpfile);
+	  for (gfc_expr_list *el = c->ext.concur.locality[LOCALITY_SHARED];
+	       el; el = el->next)
+	    {
+	      show_expr (el->expr);
+	      if (el->next)
+		fputc (',', dumpfile);
+	    }
+	  fputc (')', dumpfile);
+	}
+
+      if (c->ext.concur.default_none)
+	{
+	  fputs (" DEFAULT (NONE)", dumpfile);
+	}
+
+      if (c->ext.concur.locality[LOCALITY_REDUCE])
+	{
+	  gfc_expr_list *el = c->ext.concur.locality[LOCALITY_REDUCE];
+	  while (el)
+	    {
+	      fputs (" REDUCE (", dumpfile);
+	      if (el->expr)
+		{
+		  if (el->expr->expr_type == EXPR_FUNCTION)
+		    {
+		      const char *name;
+		      switch (el->expr->value.function.isym->id)
+			{
+			  case GFC_ISYM_MIN:
+			    name = "MIN";
+			    break;
+			  case GFC_ISYM_MAX:
+			    name = "MAX";
+			    break;
+			  case GFC_ISYM_IAND:
+			    name = "IAND";
+			    break;
+			  case GFC_ISYM_IOR:
+			    name = "IOR";
+			    break;
+			  case GFC_ISYM_IEOR:
+			    name = "IEOR";
+			    break;
+			  default:
+			    gcc_unreachable ();
+			}
+		      fputs (name, dumpfile);
+		    }
+		  else
+		    show_expr (el->expr);
+		}
+	      else
+		{
+		  fputs ("(NULL)", dumpfile);
+		}
+
+	      fputc (':', dumpfile);
+	      el = el->next;
+
+	      while (el && el->expr && el->expr->expr_type == EXPR_VARIABLE)
+		{
+		  show_expr (el->expr);
+		  el = el->next;
+		  if (el && el->expr && el->expr->expr_type == EXPR_VARIABLE)
+		    fputc (',', dumpfile);
+		}
+
+	      fputc (')', dumpfile);
+	    }
+	}
+
       ++show_level;
 
       show_code (level + 1, c->block->next);