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.