diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 15 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/char_length_6.f90 | 21 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 5 | ||||
| -rw-r--r-- | libgfortran/intrinsics/string_intrinsics.c | 2 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 4 |
9 files changed, 54 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 51b047b..758ed43 100644 --- 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 --- 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 --- 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 --- 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 --- 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 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 --- 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 --- 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 --- 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 */ |