trans-expr.c (gfc_conv_function_call): Return int instead of void.
authorJakub Jelinek <jakub@redhat.com>
Mon, 13 Jun 2005 15:24:54 +0000 (17:24 +0200)
committerJakub Jelinek <jakub@gcc.gnu.org>
Mon, 13 Jun 2005 15:24:54 +0000 (17:24 +0200)
* trans-expr.c (gfc_conv_function_call): Return int instead of
void.  Use a local variable for has_alternate_specifier and
return it.  Avoid modification of function type's return value
in place, since it may be shared.
* trans.h (has_alternate_specifier): Remove.
(gfc_conv_function_call): Change return type.
* trans-stmt.c (has_alternate_specifier): Remove.
(gfc_trans_call): Add a local has_alternate_specifier variable,
set it from gfc_conv_function_call return value.

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

From-SVN: r100878

gcc/ChangeLog
gcc/fortran/trans-expr.c
gcc/fortran/trans-stmt.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/altreturn_1.f90 [new file with mode: 0644]

index f32577815f2ae582ab64a42dc76d250b962ed8ae..7e8425c05d0309a1f327c2a0e8bf6e6a3574c97e 100644 (file)
@@ -1,3 +1,15 @@
+2005-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+       * trans-expr.c (gfc_conv_function_call): Return int instead of
+       void.  Use a local variable for has_alternate_specifier and
+       return it.  Avoid modification of function type's return value
+       in place, since it may be shared.
+       * trans.h (has_alternate_specifier): Remove.
+       (gfc_conv_function_call): Change return type.
+       * trans-stmt.c (has_alternate_specifier): Remove.
+       (gfc_trans_call): Add a local has_alternate_specifier variable,
+       set it from gfc_conv_function_call return value.
+
 2005-06-13  Zdenek Dvorak  <dvorakz@suse.cz>
 
        PR middle-end/21985
index 4395534e0500075acc192662c7c12c2950e5f204..3a4d52a674d2afa1dbad8590afea2eb26373a4d5 100644 (file)
@@ -1073,9 +1073,10 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
 
 
 /* Generate code for a procedure call.  Note can return se->post != NULL.
-   If se->direct_byref is set then se->expr contains the return parameter.  */
+   If se->direct_byref is set then se->expr contains the return parameter.
+   Return non-zero, if the call has alternate specifiers.  */
 
-void
+int
 gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
                        gfc_actual_arglist * arg)
 {
@@ -1091,6 +1092,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   tree len;
   tree stringargs;
   gfc_formal_arglist *formal;
+  int has_alternate_specifier = 0;
 
   arglist = NULL_TREE;
   stringargs = NULL_TREE;
@@ -1123,7 +1125,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 
              /* Bundle in the string length.  */
              se->string_length = len;
-              return;
+              return 0;
             }
        }
       info = &se->ss->data.info;
@@ -1307,9 +1309,17 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   /* Generate the actual call.  */
   gfc_conv_function_val (se, sym);
   /* If there are alternate return labels, function type should be
-     integer.  */
-  if (has_alternate_specifier)
-    TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
+     integer.  Can't modify the type in place though, since it can be shared
+     with other functions.  */
+  if (has_alternate_specifier
+      && TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) != integer_type_node)
+    {
+      gcc_assert (! sym->attr.dummy);
+      TREE_TYPE (sym->backend_decl)
+        = build_function_type (integer_type_node,
+                               TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl)));
+      se->expr = gfc_build_addr_expr (NULL, sym->backend_decl);
+    }
 
   fntype = TREE_TYPE (TREE_TYPE (se->expr));
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
@@ -1378,6 +1388,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
            }
        }
     }
+
+  return has_alternate_specifier;
 }
 
 
index 55543182f8d32ec9e218a40633b76f22f4f46e2c..46a69d461487f8a1c4ed2d26ba190841afef86f8 100644 (file)
@@ -37,8 +37,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "trans-const.h"
 #include "arith.h"
 
-int has_alternate_specifier;
-
 typedef struct iter_info
 {
   tree var;
@@ -206,6 +204,7 @@ tree
 gfc_trans_call (gfc_code * code)
 {
   gfc_se se;
+  int has_alternate_specifier;
 
   /* A CALL starts a new block because the actual arguments may have to
      be evaluated first.  */
@@ -213,10 +212,10 @@ gfc_trans_call (gfc_code * code)
   gfc_start_block (&se.pre);
 
   gcc_assert (code->resolved_sym);
-  has_alternate_specifier = 0;
 
   /* Translate the call.  */
-  gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
+  has_alternate_specifier
+    = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
 
   /* A subroutine without side-effect, by definition, does nothing!  */
   TREE_SIDE_EFFECTS (se.expr) = 1;
index f3bcbaa386d5e94804194d3e0deaaee305ed5d34..705e9f6a7f9d0c01669a63714b6c1aa3a57348be 100644 (file)
@@ -301,7 +301,7 @@ void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
 int gfc_is_intrinsic_libcall (gfc_expr *);
 
 /* Also used to CALL subroutines.  */
-void gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *);
+int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *);
 /* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
 
 /* Generate code for a scalar assignment.  */
@@ -574,7 +574,4 @@ struct lang_decl            GTY(())
                                           arg1, arg2)
 #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \
                                                 arg1, arg2, arg3)
-
-/* flag for alternative return labels.  */
-extern int has_alternate_specifier;  /* for caller */
 #endif /* GFC_TRANS_H */
index 42536ea780e86f368877983cfe5fc1e74413a7ae..af6d1b13266e51c90516360541b409757f5ba87c 100644 (file)
@@ -1,3 +1,7 @@
+2005-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+       * gfortran.dg/altreturn_1.f90: New test.
+
 2005-06-13  Zdenek Dvorak  <dvorakz@suse.cz>
 
        PR middle-end/21985
diff --git a/gcc/testsuite/gfortran.dg/altreturn_1.f90 b/gcc/testsuite/gfortran.dg/altreturn_1.f90
new file mode 100644 (file)
index 0000000..0849358
--- /dev/null
@@ -0,0 +1,7 @@
+! { dg-do compile }
+       subroutine foo (a)
+       real t, a, baz
+       call bar (*10)
+       t = 2 * baz ()
+       IF (t.gt.0) t = baz ()
+10     END