PR fortran/32937

	* trans-array.c (gfc_conv_expr_descriptor): Use
	gfc_conv_const_charlen to generate backend_decl of right type.
	* trans-expr.c (gfc_conv_expr_op): Use correct return type.
	(gfc_build_compare_string): Use int type instead of default
	integer kind for single character comparison.
	(gfc_conv_aliased_arg): Give backend_decl the right type.
	* trans-decl.c (gfc_build_intrinsic_function_decls): Make
	compare_string return an int.

	* gfortran.dg/char_length_6.f90: New test.

	* intrinsics/string_intrinsics.c (compare_string): Return an int.
	* libgfortran.h (compare_string): Likewise.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127363 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 51b047b..758ed43 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/32937
+       * trans-array.c (gfc_conv_expr_descriptor): Use
+       gfc_conv_const_charlen to generate backend_decl of right type.
+       * trans-expr.c (gfc_conv_expr_op): Use correct return type.
+       (gfc_build_compare_string): Use int type instead of default
+       integer kind for single character comparison.
+       (gfc_conv_aliased_arg): Give backend_decl the right type.
+       * trans-decl.c (gfc_build_intrinsic_function_decls): Make
+       compare_string return an int.
+
 2007-08-11  Ian Lance Taylor  <iant@google.com>
 
        * f95-lang.c (gfc_get_alias_set): Change return type to

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78b038a..1cf00fd 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4573,9 +4573,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
          else if (expr->ts.cl->length
                     && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
            {
-             expr->ts.cl->backend_decl
-               = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
-                                       expr->ts.cl->length->ts.kind);
+             gfc_conv_const_charlen (expr->ts.cl);
              loop.temp_ss->data.temp.type
                = gfc_typenode_for_spec (&expr->ts);
              loop.temp_ss->string_length

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 58cbc37..4b0902f 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1999,8 +1999,7 @@ gfc_build_intrinsic_function_decls (void)
   /* String functions.  */
   gfor_fndecl_compare_string =
     gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")),
-                                    gfc_int4_type_node,
-                                    4,
+                                    integer_type_node, 4,
                                     gfc_charlen_type_node, pchar_type_node,
                                     gfc_charlen_type_node, pchar_type_node);
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b24a8ac..1ae601f 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1036,8 +1036,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
   enum tree_code code;
   gfc_se lse;
   gfc_se rse;
-  tree type;
-  tree tmp;
+  tree tmp, type;
   int lop;
   int checkstring;
 
@@ -1186,7 +1185,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
   if (lop)
     {
       /* The result of logical ops is always boolean_type_node.  */
-      tmp = fold_build2 (code, type, lse.expr, rse.expr);
+      tmp = fold_build2 (code, boolean_type_node, lse.expr, rse.expr);
       se->expr = convert (type, tmp);
     }
   else
@@ -1280,23 +1279,20 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2)
 {
   tree sc1;
   tree sc2;
-  tree type;
   tree tmp;
 
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)));
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)));
 
-  type = gfc_get_int_type (gfc_default_integer_kind);
-
   sc1 = gfc_to_single_character (len1, str1);
   sc2 = gfc_to_single_character (len2, str2);
 
   /* Deal with single character specially.  */
   if (sc1 != NULL_TREE && sc2 != NULL_TREE)
     {
-      sc1 = fold_convert (type, sc1);
-      sc2 = fold_convert (type, sc2);
-      tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2);
+      sc1 = fold_convert (integer_type_node, sc1);
+      sc2 = fold_convert (integer_type_node, sc2);
+      tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
     }
    else
      /* Build a call for the comparison.  */
@@ -1860,6 +1856,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
                                gfc_array_index_type);
            tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
                               tmp, tmp_se.expr);
+           tmp = fold_convert (gfc_charlen_type_node, tmp);
            expr->ts.cl->backend_decl = tmp;
 
            break;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0712f70..4029152 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/32937
+       * gfortran.dg/char_length_6.f90: New test.
+
 2007-08-10  Ollie Wild  <aaw@google.com>
 
        * g++.dg/lookup/using18.C: New test.

diff --git a/gcc/testsuite/gfortran.dg/char_length_6.f90 b/gcc/testsuite/gfortran.dg/char_length_6.f90
new file mode 100644 (file)
index 0000000..1a8b2f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_6.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+program test
+  character(2_8) :: c(2)
+  logical :: l(2)
+
+  c = "aa"
+  l = c .eq. "aa"
+  if (any (.not. l)) call abort
+
+  call foo ([c(1)])
+  l = c .eq. "aa"
+  if (any (.not. l)) call abort
+
+contains
+
+  subroutine foo (c)
+    character(2) :: c(1)
+  end subroutine foo
+
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 46f7282..4e47f28 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       * intrinsics/string_intrinsics.c (compare_string): Return an int.
+       * libgfortran.h (compare_string): Likewise.
+
 2007-08-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/31270

diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index 3e0940f..be02811 100644 (file)
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -79,7 +79,7 @@ export_proto(string_minmax);
 
 /* Strings of unequal length are extended with pad characters.  */
 
-GFC_INTEGER_4
+int
 compare_string (GFC_INTEGER_4 len1, const char * s1,
                GFC_INTEGER_4 len2, const char * s2)
 {

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index c32b5a3..6013ce6 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -759,8 +759,8 @@ internal_proto(internal_unpack_c16);
 
 /* string_intrinsics.c */
 
-extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
-                                    GFC_INTEGER_4, const char *);
+extern int compare_string (GFC_INTEGER_4, const char *,
+                          GFC_INTEGER_4, const char *);
 iexport_proto(compare_string);
 
 /* random.c */