From 2cbf164c7fd0b84bf3ed361188b8cb014f25a900 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 30 Oct 2023 10:53:29 +0100
Subject: [PATCH] OpenMP/Fortran: Ensure allocator is gimplified for 'omp
 allocate'

Without this change, we we get an ICE in verify_gimple_call for
GOMP_allocate when doing a late replacement in omp-low.cc

gcc/fortran/ChangeLog:

       * trans-openmp.cc (gfc_trans_omp_clauses): Avoid gfc_evaluate_now
       for allocator with indirect ref for better diagnostic.

gcc/ChangeLog:

	* gcc/gimplify.cc (gimplify_omp_allocate): Gimplify allocator.
	* omp-low.cc (lower_omp_allocate): Simplify; GOMP_free can also
	take a plain 0 as allocator argument (arg is unused in libgomp).

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-8a.f90: New test.
---
 gcc/ChangeLog.omp                             |  6 +++
 gcc/fortran/ChangeLog.omp                     |  5 +++
 gcc/fortran/trans-openmp.cc                   |  5 +--
 gcc/gimplify.cc                               |  9 ++++
 gcc/omp-low.cc                                |  7 +--
 libgomp/ChangeLog.omp                         |  4 ++
 .../testsuite/libgomp.fortran/allocate-8a.f90 | 44 +++++++++++++++++++
 7 files changed, 73 insertions(+), 7 deletions(-)
 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-8a.f90

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 570f0b009fe..fd389860a97 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,9 @@
+2023-10-30  Tobias Burnus  <tobias@codesourcery.com>
+
+	* gcc/gimplify.cc (gimplify_omp_allocate): Gimplify allocator.
+	* omp-low.cc (lower_omp_allocate): Simplify; GOMP_free can also
+	take a plain 0 as allocator argument (arg is unused in libgomp).
+
 2023-10-27  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 2b81cada326..6b30302428f 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,8 @@
+2023-10-30  Tobias Burnus  <tobias@codesourcery.com>
+
+	* trans-openmp.cc (gfc_trans_omp_clauses): Avoid gfc_evaluate_now
+	for allocator with indirect ref for better diagnostic.
+
 2023-10-26  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 30e43cea56c..ab45032eda3 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4730,11 +4730,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      allocator_
 				= gfc_trans_omp_variable (n->u2.allocator->symtree->n.sym,
 							  false);
-			    if (POINTER_TYPE_P (TREE_TYPE (allocator_)))
-			      {
+			      if (POINTER_TYPE_P (TREE_TYPE (allocator_)))
 				allocator_ = build_fold_indirect_ref (allocator_);
-				allocator_ = gfc_evaluate_now (allocator_, block);
-			      }
 			    }
 			  else if (alloc_expr != n->u2.allocator)
 			    {
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 2b6e592213f..70fda6bbf0d 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -17876,6 +17876,15 @@ gimplify_omp_allocate (tree *expr_p, gimple_seq *pre_p)
     kind = GF_OMP_ALLOCATE_KIND_ALLOCATE;
   else
     kind = GF_OMP_ALLOCATE_KIND_FREE;
+  for (tree c = OMP_ALLOCATE_CLAUSES (expr); c; c = OMP_CLAUSE_CHAIN (c))
+    {
+      if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATE)
+	continue;
+
+      gimplify_expr (&OMP_CLAUSE_ALLOCATE_ALLOCATOR (c), pre_p, NULL,
+			 is_gimple_val, fb_rvalue);
+    }
+
   gimple *stmt = gimple_build_omp_allocate (OMP_ALLOCATE_CLAUSES (expr),
 					    kind);
   gimplify_seq_add_stmt (pre_p, stmt);
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 77142589f27..731271e5c96 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -9486,11 +9486,11 @@ lower_omp_allocate (gimple_stmt_iterator *gsi_p)
 	    continue;
 
 	  const gcall *gs = as_a <const gcall *> (stmt);
-	  tree allocator = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
-			   ? OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
-			   : build_zero_cst (ptr_type_node);
 	  if (allocate)
 	    {
+	      tree allocator = (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
+				? OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
+				: build_zero_cst (ptr_type_node));
 	      tree lhs = gimple_call_lhs (gs);
 	      if (lhs && TREE_CODE (lhs) == SSA_NAME)
 		{
@@ -9559,6 +9559,7 @@ lower_omp_allocate (gimple_stmt_iterator *gsi_p)
 	      if (arg == var)
 		{
 		  tree repl = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
+		  tree allocator = build_zero_cst (ptr_type_node);
 		  gimple *g = gimple_build_call (repl, 2,
 						 gimple_call_arg (gs, 0),
 						 allocator);
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index d23a4be94a0..4cb8749c152 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,7 @@
+2023-10-30  Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.fortran/allocate-8a.f90: New test.
+
 2023-10-26  Tobias Burnus  <tobias@codesourcery.com>
 
 	* libgomp.texi (OpenMP Impl. Status): Document that 'omp allocate'
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-8a.f90 b/libgomp/testsuite/libgomp.fortran/allocate-8a.f90
new file mode 100644
index 00000000000..28fe04fbd58
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-8a.f90
@@ -0,0 +1,44 @@
+! { dg-additional-options "-fdump-tree-omplower" }
+program main
+  use iso_c_binding
+  use omp_lib
+  implicit none (type, external)
+  integer(omp_allocator_handle_kind):: alloc_h
+  integer :: i, N
+  integer(c_intptr_t) :: intptr
+  integer, allocatable :: A(:)
+  type(omp_alloctrait):: traits(1) = [omp_alloctrait(omp_atk_alignment, 128)]
+
+  N = 10
+  alloc_h = omp_init_allocator(omp_default_mem_space, 1, traits)
+
+  !$omp allocate(A) allocator(alloc_h)
+  allocate(A(N))
+  a(:) = [(i, i=1,N)]
+  if (mod (transfer (loc(a), intptr),128) /= 0) &
+    stop 1
+  if (any (a /= [(i, i=1,N)])) &
+    stop 2
+  deallocate(A)
+  !$omp allocate(A) allocator(alloc_h) align(512)
+  allocate(A(N))
+  block
+    integer, allocatable :: B(:)
+    !$omp allocators allocate(allocator(alloc_h), align(256) : B)
+    allocate(B(N))
+    B(:) = [(2*i, i=1,N)]
+    A(:) = B
+    if (mod (transfer (loc(B), intptr), 256) /= 0) &
+      stop 1
+    ! end of scope deallocation
+  end block
+  if (mod (transfer (loc(a), intptr),512) /= 0) &
+    stop 1
+  if (any (a /= [(2*i, i=1,N)])) &
+    stop 2
+  deallocate(A) ! Must deallocate here - before deallocator is destroyed
+  call omp_destroy_allocator(alloc_h)
+  ! No auto dealloc of A because it is SAVE
+end
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 3 "omplower" } }
-- 
2.34.1

