This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Fortran, Patch] PR36462 - fix INDEX/SCAN with KIND= and not BACK= argument
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, François-Xavier Coudert <fxcoudert at gmail dot com>
- Date: Thu, 12 Jun 2008 12:25:42 +0200
- Subject: [Fortran, Patch] PR36462 - fix INDEX/SCAN with KIND= and not BACK= argument
The library versions of INDEX/SCAN library functions take as argument
only the two strings and then a logical for BACK=.
However, in the FE the value of the third (present) argument was passed,
which was the kind value if BACK= was not present.
Build and lightly tested. (I will do a full check-gfortran later.)
OK when the test succeeds?
Tobias
2008-06-12 Tobias Burnus <burnus@net-b.de>
PR fortran/36462
* trans-intrinsic.c (gfc_conv_intrinsic_index_scan_verify):
Fix passing of the BACK= argument.
2008-06-12 Tobias Burnus <burnus@net-b.de>
PR fortran/36462
* gfortran.dg/index_2.f90: New.
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 136692)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -2751,11 +2751,17 @@ gfc_conv_intrinsic_index_scan_verify (gf
tree *args;
unsigned int num_args;
- num_args = gfc_intrinsic_argument_list_length (expr);
args = alloca (sizeof (tree) * 5);
- gfc_conv_intrinsic_function_args (se, expr, args,
- num_args >= 5 ? 5 : num_args);
+ /* Get number of arguments; characters count double due to the
+ string length argument. Kind= is not passed to the libary
+ and thus ignored. */
+ if (expr->value.function.actual->next->next->expr == NULL)
+ num_args = 4;
+ else
+ num_args = 5;
+
+ gfc_conv_intrinsic_function_args (se, expr, args, num_args);
type = gfc_typenode_for_spec (&expr->ts);
if (num_args == 4)
Index: gcc/testsuite/gfortran.dg/index_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/index_2.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/index_2.f90 (Revision 0)
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/36462
+!
+ implicit none
+ character(len=10,kind=1) string1
+ character(len=10,kind=4) string4
+ string1 = 'ABCDEEDCBA'
+ string4 = 'ABCDEEDCBA'
+
+ if(index(string1,1_'A') /= 1) call abort()
+ if(index(string4,4_'A') /= 1) call abort()
+ if(index(string1,1_'A',kind=4) /= 1_4) call abort()
+ if(index(string4,4_'A',kind=4) /= 1_4) call abort()
+ if(index(string1,1_'A',kind=1) /= 1_1) call abort()
+ if(index(string4,4_'A',kind=1) /= 1_1) call abort()
+
+ if(index(string1,1_'A',back=.true.) /= 10) call abort()
+ if(index(string4,4_'A',back=.true.) /= 10) call abort()
+ if(index(string1,1_'A',kind=4,back=.true.) /= 10_4) call abort()
+ if(index(string4,4_'A',kind=4,back=.true.) /= 10_4) call abort()
+ if(index(string1,1_'A',kind=1,back=.true.) /= 10_1) call abort()
+ if(index(string4,4_'A',kind=1,back=.true.) /= 10_1) call abort()
+
+ if(index(string1,1_'A',back=.false.) /= 1) call abort()
+ if(index(string4,4_'A',back=.false.) /= 1) call abort()
+ if(index(string1,1_'A',kind=4,back=.false.) /= 1_4) call abort()
+ if(index(string4,4_'A',kind=4,back=.false.) /= 1_4) call abort()
+ if(index(string1,1_'A',kind=1,back=.false.) /= 1_1) call abort()
+ if(index(string4,4_'A',kind=1,back=.false.) /= 1_1) call abort()
+
+ if(scan(string1,1_'A') /= 1) call abort()
+ if(scan(string4,4_'A') /= 1) call abort()
+ if(scan(string1,1_'A',kind=4) /= 1_4) call abort()
+ if(scan(string4,4_'A',kind=4) /= 1_4) call abort()
+ if(scan(string1,1_'A',kind=1) /= 1_1) call abort()
+ if(scan(string4,4_'A',kind=1) /= 1_1) call abort()
+
+ if(scan(string1,1_'A',back=.true.) /= 10) call abort()
+ if(scan(string4,4_'A',back=.true.) /= 10) call abort()
+ if(scan(string1,1_'A',kind=4,back=.true.) /= 10_4) call abort()
+ if(scan(string4,4_'A',kind=4,back=.true.) /= 10_4) call abort()
+ if(scan(string1,1_'A',kind=1,back=.true.) /= 10_1) call abort()
+ if(scan(string4,4_'A',kind=1,back=.true.) /= 10_1) call abort()
+
+ if(scan(string1,1_'A',back=.false.) /= 1) call abort()
+ if(scan(string4,4_'A',back=.false.) /= 1) call abort()
+ if(scan(string1,1_'A',kind=4,back=.false.) /= 1_4) call abort()
+ if(scan(string4,4_'A',kind=4,back=.false.) /= 1_4) call abort()
+ if(scan(string1,1_'A',kind=1,back=.false.) /= 1_1) call abort()
+ if(scan(string4,4_'A',kind=1,back=.false.) /= 1_1) call abort()
+ end
+
+! { dg-final { scan-tree-dump-times "if ..integer.kind=1.. _gfortran_string_index" 6 "original" } }
+! { dg-final { scan-tree-dump-times "if ..integer.kind=1.. _gfortran_string_scan" 6 "original" } }