This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, fortran] Fix PR 78021
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 22 Oct 2016 14:33:57 +0200
- Subject: [patch, fortran] Fix PR 78021
- Authentication-results: sourceware.org; auth=none
Hello world,
this rather self-explanatory patch fixes a problem where two
function invocations with 'c ' and 'c' as arguments
were considered equal.
Regression-tested. OK for trunk and 6 and 5 branches?
Regards
Thomas
2016-10-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78021
* gfc_compare_functions: Strings with different lengths in
argument lists compare unequal.
2016-10-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78021
* gfortran.dg/string_length-3.f90: New test.
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! PR 78021 - calls to mylen were folded after shortening the
! argument list.
PROGRAM test_o_char
implicit none
integer :: n
n = mylen('c') + mylen('c ')
if (n /= 5) call abort
CONTAINS
FUNCTION mylen(c)
CHARACTER(len=*),INTENT(in) :: c
INTEGER :: mylen
mylen=LEN(c)
END FUNCTION mylen
END PROGRAM test_o_char
! { dg-final { scan-tree-dump-times "__var" 0 "original" } }
Index: dependency.c
===================================================================
--- dependency.c (Revision 240928)
+++ dependency.c (Arbeitskopie)
@@ -226,10 +226,27 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
if ((args1->expr == NULL) ^ (args2->expr == NULL))
return -2;
- if (args1->expr != NULL && args2->expr != NULL
- && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
- return -2;
+ if (args1->expr != NULL && args2->expr != NULL)
+ {
+ gfc_expr *e1, *e2;
+ e1 = args1->expr;
+ e2 = args2->expr;
+ if (gfc_dep_compare_expr (e1, e2) != 0)
+ return -2;
+
+ /* Special case: String arguments which compare equal can have
+ different lengths, which makes them different in calls to
+ procedures. */
+
+ if (e1->expr_type == EXPR_CONSTANT
+ && e1->ts.type == BT_CHARACTER
+ && e2->expr_type == EXPR_CONSTANT
+ && e2->ts.type == BT_CHARACTER
+ && e1->value.character.length != e2->value.character.length)
+ return -2;
+ }
+
args1 = args1->next;
args2 = args2->next;
}