aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/trans-decl.c2
-rw-r--r--gcc/fortran/trans-stmt.c54
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/select_char_1.f9076
-rw-r--r--libgfortran/ChangeLog6
-rw-r--r--libgfortran/runtime/select.c16
7 files changed, 122 insertions, 45 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b0089ef..40cd9af 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 8a3b968..f2dcec7 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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")),
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 034a505..b196315 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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);
- gfc_add_expr_to_block (&block, tmp);
-
tmp = gfc_finish_block (&body);
+ tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
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);
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 59653d7..863402c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/select_char_1.f90 b/gcc/testsuite/gfortran.dg/select_char_1.f90
new file mode 100644
index 0000000..83c5268
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_char_1.f90
@@ -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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 2b63dd1..fcb5f44 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.
diff --git a/libgfortran/runtime/select.c b/libgfortran/runtime/select.c
index 4421e02..cecd025 100644
--- a/libgfortran/runtime/select.c
+++ b/libgfortran/runtime/select.c
@@ -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 */
generated by cgit v1.1 at 2024-09-30 17:43:46 +0000