OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Francois-Xavier Coudert 2007-08-11 21:31:35 +00:00 committed by François-Xavier Coudert
parent 4862826d55
commit c9ff1de3ae
9 changed files with 54 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

4
gcc/fortran/trans-array.c
View File

@ -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

3
gcc/fortran/trans-decl.c
View File

@ -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);

15
gcc/fortran/trans-expr.c
View File

@ -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;

5
gcc/testsuite/ChangeLog
View File

@ -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.

21
gcc/testsuite/gfortran.dg/char_length_6.f90 Normal file
View File

@ -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

5
libgfortran/ChangeLog
View File

@ -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

2
libgfortran/intrinsics/string_intrinsics.c
View File

@ -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)
{

4
libgfortran/libgfortran.h
View File

@ -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 */