[committed] openmp: Gimplify OMP_CLAUSE_SIZE during gfc_omp_finish_clause [PR100965]

2021-06-09 Thread Jakub Jelinek via Fortran
Hi!

As the testcase shows, we need to gimplify OMP_CLAUSE_SIZE, so that we
don't end up with SAVE_EXPR or anything similar non-gimple in it.

Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk.

2021-06-08  Jakub Jelinek  

PR fortran/100965
* trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE.

* gfortran.dg/gomp/pr100965.f90: New test.

--- gcc/fortran/trans-openmp.c.jj   2021-06-08 11:23:45.704331441 +0200
+++ gcc/fortran/trans-openmp.c  2021-06-08 16:28:09.433635685 +0200
@@ -1639,6 +1639,9 @@ gfc_omp_finish_clause (tree c, gimple_se
 OMP_CLAUSE_SIZE (c)
   = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
  : TYPE_SIZE_UNIT (TREE_TYPE (decl));
+  if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
+NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
+OMP_CLAUSE_SIZE (c) = size_int (0);
   if (c2)
 {
   OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
--- gcc/testsuite/gfortran.dg/gomp/pr100965.f90.jj  2021-06-08 
16:33:29.701355827 +0200
+++ gcc/testsuite/gfortran.dg/gomp/pr100965.f90 2021-06-08 16:33:07.876647478 
+0200
@@ -0,0 +1,16 @@
+! PR fortran/100965
+! { dg-do compile }
+
+implicit none
+  character(len=:), allocatable :: s
+  logical :: l
+  !$omp target map(from: l)
+l = allocated (s)
+  !$omp end target
+  if (l) stop 1
+
+  !$omp target map(from: l)
+l = allocated (s)
+  !$omp end target
+  if (l) stop 2
+end

Jakub



[PATCH][pushed] docs: add missing @headitem in Intrinsic Procedures

2021-06-09 Thread Martin Liška

Pushed as obvious.

Martin

gcc/fortran/ChangeLog:

* intrinsic.texi: Add missing @headitem to tables with a header.
---
 gcc/fortran/intrinsic.texi | 144 ++---
 1 file changed, 72 insertions(+), 72 deletions(-)

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 260dbaae76b..8a92b862070 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -462,7 +462,7 @@ end program test_abs
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument@tab Return type   @tab 
Standard
+@headitem Name@tab Argument@tab Return type   @tab 
Standard
 @item @code{ABS(A)}   @tab @code{REAL(4) A}@tab @code{REAL(4)}@tab 
Fortran 77 and later
 @item @code{CABS(A)}  @tab @code{COMPLEX(4) A} @tab @code{REAL(4)}@tab 
Fortran 77 and later
 @item @code{DABS(A)}  @tab @code{REAL(8) A}@tab @code{REAL(8)}@tab 
Fortran 77 and later
@@ -627,7 +627,7 @@ end program test_acos
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument @tab Return type @tab Standard
+@headitem Name@tab Argument @tab Return type @tab 
Standard
 @item @code{ACOS(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}  @tab Fortran 
77 and later
 @item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}  @tab Fortran 
77 and later
 @end multitable
@@ -686,7 +686,7 @@ end program test_acosd
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument @tab Return type @tab Standard
+@headitem Name@tab Argument @tab Return type @tab 
Standard
 @item @code{ACOSD(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}  @tab GNU 
extension
 @item @code{DACOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}  @tab GNU 
extension
 @end multitable
@@ -742,7 +742,7 @@ END PROGRAM
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name @tab Argument  @tab Return type   @tab 
Standard
+@headitem Name @tab Argument  @tab Return type   @tab 
Standard
 @item @code{DACOSH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}@tab GNU 
extension
 @end multitable
 
@@ -891,7 +891,7 @@ end program test_aimag
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name   @tab Argument@tab Return type @tab 
Standard
+@headitem Name   @tab Argument@tab Return type 
@tab Standard
 @item @code{AIMAG(Z)}@tab @code{COMPLEX Z}@tab @code{REAL} @tab 
Fortran 77 and later
 @item @code{DIMAG(Z)}@tab @code{COMPLEX(8) Z} @tab @code{REAL(8)}  @tab 
GNU extension
 @item @code{IMAG(Z)} @tab @code{COMPLEX Z}@tab @code{REAL} @tab 
GNU extension
@@ -951,7 +951,7 @@ end program test_aint
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name   @tab Argument @tab Return type  @tab Standard
+@headitem Name   @tab Argument @tab Return type  @tab 
Standard
 @item @code{AINT(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab Fortran 
77 and later
 @item @code{DINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 
77 and later
 @end multitable
@@ -1231,7 +1231,7 @@ end program test_anint
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument @tab Return type  @tab Standard
+@headitem Name@tab Argument @tab Return type  @tab 
Standard
 @item @code{ANINT(A)}  @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab 
Fortran 77 and later
 @item @code{DNINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 
77 and later
 @end multitable
@@ -1347,7 +1347,7 @@ end program test_asin
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument  @tab Return type   @tab 
Standard
+@headitem Name@tab Argument  @tab Return type   @tab 
Standard
 @item @code{ASIN(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}@tab 
Fortran 77 and later
 @item @code{DASIN(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}@tab 
Fortran 77 and later
 @end multitable
@@ -1406,7 +1406,7 @@ end program test_asind
 
 @item @emph{Specific names}:

 @multitable @columnfractions .20 .20 .20 .25
-@item Name@tab Argument  @tab Return type   @tab 
Standard
+@headitem Name@tab Argument  @tab Return type   @tab 
Standard
 @item @code{ASIND(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}@tab GNU 
extension
 @item @code{DASIND(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}@tab GNU 
extension
 @end multitable
@@ -1462,7 +1462,7 @@ END PROGRAM
 
 @item @emph{Specif

[Patch ]Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568]

2021-06-09 Thread Tobias Burnus

This patch add's OpenMP 5.1's  defaultmap extensions to Fortran.

There is one odd thing,
  integer :: ii, it
  target :: it
both count as nonallocatable, nonpointer scalars (i.e. category 'scalar').
But with implicit mapping (and 'defaultmap(default)'), 'it' is mapped
tofrom due to the TARGET attribute (cf. quote in the PR).

I also had fun with scalar vs. pointer, but solved it by adding an
additional argument, which solves the problems with different use.
(nonpointer/nonallocatable scalar vs. all scalars).

Tobias

PS: The run-time testcase (libgomp.fortran/defaultmap-8.f90) shows two
issues (cf. PR fortran/100991 + PR fortran/90742). Namely,
(a) optional scalars are not recognized as scalar (first PR),
(b) firstprivate does not handle absent scalars nor allocatables
(and all complex objects).

PPS:  There seem to be also issues with character handling, at least I get some
run-time errors with -fsanitize=address,undefined for the 'dg-do compile' tests,
which I have not debugged. (I think they are real issues and not test-case
issues, but I have not yet check this.)

PPPS: In principle, also OpenACC should use 'copy'/'map(tofrom:' instead of
'firstprivate' for allocatable/pointer scalars – but testing shows that
this patch does not affect OpenACC (at least not for my testcase).

-
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München 
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank 
Thürauf
Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568]

	PR fortran/92568

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Update for defaultmap.
	* f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P,
	LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	* gfortran.h (enum gfc_omp_defaultmap,
	enum gfc_omp_dfltmpap_category): New.
	* openmp.c (gfc_match_omp_clauses): Update defaultmap matching.
	* trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET.
	* trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument.
	(gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for
	defaultmap changes.
	* trans.h (gfc_omp_scalar_p): Update prototype.
	(gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(struct lang_decl): Add scalar_target.
	(GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New.

gcc/ChangeLog:

	* gimplify.c (enum gimplify_defaultmap_kind): Add GDMK_SCALAR_TARGET.
	(struct gimplify_omp_ctx): Extend defaultmap array by one.
	(new_omp_context): Init defaultmap[GDMK_SCALAR_TARGET].
	(omp_notice_variable): Update type classification for Fortran.
	(gimplify_scan_omp_clauses): Update calls for new argument; handle
	GDMK_SCALAR_TARGET; for Fortran, GDMK_POINTER avoid GOVD_MAP_0LEN_ARRAY.
	* langhooks-def.h (lhd_omp_scalar_p): Add 'ptr_ok' argument.
	* langhooks.c (lhd_omp_scalar_p): Likewise.
	(LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	(LANG_HOOKS_DECLS): Add them.
	* langhooks.h (struct lang_hooks_for_decls): Add new hooks, update
	omp_scalar_p pointer type to include the new bool argument.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/defaultmap-8.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/pr99928-1.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-2.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-3.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-4.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-5.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-6.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-8.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/defaultmap-1.f90: New test.
	* gfortran.dg/gomp/defaultmap-2.f90: New test.
	* gfortran.dg/gomp/defaultmap-3.f90: New test.
	* gfortran.dg/gomp/defaultmap-4.f90: New test.
	* gfortran.dg/gomp/defaultmap-5.f90: New test.
	* gfortran.dg/gomp/defaultmap-6.f90: New test.
	* gfortran.dg/gomp/defaultmap-7.f90: New test.

 gcc/fortran/dump-parse-tree.c  |  38 ++-
 gcc/fortran/f95-lang.c |   4 +
 gcc/fortran/gfortran.h |  26 +-
 gcc/fortran/openmp.c   |  83 +-
 gcc/fortran/trans-decl.c   |   5 +
 gcc/fortran/trans-openmp.c |  91 ++-
 gcc/fortran/trans.h|   9 +-
 gcc/gimplify.c |  35 ++-
 gcc/langhooks-def.h|   6 +-
 gcc/langhooks.c|   7 +-
 gcc/langhooks.h|  13 +-
 gcc/testsuite/gfortran.dg/gomp/defaultmap-1.f90|  19 ++
 gcc/testsuite/gfortran.dg/gomp/defaultmap-2.f90| 108 
 gcc/testsuite/gfortran.dg/gomp/defaultmap-3.f90|  60 +
 gcc/testsuite/gfortran.dg/gomp/defaultmap-4.f90| 141 +++
 gcc/testsuite/gfortran.dg/gomp/defaultmap-5.f90| 145 

[PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514

2021-06-09 Thread Harald Anlauf via Fortran
Dear Fortranners,

we should be able to simplify the length of a substring with known
constant bounds.  The attached patch adds this.

Regtested on x86_64-pc-linux-gnu.

OK for mainline?  Since this should be rather safe, to at least 11-branch?

Thanks,
Harald


Fortran - simplify length of substring with constant bounds

gcc/fortran/ChangeLog:

PR fortran/100950
* simplify.c (substring_has_constant_len): New.
(gfc_simplify_len): Handle case of substrings with constant
bounds.

gcc/testsuite/ChangeLog:

PR fortran/100950
* gfortran.dg/pr100950.f90: New test.

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..016ec259518 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,60 @@ gfc_simplify_leadz (gfc_expr *e)
 }


+/* Check for constant length of a substring.  */
+
+static bool
+substring_has_constant_len (gfc_expr *e)
+{
+  ptrdiff_t istart, iend;
+  size_t length;
+  bool equal_length = false;
+
+  if (e->ts.type != BT_CHARACTER
+  || !(e->ref && e->ref->type == REF_SUBSTRING)
+  || !e->ref->u.ss.start
+  || e->ref->u.ss.start->expr_type != EXPR_CONSTANT
+  || !e->ref->u.ss.end
+  || e->ref->u.ss.end->expr_type != EXPR_CONSTANT
+  || !e->ref->u.ss.length
+  || !e->ref->u.ss.length->length
+  || e->ref->u.ss.length->length->expr_type != EXPR_CONSTANT)
+return false;
+
+  /* Basic checks on substring starting and ending indices.  */
+  if (!gfc_resolve_substring (e->ref, &equal_length))
+return false;
+
+  istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer);
+  iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer);
+  length = gfc_mpz_get_hwi (e->ref->u.ss.length->length->value.integer);
+
+  if (istart <= iend)
+{
+  if (istart < 1)
+	{
+	  gfc_error ("Substring start index (%ld) at %L below 1",
+		 (long) istart, &e->ref->u.ss.start->where);
+	  return false;
+	}
+  if (iend > (ssize_t) length)
+	{
+	  gfc_error ("Substring end index (%ld) at %L exceeds string "
+		 "length", (long) iend, &e->ref->u.ss.end->where);
+	  return false;
+	}
+  length = iend - istart + 1;
+}
+  else
+length = 0;
+
+  /* Fix substring length.  */
+  e->value.character.length = length;
+
+  return true;
+}
+
+
 gfc_expr *
 gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
@@ -4547,6 +4601,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
of the unlimited polymorphic entity.  To get the _len component the last
_data ref needs to be stripped and a ref to the _len component added.  */
 return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
+  else if (substring_has_constant_len (e))
+{
+  result = gfc_get_constant_expr (BT_INTEGER, k, &e->where);
+  mpz_set_si (result->value.integer,
+		  e->value.character.length);
+  return range_check (result, "LEN");
+}
   else
 return NULL;
 }
diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90
new file mode 100644
index 000..f06db45b0b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514
+
+program p
+  character(8), parameter :: u = "123"
+  character(8):: x = "", s
+  character(2):: w(2) = [character(len(x(3:4))) :: 'a','b' ]
+  character(*), parameter :: y(*) = [character(len(u(3:4))) :: 'a','b' ]
+  character(*), parameter :: z(*) = [character(len(x(3:4))) :: 'a','b' ]
+  if (len (y) /= 2) stop 1
+  if (len (z) /= 2) stop 2
+  if (any (w /= y)) stop 3
+  if (len ([character(len(u(3:4))) :: 'a','b' ]) /= 2)  stop 4
+  if (len ([character(len(x(3:4))) :: 'a','b' ]) /= 2)  stop 5
+  if (any ([character(len(x(3:4))) :: 'a','b' ]  /= y)) stop 6
+  write(s,*) [character(len(x(3:4))) :: 'a','b' ]
+  if (s /= " a b") stop 7
+end