re PR fortran/60928 (gfortran issue with allocatable components and OpenMP)

	PR fortran/60928
	* omp-low.c (lower_rec_input_clauses) <case OMP_CLAUSE_LASTPRIVATE>:
	Set lastprivate_firstprivate even if omp_private_outer_ref
	langhook returns true.
	<case OMP_CLAUSE_REDUCTION>: When calling omp_clause_default_ctor
	langhook, call unshare_expr on new_var and call
	build_outer_var_ref to get the last argument.
gcc/c-family/
	* c-pragma.c (omp_pragmas_simd): Move PRAGMA_OMP_TASK...
	(omp_pragmas): ... back here.
gcc/fortran/
	* f95-lang.c (gfc_init_builtin_functions): Handle -fopenmp-simd
	like -fopenmp.
	* openmp.c (resolve_omp_clauses): Remove allocatable components
	diagnostics.  Add associate-name and intent(in) pointer
	diagnostics for various clauses, diagnose procedure pointers in
	reduction clause.
	* parse.c (match_word_omp_simd): New function.
	(matchs, matcho): New macros.
	(decode_omp_directive): Change match macros to either matchs
	or matcho.  Handle -fopenmp-simd.
	(next_free, next_fixed): Handle -fopenmp-simd like -fopenmp.
	* scanner.c (skip_free_comments, skip_fixed_comments, include_line):
	Likewise.
	* trans-array.c (get_full_array_size): Rename to...
	(gfc_full_array_size): ... this.  No longer static.
	(duplicate_allocatable): Adjust caller.  Add NO_MEMCPY argument
	and handle it.
	(gfc_duplicate_allocatable, gfc_copy_allocatable_data): Adjust
	duplicate_allocatable callers.
	(gfc_duplicate_allocatable_nocopy): New function.
	(structure_alloc_comps): Adjust g*_full_array_size and
	duplicate_allocatable caller.
	* trans-array.h (gfc_full_array_size,
	gfc_duplicate_allocatable_nocopy): New prototypes.
	* trans-common.c (create_common): Call gfc_finish_decl_attrs.
	* trans-decl.c (gfc_finish_decl_attrs): New function.
	(gfc_finish_var_decl, create_function_arglist,
	gfc_get_fake_result_decl): Call it.
	(gfc_allocate_lang_decl): If DECL_LANG_SPECIFIC is already allocated,
	don't allocate it again.
	(gfc_get_symbol_decl): Set GFC_DECL_ASSOCIATE_VAR_P on
	associate-names.
	* trans.h (gfc_finish_decl_attrs): New prototype.
	(struct lang_decl): Add scalar_allocatable and scalar_pointer
	bitfields.
	(GFC_DECL_SCALAR_ALLOCATABLE, GFC_DECL_SCALAR_POINTER,
	GFC_DECL_GET_SCALAR_ALLOCATABLE, GFC_DECL_GET_SCALAR_POINTER,
	GFC_DECL_ASSOCIATE_VAR_P): Define.
	(GFC_POINTER_TYPE_P): Remove.
	* trans-openmp.c (gfc_omp_privatize_by_reference): Don't check
	GFC_POINTER_TYPE_P, instead test GFC_DECL_GET_SCALAR_ALLOCATABLE,
	GFC_DECL_GET_SCALAR_POINTER or GFC_DECL_CRAY_POINTEE on decl.
	(gfc_omp_predetermined_sharing): Associate-names are predetermined.
	(enum walk_alloc_comps): New.
	(gfc_has_alloc_comps, gfc_omp_unshare_expr_r, gfc_omp_unshare_expr,
	gfc_walk_alloc_comps): New functions.
	(gfc_omp_private_outer_ref): Return true for scalar allocatables or
	decls with allocatable components.
	(gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor,
	gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Fix up handling of
	allocatables, handle also OMP_CLAUSE_REDUCTION, handle scalar
	allocatables and decls with allocatable components.
	(gfc_trans_omp_array_reduction_or_udr): Don't handle allocatable
	arrays here.
	(gfc_trans_omp_reduction_list): Call
	gfc_trans_omp_array_reduction_or_udr even for allocatable scalars.
	(gfc_trans_omp_do_simd): If -fno-openmp, just expand it as OMP_SIMD.
	(gfc_trans_omp_parallel_do_simd): Likewise.
	* trans-types.c (gfc_sym_type): Don't set GFC_POINTER_TYPE_P.
	(gfc_get_derived_type): Call gfc_finish_decl_attrs.
gcc/testsuite/
	* gfortran.dg/gomp/allocatable_components_1.f90: Remove dg-error
	directives.
	* gfortran.dg/gomp/associate1.f90: New test.
	* gfortran.dg/gomp/intentin1.f90: New test.
	* gfortran.dg/gomp/openmp-simd-1.f90: New test.
	* gfortran.dg/gomp/openmp-simd-2.f90: New test.
	* gfortran.dg/gomp/openmp-simd-3.f90: New test.
	* gfortran.dg/gomp/proc_ptr_2.f90: New test.
libgomp/
	* testsuite/libgomp.fortran/allocatable9.f90: New test.
	* testsuite/libgomp.fortran/allocatable10.f90: New test.
	* testsuite/libgomp.fortran/allocatable11.f90: New test.
	* testsuite/libgomp.fortran/allocatable12.f90: New test.
	* testsuite/libgomp.fortran/alloc-comp-1.f90: New test.
	* testsuite/libgomp.fortran/alloc-comp-2.f90: New test.
	* testsuite/libgomp.fortran/alloc-comp-3.f90: New test.
	* testsuite/libgomp.fortran/associate1.f90: New test.
	* testsuite/libgomp.fortran/associate2.f90: New test.
	* testsuite/libgomp.fortran/procptr1.f90: New test.

From-SVN: r211397

1 files changed, 124 insertions, 61 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index b7c4273..bdee831 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -74,6 +74,34 @@ match_word (const char *str, match (*subr) (void), locus *old_locus)
 }
 
 
+/* Like match_word, but if str is matched, set a flag that it
+   was matched.  */
+static match
+match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus,
+		     bool *simd_matched)
+{
+  match m;
+
+  if (str != NULL)
+    {
+      m = gfc_match (str);
+      if (m != MATCH_YES)
+	return m;
+      *simd_matched = true;
+    }
+
+  m = (*subr) ();
+
+  if (m != MATCH_YES)
+    {
+      gfc_current_locus = *old_locus;
+      reject_statement ();
+    }
+
+  return m;
+}
+
+
 /* Load symbols from all USE statements encountered in this scoping unit.  */
 
 static void
@@ -103,7 +131,7 @@ use_modules (void)
       if (match_word (keyword, subr, &old_locus) == MATCH_YES)	\
 	return st;						\
       else							\
-	undo_new_statement ();				  \
+	undo_new_statement ();				  	\
     } while (0);
 
 
@@ -531,11 +559,34 @@ decode_statement (void)
   return ST_NONE;
 }
 
+/* Like match, but set a flag simd_matched if keyword matched.  */
+#define matchs(keyword, subr, st)				\
+    do {							\
+      if (match_word_omp_simd (keyword, subr, &old_locus,	\
+			       &simd_matched) == MATCH_YES)	\
+	return st;						\
+      else							\
+	undo_new_statement ();				  	\
+    } while (0);
+
+/* Like match, but don't match anything if not -fopenmp.  */
+#define matcho(keyword, subr, st)				\
+    do {							\
+      if (!gfc_option.gfc_flag_openmp)				\
+	;							\
+      else if (match_word (keyword, subr, &old_locus)		\
+	       == MATCH_YES)					\
+	return st;						\
+      else							\
+	undo_new_statement ();				  	\
+    } while (0);
+
 static gfc_statement
 decode_omp_directive (void)
 {
   locus old_locus;
   char c;
+  bool simd_matched = false;
 
   gfc_enforce_clean_symbol_state ();
 
@@ -560,94 +611,102 @@ decode_omp_directive (void)
 
   c = gfc_peek_ascii_char ();
 
+  /* match is for directives that should be recognized only if
+     -fopenmp, matchs for directives that should be recognized
+     if either -fopenmp or -fopenmp-simd.  */
   switch (c)
     {
     case 'a':
-      match ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
+      matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
       break;
     case 'b':
-      match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+      matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
       break;
     case 'c':
-      match ("cancellation% point", gfc_match_omp_cancellation_point,
-	     ST_OMP_CANCELLATION_POINT);
-      match ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL);
-      match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
+      matcho ("cancellation% point", gfc_match_omp_cancellation_point,
+	      ST_OMP_CANCELLATION_POINT);
+      matcho ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL);
+      matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
       break;
     case 'd':
-      match ("declare reduction", gfc_match_omp_declare_reduction,
-	     ST_OMP_DECLARE_REDUCTION);
-      match ("declare simd", gfc_match_omp_declare_simd,
-	     ST_OMP_DECLARE_SIMD);
-      match ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD);
-      match ("do", gfc_match_omp_do, ST_OMP_DO);
+      matchs ("declare reduction", gfc_match_omp_declare_reduction,
+	      ST_OMP_DECLARE_REDUCTION);
+      matchs ("declare simd", gfc_match_omp_declare_simd,
+	      ST_OMP_DECLARE_SIMD);
+      matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD);
+      matcho ("do", gfc_match_omp_do, ST_OMP_DO);
       break;
     case 'e':
-      match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC);
-      match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
-      match ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
-      match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
-      match ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD);
-      match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
-      match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED);
-      match ("end parallel do simd", gfc_match_omp_eos,
-	     ST_OMP_END_PARALLEL_DO_SIMD);
-      match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO);
-      match ("end parallel sections", gfc_match_omp_eos,
-	     ST_OMP_END_PARALLEL_SECTIONS);
-      match ("end parallel workshare", gfc_match_omp_eos,
-	     ST_OMP_END_PARALLEL_WORKSHARE);
-      match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
-      match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
-      match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
-      match ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP);
-      match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
-      match ("end workshare", gfc_match_omp_end_nowait,
-	     ST_OMP_END_WORKSHARE);
+      matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC);
+      matcho ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
+      matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
+      matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
+      matchs ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD);
+      matcho ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
+      matcho ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED);
+      matchs ("end parallel do simd", gfc_match_omp_eos,
+	      ST_OMP_END_PARALLEL_DO_SIMD);
+      matcho ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO);
+      matcho ("end parallel sections", gfc_match_omp_eos,
+	      ST_OMP_END_PARALLEL_SECTIONS);
+      matcho ("end parallel workshare", gfc_match_omp_eos,
+	      ST_OMP_END_PARALLEL_WORKSHARE);
+      matcho ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
+      matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
+      matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
+      matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP);
+      matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
+      matcho ("end workshare", gfc_match_omp_end_nowait,
+	      ST_OMP_END_WORKSHARE);
       break;
     case 'f':
-      match ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
+      matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
       break;
     case 'm':
-      match ("master", gfc_match_omp_master, ST_OMP_MASTER);
+      matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
       break;
     case 'o':
-      match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
+      matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
       break;
     case 'p':
-      match ("parallel do simd", gfc_match_omp_parallel_do_simd,
-	     ST_OMP_PARALLEL_DO_SIMD);
-      match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
-      match ("parallel sections", gfc_match_omp_parallel_sections,
-	     ST_OMP_PARALLEL_SECTIONS);
-      match ("parallel workshare", gfc_match_omp_parallel_workshare,
-	     ST_OMP_PARALLEL_WORKSHARE);
-      match ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
+      matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
+	      ST_OMP_PARALLEL_DO_SIMD);
+      matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      matcho ("parallel sections", gfc_match_omp_parallel_sections,
+	      ST_OMP_PARALLEL_SECTIONS);
+      matcho ("parallel workshare", gfc_match_omp_parallel_workshare,
+	      ST_OMP_PARALLEL_WORKSHARE);
+      matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
       break;
     case 's':
-      match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
-      match ("section", gfc_match_omp_eos, ST_OMP_SECTION);
-      match ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
-      match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
+      matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
+      matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION);
+      matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
+      matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
       break;
     case 't':
-      match ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP);
-      match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
-      match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
-      match ("task", gfc_match_omp_task, ST_OMP_TASK);
-      match ("threadprivate", gfc_match_omp_threadprivate,
-	     ST_OMP_THREADPRIVATE);
+      matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP);
+      matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
+      matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
+      matcho ("task", gfc_match_omp_task, ST_OMP_TASK);
+      matcho ("threadprivate", gfc_match_omp_threadprivate,
+	      ST_OMP_THREADPRIVATE);
       break;
     case 'w':
-      match ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
+      matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
       break;
     }
 
   /* All else has failed, so give up.  See if any of the matchers has
-     stored an error message of some sort.  */
+     stored an error message of some sort.  Don't error out if
+     not -fopenmp and simd_matched is false, i.e. if a directive other
+     than one marked with match has been seen.  */
 
-  if (gfc_error_check () == 0)
-    gfc_error_now ("Unclassifiable OpenMP directive at %C");
+  if (gfc_option.gfc_flag_openmp || simd_matched)
+    {
+      if (gfc_error_check () == 0)
+	gfc_error_now ("Unclassifiable OpenMP directive at %C");
+    }
 
   reject_statement ();
 
@@ -770,7 +829,9 @@ next_free (void)
 	  return decode_gcc_attribute ();
 
 	}
-      else if (c == '$' && gfc_option.gfc_flag_openmp)
+      else if (c == '$'
+	       && (gfc_option.gfc_flag_openmp
+		   || gfc_option.gfc_flag_openmp_simd))
 	{
 	  int i;
 
@@ -859,7 +920,9 @@ next_fixed (void)
 
 	      return decode_gcc_attribute ();
 	    }
-	  else if (c == '$' && gfc_option.gfc_flag_openmp)
+	  else if (c == '$'
+		   && (gfc_option.gfc_flag_openmp
+		       || gfc_option.gfc_flag_openmp_simd))
 	    {
 	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
 		gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);