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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126978 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b0089ef..40cd9af 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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 (file)
--- 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 */