Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
Hi Paul, 2018-10-18 Paul Thomas PR fortran/85603 * frontend-passes.c (get_len_call): New function to generate a call to intrinsic LEN. (create_var): Use this to make length expressions for variable rhs string lengths. Clean up some white space issues. 2018-10-18 Paul Thomas PR fortran/85603 * gfortran.dg/deferred_character_23.f90 : Check reallocation is occurring as it should and a regression caused by version 1 of this patch. OK. Thanks for the patch! Regards Thomas
Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
Hmmm! It helps to provide the patch. 2018-10-18 Paul Thomas PR fortran/85603 * frontend-passes.c (get_len_call): New function to generate a call to intrinsic LEN. (create_var): Use this to make length expressions for variable rhs string lengths. Clean up some white space issues. 2018-10-18 Paul Thomas PR fortran/85603 * gfortran.dg/deferred_character_23.f90 : Check reallocation is occurring as it should and a regression caused by version 1 of this patch. On Sat, 20 Oct 2018 at 13:32, Paul Richard Thomas wrote: > > Hi Dominique, > > Thanks for picking that up. For some reason that I do now see, the > regression is caused by the component references. The frontend > temporary is picking up the deferred tag from somewhere, even though > it is not set. Anyway, all is well if the patch is restricted to > character right hand side symbols. I have added a test for the > regression to the testcase. > > OK for trunk? > > Paul > > On Fri, 19 Oct 2018 at 23:15, Dominique d'Humières wrote: > > > > Reduced test > > > > ! { dg-do compile } > > MODULE TN4 > > IMPLICIT NONE > > PRIVATE > > INTEGER,PARAMETER::SH4=KIND('a') > > TYPE,PUBLIC::TOP > > CHARACTER(:,KIND=SH4),ALLOCATABLE::ROR > > CHARACTER(:,KIND=SH4),ALLOCATABLE::VI8 > > CONTAINS > > PROCEDURE,NON_OVERRIDABLE::SB=>TPX > > END TYPE TOP > > CONTAINS > > SUBROUTINE TPX(TP6,PP4,BA3) > > CLASS(TOP),INTENT(INOUT)::TP6 > > INTEGER,INTENT(IN)::PP4 > > TYPE(TOP),INTENT(OUT)::BA3 > > BA3%ROR=TP6%ROR(PP4:) > > BA3%VI8=TP6%ROR(PP4:) > > TP6%ROR=TP6%ROR(:PP4-1) > > TP6%VI8=TP6%ROR(:PP4-1) > > END SUBROUTINE TPX > > END MODULE TN4 > > ! https://groups.google.com/forum/#!topic/comp.lang.fortran/nV3TlRlVKBc > > > > TIA > > > > Dominique > > > > > Le 19 oct. 2018 à 23:39, Dominique d'Humières a > > > écrit : > > > > > > Hi Paul, > > > > > > I get a regression with your patch: > > > > > > obfuscated_tn4.f90:300:0: > > > > > > 300 | TP6%ROR=TP6%ROR(:PP4-1) > > > | > > > internal compiler error: in gfc_trans_deferred_vars, at > > > fortran/trans-decl.c:4754 > > > > > > > > > I’ll try to reduce the test. > > > > > > Dominique > > > > > > > > -- > "If you can't explain it simply, you don't understand it well enough" > - Albert Einstein -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein Index: gcc/fortran/frontend-passes.c === *** gcc/fortran/frontend-passes.c (revision 265262) --- gcc/fortran/frontend-passes.c (working copy) *** realloc_string_callback (gfc_code **c, i *** 280,286 && (expr2->expr_type != EXPR_OP || expr2->value.op.op != INTRINSIC_CONCAT)) return 0; ! if (!gfc_check_dependency (expr1, expr2, true)) return 0; --- 280,286 && (expr2->expr_type != EXPR_OP || expr2->value.op.op != INTRINSIC_CONCAT)) return 0; ! if (!gfc_check_dependency (expr1, expr2, true)) return 0; *** insert_block () *** 704,709 --- 704,744 return ns; } + + /* Insert a call to the intrinsic len. Use a different name for +the symbol tree so we don't run into trouble when the user has +renamed len for some reason. */ + + static gfc_expr* + get_len_call (gfc_expr *str) + { + gfc_expr *fcn; + gfc_actual_arglist *actual_arglist; + + fcn = gfc_get_expr (); + fcn->expr_type = EXPR_FUNCTION; + fcn->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LEN); + actual_arglist = gfc_get_actual_arglist (); + actual_arglist->expr = str; + + fcn->value.function.actual = actual_arglist; + fcn->where = str->where; + fcn->ts.type = BT_INTEGER; + fcn->ts.kind = gfc_charlen_int_kind; + + gfc_get_sym_tree ("__internal_len", current_ns, &fcn->symtree, false); + fcn->symtree->n.sym->ts = fcn->ts; + fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE; + fcn->symtree->n.sym->attr.function = 1; + fcn->symtree->n.sym->attr.elemental = 1; + fcn->symtree->n.sym->attr.referenced = 1; + fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; + gfc_commit_symbol (fcn->symtree->n.sym); + + return fcn; + } + + /* Returns a new expression (a variable) to be used in place of the old one, with an optional assignment statement before the current statement to set the value of the variable. Creates a new BLOCK for the statement if that *** create_var (gfc_expr * e, const char *vn *** 786,791 --- 821,830 length = constant_string_length (e); if (length) symbol->ts.u.cl->length = length; + else if (e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->ts.type == BT_CHARACTER + && e->ts.u.cl->length) + symbol->ts.u.cl->length = get_len_call (gfc_copy_expr (e)); else { symbol->attr.allocatable = 1; *** traverse_io_block (gfc_code *code, boo
Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
Hi Dominique, Thanks for picking that up. For some reason that I do now see, the regression is caused by the component references. The frontend temporary is picking up the deferred tag from somewhere, even though it is not set. Anyway, all is well if the patch is restricted to character right hand side symbols. I have added a test for the regression to the testcase. OK for trunk? Paul On Fri, 19 Oct 2018 at 23:15, Dominique d'Humières wrote: > > Reduced test > > ! { dg-do compile } > MODULE TN4 > IMPLICIT NONE > PRIVATE > INTEGER,PARAMETER::SH4=KIND('a') > TYPE,PUBLIC::TOP > CHARACTER(:,KIND=SH4),ALLOCATABLE::ROR > CHARACTER(:,KIND=SH4),ALLOCATABLE::VI8 > CONTAINS > PROCEDURE,NON_OVERRIDABLE::SB=>TPX > END TYPE TOP > CONTAINS > SUBROUTINE TPX(TP6,PP4,BA3) > CLASS(TOP),INTENT(INOUT)::TP6 > INTEGER,INTENT(IN)::PP4 > TYPE(TOP),INTENT(OUT)::BA3 > BA3%ROR=TP6%ROR(PP4:) > BA3%VI8=TP6%ROR(PP4:) > TP6%ROR=TP6%ROR(:PP4-1) > TP6%VI8=TP6%ROR(:PP4-1) > END SUBROUTINE TPX > END MODULE TN4 > ! https://groups.google.com/forum/#!topic/comp.lang.fortran/nV3TlRlVKBc > > TIA > > Dominique > > > Le 19 oct. 2018 à 23:39, Dominique d'Humières a écrit : > > > > Hi Paul, > > > > I get a regression with your patch: > > > > obfuscated_tn4.f90:300:0: > > > > 300 | TP6%ROR=TP6%ROR(:PP4-1) > > | > > internal compiler error: in gfc_trans_deferred_vars, at > > fortran/trans-decl.c:4754 > > > > > > I’ll try to reduce the test. > > > > Dominique > > > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
Reduced test ! { dg-do compile } MODULE TN4 IMPLICIT NONE PRIVATE INTEGER,PARAMETER::SH4=KIND('a') TYPE,PUBLIC::TOP CHARACTER(:,KIND=SH4),ALLOCATABLE::ROR CHARACTER(:,KIND=SH4),ALLOCATABLE::VI8 CONTAINS PROCEDURE,NON_OVERRIDABLE::SB=>TPX END TYPE TOP CONTAINS SUBROUTINE TPX(TP6,PP4,BA3) CLASS(TOP),INTENT(INOUT)::TP6 INTEGER,INTENT(IN)::PP4 TYPE(TOP),INTENT(OUT)::BA3 BA3%ROR=TP6%ROR(PP4:) BA3%VI8=TP6%ROR(PP4:) TP6%ROR=TP6%ROR(:PP4-1) TP6%VI8=TP6%ROR(:PP4-1) END SUBROUTINE TPX END MODULE TN4 ! https://groups.google.com/forum/#!topic/comp.lang.fortran/nV3TlRlVKBc TIA Dominique > Le 19 oct. 2018 à 23:39, Dominique d'Humières a écrit : > > Hi Paul, > > I get a regression with your patch: > > obfuscated_tn4.f90:300:0: > > 300 | TP6%ROR=TP6%ROR(:PP4-1) > | > internal compiler error: in gfc_trans_deferred_vars, at > fortran/trans-decl.c:4754 > > > I’ll try to reduce the test. > > Dominique >
Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
Hi Paul, I get a regression with your patch: obfuscated_tn4.f90:300:0: 300 | TP6%ROR=TP6%ROR(:PP4-1) | internal compiler error: in gfc_trans_deferred_vars, at fortran/trans-decl.c:4754 I’ll try to reduce the test. Dominique
Re: [Patc, fortran] PR85603 - ICE with character array substring assignment
It turned out that this patch did not quite complete the job (Thanks Walt): The ICE has gone but reallocation on assignment is not occurring because the correct string length for the rhs expression was not being picked up. The fix for this took rather more detective work than I anticipated but here it is. Bootstraps and regtests on FC28/x86_64 - OK for trunk? Cheers Paul 2018-10-18 Paul Thomas PR fortran/85603 * frontend-passes.c (get_len_call): New function to generate a call to intrinsic LEN. (create_var): Use this to make length expressions for variable rhs string lengths. Clean up some white space issues. 2018-10-18 Paul Thomas PR fortran/85603 * gfortran.dg/deferred_character_23.f90 : Check reallocation is occurring as it should.. On Sat, 22 Sep 2018 at 11:23, Paul Richard Thomas wrote: > > Yet another 'obvious' deferred character fix. Committed to trunk as > r264502. Will backport in about ten days time. > > Paul > > 2018-09-22 Paul Thomas > > PR fortran/85603 > * trans-array.c (gfc_alloc_allocatable_for_assignment): Test > the charlen backend_decl before using the VAR_P macro. > > 2018-09-22 Paul Thomas > > PR fortran/85603 > * gfortran.dg/deferred_character_23.f90 : New test. -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein Index: gcc/fortran/frontend-passes.c === *** gcc/fortran/frontend-passes.c (revision 265262) --- gcc/fortran/frontend-passes.c (working copy) *** realloc_string_callback (gfc_code **c, i *** 280,286 && (expr2->expr_type != EXPR_OP || expr2->value.op.op != INTRINSIC_CONCAT)) return 0; ! if (!gfc_check_dependency (expr1, expr2, true)) return 0; --- 280,286 && (expr2->expr_type != EXPR_OP || expr2->value.op.op != INTRINSIC_CONCAT)) return 0; ! if (!gfc_check_dependency (expr1, expr2, true)) return 0; *** insert_block () *** 704,709 --- 704,744 return ns; } + + /* Insert a call to the intrinsic len. Use a different name for +the symbol tree so we don't run into trouble when the user has +renamed len for some reason. */ + + static gfc_expr* + get_len_call (gfc_expr *str) + { + gfc_expr *fcn; + gfc_actual_arglist *actual_arglist; + + fcn = gfc_get_expr (); + fcn->expr_type = EXPR_FUNCTION; + fcn->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LEN); + actual_arglist = gfc_get_actual_arglist (); + actual_arglist->expr = str; + + fcn->value.function.actual = actual_arglist; + fcn->where = str->where; + fcn->ts.type = BT_INTEGER; + fcn->ts.kind = gfc_charlen_int_kind; + + gfc_get_sym_tree ("__internal_len", current_ns, &fcn->symtree, false); + fcn->symtree->n.sym->ts = fcn->ts; + fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE; + fcn->symtree->n.sym->attr.function = 1; + fcn->symtree->n.sym->attr.elemental = 1; + fcn->symtree->n.sym->attr.referenced = 1; + fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; + gfc_commit_symbol (fcn->symtree->n.sym); + + return fcn; + } + + /* Returns a new expression (a variable) to be used in place of the old one, with an optional assignment statement before the current statement to set the value of the variable. Creates a new BLOCK for the statement if that *** create_var (gfc_expr * e, const char *vn *** 786,791 --- 821,828 length = constant_string_length (e); if (length) symbol->ts.u.cl->length = length; + else if (e->expr_type == EXPR_VARIABLE && e->ts.u.cl->length) + symbol->ts.u.cl->length = get_len_call (gfc_copy_expr (e)); else { symbol->attr.allocatable = 1; *** traverse_io_block (gfc_code *code, bool *** 1226,1232 { /* Check for (a(i,i), i=1,3). */ int j; ! for (j=0; jvar->symtree == start->symtree) return false; --- 1263,1269 { /* Check for (a(i,i), i=1,3). */ int j; ! for (j=0; jvar->symtree == start->symtree) return false; *** traverse_io_block (gfc_code *code, bool *** 1286,1292 || var_in_expr (var, iters[j]->end) || var_in_expr (var, iters[j]->step))) return false; ! } } } --- 1323,1329 || var_in_expr (var, iters[j]->end) || var_in_expr (var, iters[j]->step))) return false; ! } } } *** get_len_trim_call (gfc_expr *str, int ki *** 2019,2024 --- 2056,2062 return fcn; } + /* Optimize expressions for equality. */ static bool *** do_subscript (gfc_expr **e) *** 2626,2632 /* If we do not know about the stepsize, the loop may be zero trip. Do not warn in this case. */ ! if (dl->ext.iterat
[Patc, fortran] PR85603 - ICE with character array substring assignment
Yet another 'obvious' deferred character fix. Committed to trunk as r264502. Will backport in about ten days time. Paul 2018-09-22 Paul Thomas PR fortran/85603 * trans-array.c (gfc_alloc_allocatable_for_assignment): Test the charlen backend_decl before using the VAR_P macro. 2018-09-22 Paul Thomas PR fortran/85603 * gfortran.dg/deferred_character_23.f90 : New test. Index: gcc/fortran/trans-array.c === *** gcc/fortran/trans-array.c (revision 264486) --- gcc/fortran/trans-array.c (working copy) *** gfc_alloc_allocatable_for_assignment (gf *** 9950,9956 { if (expr2->ts.deferred) { ! if (VAR_P (expr2->ts.u.cl->backend_decl)) tmp = expr2->ts.u.cl->backend_decl; else tmp = rss->info->string_length; --- 9950,9957 { if (expr2->ts.deferred) { ! if (expr2->ts.u.cl->backend_decl ! && VAR_P (expr2->ts.u.cl->backend_decl)) tmp = expr2->ts.u.cl->backend_decl; else tmp = rss->info->string_length; Index: gcc/testsuite/gfortran.dg/deferred_character_23.f90 === *** gcc/testsuite/gfortran.dg/deferred_character_23.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/deferred_character_23.f90 (working copy) *** *** 0 --- 1,22 + ! { dg-do run } + ! + ! Tests the fix for PR85603. + ! + ! Contributed by Walt Spector + ! + program strlen_bug + implicit none + + character(:), allocatable :: strings(:) + integer :: maxlen + + strings = [ character(32) :: & + 'short', & + 'somewhat longer' ] + maxlen = maxval (len_trim (strings)) + if (maxlen .ne. 15) stop 1 + strings = strings(:)(:maxlen) ! Used to ICE + if (any (strings .ne. ['short ','somewhat longer'])) stop 2 + + deallocate (strings) ! To check for memory leaks + end program