https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67277

Thomas Koenig <tkoenig at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |NEW
           Assignee|tkoenig at gcc dot gnu.org         |unassigned at gcc dot 
gnu.org

--- Comment #6 from Thomas Koenig <tkoenig at gcc dot gnu.org> ---
I thought something like this

Index: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c   (Revision 267903)
+++ trans-intrinsic.c   (Arbeitskopie)
@@ -6355,6 +6355,9 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr *
   tree rrot;
   tree zero;
   unsigned int num_args;
+  bool optional_size = false;
+  gfc_expr *size = NULL;
+  tree library, inlined, present;

   num_args = gfc_intrinsic_argument_list_length (expr);
   args = XALLOCAVEC (tree, num_args);
@@ -6363,6 +6366,11 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr *

   if (num_args == 3)
     {
+      size = expr->value.function.actual->next->next->expr;
+      optional_size = size->expr_type == EXPR_VARIABLE
+       && size->symtree->n.sym->attr.dummy
+       && size->symtree->n.sym->attr.optional;
+
       /* Use a library function for the 3 parameter version.  */
       tree int4type = gfc_get_int_type (4);

@@ -6396,14 +6404,19 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr *
        default:
          gcc_unreachable ();
        }
-      se->expr = build_call_expr_loc (input_location,
+      library = build_call_expr_loc (input_location,
                                      tmp, 3, args[0], args[1], args[2]);
       /* Convert the result back to the original type, if we extended
         the first argument's width above.  */
       if (expr->ts.kind < 4)
-       se->expr = convert (type, se->expr);
+       library = convert (type, se->expr);

-      return;
+      if (!optional_size)
+       {
+         se->expr = library;
+         return;
+       }
+      //      debug_tree (library);
     }
   type = TREE_TYPE (args[0]);

@@ -6427,8 +6440,20 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr *
   /* Do nothing if shift == 0.  */
   tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, args[1],
                         zero);
-  se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, args[0],
-                             rrot);
+
+  inlined = fold_build3_loc (input_location, COND_EXPR, type, tmp, args[0],
+                            rrot);
+
+  //  debug_tree(inlined);
+  if (!optional_size)
+    {
+      se->expr = inlined;
+      return;
+    }
+
+  present = gfc_conv_expr_present (size->symtree->n.sym);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, present,
+                             library, inlined);
 }

would do the trick. However, this results in

{
  integer(kind=4) r;
  integer(kind=4) s[4];

  {
    static integer(kind=4) A.0[4] = {1, 2, 3, 4};
    integer(kind=4) D.3868;

    D.3868 = *j;
    {
      integer(kind=8) S.1;

      S.1 = 0;
      while (1)
        {
          if (S.1 > 3) goto L.1;
          {
            integer(kind=4) D.3870;
            integer(kind=4) D.3871;

            D.3870 = j != 0B ? D.3868 : 0;
            D.3871 = A.0[S.1];
            s[S.1] = j != 0B ? _gfortran_ishftc4 (A.0[S.1], 1, D.3870) : D.3871
r>> 31;
          }
          S.1 = S.1 + 1;
        }
      L.1:;
    }
  }

so *j is dereferenced outside the check for presence.

Unassigning for now.

Reply via email to