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.