Commit c9ff1de3 by Francois-Xavier Coudert Committed by François-Xavier Coudert

re PR fortran/32937 (segfault with string and -fdefault-integer-8)

	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.

From-SVN: r127363
parent 4862826d
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> 2007-08-11 Ian Lance Taylor <iant@google.com>
* f95-lang.c (gfc_get_alias_set): Change return type to * f95-lang.c (gfc_get_alias_set): Change return type to
......
...@@ -4573,9 +4573,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) ...@@ -4573,9 +4573,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
else if (expr->ts.cl->length else if (expr->ts.cl->length
&& expr->ts.cl->length->expr_type == EXPR_CONSTANT) && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{ {
expr->ts.cl->backend_decl gfc_conv_const_charlen (expr->ts.cl);
= gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
expr->ts.cl->length->ts.kind);
loop.temp_ss->data.temp.type loop.temp_ss->data.temp.type
= gfc_typenode_for_spec (&expr->ts); = gfc_typenode_for_spec (&expr->ts);
loop.temp_ss->string_length loop.temp_ss->string_length
......
...@@ -1999,8 +1999,7 @@ gfc_build_intrinsic_function_decls (void) ...@@ -1999,8 +1999,7 @@ gfc_build_intrinsic_function_decls (void)
/* String functions. */ /* String functions. */
gfor_fndecl_compare_string = gfor_fndecl_compare_string =
gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")), gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")),
gfc_int4_type_node, integer_type_node, 4,
4,
gfc_charlen_type_node, pchar_type_node, gfc_charlen_type_node, pchar_type_node,
gfc_charlen_type_node, pchar_type_node); gfc_charlen_type_node, pchar_type_node);
......
...@@ -1036,8 +1036,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) ...@@ -1036,8 +1036,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
enum tree_code code; enum tree_code code;
gfc_se lse; gfc_se lse;
gfc_se rse; gfc_se rse;
tree type; tree tmp, type;
tree tmp;
int lop; int lop;
int checkstring; int checkstring;
...@@ -1186,7 +1185,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) ...@@ -1186,7 +1185,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
if (lop) if (lop)
{ {
/* The result of logical ops is always boolean_type_node. */ /* 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); se->expr = convert (type, tmp);
} }
else else
...@@ -1280,23 +1279,20 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2) ...@@ -1280,23 +1279,20 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2)
{ {
tree sc1; tree sc1;
tree sc2; tree sc2;
tree type;
tree tmp; tree tmp;
gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)));
gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)));
type = gfc_get_int_type (gfc_default_integer_kind);
sc1 = gfc_to_single_character (len1, str1); sc1 = gfc_to_single_character (len1, str1);
sc2 = gfc_to_single_character (len2, str2); sc2 = gfc_to_single_character (len2, str2);
/* Deal with single character specially. */ /* Deal with single character specially. */
if (sc1 != NULL_TREE && sc2 != NULL_TREE) if (sc1 != NULL_TREE && sc2 != NULL_TREE)
{ {
sc1 = fold_convert (type, sc1); sc1 = fold_convert (integer_type_node, sc1);
sc2 = fold_convert (type, sc2); sc2 = fold_convert (integer_type_node, sc2);
tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2); tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
} }
else else
/* Build a call for the comparison. */ /* Build a call for the comparison. */
...@@ -1860,6 +1856,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr, ...@@ -1860,6 +1856,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
gfc_array_index_type); gfc_array_index_type);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
tmp, tmp_se.expr); tmp, tmp_se.expr);
tmp = fold_convert (gfc_charlen_type_node, tmp);
expr->ts.cl->backend_decl = tmp; expr->ts.cl->backend_decl = tmp;
break; break;
......
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> 2007-08-10 Ollie Wild <aaw@google.com>
* g++.dg/lookup/using18.C: New test. * g++.dg/lookup/using18.C: New test.
! { 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
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> 2007-08-10 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31270 PR fortran/31270
......
...@@ -79,7 +79,7 @@ export_proto(string_minmax); ...@@ -79,7 +79,7 @@ export_proto(string_minmax);
/* Strings of unequal length are extended with pad characters. */ /* Strings of unequal length are extended with pad characters. */
GFC_INTEGER_4 int
compare_string (GFC_INTEGER_4 len1, const char * s1, compare_string (GFC_INTEGER_4 len1, const char * s1,
GFC_INTEGER_4 len2, const char * s2) GFC_INTEGER_4 len2, const char * s2)
{ {
......
...@@ -759,7 +759,7 @@ internal_proto(internal_unpack_c16); ...@@ -759,7 +759,7 @@ internal_proto(internal_unpack_c16);
/* string_intrinsics.c */ /* string_intrinsics.c */
extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *, extern int compare_string (GFC_INTEGER_4, const char *,
GFC_INTEGER_4, const char *); GFC_INTEGER_4, const char *);
iexport_proto(compare_string); iexport_proto(compare_string);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment