re PR fortran/36462 ([F03] Audit intrinsics for KIND arguments)

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.

From-SVN: r136712

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 317fbe26231e20f9df2b7b9abe88a83b1efb423e..e42da2f1e91f1e0182eb4f191d4fe694362c4c14 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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-10  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * cpp.c: Add copyright notice.

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f12239330809fde887fbdea24d3c0db7112a1275..c032675cfcb8a54b94178b7eb55134f611905913 100644 (file)
--- 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 d0e0a736abba665da3596930a9459eba21f8ebed..2026e22b1598ffe28d4dc4b94ee85ec8d5c0a37f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-06-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/36462
+       * gfortran.dg/index_2.f90: New.
+
 2008-06-12  Eric Botcazou  <ebotcazou@adacore.com>
 
        * 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 (file)
index 0000000..9b92f0a
--- /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" } }