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

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

Browse Source 
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
This commit is contained in:
Francois-Xavier Coudert 2007-07-27 14:26:43 +00:00 committed by François-Xavier Coudert
parent 8fb632ebbe
commit 2b8327ce6a
7 changed files with 122 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
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>
PR fortran/32903

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

@ -2333,7 +2333,7 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_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 =
gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")),

54
gcc/fortran/trans-stmt.c
View File

@ -1319,13 +1319,13 @@ gfc_trans_logical_select (gfc_code * code)
static tree
gfc_trans_character_select (gfc_code *code)
{
tree init, node, end_label, tmp, type, *labels;
tree case_label;
tree init, node, end_label, tmp, type, case_num, label;
tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
stmtblock_t block, body;
gfc_case *cp, *d;
gfc_code *c;
gfc_se se;
int i, n;
int n;
static tree select_struct;
static tree ss_string1, ss_string1_len;
@ -1351,7 +1351,7 @@ gfc_trans_character_select (gfc_code *code)
ADD_FIELD (string2, pchar_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
gfc_finish_type (select_struct);
@ -1365,20 +1365,6 @@ gfc_trans_character_select (gfc_code *code)
for (d = cp; d; d = d->right)
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);
/* Generate the body */
@ -1389,7 +1375,10 @@ gfc_trans_character_select (gfc_code *code)
{
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);
}
@ -1402,9 +1391,8 @@ gfc_trans_character_select (gfc_code *code)
/* Generate the structure describing the branches */
init = NULL_TREE;
i = 0;
for(d = cp; d; d = d->right, i++)
for(d = cp; d; d = d->right)
{
node = NULL_TREE;
@ -1437,8 +1425,8 @@ gfc_trans_character_select (gfc_code *code)
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, tmp, node);
node = tree_cons (ss_target, build_int_cst (gfc_c_int_type_node, d->n),
node);
tmp = build_constructor_from_list (select_struct, nreverse (node));
init = tree_cons (NULL_TREE, tmp, init);
@ -1462,33 +1450,27 @@ gfc_trans_character_select (gfc_code *code)
/* Build the library call */
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_conv_expr_reference (&se, code->expr);
gfc_add_block_to_block (&block, &se.pre);
tmp = build_call_expr (gfor_fndecl_select_string, 5,
init, build_int_cst (NULL_TREE, n),
tmp, se.expr, se.string_length);
case_label = gfc_create_var (TREE_TYPE (tmp), "case_label");
gfc_add_modify_expr (&block, case_label, tmp);
tmp = build_call_expr (gfor_fndecl_select_string, 4, init,
build_int_cst (NULL_TREE, n), se.expr,
se.string_length);
case_num = gfc_create_var (gfc_c_int_type_node, "case_num");
gfc_add_modify_expr (&block, case_num, tmp);
gfc_add_block_to_block (&block, &se.post);
tmp = build1 (GOTO_EXPR, void_type_node, case_label);
tmp = gfc_finish_block (&body);
tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
gfc_add_expr_to_block (&block, tmp);
tmp = gfc_finish_block (&body);
gfc_add_expr_to_block (&block, tmp);
tmp = build1_v (LABEL_EXPR, end_label);
gfc_add_expr_to_block (&block, tmp);
if (n != 0)
gfc_free (labels);
return gfc_finish_block (&block);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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>
PR fortran/32903

76
gcc/testsuite/gfortran.dg/select_char_1.f90 Normal file
View File

@ -0,0 +1,76 @@
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

6
libgfortran/ChangeLog
View File

@ -1,3 +1,9 @@
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>
* libgfortran.h: Add bounds_check to compile_options_t.

16
libgfortran/runtime/select.c
View File

@ -35,28 +35,28 @@ typedef struct
int low_len;
char *high;
int high_len;
void *address;
int address;
}
select_struct;
extern void * select_string (select_struct *table, int table_len,
void *default_jump, const char *selector,
int selector_len);
extern int select_string (select_struct *table, int table_len,
const char *selector, int selector_len);
export_proto(select_string);
/* select_string()-- Given a selector string and a table of
* select_struct structures, return the address to jump to. */
void *
select_string (select_struct *table, int table_len, void *default_jump,
const char *selector, int selector_len)
int
select_string (select_struct *table, int table_len, const char *selector,
int selector_len)
{
select_struct *t;
int i, low, high, mid;
int default_jump;
if (table_len == 0)
return default_jump;
return -1;
/* Record the default address if present */