From: tobi Date: Thu, 21 Dec 2006 03:04:43 +0000 (+0000) Subject: PR fortran/25392 X-Git-Url: http://git.sourceforge.jp/view?a=commitdiff_plain;h=3350e71671d4598d6036a52781448e760d3457df;p=pf3gnuchains%2Fgcc-fork.git PR fortran/25392 fortran/ * trans-stmt.c (gfc_trans_return): Fix comment formatting. * trans-types.c (gfc_sym_type): Don't return early for functions. Remove special handling for -ff2c. (gfc_get_function_type): Add special handling for -ff2c. * trans-decl.c (gfc_create_function_decl): Fix comment formatting. (gfc_get_fake_result_decl): Make sure we get the right type for functions. (gfc_generate_function_code): Convert type of result variable to type of function. testsuite/ * gfortran.dg/f2c_8.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120099 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c3b60fc5f02..dbc724a4321 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2006-12-20 Tobias Schlüter + + PR fortran/25392 + * trans-stmt.c (gfc_trans_return): Fix comment formatting. + * trans-types.c (gfc_sym_type): Don't return early for functions. + Remove special handling for -ff2c. + (gfc_get_function_type): Add special handling for -ff2c. + * trans-decl.c (gfc_create_function_decl): Fix comment formatting. + (gfc_get_fake_result_decl): Make sure we get the right type for + functions. + (gfc_generate_function_code): Convert type of result variable to + type of function. + 2006-12-20 Paul Thomas PR fortran/30190 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 815b15e1016..2a0341698a5 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1777,7 +1777,7 @@ gfc_create_function_decl (gfc_namespace * ns) } /* Return the decl used to hold the function return value. If - parent_flag is set, the context is the parent_scope*/ + parent_flag is set, the context is the parent_scope. */ tree gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) @@ -1886,9 +1886,12 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) sprintf (name, "__result_%.20s", IDENTIFIER_POINTER (DECL_NAME (this_function_decl))); - decl = build_decl (VAR_DECL, get_identifier (name), - TREE_TYPE (TREE_TYPE (this_function_decl))); - + if (!sym->attr.mixed_entry_master && sym->attr.function) + decl = build_decl (VAR_DECL, get_identifier (name), + gfc_sym_type (sym)); + else + decl = build_decl (VAR_DECL, get_identifier (name), + TREE_TYPE (TREE_TYPE (this_function_decl))); DECL_ARTIFICIAL (decl) = 1; DECL_EXTERNAL (decl) = 0; TREE_PUBLIC (decl) = 0; @@ -3258,9 +3261,12 @@ gfc_generate_function_code (gfc_namespace * ns) warning (0, "Function return value not set"); else { - /* Set the return value to the dummy result variable. */ - tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), - DECL_RESULT (fndecl), result); + /* Set the return value to the dummy result variable. The + types may be different for scalar default REAL functions + with -ff2c, therefore we have to convert. */ + tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); + tmp = build2 (MODIFY_EXPR, TREE_TYPE (tmp), + DECL_RESULT (fndecl), tmp); tmp = build1_v (RETURN_EXPR, tmp); gfc_add_expr_to_block (&block, tmp); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index df853ec264b..8a2a2b37255 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -431,7 +431,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) tree tmp; tree result; - /* if code->expr is not NULL, this return statement must appear + /* If code->expr is not NULL, this return statement must appear in a subroutine and current_fake_result_decl has already been generated. */ diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 381e007ab3c..d0775f77111 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1321,27 +1321,13 @@ gfc_sym_type (gfc_symbol * sym) if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) return void_type_node; - if (sym->backend_decl) - { - if (sym->attr.function) - return TREE_TYPE (TREE_TYPE (sym->backend_decl)); - else - return TREE_TYPE (sym->backend_decl); - } + /* In the case of a function the fake result variable may have a + type different from the function type, so don't return early in + that case. */ + if (sym->backend_decl && !sym->attr.function) + return TREE_TYPE (sym->backend_decl); type = gfc_typenode_for_spec (&sym->ts); - if (gfc_option.flag_f2c - && sym->attr.function - && sym->ts.type == BT_REAL - && sym->ts.kind == gfc_default_real_kind - && !sym->attr.always_explicit) - { - /* Special case: f2c calling conventions require that (scalar) - default REAL functions return the C type double instead. */ - sym->ts.kind = gfc_default_double_kind; - type = gfc_typenode_for_spec (&sym->ts); - sym->ts.kind = gfc_default_real_kind; - } if (sym->attr.dummy && !sym->attr.function && !sym->attr.value) byref = 1; @@ -1790,6 +1776,20 @@ gfc_get_function_type (gfc_symbol * sym) type = void_type_node; else if (sym->attr.mixed_entry_master) type = gfc_get_mixed_entry_union (sym->ns); + else if (gfc_option.flag_f2c + && sym->ts.type == BT_REAL + && sym->ts.kind == gfc_default_real_kind + && !sym->attr.always_explicit) + { + /* Special case: f2c calling conventions require that (scalar) + default REAL functions return the C type double instead. f2c + compatibility is only an issue with functions that don't + require an explicit interface, as only these could be + implemented in Fortran 77. */ + sym->ts.kind = gfc_default_double_kind; + type = gfc_typenode_for_spec (&sym->ts); + sym->ts.kind = gfc_default_real_kind; + } else type = gfc_sym_type (sym); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 35d77a8c36c..a1e84b11b5e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-12-20 Tobias Schlüter + + PR fortran/25392 + * gfortran.dg/f2c_8.f90: New test. + 2006-12-20 Bill Wendling * gcc.dg/asm-b.c: Check for __ppc64__. diff --git a/gcc/testsuite/gfortran.dg/f2c_8.f90 b/gcc/testsuite/gfortran.dg/f2c_8.f90 new file mode 100644 index 00000000000..03baa36be53 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2c_8.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! { dg-options "-ff2c" } +! PR 25392 +! Verify that the type of the result variable matches the declared +! type of the function. The actual type of the function may be +! different for f2c calling conventions. +real function goo () result (foo) + real x + foo = sign(foo, x) +end + +real function foo () + real x + foo = sign(foo, x) +end +