From b49a3de7433301048a330df014a008a2b4066e7d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tobias=20Schl=C3=BCter?=
<tobias.schlueter@physik.uni-muenchen.de>
Date: Sun, 12 Jun 2005 17:21:12 +0200
Subject: [PATCH] trans-expr.c (gfc_conv_variable): POINTER results don't need
f2c calling conventions.
fortran/
* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
calling conventions. Look at sym instead of sym->result.
* trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
Remove condition which is always false with workaround removed.
(gfc_return_by_reference): Always look at sym, never at sym->result.
testsuite/
* gfortran.dg/f2c_7.f90: New test.
From-SVN: r100857
---
gcc/fortran/ChangeLog | 8 ++++
gcc/fortran/trans-expr.c | 5 +--
gcc/fortran/trans-types.c | 17 ++-------
gcc/testsuite/ChangeLog | 4 ++
gcc/testsuite/gfortran.dg/f2c_7.f90 | 57 +++++++++++++++++++++++++++++
5 files changed, 74 insertions(+), 17 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/f2c_7.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af1d05f6fabe..a63f47560695 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2005-06-11 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
+ calling conventions. Look at sym instead of sym->result.
+ * trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
+ Remove condition which is always false with workaround removed.
+ (gfc_return_by_reference): Always look at sym, never at sym->result.
+
2005-06-11 Steven G. Kargl <kargls@comcast.net>
PR fortran/17792
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 52d37039753f..ee6de7ee46a7 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -379,7 +379,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
/* Dereference scalar hidden result. */
if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX
&& (sym->attr.function || sym->attr.result)
- && !sym->attr.dimension)
+ && !sym->attr.dimension && !sym->attr.pointer)
se->expr = gfc_build_indirect_ref (se->expr);
/* Dereference non-character pointer variables.
@@ -1315,9 +1315,6 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
arglist, NULL_TREE);
- if (sym->result)
- sym = sym->result;
-
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
x = f()
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1338297c3e8c..c550eec0584f 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1268,11 +1268,6 @@ gfc_sym_type (gfc_symbol * sym)
return TREE_TYPE (sym->backend_decl);
}
- /* The frontend doesn't set all the attributes for a function with an
- explicit result value, so we use that instead when present. */
- if (sym->attr.function && sym->result)
- sym = sym->result;
-
type = gfc_typenode_for_spec (&sym->ts);
if (gfc_option.flag_f2c
&& sym->attr.function
@@ -1299,7 +1294,7 @@ gfc_sym_type (gfc_symbol * sym)
/* If this is a character argument of unknown length, just use the
base type. */
if (sym->ts.type != BT_CHARACTER
- || !(sym->attr.dummy || sym->attr.function || sym->attr.result)
+ || !(sym->attr.dummy || sym->attr.function)
|| sym->ts.cl->backend_decl)
{
type = gfc_get_nodesc_array_type (type, sym->as,
@@ -1467,17 +1462,13 @@ gfc_get_derived_type (gfc_symbol * derived)
int
gfc_return_by_reference (gfc_symbol * sym)
{
- gfc_symbol *result;
-
if (!sym->attr.function)
return 0;
- result = sym->result ? sym->result : sym;
-
- if (result->attr.dimension)
+ if (sym->attr.dimension)
return 1;
- if (result->ts.type == BT_CHARACTER)
+ if (sym->ts.type == BT_CHARACTER)
return 1;
/* Possibly return complex numbers by reference for g77 compatibility.
@@ -1486,7 +1477,7 @@ gfc_return_by_reference (gfc_symbol * sym)
require an explicit interface, as no compatibility problems can
arise there. */
if (gfc_option.flag_f2c
- && result->ts.type == BT_COMPLEX
+ && sym->ts.type == BT_COMPLEX
&& !sym->attr.intrinsic && !sym->attr.always_explicit)
return 1;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e890f8066cc0..929900e1188a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2005-06-12 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * gfortran.dg/f2c_7.f90: New test.
+
2005-06-12 James A. Morrison <phython@gcc.gnu.org>
* gcc.dg/pr14796-1.c: New.
diff --git a/gcc/testsuite/gfortran.dg/f2c_7.f90 b/gcc/testsuite/gfortran.dg/f2c_7.f90
new file mode 100644
index 000000000000..848dcc5a3c89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_7.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-ff2c -O" }
+! Verifies that array results work with -ff2c
+! try all permutations of result clause in function yes/no
+! and result clause in interface yes/no
+! this is not possible in Fortran 77, but this exercises a previously
+! buggy codepath
+function c() result (r)
+ complex :: r(5)
+ r = 0.
+end function c
+
+function d()
+ complex :: d(5)
+ d = 1.
+end function d
+
+subroutine test_without_result
+interface
+ function c
+ complex :: c(5)
+ end function c
+end interface
+interface
+ function d
+ complex :: d(5)
+ end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_without_result
+
+subroutine test_with_result
+interface
+ function c result(r)
+ complex :: r(5)
+ end function c
+end interface
+interface
+ function d result(r)
+ complex :: r(5)
+ end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_with_result
+
+call test_without_result
+call test_with_result
+end
+
--
GitLab