From: Tobias Burnus Date: Thu, 12 Jun 2008 16:16:39 +0000 (+0200) Subject: re PR fortran/36462 ([F03] Audit intrinsics for KIND arguments) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f5dce7973fd8ea778c77f3ce3a1875752d5c7501;p=gcc.git re PR fortran/36462 ([F03] Audit intrinsics for KIND arguments) 2008-06-12 Tobias Burnus PR fortran/36462 * trans-intrinsic.c (gfc_conv_intrinsic_index_scan_verify): Fix passing of the BACK= argument. 2008-06-12 Tobias Burnus PR fortran/36462 * gfortran.dg/index_2.f90: New. From-SVN: r136712 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 317fbe26231..e42da2f1e91 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-06-12 Tobias Burnus + + PR fortran/36462 + * trans-intrinsic.c (gfc_conv_intrinsic_index_scan_verify): + Fix passing of the BACK= argument. + 2008-06-10 Jerry DeLisle * cpp.c: Add copyright notice. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index f1223933080..c032675cfcb 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2751,11 +2751,17 @@ gfc_conv_intrinsic_index_scan_verify (gfc_se * se, gfc_expr * expr, 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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d0e0a736abb..2026e22b159 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-06-12 Tobias Burnus + + PR fortran/36462 + * gfortran.dg/index_2.f90: New. + 2008-06-12 Eric Botcazou * gnat.dg/discr9.ad[sb]: New test. diff --git a/gcc/testsuite/gfortran.dg/index_2.f90 b/gcc/testsuite/gfortran.dg/index_2.f90 new file mode 100644 index 00000000000..9b92f0acee7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/index_2.f90 @@ -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" } }