Re: [PATCH] Fortran: handle procedure pointer component in DT array [PR110826]

2024-03-12 Thread Paul Richard Thomas
Hi Harald,

This looks good to me. OK for mainline and, since it is so straightforward,
for backporting.

Thanks for the patch.

Paul


On Mon, 11 Mar 2024 at 21:20, Harald Anlauf  wrote:

> Dear all,
>
> the attached patch fixes an ICE-on-valid code when assigning
> a procedure pointer that is a component of a DT array and
> the function in question is array-valued.  (The procedure
> pointer itself cannot be an array.)
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


Re: [Patch] OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283]

2024-03-12 Thread Tobias Burnus

Jakub Jelinek wrote:


So firstprivate clause handling remaps them then if declare target indirect
is used? If so, the patch looks reasonable to me.


[I have now updated the patch to turn the testcase to ensure
that is also keeps works at runtime.]

OpenMP leaves it a bit open when the remapping has to happen,
but one can construct cases – in particular with unified-shared memory –
where it is not possible to do this upon entry to a target region.

Thus, it has to be done when the function is invoked, e.g.

i = (*g) ();

is turned (in the target region but only on the device side) into

i = (*GOMP_target_map_indirect_ptr (g)) ();

Thus, as long as the host pointer value is transferred to the device,
it works – as the lookup is done on the device side. Directly using a
device address (remap when mapping to the target) will also not shorten
the lookup, i.e. there is no need for it.

Does it still look reasonable to you?

Tobias

PS: The current OpenMP specification, it is listed mainly described via
the glossary (newest change is the addition of dummy procedure):

"indirect device invocation – An indirect call to the _device_ version of 
a _procedure_ on a _device_ other than the _host-device_, through a 
function pointer (C/C++), a pointer to a member function (C++), a dummy 
procedure (Fortran), or a procedure pointer (Fortran) that refers to the 
host version of the _procedure_."
OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283]

Dummy procedures look similar to variables but aren't - neither in Fortran
nor in OpenMP. As the middle end sees PARM_DECLs, mark them as predetermined
firstprivate for mapping (as already done in gfc_omp_predetermined_sharing).

This does not address the isses related to procedure pointers, which are
still discussed on spec level [see PR].

	PR fortran/114283

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_omp_predetermined_mapping): Map dummy
	procedures as firstprivate.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/declare-target-indirect-4.f90: New test.

 gcc/fortran/trans-openmp.cc|  9 +
 .../libgomp.fortran/declare-target-indirect-4.f90  | 43 ++
 2 files changed, 52 insertions(+)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a2bf15665b3..1dba47126ed 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -343,6 +343,15 @@ gfc_omp_predetermined_mapping (tree decl)
 	&& GFC_DECL_SAVED_DESCRIPTOR (decl)))
 return OMP_CLAUSE_DEFAULTMAP_TO;
 
+  /* Dummy procedures aren't considered variables by OpenMP, thus are
+ disallowed in OpenMP clauses.  They are represented as PARM_DECLs
+ in the middle-end, so return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE here
+ to avoid complaining about their uses with defaultmap(none).  */
+  if (TREE_CODE (decl) == PARM_DECL
+  && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+  && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
+
   /* These are either array or derived parameters, or vtables.  */
   if (VAR_P (decl) && TREE_READONLY (decl)
   && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90
new file mode 100644
index 000..43f4295494c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90
@@ -0,0 +1,43 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! PR fortran/114283
+
+! { dg-final { scan-tree-dump "#pragma omp parallel shared\\(i\\) if\\(0\\) default\\(none\\) firstprivate\\(g\\)" "gimple" } }
+! { dg-final { scan-tree-dump "#pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) firstprivate\\(h\\) map\\(from:j \\\[len: 4\\\]\\) defaultmap\\(none\\)" "gimple" } }
+
+
+module m
+  implicit none (type, external)
+  !$omp declare target indirect enter(f1, f2)
+contains
+  integer function f1 ()
+f1 = 99
+  end
+  integer function f2 ()
+f2 = 89
+  end
+end module m
+
+use m
+implicit none (type, external)
+call sub1(f1)
+call sub2(f2)
+contains
+  subroutine sub1(g)
+procedure(integer) :: g
+integer :: i
+!$omp parallel default(none) if(.false.) shared(i)
+  i = g ()
+!$omp end parallel
+if (i /= 99) stop 1
+  end
+
+  subroutine sub2(h)
+procedure(integer) :: h
+integer :: j
+!$omp target defaultmap(none) map(from:j)
+  j = h ()
+!$omp end target
+if (j /= 89) stop 1
+  end
+end


Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-12 Thread Paul Richard Thomas
Hi All,

This is the last posting of this patch before I push it. Harald is OK with
it on the grounds that the inferred_type flag guards the whole lot,
except for the chunks in trans-stmt.cc.

In spite of Harald's off-list admonition not to try to fix everything at
once, this version fixes most of the inquiry reference bugs
(associate_68.f90) with the exception of character(kind=4) function
selectors. The reason for this is that I have some housekeeping to do
before release on finalization and then I want to replace this patch in
15-branch with two pass parsing. My first attempts at the latter were a
partial success.

It regtests OK on x86_64. Unless there are objections, I will commit on
Thursday evening.

Cheers

Paul

Fortran: Fix class/derived/complex function associate selectors [PR87477]

2024-03-12  Paul Thomas  

gcc/fortran
PR fortran/87477
PR fortran/89645
PR fortran/99065
PR fortran/114141
PR fortran/114280
* class.cc (gfc_change_class): New function needed for
associate names, when rank changes or a derived type is
produced by resolution
* dump-parse-tree.cc (show_code_node): Make output for SELECT
TYPE more comprehensible.
* expr.cc (find_inquiry_ref): Do not simplify expressions of
an inferred type.
* gfortran.h : Add 'gfc_association_list' to structure
'gfc_association_list'. Add prototypes for
'gfc_find_derived_types', 'gfc_fixup_inferred_type_refs' and
'gfc_change_class'. Add macro IS_INFERRED_TYPE.
* match.cc (copy_ts_from_selector_to_associate): Add bolean arg
'select_type' with default false. If this is a select type name
and the selector is a inferred type, build the class type and
apply it to the associate name.
(build_associate_name): Pass true to 'select_type' in call to
previous.
* parse.cc (parse_associate): If the selector is inferred type
the associate name is too. Make sure that function selector
class and rank, if known, are passed to the associate name. If
a function result exists, pass its typespec to the associate
name.
* primary.cc (resolvable_fcns): New function to check that all
the function references are resolvable.
(gfc_match_varspec): If a scalar derived type select type
temporary has an array reference, match the array reference,
treating this in the same way as an equivalence member. Do not
set 'inquiry' if applied to an unknown type the inquiry name
is ambiguous with the component of an accessible derived type.
Check that resolution of the target expression is OK by testing
if the symbol is declared or is an operator expression, then
using 'resolvable_fcns' recursively. If all is well, resolve
the expression. If this is an inferred type with a component
reference, call 'gfc_find_derived_types' to find a suitable
derived type. If there is an inquiry ref and the symbol either
is of unknown type or is inferred to be a derived type, set the
primary and symbol TKR appropriately.
* resolve.cc (resolve_variable): Call new function below.
(gfc_fixup_inferred_type_refs): New function to ensure that the
expression references for a inferred type are consistent with
the now fixed up selector.
(resolve_assoc_var): Ensure that derived type or class function
selectors transmit the correct arrayspec to the associate name.
(resolve_select_type): If the selector is an associate name of
inferred type and has no component references, the associate
name should have its typespec. Simplify the conversion of a
class array to class scalar by calling 'gfc_change_class'.
Make sure that a class, inferred type selector with an array
ref transfers the typespec from the symbol to the expression.
* symbol.cc (gfc_set_default_type): If an associate name with
unknown type has a selector expression, try resolving the expr.
(find_derived_types, gfc_find_derived_types): New functions
that search for a derived type with a given name.
* trans-expr.cc (gfc_conv_variable): Some inferred type exprs
escape resolution so call 'gfc_fixup_inferred_type_refs'.
* trans-stmt.cc (trans_associate_var): Tidy up expression for
'class_target'. Finalize and free class function results.
Correctly handle selectors that are class functions and class
array references, passed as derived types.

gcc/testsuite/
PR fortran/87477
PR fortran/89645
PR fortran/99065
* gfortran.dg/associate_64.f90 : New test
* gfortran.dg/associate_66.f90 : New test
* gfortran.dg/associate_67.f90 : New test

PR fortran/114141
* gfortran.dg/associate_65.f90 : New test

PR fortran/114280
* gfortran.dg/associate_68.f90 : New test
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index ce31a93abcd..abe89630be3 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -815,6 +815,56 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 }
 
 
+/* Change class, using gfc_build_class_symbol. This is needed for associate
+   names, when rank changes or a derived type is produced by resolution.  */
+
+void
+gfc_change_class (gfc_typespec *ts, symbol_attribute *sym_attr,
+		  gfc_array_spec *sym_as, int rank, int corank)
+{
+  sy

Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-12 Thread Harald Anlauf

Hi Paul,

On 3/12/24 15:54, Paul Richard Thomas wrote:

Hi All,

This is the last posting of this patch before I push it. Harald is OK with
it on the grounds that the inferred_type flag guards the whole lot,
except for the chunks in trans-stmt.cc.

In spite of Harald's off-list admonition not to try to fix everything at
once, this version fixes most of the inquiry reference bugs
(associate_68.f90) with the exception of character(kind=4) function
selectors. The reason for this is that I have some housekeeping to do
before release on finalization and then I want to replace this patch in
15-branch with two pass parsing. My first attempts at the latter were a
partial success.


you wouldn't stop trying to fix everything, would you?  ;-)


It regtests OK on x86_64. Unless there are objections, I will commit on
Thursday evening.


No objections, just one wish: could you improve the text of the
following comments so that mere mortals understand them?

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 12e7bf3c873..0ab69bb9dce 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
[...]
+  /* If there is a usable inquiry reference not there are no matching
+derived types, force the inquiry reference by setting unknown the
+type of the primary expression.  */


I have a hard time parsing the first part of that sentence.

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 5d9852c79e0..16adb2a7efb 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
[...]
+/* Find all derived types in the uppermost namespace that have a component
+   a component called name and stash them in the assoc field of an
+   associate name variable.


"a component" too much?

Thanks,
Harald


Cheers

Paul




Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-12 Thread Paul Richard Thomas
Hi Harald,

Roger that about the comments. The major part of my recent efforts has been
to maximise comments - apparently not always successfully!

The main reason that I want to "fix everything" is that this is it; I will
not work on this approach anymore. The gfortran/g95 founder's approach was
very clever but has found it's limit with the associate construct. The sad
thing is that this is the only blocker that I know of.

Thanks

Paul


On Tue, 12 Mar 2024 at 21:07, Harald Anlauf  wrote:

> Hi Paul,
>
> On 3/12/24 15:54, Paul Richard Thomas wrote:
> > Hi All,
> >
> > This is the last posting of this patch before I push it. Harald is OK
> with
> > it on the grounds that the inferred_type flag guards the whole lot,
> > except for the chunks in trans-stmt.cc.
> >
> > In spite of Harald's off-list admonition not to try to fix everything at
> > once, this version fixes most of the inquiry reference bugs
> > (associate_68.f90) with the exception of character(kind=4) function
> > selectors. The reason for this is that I have some housekeeping to do
> > before release on finalization and then I want to replace this patch in
> > 15-branch with two pass parsing. My first attempts at the latter were a
> > partial success.
>
> you wouldn't stop trying to fix everything, would you?  ;-)
>
> > It regtests OK on x86_64. Unless there are objections, I will commit on
> > Thursday evening.
>
> No objections, just one wish: could you improve the text of the
> following comments so that mere mortals understand them?
>
> diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
> index 12e7bf3c873..0ab69bb9dce 100644
> --- a/gcc/fortran/primary.cc
> +++ b/gcc/fortran/primary.cc
> [...]
> +  /* If there is a usable inquiry reference not there are no matching
> +derived types, force the inquiry reference by setting unknown the
> +type of the primary expression.  */
>
>
> I have a hard time parsing the first part of that sentence.
>
> diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
> index 5d9852c79e0..16adb2a7efb 100644
> --- a/gcc/fortran/symbol.cc
> +++ b/gcc/fortran/symbol.cc
> [...]
> +/* Find all derived types in the uppermost namespace that have a component
> +   a component called name and stash them in the assoc field of an
> +   associate name variable.
>
>
> "a component" too much?
>
> Thanks,
> Harald
>
> > Cheers
> >
> > Paul
>
>


[PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001]

2024-03-12 Thread Harald Anlauf
Dear all,

here's another small fix: IS_CONTIGUOUS did erroneously always
return .true. for CLASS dummy arguments.  The solution was to
adjust the logic in gfc_is_simply_contiguous to also handle
CLASS symbols.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 8f535b19bd0cb6a7c99ac9ba4c07778f86698a1c Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 12 Mar 2024 22:58:39 +0100
Subject: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments
 [PR114001]

gcc/fortran/ChangeLog:

	PR fortran/114001
	* expr.cc (gfc_is_simply_contiguous): Adjust logic so that CLASS
	symbols are also handled.

gcc/testsuite/ChangeLog:

	PR fortran/114001
	* gfortran.dg/is_contiguous_4.f90: New test.
---
 gcc/fortran/expr.cc   | 19 ++---
 gcc/testsuite/gfortran.dg/is_contiguous_4.f90 | 81 +++
 2 files changed, 91 insertions(+), 9 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/is_contiguous_4.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 37ea95d0185..82a642b01f7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6025,15 +6025,16 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
 }

   sym = expr->symtree->n.sym;
-  if (expr->ts.type != BT_CLASS
-  && ((part_ref
-	   && !part_ref->u.c.component->attr.contiguous
-	   && part_ref->u.c.component->attr.pointer)
-	  || (!part_ref
-	  && !sym->attr.contiguous
-	  && (sym->attr.pointer
-		  || (sym->as && sym->as->type == AS_ASSUMED_RANK)
-		  || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
+  if ((part_ref
+   && part_ref->u.c.component
+   && !part_ref->u.c.component->attr.contiguous
+   && IS_POINTER (part_ref->u.c.component))
+  || (!part_ref
+	  && expr->ts.type != BT_CLASS
+	  && !sym->attr.contiguous
+	  && (sym->attr.pointer
+	  || (sym->as && sym->as->type == AS_ASSUMED_RANK)
+	  || (sym->as && sym->as->type == AS_ASSUMED_SHAPE
 return false;

   if (!ar || ar->type == AR_FULL)
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_4.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90
new file mode 100644
index 000..cb066f8836b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+! PR fortran/114001 - IS_CONTIGUOUS and polymorphic dummy
+
+program main
+  implicit none
+  integer :: i, cnt = 0
+  logical :: expect
+  integer, target  :: m(10) = [(i,i=1,size(m))]
+  integer, pointer :: p(:)
+  type t
+ integer :: j
+  end type t
+  type(t),  pointer :: tt(:), tp(:) ! Type pointer
+  class(t), pointer :: ct(:), cp(:) ! Class pointer
+
+  p => m(1:3)
+  expect = is_contiguous (p)
+  print *, "is_contiguous (p)=", expect
+  if (.not. expect) stop 91
+  call sub_star (p, expect)
+  p => m(1::3)
+  expect = is_contiguous (p)
+  print *, "is_contiguous (p)=", expect
+  if (expect) stop 92
+  call sub_star (p, expect)
+
+  allocate (tt(10))
+  tt(:)% j = m
+  tp => tt(4:6)
+  expect = is_contiguous (tp)
+  if (.not. expect) stop 96
+  print *, "is_contiguous (tp)=", expect
+  call sub_t (tp, expect)
+  tp => tt(4::3)
+  expect = is_contiguous (tp)
+  if (expect) stop 97
+  print *, "is_contiguous (tp)=", expect
+  call sub_t (tp, expect)
+
+  allocate (ct(10))
+  ct(:)% j = m
+  cp => ct(7:9)
+  expect = is_contiguous (cp)
+  print *, "is_contiguous (cp)=", expect
+  if (.not. expect) stop 98
+  call sub_t (cp, expect)
+  cp => ct(4::3)
+  expect = is_contiguous (cp)
+  print *, "is_contiguous (cp)=", expect
+  if (expect) stop 99
+  call sub_t (cp, expect)
+
+contains
+
+  subroutine sub_star (x, expect)
+class(*), intent(in) :: x(:)
+logical,  intent(in) :: expect
+cnt = cnt + 10
+if (is_contiguous (x) .neqv. expect) then
+   print *, "sub_star(1): is_contiguous (x)=", is_contiguous (x), expect
+   stop (cnt + 1)
+end if
+select type (x)
+type is (integer)
+   if (is_contiguous (x) .neqv. expect) then
+  print *, "sub_star(2): is_contiguous (x)=", is_contiguous (x), expect
+  stop (cnt + 2)
+   end if
+end select
+  end
+
+  subroutine sub_t (x, expect)
+class(t), intent(in) :: x(:)
+logical,  intent(in) :: expect
+cnt = cnt + 10
+if (is_contiguous (x) .neqv. expect) then
+   print *, "sub_t: is_contiguous (x)=", is_contiguous (x), expect
+   stop (cnt + 3)
+end if
+  end
+end
--
2.35.3