Commit 2b8327ce by Francois-Xavier Coudert Committed by François-Xavier Coudert

re PR fortran/32035 ('<anonymous>' may be used uninitialized in this function)

	PR fortran/32035

	* trans-stmt.c (gfc_trans_character_select): Replace the
	mechanism with labels by a SWITCH_EXPR.
	* trans-decl.c (gfc_build_builtin_function_decls): Change
	return type for select_string.

	* runtime/select.c (select_string): Adjust prototype and function
	so that the return value is an integer, not a pointer.

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

From-SVN: r126978
parent 8fb632eb
2007-07-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/32035
* trans-stmt.c (gfc_trans_character_select): Replace the
mechanism with labels by a SWITCH_EXPR.
* trans-decl.c (gfc_build_builtin_function_decls): Change
return type for select_string.
2007-07-27 Paul Thomas <pault@gcc.gnu.org> 2007-07-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32903 PR fortran/32903
......
...@@ -2333,7 +2333,7 @@ gfc_build_builtin_function_decls (void) ...@@ -2333,7 +2333,7 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_select_string = gfor_fndecl_select_string =
gfc_build_library_function_decl (get_identifier (PREFIX("select_string")), gfc_build_library_function_decl (get_identifier (PREFIX("select_string")),
pvoid_type_node, 0); gfc_c_int_type_node, 0);
gfor_fndecl_runtime_error = gfor_fndecl_runtime_error =
gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")),
......
...@@ -1319,13 +1319,13 @@ gfc_trans_logical_select (gfc_code * code) ...@@ -1319,13 +1319,13 @@ gfc_trans_logical_select (gfc_code * code)
static tree static tree
gfc_trans_character_select (gfc_code *code) gfc_trans_character_select (gfc_code *code)
{ {
tree init, node, end_label, tmp, type, *labels; tree init, node, end_label, tmp, type, case_num, label;
tree case_label; tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
stmtblock_t block, body; stmtblock_t block, body;
gfc_case *cp, *d; gfc_case *cp, *d;
gfc_code *c; gfc_code *c;
gfc_se se; gfc_se se;
int i, n; int n;
static tree select_struct; static tree select_struct;
static tree ss_string1, ss_string1_len; static tree ss_string1, ss_string1_len;
...@@ -1351,7 +1351,7 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1351,7 +1351,7 @@ gfc_trans_character_select (gfc_code *code)
ADD_FIELD (string2, pchar_type_node); ADD_FIELD (string2, pchar_type_node);
ADD_FIELD (string2_len, gfc_int4_type_node); ADD_FIELD (string2_len, gfc_int4_type_node);
ADD_FIELD (target, pvoid_type_node); ADD_FIELD (target, gfc_c_int_type_node);
#undef ADD_FIELD #undef ADD_FIELD
gfc_finish_type (select_struct); gfc_finish_type (select_struct);
...@@ -1365,20 +1365,6 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1365,20 +1365,6 @@ gfc_trans_character_select (gfc_code *code)
for (d = cp; d; d = d->right) for (d = cp; d; d = d->right)
d->n = n++; d->n = n++;
if (n != 0)
labels = gfc_getmem (n * sizeof (tree));
else
labels = NULL;
for(i = 0; i < n; i++)
{
labels[i] = gfc_build_label_decl (NULL_TREE);
TREE_USED (labels[i]) = 1;
/* TODO: The gimplifier should do this for us, but it has
inadequacies when dealing with static initializers. */
FORCED_LABEL (labels[i]) = 1;
}
end_label = gfc_build_label_decl (NULL_TREE); end_label = gfc_build_label_decl (NULL_TREE);
/* Generate the body */ /* Generate the body */
...@@ -1389,7 +1375,10 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1389,7 +1375,10 @@ gfc_trans_character_select (gfc_code *code)
{ {
for (d = c->ext.case_list; d; d = d->next) for (d = c->ext.case_list; d; d = d->next)
{ {
tmp = build1_v (LABEL_EXPR, labels[d->n]); label = gfc_build_label_decl (NULL_TREE);
tmp = build3 (CASE_LABEL_EXPR, void_type_node,
build_int_cst (NULL_TREE, d->n),
build_int_cst (NULL_TREE, d->n), label);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
} }
...@@ -1402,9 +1391,8 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1402,9 +1391,8 @@ gfc_trans_character_select (gfc_code *code)
/* Generate the structure describing the branches */ /* Generate the structure describing the branches */
init = NULL_TREE; init = NULL_TREE;
i = 0;
for(d = cp; d; d = d->right, i++) for(d = cp; d; d = d->right)
{ {
node = NULL_TREE; node = NULL_TREE;
...@@ -1437,8 +1425,8 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1437,8 +1425,8 @@ gfc_trans_character_select (gfc_code *code)
node = tree_cons (ss_string2_len, se.string_length, node); node = tree_cons (ss_string2_len, se.string_length, node);
} }
tmp = gfc_build_addr_expr (pvoid_type_node, labels[i]); node = tree_cons (ss_target, build_int_cst (gfc_c_int_type_node, d->n),
node = tree_cons (ss_target, tmp, node); node);
tmp = build_constructor_from_list (select_struct, nreverse (node)); tmp = build_constructor_from_list (select_struct, nreverse (node));
init = tree_cons (NULL_TREE, tmp, init); init = tree_cons (NULL_TREE, tmp, init);
...@@ -1462,33 +1450,27 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1462,33 +1450,27 @@ gfc_trans_character_select (gfc_code *code)
/* Build the library call */ /* Build the library call */
init = gfc_build_addr_expr (pvoid_type_node, init); init = gfc_build_addr_expr (pvoid_type_node, init);
tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
gfc_init_se (&se, NULL); gfc_init_se (&se, NULL);
gfc_conv_expr_reference (&se, code->expr); gfc_conv_expr_reference (&se, code->expr);
gfc_add_block_to_block (&block, &se.pre); gfc_add_block_to_block (&block, &se.pre);
tmp = build_call_expr (gfor_fndecl_select_string, 5, tmp = build_call_expr (gfor_fndecl_select_string, 4, init,
init, build_int_cst (NULL_TREE, n), build_int_cst (NULL_TREE, n), se.expr,
tmp, se.expr, se.string_length); se.string_length);
case_num = gfc_create_var (gfc_c_int_type_node, "case_num");
case_label = gfc_create_var (TREE_TYPE (tmp), "case_label"); gfc_add_modify_expr (&block, case_num, tmp);
gfc_add_modify_expr (&block, case_label, tmp);
gfc_add_block_to_block (&block, &se.post); gfc_add_block_to_block (&block, &se.post);
tmp = build1 (GOTO_EXPR, void_type_node, case_label);
gfc_add_expr_to_block (&block, tmp);
tmp = gfc_finish_block (&body); tmp = gfc_finish_block (&body);
tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
tmp = build1_v (LABEL_EXPR, end_label); tmp = build1_v (LABEL_EXPR, end_label);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
if (n != 0)
gfc_free (labels);
return gfc_finish_block (&block); return gfc_finish_block (&block);
} }
......
2007-07-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/32035
* gfortran.dg/select_char_1.f90: New test.
2007-07-27 Tobias Burnus <burnus@net-b.de> 2007-07-27 Tobias Burnus <burnus@net-b.de>
PR fortran/32903 PR fortran/32903
integer function char_select (s)
character(len=*), intent(in) :: s
select case(s)
case ("foo")
char_select = 1
case ("bar", "gee")
char_select = 2
case ("111", "999")
char_select = 3
case ("1024", "1900")
char_select = 4
case ("12", "17890")
char_select = 5
case default
char_select = -1
end select
end function char_select
integer function char_select2 (s)
character(len=*), intent(in) :: s
char_select2 = -1
select case(s)
case ("foo")
char_select2 = 1
case ("bar", "gee")
char_select2 = 2
case ("111", "999")
char_select2 = 3
case ("1024", "1900")
char_select2 = 4
case ("12", "17890")
char_select2 = 5
end select
end function char_select2
program test
interface
integer function char_select (s)
character(len=*), intent(in) :: s
end function char_select
integer function char_select2 (s)
character(len=*), intent(in) :: s
end function char_select2
end interface
if (char_select("foo") /= 1) call abort
if (char_select("foo ") /= 1) call abort
if (char_select("foo2 ") /= -1) call abort
if (char_select("bar") /= 2) call abort
if (char_select("gee") /= 2) call abort
if (char_select("000") /= -1) call abort
if (char_select("101") /= -1) call abort
if (char_select("109") /= -1) call abort
if (char_select("111") /= 3) call abort
if (char_select("254") /= -1) call abort
if (char_select("999") /= 3) call abort
if (char_select("9989") /= -1) call abort
if (char_select("1882") /= -1) call abort
if (char_select2("foo") /= 1) call abort
if (char_select2("foo ") /= 1) call abort
if (char_select2("foo2 ") /= -1) call abort
if (char_select2("bar") /= 2) call abort
if (char_select2("gee") /= 2) call abort
if (char_select2("000") /= -1) call abort
if (char_select2("101") /= -1) call abort
if (char_select2("109") /= -1) call abort
if (char_select2("111") /= 3) call abort
if (char_select2("254") /= -1) call abort
if (char_select2("999") /= 3) call abort
if (char_select2("9989") /= -1) call abort
if (char_select2("1882") /= -1) call abort
end program test
2007-07-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/32035
* runtime/select.c (select_string): Adjust prototype and function
so that the return value is an integer, not a pointer.
2007-07-24 Tobias Burnus <burnus@net-b.de> 2007-07-24 Tobias Burnus <burnus@net-b.de>
* libgfortran.h: Add bounds_check to compile_options_t. * libgfortran.h: Add bounds_check to compile_options_t.
......
...@@ -35,28 +35,28 @@ typedef struct ...@@ -35,28 +35,28 @@ typedef struct
int low_len; int low_len;
char *high; char *high;
int high_len; int high_len;
void *address; int address;
} }
select_struct; select_struct;
extern void * select_string (select_struct *table, int table_len, extern int select_string (select_struct *table, int table_len,
void *default_jump, const char *selector, const char *selector, int selector_len);
int selector_len);
export_proto(select_string); export_proto(select_string);
/* select_string()-- Given a selector string and a table of /* select_string()-- Given a selector string and a table of
* select_struct structures, return the address to jump to. */ * select_struct structures, return the address to jump to. */
void * int
select_string (select_struct *table, int table_len, void *default_jump, select_string (select_struct *table, int table_len, const char *selector,
const char *selector, int selector_len) int selector_len)
{ {
select_struct *t; select_struct *t;
int i, low, high, mid; int i, low, high, mid;
int default_jump;
if (table_len == 0) if (table_len == 0)
return default_jump; return -1;
/* Record the default address if present */ /* Record the default address if present */
......
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