diff mbox series

OpenMP: Duplicate checking for map clauses in Fortran (PR107214)

Message ID 20221020161414.7430-1-julian@codesourcery.com
State New
Headers show
Series OpenMP: Duplicate checking for map clauses in Fortran (PR107214) | expand

Commit Message

Julian Brown Oct. 20, 2022, 4:14 p.m. UTC 
This patch adds duplicate checking for OpenMP "map" clauses, taking some
cues from the implementation for C in c-typeck.cc:c_finish_omp_clauses
(and similar for C++).

In addition to the existing use of the "mark" and "comp_mark" bitfields
in the gfc_symbol structure, the patch adds several new bits handling
duplicate checking within various categories of clause types.  If "mark"
is being used for map clauses, we need to use different bits for other
clauses for cases where "map" and some other clause can refer to the
same symbol (e.g. "map(n) shared(n)").

Tested with offloading to NVPTX. OK?

2022-10-20  Julian Brown  <julian@codesourcery.com>

gcc/fortran/
	PR fortran/107214
	* gfortran.h (gfc_symbol): Add data_mark, dev_mark, gen_mark and
	reduc_mark bitfields.
	* openmp.cc (resolve_omp_clauses): Use above bitfields to improve
	duplicate clause detection.

gcc/testsuite/
	PR fortran/107214
	* gfortran.dg/gomp/pr107214.f90: New test.
---
 gcc/fortran/gfortran.h                      | 16 +++++-
 gcc/fortran/openmp.cc                       | 63 +++++++++++++++++----
 gcc/testsuite/gfortran.dg/gomp/pr107214.f90 |  7 +++
 3 files changed, 72 insertions(+), 14 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr107214.f90

Comments

Tobias Burnus Oct. 26, 2022, 10:39 a.m. UTC | #1 
Hi Julian,

I had a first quick lock at this patch, I should have a closer look
later. However, I stumbled over the following:

On 20.10.22 18:14, Julian Brown wrote:
> typedef struct gfc_symbol
> {
> ...
>    struct gfc_symbol *old_symbol;
>
>    unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1;
>    unsigned reduc_mark:1, gfc_new:1;
>
>    struct gfc_symbol *tlink;
>
>    unsigned equiv_built:1;
>    ...
I know that this was the case before, but can you move the mark:1 etc.
after 'tlink'? In that case all bitfields are grouped together. If I
have not miscounted, we have currently 7 bits before and 9 bits after
'tlink' and grouping them together reduced pointless padding.

* * *
> +      else if (n->sym->mark)
> +     gfc_error ("Symbol %qs present on both data and map clauses "
> +                "at %L", n->sym->name, &n->where);

I wonder whether that also rejects the following – which seems to be
valid. The 'map' goes to 'target' and the 'firstprivate' to 'parallel',
cf. OpenMP 5.2, "17.2 Clauses on Combined and Composite Constructs",
[340:3-4 & 12-14]. (BTW: While some fixes went into 5.1 regarding this section,
a likewise wording is already in 5.0.)

(Testing showed: it give an ICE without the patch and an error with.)

module m
   integer :: a = 1
end module m

module m2
contains
subroutine bar()
   use m
   !$omp declare target
   a = a + 5
end subroutine bar
end

program p
   use m
   !$omp target parallel do map(a) firstprivate(a)
     do i = 1, 1
        a = 7
       call bar()
        if (a /= 7) error stop 1
        a = a + 8

    end do
   if (a /= 6) error stop
end

  * * *

The ICE seems to be because gcc/fortran/trans-openmp.cc's gfc_split_omp_clauses
mishandles this as the dump shows the following:

   #pragma omp target firstprivate(a) map(tofrom:a)
         #pragma omp parallel firstprivate(a)

  * * *

In contrast, for the C testcase:

void foo(int x) {
#pragma omp target parallel for simd map(x) firstprivate(x)
for (int k = 0; k < 1; ++k)
   x = 1;
}

the dump is as follows, which seems to be sensible:

   #pragma omp target map(tofrom:x)
         #pragma omp parallel firstprivate(x)
               #pragma omp for nowait
                     #pragma omp simd

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
diff mbox series

Patch

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fe8c4e131f3..511a1ec3623 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1861,9 +1861,21 @@  typedef struct gfc_symbol
      the current statement.  Otherwise, old_symbol points to a copy of
      the old symbol. gfc_new is used in symbol.cc to flag new symbols.
      comp_mark is used to indicate variables which have component accesses
-     in OpenMP/OpenACC directive clauses.  */
+     in OpenMP/OpenACC directive clauses (cf. c-typeck.cc:c_finish_omp_clauses,
+     map_field_head).
+     data_mark is used to check duplicate mappings for OpenMP data-sharing
+     clauses (see firstprivate_head/lastprivate_head in the above function).
+     dev_mark is used to check duplicate mappings for OpenMP
+     is_device_ptr/has_device_addr clauses (see is_on_device_head in above
+     function).
+     gen_mark is used to check duplicate mappings for OpenMP
+     use_device_ptr/use_device_addr/private/shared clauses (see generic_head in
+     above functon).
+     reduc_mark is used to check duplicate mappings for OpenMP reduction
+     clauses.  */
   struct gfc_symbol *old_symbol;
-  unsigned mark:1, comp_mark:1, gfc_new:1;
+  unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1;
+  unsigned reduc_mark:1, gfc_new:1;
 
   /* The tlink field is used in the front end to carry the module
      declaration of separate module procedures so that the characteristics
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index ce719bd5d92..d4595aae23e 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6738,6 +6738,10 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  continue;
 	n->sym->mark = 0;
 	n->sym->comp_mark = 0;
+	n->sym->data_mark = 0;
+	n->sym->dev_mark = 0;
+	n->sym->gen_mark = 0;
+	n->sym->reduc_mark = 0;
 	if (n->sym->attr.flavor == FL_VARIABLE
 	    || n->sym->attr.proc_pointer
 	    || (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
@@ -6806,7 +6810,6 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	&& list != OMP_LIST_LASTPRIVATE
 	&& list != OMP_LIST_ALIGNED
 	&& list != OMP_LIST_DEPEND
-	&& (list != OMP_LIST_MAP || openacc)
 	&& list != OMP_LIST_FROM
 	&& list != OMP_LIST_TO
 	&& (list != OMP_LIST_REDUCTION || !openacc)
@@ -6825,10 +6828,43 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	    for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
 	      if (ref->type == REF_COMPONENT)
 		component_ref_p = true;
-	  if ((!component_ref_p && n->sym->comp_mark)
-	      || (component_ref_p && n->sym->mark))
-	    gfc_error ("Symbol %qs has mixed component and non-component "
-		       "accesses at %L", n->sym->name, &n->where);
+	  if ((list == OMP_LIST_IS_DEVICE_PTR
+	       || list == OMP_LIST_HAS_DEVICE_ADDR)
+	      && !component_ref_p)
+	    {
+	      if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark)
+		gfc_error ("Symbol %qs present on multiple clauses at %L",
+			   n->sym->name, &n->where);
+	      else
+		n->sym->dev_mark = 1;
+	    }
+	  else if ((list == OMP_LIST_USE_DEVICE_PTR
+		    || list == OMP_LIST_USE_DEVICE_ADDR
+		    || list == OMP_LIST_PRIVATE
+		    || list == OMP_LIST_SHARED)
+		   && !component_ref_p)
+	    {
+	      if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark)
+		gfc_error ("Symbol %qs present on multiple clauses at %L",
+			   n->sym->name, &n->where);
+	      else
+		n->sym->gen_mark = 1;
+	    }
+	  else if (list == OMP_LIST_REDUCTION && !component_ref_p)
+	    {
+	      if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark)
+		gfc_error ("Symbol %qs present on multiple clauses at %L",
+			   n->sym->name, &n->where);
+	      else
+		n->sym->reduc_mark = 1;
+	    }
+	  else if ((!component_ref_p && n->sym->comp_mark)
+		   || (component_ref_p && n->sym->mark))
+	    {
+	      if (openacc)
+		gfc_error ("Symbol %qs has mixed component and non-component "
+			   "accesses at %L", n->sym->name, &n->where);
+	    }
 	  else if (n->sym->mark)
 	    gfc_error ("Symbol %qs present on multiple clauses at %L",
 		       n->sym->name, &n->where);
@@ -6844,31 +6880,34 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
   gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
   for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
     for (n = omp_clauses->lists[list]; n; n = n->next)
-      if (n->sym->mark)
+      if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark)
 	{
 	  gfc_error ("Symbol %qs present on multiple clauses at %L",
 		     n->sym->name, &n->where);
-	  n->sym->mark = 0;
+	  n->sym->data_mark = 0;
 	}
+      else if (n->sym->mark)
+	gfc_error ("Symbol %qs present on both data and map clauses "
+		   "at %L", n->sym->name, &n->where);
 
   for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
     {
-      if (n->sym->mark)
+      if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark)
 	gfc_error ("Symbol %qs present on multiple clauses at %L",
 		   n->sym->name, &n->where);
       else
-	n->sym->mark = 1;
+	n->sym->data_mark = 1;
     }
   for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
-    n->sym->mark = 0;
+    n->sym->data_mark = 0;
 
   for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
     {
-      if (n->sym->mark)
+      if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark)
 	gfc_error ("Symbol %qs present on multiple clauses at %L",
 		   n->sym->name, &n->where);
       else
-	n->sym->mark = 1;
+	n->sym->data_mark = 1;
     }
 
   for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr107214.f90 b/gcc/testsuite/gfortran.dg/gomp/pr107214.f90
new file mode 100644
index 00000000000..25949934e84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr107214.f90
@@ -0,0 +1,7 @@ 
+! { dg-do compile }
+
+program p
+   integer, allocatable :: a
+   !$omp target map(tofrom: a, a) ! { dg-error "Symbol 'a' present on multiple clauses" }
+   !$omp end target
+end