Hi!

I've committed following patch to allow linear clause to be used
on (integer) arrays (including allocatable) and scalar integer allocatables.
For simplicity we force safelen(1) for these (I don't think such loops would
be ever vectorizable anyway), so the only problem is with for simd or
distribute simd where we need to initialize it at the start of simd region
accordingly.

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

This is the last patch in the Fortran OpenMP 4.0 series where I'm not
waiting on omp-lang feedback, so I'd like to backport all the stuff to 4.9.1
next week.

2014-06-25  Jakub Jelinek  <ja...@redhat.com>

        * langhooks-def.h (LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR): Define.
        (LANG_HOOKS_DECLS): Add it.
        * gimplify.c (gimplify_omp_for): Make sure OMP_CLAUSE_LINEAR_STEP
        has correct type.
        * tree.h (OMP_CLAUSE_LINEAR_ARRAY): Define.
        * langhooks.h (struct lang_hooks_for_decls): Add
        omp_clause_linear_ctor hook.
        * omp-low.c (lower_rec_input_clauses): Set max_vf even if
        OMP_CLAUSE_LINEAR_ARRAY is set.  Don't fold_convert
        OMP_CLAUSE_LINEAR_STEP.  For OMP_CLAUSE_LINEAR_ARRAY in
        combined simd loop use omp_clause_linear_ctor hook.
gcc/c/
        * c-typeck.c (c_finish_omp_clauses): Make sure
        OMP_CLAUSE_LINEAR_STEP has correct type.
gcc/cp/
        * semantics.c (finish_omp_clauses): Make sure
        OMP_CLAUSE_LINEAR_STEP has correct type.
gcc/fortran/
        * trans.h (gfc_omp_clause_linear_ctor): New prototype.
        * trans-openmp.c (gfc_omp_linear_clause_add_loop,
        gfc_omp_clause_linear_ctor): New functions.
        (gfc_trans_omp_clauses): Make sure OMP_CLAUSE_LINEAR_STEP has
        correct type.  Set OMP_CLAUSE_LINEAR_ARRAY flag if needed.
        * f95-lang.c (LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR): Redefine.
libgomp/
        * testsuite/libgomp.fortran/simd5.f90: New test.
        * testsuite/libgomp.fortran/simd6.f90: New test.
        * testsuite/libgomp.fortran/simd7.f90: New test.

--- gcc/langhooks-def.h.jj      2014-06-18 09:11:57.000000000 +0200
+++ gcc/langhooks-def.h 2014-06-24 13:06:10.636044546 +0200
@@ -215,6 +215,7 @@ extern tree lhd_make_node (enum tree_cod
 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR hook_tree_tree_tree_tree_null
 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR lhd_omp_assignment
 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP lhd_omp_assignment
+#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR NULL
 #define LANG_HOOKS_OMP_CLAUSE_DTOR hook_tree_tree_tree_null
 #define LANG_HOOKS_OMP_FINISH_CLAUSE lhd_omp_finish_clause
 
@@ -238,6 +239,7 @@ extern tree lhd_make_node (enum tree_cod
   LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR, \
   LANG_HOOKS_OMP_CLAUSE_COPY_CTOR, \
   LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP, \
+  LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR, \
   LANG_HOOKS_OMP_CLAUSE_DTOR, \
   LANG_HOOKS_OMP_FINISH_CLAUSE \
 }
--- gcc/gimplify.c.jj   2014-06-24 09:51:25.981447585 +0200
+++ gcc/gimplify.c      2014-06-24 10:14:05.961841816 +0200
@@ -6913,8 +6913,8 @@ gimplify_omp_for (tree *expr_p, gimple_s
        case POSTINCREMENT_EXPR:
          {
            tree decl = TREE_OPERAND (t, 0);
-           // c_omp_for_incr_canonicalize_ptr() should have been
-           // called to massage things appropriately.
+           /* c_omp_for_incr_canonicalize_ptr() should have been
+              called to massage things appropriately.  */
            gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
 
            if (orig_for_stmt != for_stmt)
@@ -6930,6 +6930,9 @@ gimplify_omp_for (tree *expr_p, gimple_s
 
        case PREDECREMENT_EXPR:
        case POSTDECREMENT_EXPR:
+         /* c_omp_for_incr_canonicalize_ptr() should have been
+            called to massage things appropriately.  */
+         gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
          if (orig_for_stmt != for_stmt)
            break;
          t = build_int_cst (TREE_TYPE (decl), -1);
@@ -6970,12 +6973,16 @@ gimplify_omp_for (tree *expr_p, gimple_s
          ret = MIN (ret, tret);
          if (c)
            {
-             OMP_CLAUSE_LINEAR_STEP (c) = TREE_OPERAND (t, 1);
+             tree step = TREE_OPERAND (t, 1);
+             tree stept = TREE_TYPE (decl);
+             if (POINTER_TYPE_P (stept))
+               stept = sizetype;
+             step = fold_convert (stept, step);
              if (TREE_CODE (t) == MINUS_EXPR)
+               step = fold_build1 (NEGATE_EXPR, stept, step);
+             OMP_CLAUSE_LINEAR_STEP (c) = step;
+             if (step != TREE_OPERAND (t, 1))
                {
-                 t = TREE_OPERAND (t, 1);
-                 OMP_CLAUSE_LINEAR_STEP (c)
-                   = fold_build1 (NEGATE_EXPR, TREE_TYPE (t), t);
                  tret = gimplify_expr (&OMP_CLAUSE_LINEAR_STEP (c),
                                        &for_pre_body, NULL,
                                        is_gimple_val, fb_rvalue);
--- gcc/tree.h.jj       2014-06-20 23:26:23.000000000 +0200
+++ gcc/tree.h  2014-06-24 12:31:26.881423510 +0200
@@ -1330,6 +1330,11 @@ extern void protected_set_expr_location
 #define OMP_CLAUSE_LINEAR_VARIABLE_STRIDE(NODE) \
   TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR))
 
+/* True if a LINEAR clause is for an array or allocatable variable that
+   needs special handling by the frontend.  */
+#define OMP_CLAUSE_LINEAR_ARRAY(NODE) \
+  (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR)->base.deprecated_flag)
+
 #define OMP_CLAUSE_LINEAR_STEP(NODE) \
   OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 1)
 
--- gcc/langhooks.h.jj  2014-06-18 09:11:57.000000000 +0200
+++ gcc/langhooks.h     2014-06-24 13:05:23.750284633 +0200
@@ -225,6 +225,10 @@ struct lang_hooks_for_decls
   /* Similarly, except use an assignment operator instead.  */
   tree (*omp_clause_assign_op) (tree clause, tree dst, tree src);
 
+  /* Build and return code for a constructor of DST that sets it to
+     SRC + ADD.  */
+  tree (*omp_clause_linear_ctor) (tree clause, tree dst, tree src, tree add);
+
   /* Build and return code destructing DECL.  Return NULL if nothing
      to be done.  */
   tree (*omp_clause_dtor) (tree clause, tree decl);
--- gcc/omp-low.c.jj    2014-06-24 09:51:25.000000000 +0200
+++ gcc/omp-low.c       2014-06-24 14:57:44.031803949 +0200
@@ -3083,11 +3083,14 @@ lower_rec_input_clauses (tree clauses, g
     for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
       switch (OMP_CLAUSE_CODE (c))
        {
+       case OMP_CLAUSE_LINEAR:
+         if (OMP_CLAUSE_LINEAR_ARRAY (c))
+           max_vf = 1;
+         /* FALLTHRU */
        case OMP_CLAUSE_REDUCTION:
        case OMP_CLAUSE_PRIVATE:
        case OMP_CLAUSE_FIRSTPRIVATE:
        case OMP_CLAUSE_LASTPRIVATE:
-       case OMP_CLAUSE_LINEAR:
          if (is_variable_sized (OMP_CLAUSE_DECL (c)))
            max_vf = 1;
          break;
@@ -3413,14 +3416,12 @@ lower_rec_input_clauses (tree clauses, g
                  if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
                      && gimple_omp_for_combined_into_p (ctx->stmt))
                    {
-                     tree stept = POINTER_TYPE_P (TREE_TYPE (x))
-                                  ? sizetype : TREE_TYPE (x);
-                     tree t = fold_convert (stept,
-                                            OMP_CLAUSE_LINEAR_STEP (c));
-                     tree c = find_omp_clause (clauses,
-                                               OMP_CLAUSE__LOOPTEMP_);
-                     gcc_assert (c);
-                     tree l = OMP_CLAUSE_DECL (c);
+                     tree t = OMP_CLAUSE_LINEAR_STEP (c);
+                     tree stept = TREE_TYPE (t);
+                     tree ct = find_omp_clause (clauses,
+                                                OMP_CLAUSE__LOOPTEMP_);
+                     gcc_assert (ct);
+                     tree l = OMP_CLAUSE_DECL (ct);
                      tree n1 = fd->loop.n1;
                      tree step = fd->loop.step;
                      tree itype = TREE_TYPE (l);
@@ -3437,6 +3438,15 @@ lower_rec_input_clauses (tree clauses, g
                        l = fold_build2 (TRUNC_DIV_EXPR, itype, l, step);
                      t = fold_build2 (MULT_EXPR, stept,
                                       fold_convert (stept, l), t);
+
+                     if (OMP_CLAUSE_LINEAR_ARRAY (c))
+                       {
+                         x = lang_hooks.decls.omp_clause_linear_ctor
+                                                       (c, new_var, x, t);
+                         gimplify_and_add (x, ilist);
+                         goto do_dtor;
+                       }
+
                      if (POINTER_TYPE_P (TREE_TYPE (x)))
                        x = fold_build2 (POINTER_PLUS_EXPR,
                                         TREE_TYPE (x), x, t);
@@ -3460,10 +3470,7 @@ lower_rec_input_clauses (tree clauses, g
                            = gimple_build_assign (unshare_expr (lvar), iv);
                          gsi_insert_before_without_update (&gsi, g,
                                                            GSI_SAME_STMT);
-                         tree stept = POINTER_TYPE_P (TREE_TYPE (iv))
-                                      ? sizetype : TREE_TYPE (iv);
-                         tree t = fold_convert (stept,
-                                                OMP_CLAUSE_LINEAR_STEP (c));
+                         tree t = OMP_CLAUSE_LINEAR_STEP (c);
                          enum tree_code code = PLUS_EXPR;
                          if (POINTER_TYPE_P (TREE_TYPE (new_var)))
                            code = POINTER_PLUS_EXPR;
--- gcc/c/c-typeck.c.jj 2014-06-24 09:38:12.902880047 +0200
+++ gcc/c/c-typeck.c    2014-06-24 10:14:05.960841840 +0200
@@ -12005,6 +12005,9 @@ c_finish_omp_clauses (tree clauses)
                s = size_one_node;
              OMP_CLAUSE_LINEAR_STEP (c) = s;
            }
+         else
+           OMP_CLAUSE_LINEAR_STEP (c)
+             = fold_convert (TREE_TYPE (t), OMP_CLAUSE_LINEAR_STEP (c));
          goto check_dup_generic;
 
        check_dup_generic:
--- gcc/cp/semantics.c.jj       2014-06-24 09:37:46.000000000 +0200
+++ gcc/cp/semantics.c  2014-06-24 16:24:03.853760421 +0200
@@ -5287,6 +5287,8 @@ finish_omp_clauses (tree clauses)
                          break;
                        }
                    }
+                 else
+                   t = fold_convert (TREE_TYPE (OMP_CLAUSE_DECL (c)), t);
                }
              OMP_CLAUSE_LINEAR_STEP (c) = t;
            }
--- gcc/fortran/trans.h.jj      2014-06-18 09:11:57.000000000 +0200
+++ gcc/fortran/trans.h 2014-06-24 13:07:31.023615324 +0200
@@ -670,6 +670,7 @@ tree gfc_omp_report_decl (tree);
 tree gfc_omp_clause_default_ctor (tree, tree, tree);
 tree gfc_omp_clause_copy_ctor (tree, tree, tree);
 tree gfc_omp_clause_assign_op (tree, tree, tree);
+tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 tree gfc_omp_clause_dtor (tree, tree);
 void gfc_omp_finish_clause (tree, gimple_seq *);
 bool gfc_omp_disregard_value_expr (tree, bool);
--- gcc/fortran/trans-openmp.c.jj       2014-06-24 09:40:42.923053066 +0200
+++ gcc/fortran/trans-openmp.c  2014-06-24 15:55:56.150475443 +0200
@@ -822,6 +822,137 @@ gfc_omp_clause_assign_op (tree clause, t
   return gfc_finish_block (&block);
 }
 
+static void
+gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
+                               tree add, tree nelems)
+{
+  stmtblock_t tmpblock;
+  tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S");
+  nelems = gfc_evaluate_now (nelems, block);
+
+  gfc_init_block (&tmpblock);
+  if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
+    {
+      desta = gfc_build_array_ref (dest, index, NULL);
+      srca = gfc_build_array_ref (src, index, NULL);
+    }
+  else
+    {
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest)));
+      tree idx = fold_build2 (MULT_EXPR, sizetype,
+                             fold_convert (sizetype, index),
+                             TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest))));
+      desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
+                                                   TREE_TYPE (dest), dest,
+                                                   idx));
+      srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
+                                                  TREE_TYPE (src), src,
+                                                   idx));
+    }
+  gfc_add_modify (&tmpblock, desta,
+                 fold_build2 (PLUS_EXPR, TREE_TYPE (desta),
+                              srca, add));
+
+  gfc_loopinfo loop;
+  gfc_init_loopinfo (&loop);
+  loop.dimen = 1;
+  loop.from[0] = gfc_index_zero_node;
+  loop.loopvar[0] = index;
+  loop.to[0] = nelems;
+  gfc_trans_scalarizing_loops (&loop, &tmpblock);
+  gfc_add_block_to_block (block, &loop.pre);
+}
+
+/* Build and return code for a constructor of DEST that initializes
+   it to SRC plus ADD (ADD is scalar integer).  */
+
+tree
+gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add)
+{
+  tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE;
+  stmtblock_t block;
+
+  gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+
+  gfc_start_block (&block);
+  add = gfc_evaluate_now (add, &block);
+
+  if ((! GFC_DESCRIPTOR_TYPE_P (type)
+       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
+      && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+    {
+      gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+      if (!TYPE_DOMAIN (type)
+         || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
+         || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
+         || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
+       {
+         nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
+                               TYPE_SIZE_UNIT (type),
+                               TYPE_SIZE_UNIT (TREE_TYPE (type)));
+         nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
+       }
+      else
+       nelems = array_type_nelts (type);
+      nelems = fold_convert (gfc_array_index_type, nelems);
+
+      gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems);
+      return gfc_finish_block (&block);
+    }
+
+  /* Allocatable arrays in LINEAR clauses need to be allocated
+     and copied from SRC.  */
+  gfc_add_modify (&block, dest, src);
+  if (GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
+      size = gfc_conv_descriptor_ubound_get (dest, rank);
+      size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+                             size,
+                             gfc_conv_descriptor_lbound_get (dest, rank));
+      size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+                             size, gfc_index_one_node);
+      if (GFC_TYPE_ARRAY_RANK (type) > 1)
+       size = fold_build2_loc (input_location, MULT_EXPR,
+                               gfc_array_index_type, size,
+                               gfc_conv_descriptor_stride_get (dest, rank));
+      tree esize = fold_convert (gfc_array_index_type,
+                                TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      nelems = gfc_evaluate_now (unshare_expr (size), &block);
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+                             nelems, unshare_expr (esize));
+      size = gfc_evaluate_now (fold_convert (size_type_node, size),
+                              &block);
+      nelems = fold_build2_loc (input_location, MINUS_EXPR,
+                               gfc_array_index_type, nelems,
+                               gfc_index_one_node);
+    }
+  else
+    size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
+  ptr = gfc_create_var (pvoid_type_node, NULL);
+  gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
+  if (GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr);
+      tree etype = gfc_get_element_type (type);
+      ptr = fold_convert (build_pointer_type (etype), ptr);
+      tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src));
+      srcptr = fold_convert (build_pointer_type (etype), srcptr);
+      gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems);
+    }
+  else
+    {
+      gfc_add_modify (&block, unshare_expr (dest),
+                     fold_convert (TREE_TYPE (dest), ptr));
+      ptr = fold_convert (TREE_TYPE (dest), ptr);
+      tree dstm = build_fold_indirect_ref (ptr);
+      tree srcm = build_fold_indirect_ref (unshare_expr (src));
+      gfc_add_modify (&block, dstm,
+                     fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add));
+    }
+  return gfc_finish_block (&block);
+}
+
 /* Build and return code destructing DECL.  Return NULL if nothing
    to be done.  */
 
@@ -1667,7 +1798,11 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
                                gfc_add_block_to_block (block, &se.post);
                              }
                          }
-                       OMP_CLAUSE_LINEAR_STEP (node) = last_step;
+                       OMP_CLAUSE_LINEAR_STEP (node)
+                         = fold_convert (gfc_typenode_for_spec (&n->sym->ts),
+                                         last_step);
+                       if (n->sym->attr.dimension || n->sym->attr.allocatable)
+                         OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
                        omp_clauses = gfc_trans_add_clause (node, omp_clauses);
                      }
                  }
--- gcc/fortran/f95-lang.c.jj   2014-06-24 09:39:03.000000000 +0200
+++ gcc/fortran/f95-lang.c      2014-06-24 13:07:02.106767551 +0200
@@ -126,6 +126,7 @@ static const struct attribute_spec gfc_a
 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
+#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
@@ -158,6 +159,7 @@ static const struct attribute_spec gfc_a
 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR     gfc_omp_clause_default_ctor
 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR                gfc_omp_clause_copy_ctor
 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP                gfc_omp_clause_assign_op
+#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR      gfc_omp_clause_linear_ctor
 #define LANG_HOOKS_OMP_CLAUSE_DTOR             gfc_omp_clause_dtor
 #define LANG_HOOKS_OMP_FINISH_CLAUSE           gfc_omp_finish_clause
 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR    gfc_omp_disregard_value_expr
--- libgomp/testsuite/libgomp.fortran/simd5.f90.jj      2014-06-24 
10:14:05.962841803 +0200
+++ libgomp/testsuite/libgomp.fortran/simd5.f90 2014-06-24 10:14:05.962841803 
+0200
@@ -0,0 +1,124 @@
+! { dg-do run }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+  integer :: i, j, b, c
+  c = 0
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    b = b + 2
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    b = b + 3
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(i) linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    b = b + 2
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(i:4) linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    b = b + 3
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd collapse(2) linear(b:2) reduction(+:c)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      b = b + 2
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd collapse(2) linear(b:2) reduction(+:c) lastprivate (i, j)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      b = b + 2
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    b = b + 2
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    b = b + 3
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(i) linear(b:2) 
reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    b = b + 2
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(i:4) linear(b:3) 
reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    b = b + 3
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) 
reduction(+:c)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      b = b + 2
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) &
+!$omp & reduction(+:c) lastprivate (i, j)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      b = b + 2
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+end
--- libgomp/testsuite/libgomp.fortran/simd6.f90.jj      2014-06-24 
10:14:05.963841767 +0200
+++ libgomp/testsuite/libgomp.fortran/simd6.f90 2014-06-24 10:14:05.963841767 
+0200
@@ -0,0 +1,135 @@
+! { dg-do run }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+  interface
+    subroutine foo (b, i, j, x)
+      integer, intent (inout) :: b
+      integer, intent (in) :: i, j, x
+    end subroutine
+  end interface
+  integer :: i, j, b, c
+  c = 0
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    call foo (b, i, j, 2)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    call foo (b, i, j, 3)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(i) linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    call foo (b, i, j, 2)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd linear(i:4) linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    call foo (b, i, j, 3)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd collapse(2) linear(b:2) reduction(+:c)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      call foo (b, i, j, 2)
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp simd collapse(2) linear(b:2) reduction(+:c) lastprivate (i, j)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      call foo (b, i, j, 2)
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(b:2) reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    call foo (b, i, j, 2)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(b:3) reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    call foo (b, i, j, 3)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(i) linear(b:2) 
reduction(+:c)
+  do i = 0, 63
+    c = c + b - (7 + 2 * i)
+    call foo (b, i, j, 2)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) linear(i:4) linear(b:3) 
reduction(+:c)
+  do i = 0, 63, 4
+    c = c + b - (7 + i / 4 * 3)
+    call foo (b, i, j, 3)
+  end do
+  if (c /= 0 .or. i /= 64 .or. b /= 7 + 16 * 3) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) 
reduction(+:c)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      call foo (b, i, j, 2)
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+  i = 4
+  j = 4
+  b = 7
+!$omp parallel do simd schedule (static, 4) collapse(2) linear(b:2) &
+!$omp & reduction(+:c) lastprivate (i, j)
+  do i = 0, 7
+    do j = 0, 7
+      c = c + b - (7 + 2 * j + 2 * 8 * i)
+      call foo (b, i, j, 2)
+    end do
+  end do
+  if (c /= 0 .or. i /= 8 .or. j /= 8 .or. b /= 7 + 64 * 2) call abort
+end
+subroutine foo (b, i, j, x)
+  integer, intent (inout) :: b
+  integer, intent (in) :: i, j, x
+  b = b + (i - i) + (j - j) + x
+end subroutine
--- libgomp/testsuite/libgomp.fortran/simd7.f90.jj      2014-06-24 
16:06:57.806056011 +0200
+++ libgomp/testsuite/libgomp.fortran/simd7.f90 2014-06-24 16:06:49.000000000 
+0200
@@ -0,0 +1,172 @@
+! { dg-do run }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+subroutine foo (d, e, f, g, m, n)
+  integer :: i, j, b(2:9), c(3:n), d(:), e(2:n), f(2:,3:), n
+  integer, allocatable :: g(:), h(:), k, m
+  logical :: l
+  l = .false.
+  allocate (h(2:7))
+  i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m 
= 15
+!$omp simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5)linear(g:6) &
+!$omp & linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l)
+  do i = 0, 63
+    l = l .or. .not.allocated (g) .or. .not.allocated (h)
+    l = l .or. .not.allocated (k) .or. .not.allocated (m)
+    l = l .or. any (b /= 7 + i) .or. any (c /= 8 + 2 * i)
+    l = l .or. any (d /= 9 + 3 * i) .or. any (e /= 10 + 4 * i)
+    l = l .or. any (f /= 11 + 5 * i) .or. any (g /= 12 + 6 * i)
+    l = l .or. any (h /= 13 + 7 * i) .or. (k /= 14 + 8 * i)
+    l = l .or. (m /= 15 + 9 * i)
+    l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)
+    l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)
+    l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)
+    l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)
+    l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)
+    l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)
+    l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)
+    l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)
+    b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6
+    h = h + 7; k = k + 8; m = m + 9
+  end do
+  if (l .or. i /= 64) call abort
+  if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort
+  if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort
+  if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort
+  if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort
+  if (m /= 15 + 9 * 64) call abort
+  if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort
+  if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort
+  if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort
+  if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort
+  if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort
+  if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort
+  if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort
+  if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort
+  i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m 
= 15
+!$omp simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5)linear(g:6) &
+!$omp & linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) collapse(2)
+  do i = 0, 7
+    do j = 0, 7
+      l = l .or. .not.allocated (g) .or. .not.allocated (h)
+      l = l .or. .not.allocated (k) .or. .not.allocated (m)
+      l = l .or. any (b /= 7 + (8 * i + j)) .or. any (c /= 8 + 2 * (8 * i + j))
+      l = l .or. any (d /= 9 + 3 * (8 * i + j)) .or. any (e /= 10 + 4 * (8 * i 
+ j))
+      l = l .or. any (f /= 11 + 5 * (8 * i + j)) .or. any (g /= 12 + 6 * (8 * 
i + j))
+      l = l .or. any (h /= 13 + 7 * (8 * i + j)) .or. (k /= 14 + 8 * (8 * i + 
j))
+      l = l .or. (m /= 15 + 9 * (8 * i + j))
+      l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)
+      l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)
+      l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)
+      l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)
+      l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)
+      l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)
+      l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)
+      l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)
+      b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6
+      h = h + 7; k = k + 8; m = m + 9
+    end do
+  end do
+  if (l .or. i /= 8 .or. j /= 8) call abort
+  if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort
+  if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort
+  if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort
+  if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort
+  if (m /= 15 + 9 * 64) call abort
+  if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort
+  if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort
+  if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort
+  if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort
+  if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort
+  if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort
+  if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort
+  if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort
+  i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m 
= 15
+!$omp parallel do simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5) &
+!$omp & linear(g:6)linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l)
+  do i = 0, 63
+    l = l .or. .not.allocated (g) .or. .not.allocated (h)
+    l = l .or. .not.allocated (k) .or. .not.allocated (m)
+    l = l .or. any (b /= 7 + i) .or. any (c /= 8 + 2 * i)
+    l = l .or. any (d /= 9 + 3 * i) .or. any (e /= 10 + 4 * i)
+    l = l .or. any (f /= 11 + 5 * i) .or. any (g /= 12 + 6 * i)
+    l = l .or. any (h /= 13 + 7 * i) .or. (k /= 14 + 8 * i)
+    l = l .or. (m /= 15 + 9 * i)
+    l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)
+    l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)
+    l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)
+    l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)
+    l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)
+    l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)
+    l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)
+    l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)
+    b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6
+    h = h + 7; k = k + 8; m = m + 9
+  end do
+  if (l .or. i /= 64) call abort
+  if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort
+  if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort
+  if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort
+  if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort
+  if (m /= 15 + 9 * 64) call abort
+  if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort
+  if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort
+  if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort
+  if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort
+  if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort
+  if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort
+  if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort
+  if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort
+  i = 4; j = 4; b = 7; c = 8; d = 9; e = 10; f = 11; g = 12; h = 13; k = 14; m 
= 15
+!$omp parallel do simd linear(b)linear(c:2)linear(d:3)linear(e:4)linear(f:5) &
+!$omp & linear(g:6)linear(h:7)linear(k:8)linear(m:9) reduction(.or.:l) 
collapse(2)
+  do i = 0, 7
+    do j = 0, 7
+      l = l .or. .not.allocated (g) .or. .not.allocated (h)
+      l = l .or. .not.allocated (k) .or. .not.allocated (m)
+      l = l .or. any (b /= 7 + (8 * i + j)) .or. any (c /= 8 + 2 * (8 * i + j))
+      l = l .or. any (d /= 9 + 3 * (8 * i + j)) .or. any (e /= 10 + 4 * (8 * i 
+ j))
+      l = l .or. any (f /= 11 + 5 * (8 * i + j)) .or. any (g /= 12 + 6 * (8 * 
i + j))
+      l = l .or. any (h /= 13 + 7 * (8 * i + j)) .or. (k /= 14 + 8 * (8 * i + 
j))
+      l = l .or. (m /= 15 + 9 * (8 * i + j))
+      l = l .or. (lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)
+      l = l .or. (lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)
+      l = l .or. (lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)
+      l = l .or. (lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)
+      l = l .or. (lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)
+      l = l .or. (lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)
+      l = l .or. (lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)
+      l = l .or. (lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)
+      b = b + 1; c = c + 2; d = d + 3; e = e + 4; f = f + 5; g = g + 6
+      h = h + 7; k = k + 8; m = m + 9
+    end do
+  end do
+  if (l .or. i /= 8 .or. j /= 8) call abort
+  if (any (b /= 7 + 64) .or. any (c /= 8 + 2 * 64)) call abort
+  if (any (d /= 9 + 3 * 64) .or. any (e /= 10 + 4 * 64)) call abort
+  if (any (f /= 11 + 5 * 64) .or. any (g /= 12 + 6 * 64)) call abort
+  if (any (h /= 13 + 7 * 64) .or. (k /= 14 + 8 * 64)) call abort
+  if (m /= 15 + 9 * 64) call abort
+  if ((lbound (b, 1) /= 2) .or. (ubound (b, 1) /= 9)) call abort
+  if ((lbound (c, 1) /= 3) .or. (ubound (c, 1) /= n)) call abort
+  if ((lbound (d, 1) /= 1) .or. (ubound (d, 1) /= 17)) call abort
+  if ((lbound (e, 1) /= 2) .or. (ubound (e, 1) /= n)) call abort
+  if ((lbound (f, 1) /= 2) .or. (ubound (f, 1) /= 3)) call abort
+  if ((lbound (f, 2) /= 3) .or. (ubound (f, 2) /= 5)) call abort
+  if ((lbound (g, 1) /= 7) .or. (ubound (g, 1) /= 10)) call abort
+  if ((lbound (h, 1) /= 2) .or. (ubound (h, 1) /= 7)) call abort
+end subroutine
+
+  interface
+    subroutine foo (d, e, f, g, m, n)
+      integer :: d(:), e(2:n), f(2:,3:), n
+      integer, allocatable :: g(:), m
+    end subroutine
+  end interface
+  integer, parameter :: n = 8
+  integer :: d(2:18), e(3:n+1), f(5:6,7:9)
+  integer, allocatable :: g(:), m
+  allocate (g(7:10))
+  call foo (d, e, f, g, m, n)
+end

        Jakub

Reply via email to