Hi Jakub, hi all,
updated patch included, i.e. avoiding 'count' for 'j' when a 'j.0' would
do (i.e. only local var without the different step calculation). I also
now reject if there is a non-unit step on the loop using an outer var.
Eventually still to be done: replace the 'sorry' by working code, i.e.
implement the suggestions to handle some/all non-unit iteration steps as
proposed in this thread.
On 20.01.23 18:39, Jakub Jelinek wrote:
I think instead of non-unity etc. it is better to talk about constant
step 1 or -1.
I concur.
The actual problem with non-simple loops for non-rectangular loops is
both in case it is an inner loop which uses some outer loop's iterator,
or if it is outer loop whose iterator is used, both of those cases
will not be handled properly.
I have now added a check for the other case as well.
Just to confirm, the following is fine, isn't it?
!$omp simd collapse(4)
do i = 1, 10, 2
do outer_var = 1, 10 ! step = + 1
do j = 1, 10, 2
do inner_var = 1, outer_var ! step = 1
i.e. both the inner_var and outer_var have 'step = 1',
even if other loops in the 'collapse' have step != 1.
I think it should be fine.
OK mainline?
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
OpenMP/Fortran: Partially fix non-rect loop nests [PR107424]
This patch ensures that loop bounds depending on outer loop vars use the
proper TREE_VEC format. It additionally gives a sorry if such an outer
var has a non-one/non-minus-one increment as currently a count variable
is used in this case (see PR).
Finally, it avoids 'count' and just uses a local loop variable if the
step increment is +/-1.
PR fortran/107424
gcc/fortran/ChangeLog:
* trans-openmp.cc (struct dovar_init_d): Add 'sym' and
'non_unit_incr' members.
(gfc_nonrect_loop_expr): New.
(gfc_trans_omp_do): Call it; use normal loop bounds
for unit stride - and only create local loop var.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/non-rectangular-loop-1.f90: New test.
* testsuite/libgomp.fortran/non-rectangular-loop-1a.f90: New test.
* testsuite/libgomp.fortran/non-rectangular-loop-2.f90: New test.
* testsuite/libgomp.fortran/non-rectangular-loop-3.f90: New test.
* testsuite/libgomp.fortran/non-rectangular-loop-4.f90: New test.
* testsuite/libgomp.fortran/non-rectangular-loop-5.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/goacc/privatization-1-compute-loop.f90: Update dg-note.
* gfortran.dg/goacc/privatization-1-routine_gang-loop.f90: Likewise.
gcc/fortran/trans-openmp.cc | 238 ++++++--
.../goacc/privatization-1-compute-loop.f90 | 6 +-
.../goacc/privatization-1-routine_gang-loop.f90 | 3 +-
.../libgomp.fortran/non-rectangular-loop-1.f90 | 637 +++++++++++++++++++++
.../libgomp.fortran/non-rectangular-loop-1a.f90 | 374 ++++++++++++
.../libgomp.fortran/non-rectangular-loop-2.f90 | 243 ++++++++
.../libgomp.fortran/non-rectangular-loop-3.f90 | 186 ++++++
.../libgomp.fortran/non-rectangular-loop-4.f90 | 188 ++++++
.../libgomp.fortran/non-rectangular-loop-5.f90 | 28 +
9 files changed, 1854 insertions(+), 49 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 87213de0918..ccee9e16648 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5116,10 +5116,135 @@ gfc_trans_omp_critical (gfc_code *code)
}
typedef struct dovar_init_d {
+ gfc_symbol *sym;
tree var;
tree init;
+ bool non_unit_iter;
} dovar_init;
+static bool
+gfc_nonrect_loop_expr (stmtblock_t *pblock, gfc_se *sep, int loop_n,
+ gfc_code *code, gfc_expr *expr, vec<dovar_init> *inits,
+ int simple, gfc_expr *curr_loop_var)
+{
+ int i;
+ for (i = 0; i < loop_n; i++)
+ {
+ gcc_assert (code->ext.iterator->var->expr_type == EXPR_VARIABLE);
+ if (gfc_find_sym_in_expr (code->ext.iterator->var->symtree->n.sym, expr))
+ break;
+ code = code->block->next;
+ }
+ if (i >= loop_n)
+ return false;
+
+ /* Canonic format: TREE_VEC with [var, multiplier, offset]. */
+ gfc_symbol *var = code->ext.iterator->var->symtree->n.sym;
+
+ tree tree_var = NULL_TREE;
+ tree a1 = integer_one_node;
+ tree a2 = integer_zero_node;
+
+ if (!simple)
+ {
+ /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424. */
+ sorry_at (gfc_get_location (&curr_loop_var->where),
+ "non-rectangular loop nest with step other than constant 1 "
+ "or -1 for %qs", curr_loop_var->symtree->n.sym->name);
+ return false;
+ }
+
+ dovar_init *di;
+ unsigned ix;
+ FOR_EACH_VEC_ELT (*inits, ix, di)
+ if (di->sym == var && !di->non_unit_iter)
+ {
+ tree_var = di->init;
+ gcc_assert (DECL_P (tree_var));
+ break;
+ }
+ else if (di->sym == var)
+ {
+ /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424. */
+ sorry_at (gfc_get_location (&code->loc),
+ "non-rectangular loop nest with step other than constant 1 "
+ "or -1 for %qs", var->name);
+ inform (gfc_get_location (&expr->where), "Used here");
+ return false;
+ }
+ if (tree_var == NULL_TREE)
+ tree_var = var->backend_decl;
+
+ if (expr->expr_type == EXPR_VARIABLE)
+ gcc_assert (expr->symtree->n.sym == var);
+ else if (expr->expr_type != EXPR_OP
+ || (expr->value.op.op != INTRINSIC_TIMES
+ && expr->value.op.op != INTRINSIC_PLUS
+ && expr->value.op.op != INTRINSIC_MINUS))
+ gcc_unreachable ();
+ else
+ {
+ gfc_se se;
+ gfc_expr *et = NULL, *eo = NULL, *e = expr;
+ if (expr->value.op.op != INTRINSIC_TIMES)
+ {
+ if (gfc_find_sym_in_expr (var, expr->value.op.op1))
+ {
+ e = expr->value.op.op1;
+ eo = expr->value.op.op2;
+ }
+ else
+ {
+ eo = expr->value.op.op1;
+ e = expr->value.op.op2;
+ }
+ }
+ if (e->value.op.op == INTRINSIC_TIMES)
+ {
+ if (e->value.op.op1->expr_type == EXPR_VARIABLE
+ && e->value.op.op1->symtree->n.sym == var)
+ et = e->value.op.op2;
+ else
+ {
+ et = e->value.op.op1;
+ gcc_assert (e->value.op.op2->expr_type == EXPR_VARIABLE
+ && e->value.op.op2->symtree->n.sym == var);
+ }
+ }
+ else
+ gcc_assert (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == var);
+ if (et != NULL)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_val (&se, et);
+ gfc_add_block_to_block (pblock, &se.pre);
+ a1 = se.expr;
+ }
+ if (eo != NULL)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_val (&se, eo);
+ gfc_add_block_to_block (pblock, &se.pre);
+ a2 = se.expr;
+ if (expr->value.op.op == INTRINSIC_MINUS && expr->value.op.op2 == eo)
+ /* outer-var - a2. */
+ a2 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a2), a2);
+ else if (expr->value.op.op == INTRINSIC_MINUS)
+ /* a2 - outer-var. */
+ a1 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a1), a1);
+ }
+ a1 = DECL_P (a1) ? a1 : gfc_evaluate_now (a1, pblock);
+ a2 = DECL_P (a2) ? a2 : gfc_evaluate_now (a2, pblock);
+ }
+
+ gfc_init_se (sep, NULL);
+ sep->expr = make_tree_vec (3);
+ TREE_VEC_ELT (sep->expr, 0) = tree_var;
+ TREE_VEC_ELT (sep->expr, 1) = fold_convert (TREE_TYPE (tree_var), a1);
+ TREE_VEC_ELT (sep->expr, 2) = fold_convert (TREE_TYPE (tree_var), a2);
+
+ return true;
+}
static tree
gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
@@ -5127,7 +5252,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
{
gfc_se se;
tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
- tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
+ tree local_dovar = NULL_TREE, cycle_label, tmp, omp_clauses;
stmtblock_t block;
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
@@ -5214,52 +5339,72 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
gfc_init_se (&se, NULL);
gfc_conv_expr_lhs (&se, code->ext.iterator->var);
gfc_add_block_to_block (pblock, &se.pre);
- dovar = se.expr;
+ local_dovar = dovar_decl = dovar = se.expr;
type = TREE_TYPE (dovar);
gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->start);
+ gfc_conv_expr_val (&se, code->ext.iterator->step);
gfc_add_block_to_block (pblock, &se.pre);
- from = gfc_evaluate_now (se.expr, pblock);
+ step = gfc_evaluate_now (se.expr, pblock);
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->end);
- gfc_add_block_to_block (pblock, &se.pre);
- to = gfc_evaluate_now (se.expr, pblock);
+ if (integer_onep (step))
+ simple = 1;
+ else if (tree_int_cst_equal (step, integer_minus_one_node))
+ simple = -1;
gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->step);
- gfc_add_block_to_block (pblock, &se.pre);
- step = gfc_evaluate_now (se.expr, pblock);
- dovar_decl = dovar;
+ if (!clauses->non_rectangular
+ || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
+ code->ext.iterator->start, &inits, simple,
+ code->ext.iterator->var))
+ {
+ gfc_conv_expr_val (&se, code->ext.iterator->start);
+ gfc_add_block_to_block (pblock, &se.pre);
+ if (!DECL_P (se.expr))
+ se.expr = gfc_evaluate_now (se.expr, pblock);
+ }
+ from = se.expr;
- /* Special case simple loops. */
- if (VAR_P (dovar))
+ gfc_init_se (&se, NULL);
+ if (!clauses->non_rectangular
+ || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
+ code->ext.iterator->end, &inits, simple,
+ code->ext.iterator->var))
{
- if (integer_onep (step))
- simple = 1;
- else if (tree_int_cst_equal (step, integer_minus_one_node))
- simple = -1;
+ gfc_conv_expr_val (&se, code->ext.iterator->end);
+ gfc_add_block_to_block (pblock, &se.pre);
+ if (!DECL_P (se.expr))
+ se.expr = gfc_evaluate_now (se.expr, pblock);
}
- else
+ to = se.expr;
+
+ if (!DECL_P (dovar))
dovar_decl
= gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
false);
-
+ if (simple && !DECL_P (dovar))
+ {
+ const char *name = code->ext.iterator->var->symtree->n.sym->name;
+ local_dovar = gfc_create_var (type, name);
+ dovar_init e = {code->ext.iterator->var->symtree->n.sym,
+ dovar, local_dovar, false};
+ inits.safe_push (e);
+ }
/* Loop body. */
if (simple)
{
- TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
+ TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar, from);
/* The condition should not be folded. */
TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
? LE_EXPR : GE_EXPR,
- logical_type_node, dovar, to);
+ logical_type_node, local_dovar,
+ to);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
- type, dovar, step);
+ type, local_dovar, step);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
MODIFY_EXPR,
- type, dovar,
+ type, local_dovar,
TREE_VEC_ELT (incr, i));
if (orig_decls && !clauses->orderedc)
orig_decls = NULL;
@@ -5280,24 +5425,27 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
step);
tmp = gfc_evaluate_now (tmp, pblock);
- count = gfc_create_var (type, "count");
- TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
+ local_dovar = gfc_create_var (type, "count");
+ TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar,
build_int_cst (type, 0));
/* The condition should not be folded. */
TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
logical_type_node,
- count, tmp);
+ local_dovar, tmp);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
- type, count,
+ type, local_dovar,
build_int_cst (type, 1));
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
- MODIFY_EXPR, type, count,
+ MODIFY_EXPR, type,
+ local_dovar,
TREE_VEC_ELT (incr, i));
/* Initialize DOVAR. */
- tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, type, local_dovar,
+ step);
tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
- dovar_init e = {dovar, tmp};
+ dovar_init e = {code->ext.iterator->var->symtree->n.sym,
+ dovar, tmp, true};
inits.safe_push (e);
if (clauses->orderedc)
{
@@ -5312,7 +5460,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
if (dovar_found == 3
&& op == EXEC_OMP_SIMD
&& collapse == 1
- && !simple)
+ && local_dovar != dovar)
{
for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
@@ -5331,11 +5479,11 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+ if (local_dovar != dovar)
+ dovar_found = 3;
}
- if (!simple)
- dovar_found = 3;
}
- else if (!dovar_found && !simple)
+ else if (!dovar_found && local_dovar != dovar)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = dovar_decl;
@@ -5346,7 +5494,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
tree c = NULL;
tmp = NULL;
- if (!simple)
+ if (local_dovar != dovar)
{
/* If dovar is lastprivate, but different counter is used,
dovar += step needs to be added to
@@ -5356,21 +5504,19 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
if (clauses->orderedc)
{
if (clauses->collapse <= 1 || i >= clauses->collapse)
- tmp = count;
+ tmp = local_dovar;
else
tmp = fold_build2_loc (input_location, PLUS_EXPR,
- type, count, build_one_cst (type));
+ type, local_dovar,
+ build_one_cst (type));
tmp = fold_build2_loc (input_location, MULT_EXPR, type,
tmp, step);
tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
from, tmp);
}
else
- {
- tmp = gfc_evaluate_now (step, pblock);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
- dovar, tmp);
- }
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
+ dovar, step);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
dovar, tmp);
for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
@@ -5405,9 +5551,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
break;
}
}
- gcc_assert (simple || c != NULL);
+ gcc_assert (local_dovar == dovar || c != NULL);
}
- if (!simple)
+ if (local_dovar != dovar)
{
if (op != EXEC_OMP_SIMD || dovar_found == 1)
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
@@ -5420,7 +5566,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
}
else
tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
- OMP_CLAUSE_DECL (tmp) = count;
+ OMP_CLAUSE_DECL (tmp) = local_dovar;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90 b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
index 13772c185ce..ad5e11abf91 100644
--- a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
@@ -47,8 +47,10 @@ contains
end do
end do
!$acc end parallel
- ! { dg-note {variable 'count\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_compute$c_compute }
- ! { dg-note {variable 'count\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 'i\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_compute$c_compute }
+ ! { dg-note {variable 'j\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_compute$c_compute }
+ ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 'j\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'a' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
diff --git a/gcc/testsuite/gfortran.dg/goacc/privatization-1-routine_gang-loop.f90 b/gcc/testsuite/gfortran.dg/goacc/privatization-1-routine_gang-loop.f90
index 6878d856919..c5c2f2b9845 100644
--- a/gcc/testsuite/gfortran.dg/goacc/privatization-1-routine_gang-loop.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/privatization-1-routine_gang-loop.f90
@@ -46,7 +46,8 @@ contains
y = a
end do
end do
- ! { dg-note {variable 'count\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 'j\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'a' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
new file mode 100644
index 00000000000..df74763d9d7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
@@ -0,0 +1,637 @@
+! { dg-do run }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+! PR fortran/107424
+
+! Nonrectangular loop nests checks
+
+! See PR or non-rectangular-loop-1a.f90 for the commented tests
+! Hint: Those use step for loop vars part of nonrectangular loop nests
+
+module m
+ implicit none (type, external)
+contains
+
+! The 'k' loop uses i or j as start value
+! but a constant end value such that 'lastprivate'
+! should be well-defined
+subroutine lastprivate_check_simd_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+! !$omp simd collapse(3) lastprivate(k)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+! !$omp simd collapse(3) lastprivate(k)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) then
+ print *, i, j, k,p, " -> i, j, k, p (k < 1 - 41 .or. k > p)"
+ error stop
+ end if
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+! !$omp simd collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+!
+! !$omp simd collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+! !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 1 .or. j /= m + 2) error stop
+
+! !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+end subroutine lastprivate_check_simd_1
+
+
+! Same but with do simd
+subroutine lastprivate_check_do_simd_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+! !$omp parallel do simd collapse(3) lastprivate(k)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+! !$omp parallel do simd collapse(3) lastprivate(k)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+! !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+! !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+! !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 1 .or. j /= m + 2) error stop
+
+! !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+end subroutine lastprivate_check_do_simd_1
+
+
+
+! Same but with do
+subroutine lastprivate_check_do_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+! !$omp parallel do collapse(3) lastprivate(k)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+! !$omp parallel do collapse(3) lastprivate(k)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+! !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+! !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+! !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n
+! do j = 1, m, 2
+! do k = j - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 1 .or. j /= m + 2) error stop
+
+! !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+! do i = 1, n, 2
+! do j = 1, m
+! do k = i - 41, p
+! if (k < 1 - 41 .or. k > p) error stop
+! end do
+! end do
+! end do
+! if (k /= p + 1) error stop
+! if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2
+ do j = 1, m
+ do k = j - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2
+ do k = i - 41, p
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+end subroutine lastprivate_check_do_1
+
+
+
+subroutine lastprivate_check_2
+ integer :: n,m,p, i,j,k,ll
+
+ n = 11
+ m = 23
+ p = 27
+
+! !$omp parallel do simd collapse(3) lastprivate(p)
+! do i = 1, n
+! do j = 1, m,2
+! do k = 1, j + 41
+! do ll = 1, p, 2
+! if (k > 23 + 41 .or. k < 1) error stop
+! end do
+! end do
+! end do
+! end do
+! if (ll /= 29) error stop
+
+! !$omp simd collapse(3) lastprivate(p)
+! do i = 1, n
+! do j = 1, m,2
+! do k = 1, j + 41
+! do ll = 1, p, 2
+! if (k > 23 + 41 .or. k < 1) error stop
+! end do
+! end do
+! end do
+! end do
+! if (ll /= 29) error stop
+
+! !$omp simd collapse(3) lastprivate(k)
+! do i = 1, n,2
+! do j = 1, m
+! do k = 1, i + 41
+! if (k > 11 + 41 .or. k < 1) error stop
+! end do
+! end do
+! end do
+!if (k /= 53) then
+! print *, k, 53
+! error stop
+!endif
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n,2
+ do j = 1, m
+ do k = 1, j + 41
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 65) then
+ print *, k, 65
+ error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n
+ do j = 1, m,2
+ do k = 1, i + 41
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+! - Same but without 'private':
+!!$omp simd collapse(3) lastprivate(k)
+!do i = 1, n
+! do j = 1, m,2
+! do k = 1, j + 41
+! if (k > 23 + 41 .or. k < 1) error stop
+! end do
+! end do
+!end do
+!if (k /= 65) then
+! print *, k, 65
+! error stop
+!endif
+
+
+!!$omp simd collapse(3) lastprivate(k)
+!do i = 1, n,2
+! do j = 1, m
+! do k = 1, i + 41
+! if (k > 11 + 41 .or. k < 1) error stop
+! end do
+! end do
+!end do
+!if (k /= 53) then
+! print *, k, 53
+! error stop
+!endif
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n,2
+ do j = 1, m
+ do k = 1, j + 41
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 65) then
+ print *, k, 65
+ error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n
+ do j = 1, m,2
+ do k = 1, i + 41
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+! - all with lastprivate
+!!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+!do i = 1, n
+! do j = 1, m,2
+! do k = 1, j + 41
+! if (k > 23 + 41 .or. k < 1) error stop
+! end do
+! end do
+!end do
+!if (k /= 65) then
+! print *, k, 65
+! error stop
+!endif
+
+
+!!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+!do i = 1, n,2
+! do j = 1, m
+! do k = 1, i + 41
+! if (k > 11 + 41 .or. k < 1) error stop
+! end do
+! end do
+!end do
+!if (k /= 53) then
+! print *, k, 53
+! error stop
+!endif
+
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n,2
+ do j = 1, m
+ do k = 1, j + 41
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 65) then
+ print *, k, 65
+ error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n
+ do j = 1, m,2
+ do k = 1, i + 41
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+end
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ call lastprivate_check_simd_1
+ call lastprivate_check_do_simd_1
+ call lastprivate_check_do_1
+ call lastprivate_check_2
+end
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90
new file mode 100644
index 00000000000..77aa887942e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90
@@ -0,0 +1,374 @@
+! { dg-do compile }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+! PR fortran/107424
+
+! Nonrectangular loop nests checks
+
+! ========================================================
+! NOTE: The testcases are from non-rectangular-loop-1.f90,
+! but commented there. Feel free to remove this
+! file + uncomment them in non-rectangular-loop-1.f90
+! Otherwise, you need to change it to 'dg-do run'!
+! ========================================================
+
+module m
+ implicit none (type, external)
+contains
+
+! The 'k' loop uses i or j as start value
+! but a constant end value such that 'lastprivate'
+! should be well-defined
+subroutine lastprivate_check_simd_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+ !$omp simd collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+ !$omp simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+ !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+
+ !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+end subroutine lastprivate_check_simd_1
+
+
+! Same but with do simd
+subroutine lastprivate_check_do_simd_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+ !$omp parallel do simd collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+ !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+ !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+
+ !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+end subroutine lastprivate_check_do_simd_1
+
+
+
+! Same but with do
+subroutine lastprivate_check_do_1
+ integer :: n,m,p, i,j,k
+
+ n = 11
+ m = 23
+ p = 27
+
+ ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+ ! Then same, except use non-unit step for 'k'
+
+ !$omp parallel do collapse(3) lastprivate(k)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same but 'private' for all (i,j) vars
+
+ !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+
+ ! Same - but with lastprivate(i,j)
+
+ !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n
+ do j = 1, m, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = j - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 1 .or. j /= m + 2) error stop
+
+ !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+ do i = 1, n, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = i - 41, p ! { dg-note "Used here" }
+ if (k < 1 - 41 .or. k > p) error stop
+ end do
+ end do
+ end do
+ if (k /= p + 1) error stop
+ if (i /= n + 2 .or. j /= m + 1) error stop
+
+end subroutine lastprivate_check_do_1
+
+
+
+subroutine lastprivate_check_2
+ integer :: n,m,p, i,j,k,ll
+
+ n = 11
+ m = 23
+ p = 27
+
+ !$omp parallel do simd collapse(3) lastprivate(p)
+ do i = 1, n
+ do j = 1, m,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = 1, j + 41 ! { dg-note "Used here" }
+ do ll = 1, p, 2
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+ end do
+ end do
+ if (ll /= 29) error stop
+
+ !$omp simd collapse(3) lastprivate(p)
+ do i = 1, n
+ do j = 1, m,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = 1, j + 41 ! { dg-note "Used here" }
+ do ll = 1, p, 2
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+ end do
+ end do
+ if (ll /= 29) error stop
+
+ !$omp simd collapse(3) lastprivate(k)
+ do i = 1, n,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = 1, i + 41 ! { dg-note "Used here" }
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+ end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+! - Same but without 'private':
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n
+ do j = 1, m,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = 1, j + 41 ! { dg-note "Used here" }
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 65) then
+ print *, k, 65
+ error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = 1, i + 41 ! { dg-note "Used here" }
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+! - all with lastprivate
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n
+ do j = 1, m,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ do k = 1, j + 41 ! { dg-note "Used here" }
+ if (k > 23 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 65) then
+ print *, k, 65
+ error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n,2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
+ do j = 1, m
+ do k = 1, i + 41 ! { dg-note "Used here" }
+ if (k > 11 + 41 .or. k < 1) error stop
+ end do
+ end do
+end do
+if (k /= 53) then
+ print *, k, 53
+ error stop
+endif
+
+end
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ call lastprivate_check_simd_1
+ call lastprivate_check_do_simd_1
+ call lastprivate_check_do_1
+ call lastprivate_check_2
+end
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-2.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-2.f90
new file mode 100644
index 00000000000..0cea61e5f0d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-2.f90
@@ -0,0 +1,243 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original -fcheck=all" }
+
+! PR fortran/107424
+
+! Nonrectangular loop nests checks
+
+! Valid patterns are:
+! (1) a2 - var-outer
+! (2) a1 * var-outer
+! (3) a1 * var-outer + a2
+! (4) a2 + a1 * var-outer
+! (5) a1 * var-outer - a2
+! (6) a2 - a1 * var-outer
+! (7) var-outer * a1
+! (8) var-outer * a1 + a2
+! (9) a2 + var-outer * a1
+! (10) var-outer * a1 - a2
+! (11) a2 - var-outer * a1
+
+module m
+contains
+
+
+! { dg-final { scan-tree-dump-times "for \\(one_two_inner = one_two_outer \\* -1 \\+ one_a2; one_two_inner <= one_two_outer \\* two_a1 \\+ 0; one_two_inner = one_two_inner \\+ 1\\)" 1 original } }
+
+! (1) a2 - var-outer
+! (2) a1 * var-outer
+subroutine one_two()
+ implicit none
+ integer :: one_a2
+ integer :: two_a1
+ integer :: one_two_outer, one_two_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ one_a2 = 13
+ two_a1 = 5
+ allocate(var(1:10, one_a2 - 10:two_a1 * 10), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do one_two_outer = 1, 10
+ do one_two_inner = one_a2 - one_two_outer, two_a1 * one_two_outer
+ !$omp atomic update
+ var(one_two_outer,one_two_inner) = var(one_two_outer,one_two_inner) + 2
+ end do
+ end do
+
+ do i = 1, 10
+ do j = one_a2 - i, two_a1 * i
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+
+
+! { dg-final { scan-tree-dump-times "for \\(three_four_inner = three_four_outer \\* three_a1 \\+ three_a2; three_four_inner <= three_four_outer \\* four_a1 \\+ four_a2; three_four_inner = three_four_inner \\+ 1\\)" 1 original } }
+
+! (3) a1 * var-outer + a2
+! (4) a2 + a1 * var-outer
+subroutine three_four()
+ implicit none
+ integer :: three_a1, three_a2
+ integer :: four_a1, four_a2
+ integer :: three_four_outer, three_four_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ three_a1 = 2
+ three_a2 = 3
+ four_a1 = 3
+ four_a2 = 5
+ allocate(var(1:10, three_a1 * 1 + three_a2:four_a2 + four_a1 * 10), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do three_four_outer = 1, 10
+ do three_four_inner = three_a1 * three_four_outer + three_a2, four_a2 + four_a1 * three_four_outer
+ !$omp atomic update
+ var(three_four_outer, three_four_inner) = var(three_four_outer, three_four_inner) + 2
+ end do
+ end do
+ do i = 1, 10
+ do j = three_a1 * i + three_a2, four_a2 + four_a1 * i
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+
+
+! { dg-final { scan-tree-dump-times "for \\(five_six_inner = five_six_outer \\* five_a1 \\+ D\\.\[0-9\]+; five_six_inner <= five_six_outer \\* D\\.\[0-9\]+ \\+ six_a2; five_six_inner = five_six_inner \\+ 1\\)" 1 original } }
+
+! (5) a1 * var-outer - a2
+! (6) a2 - a1 * var-outer
+subroutine five_six()
+ implicit none
+ integer :: five_a1, five_a2
+ integer :: six_a1, six_a2
+ integer :: five_six_outer, five_six_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ five_a1 = 2
+ five_a2 = -3
+ six_a1 = 3
+ six_a2 = 20
+ allocate(var(1:10, five_a1 * 1 - five_a2:six_a2 - six_a1 * 1), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do five_six_outer = 1, 10
+ do five_six_inner = five_a1 * five_six_outer - five_a2, six_a2 - six_a1 * five_six_outer
+ !$omp atomic update
+ var(five_six_outer, five_six_inner) = var(five_six_outer, five_six_inner) + 2
+ end do
+ end do
+
+ do i = 1, 10
+ do j = five_a1 * i - five_a2, six_a2 - six_a1 * i
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+
+
+! { dg-final { scan-tree-dump-times "for \\(seven_eight_inner = seven_eight_outer \\* seven_a1 \\+ 0; seven_eight_inner <= seven_eight_outer \\* eight_a1 \\+ eight_a2; seven_eight_inner = seven_eight_inner \\+ 1\\)" 1 original } }
+
+! (7) var-outer * a1
+! (8) var-outer * a1 + a2
+subroutine seven_eight()
+ implicit none
+ integer :: seven_a1
+ integer :: eight_a1, eight_a2
+ integer :: seven_eight_outer, seven_eight_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ seven_a1 = 3
+ eight_a1 = 2
+ eight_a2 = -4
+ allocate(var(1:10, 1 * seven_a1 : 10 * eight_a1 + eight_a2), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do seven_eight_outer = 1, 10
+ do seven_eight_inner = seven_eight_outer * seven_a1, seven_eight_outer * eight_a1 + eight_a2
+ !$omp atomic update
+ var(seven_eight_outer, seven_eight_inner) = var(seven_eight_outer, seven_eight_inner) + 2
+ end do
+ end do
+
+ do i = 1, 10
+ do j = i * seven_a1, i * eight_a1 + eight_a2
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+
+
+! { dg-final { scan-tree-dump-times "for \\(nine_ten_inner = nine_ten_outer \\* nine_a1 \\+ nine_a2; nine_ten_inner <= nine_ten_outer \\* ten_a1 \\+ D\\.\[0-9\]+; nine_ten_inner = nine_ten_inner \\+ 1\\)" 1 original } }
+
+! (9) a2 + var-outer * a1
+! (10) var-outer * a1 - a2
+subroutine nine_ten()
+ implicit none
+ integer :: nine_a1, nine_a2
+ integer :: ten_a1, ten_a2
+ integer :: nine_ten_outer, nine_ten_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ nine_a1 = 3
+ nine_a2 = 5
+ ten_a1 = 2
+ ten_a2 = 3
+ allocate(var(1:10, nine_a2 + 1 * nine_a1:10 * ten_a1 - ten_a2), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do nine_ten_outer = 1, 10
+ do nine_ten_inner = nine_a2 + nine_ten_outer * nine_a1, nine_ten_outer * ten_a1 - ten_a2
+ !$omp atomic update
+ var(nine_ten_outer, nine_ten_inner) = var(nine_ten_outer, nine_ten_inner) + 2
+ end do
+ end do
+
+ do i = 1, 10
+ do j = nine_a2 + i * nine_a1, i * ten_a1 - ten_a2
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+
+
+! { dg-final { scan-tree-dump-times "for \\(eleven_inner = eleven_outer \\* D\\.\[0-9\]+ \\+ eleven_a2; eleven_inner <= 10; eleven_inner = eleven_inner \\+ 1\\)" 1 original } }
+
+! (11) a2 - var-outer * a1
+
+subroutine eleven()
+ implicit none
+ integer :: eleven_a1, eleven_a2
+ integer :: eleven_outer, eleven_inner
+ integer :: i, j
+ integer, allocatable :: var(:,:)
+
+ eleven_a1 = 2
+ eleven_a2 = 3
+ allocate(var(1:10, eleven_a2 - 10 * eleven_a1 : 10), &
+ source=0)
+ if (size(var) <= 4) error stop
+
+ !$omp simd collapse(2)
+ do eleven_outer = 1, 10
+ do eleven_inner = eleven_a2 - eleven_outer * eleven_a1, 10
+ !$omp atomic update
+ var(eleven_outer, eleven_inner) = var(eleven_outer, eleven_inner) + 2
+ end do
+ end do
+
+ do i = 1, 10
+ do j = eleven_a2 - i * eleven_a1, 10
+ if (var(i,j) /= 2) error stop
+ end do
+ end do
+end
+end module m
+
+program main
+use m
+implicit none
+call one_two()
+call three_four()
+call five_six()
+call seven_eight()
+call nine_ten()
+call eleven()
+end
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-3.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-3.f90
new file mode 100644
index 00000000000..133d48432d8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-3.f90
@@ -0,0 +1,186 @@
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/107424
+
+module m
+contains
+subroutine foo (av, avo, a0, a0o, a1, a2, a3, a4)
+implicit none
+
+integer, value :: av
+integer, value, optional :: avo
+integer :: a0
+integer, optional :: a0o
+integer, pointer :: a1
+integer, pointer, optional :: a2
+integer, allocatable :: a3
+integer, allocatable, optional :: a4
+integer :: a5
+integer, pointer :: a6
+integer, allocatable :: a7
+integer :: arr(20,10), ref(20,10)
+
+integer :: j, i
+
+allocate(a6, a7)
+
+ref = 44
+do i = 1, 10
+ do j = i, 20
+ ref(j, i) = j + 100 * i
+ end do
+end do
+
+! { dg-final { scan-tree-dump-times "for \\(av = 1; av <= 10; av = av \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = av \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do av = 1, 10
+ do j = av, 20
+ arr(j, av) = j + 100 * av
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(avo = 1; avo <= 10; avo = avo \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = avo \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do avo = 1, 10
+ do j = avo, 20
+ arr(j, avo) = j + 100 * avo
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a0\\.\[0-9\]+ = 1; a0\\.\[0-9\]+ <= 10; a0\\.\[0-9\]+ = a0\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a0\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a0 = a0\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a0 = 1, 10
+ do j = a0, 20
+ arr(j, a0) = j + 100 * a0
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a0o\\.\[0-9\]+ = 1; a0o\\.\[0-9\]+ <= 10; a0o\\.\[0-9\]+ = a0o\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a0o\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a0o = a0o\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a0o = 1, 10
+ do j = a0o, 20
+ arr(j, a0o) = j + 100 * a0o
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a1\\.\[0-9\]+ = 1; a1\\.\[0-9\]+ <= 10; a1\\.\[0-9\]+ = a1\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a1\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a1 = a1\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a1 = 1, 10
+ do j = a1, 20
+ arr(j, a1) = j + 100 * a1
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a2\\.\[0-9\]+ = 1; a2\\.\[0-9\]+ <= 10; a2\\.\[0-9\]+ = a2\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a2\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a2 = a2\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a2 = 1, 10
+ do j = a2, 20
+ arr(j, a2) = j + 100 * a2
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a3\\.\[0-9\]+ = 1; a3\\.\[0-9\]+ <= 10; a3\\.\[0-9\]+ = a3\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a3\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a3 = a3\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a3 = 1, 10
+ do j = a3, 20
+ arr(j, a3) = j + 100 * a3
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a4\\.\[0-9\]+ = 1; a4\\.\[0-9\]+ <= 10; a4\\.\[0-9\]+ = a4\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a4\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a4 = a4\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a4 = 1, 10
+ do j = a4, 20
+ arr(j, a4) = j + 100 * a4
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a5 = 1; a5 <= 10; a5 = a5 \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a5 \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do a5 = 1, 10
+ do j = a5, 20
+ arr(j, a5) = j + 100 * a5
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a6\\.\[0-9\]+ = 1; a6\\.\[0-9\]+ <= 10; a6\\.\[0-9\]+ = a6\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a6\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a6 = a6\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a6 = 1, 10
+ do j = a6, 20
+ arr(j, a6) = j + 100 * a6
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a7\\.\[0-9\]+ = 1; a7\\.\[0-9\]+ <= 10; a7\\.\[0-9\]+ = a7\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = a7\\.\[0-9\]+ \\* 1 \\+ 0; j <= 20; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a7 = a7\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a7 = 1, 10
+ do j = a7, 20
+ arr(j, a7) = j + 100 * a7
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+deallocate(a6, a7)
+end
+
+end module m
+
+
+use m
+implicit none
+
+integer :: av
+integer :: avo
+integer :: a0
+integer :: a0o
+integer, pointer :: a1
+integer, pointer :: a2
+integer, allocatable :: a3
+integer, allocatable :: a4
+
+allocate(a1,a2,a3,a4)
+call foo (av, avo, a0, a0o, a1, a2, a3, a4)
+deallocate(a1,a2,a3,a4)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-4.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-4.f90
new file mode 100644
index 00000000000..7e265725170
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-4.f90
@@ -0,0 +1,188 @@
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/107424
+
+! Same as non-rectangular-loop-4.f90 but expr in upper bound
+
+module m
+contains
+subroutine foo (av, avo, a0, a0o, a1, a2, a3, a4)
+implicit none
+
+integer, value :: av
+integer, value, optional :: avo
+integer :: a0
+integer, optional :: a0o
+integer, pointer :: a1
+integer, pointer, optional :: a2
+integer, allocatable :: a3
+integer, allocatable, optional :: a4
+integer :: a5
+integer, pointer :: a6
+integer, allocatable :: a7
+integer :: arr(20,10), ref(20,10)
+
+integer :: j, i
+
+allocate(a6, a7)
+
+ref = 44
+do i = 1, 10
+ do j = 1, i*2-1
+ ref(j, i) = j + 100 * i
+ end do
+end do
+
+! { dg-final { scan-tree-dump-times "for \\(av = 1; av <= 10; av = av \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= av \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do av = 1, 10
+ do j = 1, av*2-1
+ arr(j, av) = j + 100 * av
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(avo = 1; avo <= 10; avo = avo \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= avo \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do avo = 1, 10
+ do j = 1, avo*2-1
+ arr(j, avo) = j + 100 * avo
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a0\\.\[0-9\]+ = 1; a0\\.\[0-9\]+ <= 10; a0\\.\[0-9\]+ = a0\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a0\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a0 = a0\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a0 = 1, 10
+ do j = 1, a0*2-1
+ arr(j, a0) = j + 100 * a0
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a0o\\.\[0-9\]+ = 1; a0o\\.\[0-9\]+ <= 10; a0o\\.\[0-9\]+ = a0o\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a0o\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a0o = a0o\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a0o = 1, 10
+ do j = 1, a0o*2-1
+ arr(j, a0o) = j + 100 * a0o
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a1\\.\[0-9\]+ = 1; a1\\.\[0-9\]+ <= 10; a1\\.\[0-9\]+ = a1\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a1\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a1 = a1\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a1 = 1, 10
+ do j = 1, a1*2-1
+ arr(j, a1) = j + 100 * a1
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a2\\.\[0-9\]+ = 1; a2\\.\[0-9\]+ <= 10; a2\\.\[0-9\]+ = a2\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a2\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a2 = a2\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a2 = 1, 10
+ do j = 1, a2*2-1
+ arr(j, a2) = j + 100 * a2
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a3\\.\[0-9\]+ = 1; a3\\.\[0-9\]+ <= 10; a3\\.\[0-9\]+ = a3\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a3\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a3 = a3\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a3 = 1, 10
+ do j = 1, a3*2-1
+ arr(j, a3) = j + 100 * a3
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a4\\.\[0-9\]+ = 1; a4\\.\[0-9\]+ <= 10; a4\\.\[0-9\]+ = a4\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a4\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*\\*a4 = a4\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a4 = 1, 10
+ do j = 1, a4*2-1
+ arr(j, a4) = j + 100 * a4
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a5 = 1; a5 <= 10; a5 = a5 \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a5 \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! -> no temp var
+arr = 44
+!$omp simd collapse(2)
+do a5 = 1, 10
+ do j = 1, a5*2-1
+ arr(j, a5) = j + 100 * a5
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a6\\.\[0-9\]+ = 1; a6\\.\[0-9\]+ <= 10; a6\\.\[0-9\]+ = a6\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a6\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a6 = a6\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a6 = 1, 10
+ do j = 1, a6*2-1
+ arr(j, a6) = j + 100 * a6
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+! { dg-final { scan-tree-dump-times "for \\(a7\\.\[0-9\]+ = 1; a7\\.\[0-9\]+ <= 10; a7\\.\[0-9\]+ = a7\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a7\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*a7 = a7\\.\[0-9\]+;" 1 "original" } }
+arr = 44
+!$omp simd collapse(2)
+do a7 = 1, 10
+ do j = 1, a7*2-1
+ arr(j, a7) = j + 100 * a7
+ end do
+end do
+if (any (ref /= arr)) error stop
+
+deallocate(a6, a7)
+end
+
+end module m
+
+
+use m
+implicit none
+
+integer :: av
+integer :: avo
+integer :: a0
+integer :: a0o
+integer, pointer :: a1
+integer, pointer :: a2
+integer, allocatable :: a3
+integer, allocatable :: a4
+
+allocate(a1,a2,a3,a4)
+call foo (av, avo, a0, a0o, a1, a2, a3, a4)
+deallocate(a1,a2,a3,a4)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
new file mode 100644
index 00000000000..643ab796a84
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+! PR fortran/107424
+
+! Nonrectangular loop nests checks
+
+!$omp simd collapse(2)
+do i = 1, 10
+ do j = i, 10, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ end do
+end do
+
+!$omp do collapse(2) lastprivate(j) ! { dg-error "lastprivate variable 'j' is private in outer context" }
+do i = 1, 10
+ do j = i, 10, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ end do
+end do
+if (i /= 11) stop 1
+
+!$omp simd collapse(2) lastprivate(j)
+do i = 1, 10
+ do j = i, 10, 2 ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+ end do
+end do
+if (i /= 11) stop 1
+end
