This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran, committed] Backport f2c calling conventions to 4.0
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 02 Jun 2005 01:02:26 +0200
- Subject: [gfortran, committed] Backport f2c calling conventions to 4.0
I've committed the patch for f2c calling conventions together with the
followup fix from <http://gcc.gnu.org/ml/fortran/2005-05/msg00116.html> to the
4.0 branch. I had intended to wait for the approval of the patch from
<http://gcc.gnu.org/ml/fortran/2005-05/msg00117.html>, but since the first
4.0.1 prerelease is scheduled for Friday (*) I decided to commit this
important functionality even though it's not in its cleanest form this way.
The patch for the remaining cleanup has been waiting for review long enough
that I assume that noone considers it important.
Bubblestrapped and regtested on i686-pc-linux, diff attached.
- Tobi
(*) http://gcc.gnu.org/ml/gcc/2005-05/msg01466.html
? build
? gcc/semantic.cache
? gcc/fortran/head.diff
? gcc/fortran/semantic.cache
? libgfortran/head.diff
? libgfortran/io/semantic.cache
Index: gcc/fortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/ChangeLog,v
retrieving revision 1.335.2.61
diff -c -3 -p -r1.335.2.61 ChangeLog
*** gcc/fortran/ChangeLog 1 Jun 2005 10:13:19 -0000 1.335.2.61
--- gcc/fortran/ChangeLog 1 Jun 2005 22:43:14 -0000
***************
*** 1,3 ****
--- 1,36 ----
+ 2005-06-01 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * gfortran.h (gfc_option): Add flag_f2c.
+ * invoke.texi: Document '-ff2c' command line option. Adapt
+ documentation for '-fno-second-underscore' and '-fno-underscoring'.
+ * lang.opt (ff2c): New entry.
+ * options.c (gfc-init_options): Set default calling convention
+ to -fno-f2c and -fno-second-underscore.
+ (handle_options): Set gfc_option.flag_f2c according to requested
+ calling convention.
+ * trans-decl.c (gfc_get_extern_function_decl): Use special f2c
+ intrinsics where necessary.
+ (gfc_trans_deferred_vars): Change todo error to assertion.
+ * trans-expr.c (gfc_conv_variable): Dereference access
+ to hidden result argument.
+ (gfc_conv_function_call): Add hidden result argument to argument
+ list if f2c calling conventions requested. Slightly restructure
+ tests. Convert result of default REAL function to requested type
+ if f2c calling conventions are used. Dereference COMPLEX result
+ if f2c cc are used.
+ * trans-types.c (gfc_sym_type): Return double for default REAL
+ function if f2c cc are used.
+ (gfc_return_by_reference): Slightly restructure logic. Return
+ COMPLEX by reference depending on calling conventions.
+ (gfc_get_function_type): Correctly make hidden result argument a
+ pass-by-reference argument for COMPLEX. Remove old code which does
+ this for derived types.
+
+ * resolve.c (resolve_symbol): Copy 'pointer' and 'dimension'
+ attribute from result symbol to function symbol.
+ * trans-expr.c (gfc_conv_function_call): Check sym for attribute
+ 'dimension' instead of sym->result.
+
2005-06-01 Jakub Jelinek <jakub@redhat.com>
PR fortran/21729
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.58.2.6
diff -c -3 -p -r1.58.2.6 gfortran.h
*** gcc/fortran/gfortran.h 29 Apr 2005 16:01:11 -0000 1.58.2.6
--- gcc/fortran/gfortran.h 1 Jun 2005 22:43:14 -0000
*************** typedef struct
*** 1419,1424 ****
--- 1419,1425 ----
int flag_no_backend;
int flag_pack_derived;
int flag_repack_arrays;
+ int flag_f2c;
int q_kind;
Index: gcc/fortran/invoke.texi
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/invoke.texi,v
retrieving revision 1.7.18.4
diff -c -3 -p -r1.7.18.4 invoke.texi
*** gcc/fortran/invoke.texi 12 Apr 2005 21:38:14 -0000 1.7.18.4
--- gcc/fortran/invoke.texi 1 Jun 2005 22:43:14 -0000
*************** by type. Explanations are in the follow
*** 156,162 ****
@item Code Generation Options
@xref{Code Gen Options,,Options for Code Generation Conventions}.
@gccoptlist{
! -fno-underscoring -fno-second-underscore @gol
-fbounds-check -fmax-stack-var-size=@var{n} @gol
-fpackderived -frepack-arrays}
@end table
--- 156,162 ----
@item Code Generation Options
@xref{Code Gen Options,,Options for Code Generation Conventions}.
@gccoptlist{
! -ff2c -fno-underscoring -fsecond-underscore @gol
-fbounds-check -fmax-stack-var-size=@var{n} @gol
-fpackderived -frepack-arrays}
@end table
*************** it.
*** 521,528 ****
@table @gcctabopt
! @cindex -fno-underscoring option
! @cindex options, -fno-underscoring
@item -fno-underscoring
@cindex underscore
@cindex symbol names, underscores
--- 521,563 ----
@table @gcctabopt
! @cindex @option{-ff2c} option
! @cindex options, @option{-ff2c}
! @item -ff2c
! @cindex calling convention
! @cindex @command{f2c} calling convention
! @cindex @command{g77} calling convention
! @cindex libf2c calling convention
! Generate code designed to be compatible with code generated
! by @command{g77} and @command{f2c}.
!
! The calling conventions used by @command{g77} (originally implemented
! in @command{f2c}) require functions that return type
! default @code{REAL} to actually return the C type @code{double}, and
! functions that return type @code{COMPLEX} to return the values via an
! extra argument in the calling sequence that points to where to
! store the return value. Under the default GNU calling conventions, such
! functions simply return their results as they would in GNU
! C -- default @code{REAL} functions return the C type @code{float}, and
! @code{COMPLEX} functions return the GNU C type @code{complex}.
! Additionally, this option implies the @option{-fsecond-underscore}
! option, unless @option{-fno-second-underscore} is explicitly requested.
!
! This does not affect the generation of code that interfaces with
! the @command{libgfortran} library.
!
! @emph{Caution:} It is not a good idea to mix Fortran code compiled
! with @code{-ff2c} with code compiled with the default @code{-fno-f2c}
! calling conventions as, calling @code{COMPLEX} or default @code{REAL}
! functions between program parts which were compiled with different
! calling conventions will break at execution time.
!
! @emph{Caution:} This will break code which passes intrinsic functions
! of type default @code{REAL} or @code{COMPLEX} as actual arguments, as
! the library implementations use the @command{-fno-f2c} calling conventions.
!
! @cindex @option{-fno-underscoring option}
! @cindex options, @option{-fno-underscoring}
@item -fno-underscoring
@cindex underscore
@cindex symbol names, underscores
*************** it.
*** 531,546 ****
Do not transform names of entities specified in the Fortran
source file by appending underscores to them.
! With @option{-funderscoring} in effect, @command{gfortran} appends two
! underscores to names with underscores and one underscore to external names
! with no underscores. (@command{gfortran} also appends two underscores to
! internal names with underscores to avoid naming collisions with external
! names. The @option{-fno-second-underscore} option disables appending of the
! second underscore in all cases.)
This is done to ensure compatibility with code produced by many
! UNIX Fortran compilers, including @command{f2c} which perform the
! same transformations.
Use of @option{-fno-underscoring} is not recommended unless you are
experimenting with issues such as integration of (GNU) Fortran into
--- 566,582 ----
Do not transform names of entities specified in the Fortran
source file by appending underscores to them.
! With @option{-funderscoring} in effect, @command{gfortran} appends one
! underscore to external names with no underscores.
This is done to ensure compatibility with code produced by many
! UNIX Fortran compilers.
!
! @emph{Caution}: The default behavior of @command{gfortran} is
! incompatible with @command{f2c} and @command{g77}, please use the
! @option{-ff2c} and @option{-fsecond-underscore} options if you want
! object files compiled with @option{gfortran} to be compatible with
! object code created with these tools.
Use of @option{-fno-underscoring} is not recommended unless you are
experimenting with issues such as integration of (GNU) Fortran into
*************** in the source, even if the names as seen
*** 596,617 ****
prevent accidental linking between procedures with incompatible
interfaces.
! @cindex -fno-second-underscore option
! @cindex options, -fno-second-underscore
! @item -fno-second-underscore
@cindex underscore
@cindex symbol names, underscores
@cindex transforming symbol names
@cindex symbol names, transforming
! Do not append a second underscore to names of entities specified
! in the Fortran source file.
This option has no effect if @option{-fno-underscoring} is
! in effect.
Otherwise, with this option, an external name such as @samp{MAX_COUNT}
is implemented as a reference to the link-time external symbol
! @samp{max_count_}, instead of @samp{max_count__}.
@cindex -fbounds-check option
--- 632,662 ----
prevent accidental linking between procedures with incompatible
interfaces.
! @cindex @option{-fsecond-underscore option}
! @cindex options, @option{-fsecond-underscore}
! @item -fsecond-underscore
@cindex underscore
@cindex symbol names, underscores
@cindex transforming symbol names
@cindex symbol names, transforming
! @cindex @command{f2c} calling convention
! @cindex @command{g77} calling convention
! @cindex libf2c calling convention
! By default, @command{gfortran} appends an underscore to external
! names. If this option is used @command{gfortran} appends two
! underscores to names with underscores and one underscore to external names
! with no underscores. (@command{gfortran} also appends two underscores to
! internal names with underscores to avoid naming collisions with external
! names.
This option has no effect if @option{-fno-underscoring} is
! in effect. It is implied by the @option{-ff2c} option.
Otherwise, with this option, an external name such as @samp{MAX_COUNT}
is implemented as a reference to the link-time external symbol
! @samp{max_count__}, instead of @samp{max_count_}. This is required
! for compatibility with @command{g77} and @command{f2c}, and is implied
! by use of the @option{-ff2c} option.
@cindex -fbounds-check option
Index: gcc/fortran/lang.opt
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/lang.opt,v
retrieving revision 1.8.20.1
diff -c -3 -p -r1.8.20.1 lang.opt
*** gcc/fortran/lang.opt 30 Mar 2005 01:40:14 -0000 1.8.20.1
--- gcc/fortran/lang.opt 1 Jun 2005 22:43:14 -0000
*************** fdump-parse-tree
*** 89,94 ****
--- 89,98 ----
F95
Display the code tree after parsing.
+ ff2c
+ F95
+ Use f2c calling convention.
+
ffixed-form
F95
Assume that the source file is fixed form
Index: gcc/fortran/options.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/options.c,v
retrieving revision 1.17.8.1
diff -c -3 -p -r1.17.8.1 options.c
*** gcc/fortran/options.c 30 Mar 2005 01:40:14 -0000 1.17.8.1
--- gcc/fortran/options.c 1 Jun 2005 22:43:14 -0000
*************** gfc_init_options (unsigned int argc ATTR
*** 62,68 ****
gfc_option.flag_default_real = 0;
gfc_option.flag_dollar_ok = 0;
gfc_option.flag_underscoring = 1;
! gfc_option.flag_second_underscore = 1;
gfc_option.flag_implicit_none = 0;
gfc_option.flag_max_stack_var_size = 32768;
gfc_option.flag_module_access_private = 0;
--- 62,69 ----
gfc_option.flag_default_real = 0;
gfc_option.flag_dollar_ok = 0;
gfc_option.flag_underscoring = 1;
! gfc_option.flag_f2c = 0;
! gfc_option.flag_second_underscore = -1;
gfc_option.flag_implicit_none = 0;
gfc_option.flag_max_stack_var_size = 32768;
gfc_option.flag_module_access_private = 0;
*************** gfc_post_options (const char **pfilename
*** 113,118 ****
--- 114,125 ----
if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
gfc_option.warn_std |= GFC_STD_GNU;
+ /* If the user didn't explicitly specify -f(no)-second-underscore we
+ use it if we're trying to be compatible with f2c, and not
+ otherwise. */
+ if (gfc_option.flag_second_underscore == -1)
+ gfc_option.flag_second_underscore = gfc_option.flag_f2c;
+
return false;
}
*************** gfc_handle_option (size_t scode, const c
*** 214,219 ****
--- 221,230 ----
gfc_option.warn_unused_labels = value;
break;
+ case OPT_ff2c:
+ gfc_option.flag_f2c = value;
+ break;
+
case OPT_fdollar_ok:
gfc_option.flag_dollar_ok = value;
break;
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.34.2.9
diff -c -3 -p -r1.34.2.9 resolve.c
*** gcc/fortran/resolve.c 1 Jun 2005 10:13:19 -0000 1.34.2.9
--- gcc/fortran/resolve.c 1 Jun 2005 22:43:16 -0000
*************** resolve_symbol (gfc_symbol * sym)
*** 4068,4073 ****
--- 4068,4075 ----
sym->ts = sym->result->ts;
sym->as = gfc_copy_array_spec (sym->result->as);
+ sym->attr.dimension = sym->result->attr.dimension;
+ sym->attr.pointer = sym->result->attr.pointer;
}
}
}
Index: gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.54.2.2
diff -c -3 -p -r1.54.2.2 trans-decl.c
*** gcc/fortran/trans-decl.c 29 Apr 2005 16:01:12 -0000 1.54.2.2
--- gcc/fortran/trans-decl.c 1 Jun 2005 22:43:16 -0000
*************** gfc_get_extern_function_decl (gfc_symbol
*** 901,907 ****
gfc_expr e;
gfc_intrinsic_sym *isym;
gfc_expr argexpr;
! char s[GFC_MAX_SYMBOL_LEN];
tree name;
tree mangled_name;
--- 901,907 ----
gfc_expr e;
gfc_intrinsic_sym *isym;
gfc_expr argexpr;
! char s[GFC_MAX_SYMBOL_LEN + 13]; /* "f2c_specific" and '\0'. */
tree name;
tree mangled_name;
*************** gfc_get_extern_function_decl (gfc_symbol
*** 937,943 ****
gcc_assert (isym->formal->next->next == NULL);
isym->resolve.f2 (&e, &argexpr, NULL);
}
! sprintf (s, "specific%s", e.value.function.name);
name = get_identifier (s);
mangled_name = name;
}
--- 937,954 ----
gcc_assert (isym->formal->next->next == NULL);
isym->resolve.f2 (&e, &argexpr, NULL);
}
!
! if (gfc_option.flag_f2c
! && ((e.ts.type == BT_REAL && e.ts.kind == gfc_default_real_kind)
! || e.ts.type == BT_COMPLEX))
! {
! /* Specific which needs a different implementation if f2c
! calling conventions are used. */
! sprintf (s, "f2c_specific%s", e.value.function.name);
! }
! else
! sprintf (s, "specific%s", e.value.function.name);
!
name = get_identifier (s);
mangled_name = name;
}
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 2030,2036 ****
fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
}
else
! gfc_todo_error ("Deferred non-array return by reference");
}
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
--- 2041,2048 ----
fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
}
else
! gcc_assert (gfc_option.flag_f2c
! && proc_sym->ts.type == BT_COMPLEX);
}
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
Index: gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.38.2.3
diff -c -3 -p -r1.38.2.3 trans-expr.c
*** gcc/fortran/trans-expr.c 29 Apr 2005 16:01:10 -0000 1.38.2.3
--- gcc/fortran/trans-expr.c 1 Jun 2005 22:43:17 -0000
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 362,367 ****
--- 362,374 ----
&& !sym->attr.dimension)
se->expr = gfc_build_indirect_ref (se->expr);
+ /* Dereference scalar hidden result. */
+ if (gfc_option.flag_f2c
+ && (sym->attr.function || sym->attr.result)
+ && sym->ts.type == BT_COMPLEX
+ && !sym->attr.dimension)
+ se->expr = gfc_build_indirect_ref (se->expr);
+
/* Dereference pointer variables. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1139,1145 ****
convert (gfc_charlen_type_node, len));
}
else
! gcc_unreachable ();
}
formal = sym->formal;
--- 1146,1158 ----
convert (gfc_charlen_type_node, len));
}
else
! {
! gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
!
! type = gfc_get_complex_type (sym->ts.kind);
! var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
! arglist = gfc_chainon_list (arglist, var);
! }
}
formal = sym->formal;
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1241,1254 ****
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
arglist, NULL_TREE);
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
x = f()
where f is pointer valued, we have to dereference the result. */
! if (!se->want_pointer && !byref
! && (sym->attr.pointer || (sym->result && sym->result->attr.pointer)))
se->expr = gfc_build_indirect_ref (se->expr);
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;
--- 1254,1278 ----
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()
where f is pointer valued, we have to dereference the result. */
! if (!se->want_pointer && !byref && sym->attr.pointer)
se->expr = gfc_build_indirect_ref (se->expr);
+ /* f2c calling conventions require a scalar default real function to
+ return a double precision result. Convert this back to default
+ real. We only care about the cases that can happen in Fortran 77.
+ */
+ if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+ && sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.always_explicit)
+ se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1265,1271 ****
if (!se->direct_byref)
{
! if (sym->result->attr.dimension)
{
if (flag_bounds_check)
{
--- 1289,1295 ----
if (!se->direct_byref)
{
! if (sym->attr.dimension)
{
if (flag_bounds_check)
{
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1283,1289 ****
se->string_length = len;
}
else
! gcc_unreachable ();
}
}
}
--- 1307,1316 ----
se->string_length = len;
}
else
! {
! gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
! se->expr = gfc_build_indirect_ref (var);
! }
}
}
}
Index: gcc/fortran/trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.37.10.4
diff -c -3 -p -r1.37.10.4 trans-types.c
*** gcc/fortran/trans-types.c 12 May 2005 18:26:44 -0000 1.37.10.4
--- gcc/fortran/trans-types.c 1 Jun 2005 22:43:17 -0000
*************** gfc_sym_type (gfc_symbol * sym)
*** 1269,1274 ****
--- 1269,1286 ----
sym = sym->result;
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)
byref = 1;
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 1450,1468 ****
int
gfc_return_by_reference (gfc_symbol * sym)
{
if (!sym->attr.function)
return 0;
! if (sym->result)
! sym = sym->result;
! if (sym->attr.dimension)
return 1;
! if (sym->ts.type == BT_CHARACTER)
return 1;
! /* Possibly return complex numbers by reference for g77 compatibility. */
return 0;
}
--- 1462,1490 ----
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)
return 1;
! if (result->ts.type == BT_CHARACTER)
return 1;
! /* Possibly return complex numbers by reference for g77 compatibility.
! We don't do this for calls to intrinsics (as the library uses the
! -fno-f2c calling convention), nor for calls to functions which always
! require an explicit interface, as no compatibility problems can
! arise there. */
! if (gfc_option.flag_f2c
! && result->ts.type == BT_COMPLEX
! && !sym->attr.intrinsic && !sym->attr.always_explicit)
! return 1;
!
return 0;
}
*************** gfc_get_function_type (gfc_symbol * sym)
*** 1548,1554 ****
gfc_conv_const_charlen (arg->ts.cl);
type = gfc_sym_type (arg);
! if (arg->ts.type == BT_DERIVED
|| arg->attr.dimension
|| arg->ts.type == BT_CHARACTER)
type = build_reference_type (type);
--- 1570,1576 ----
gfc_conv_const_charlen (arg->ts.cl);
type = gfc_sym_type (arg);
! if (arg->ts.type == BT_COMPLEX
|| arg->attr.dimension
|| arg->ts.type == BT_CHARACTER)
type = build_reference_type (type);
Index: gcc/testsuite/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/ChangeLog,v
retrieving revision 1.5084.2.218
diff -c -3 -p -r1.5084.2.218 ChangeLog
*** gcc/testsuite/ChangeLog 1 Jun 2005 14:47:00 -0000 1.5084.2.218
--- gcc/testsuite/ChangeLog 1 Jun 2005 22:43:22 -0000
***************
*** 1,3 ****
--- 1,9 ----
+ 2005-06-01 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
+ gfortran.dg/f2c_3.f90, gfortran.dg/func_result_2.f90:
+ New tests.
+
2005-06-01 Nathan Sidwell <nathan@codesourcery.com>
PR c++/20350
Index: gcc/testsuite/gfortran.dg/f2c_1.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_1.f90
diff -N gcc/testsuite/gfortran.dg/f2c_1.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_1.f90 1 Jun 2005 22:43:25 -0000
***************
*** 0 ****
--- 1,73 ----
+ ! Make sure the f2c calling conventions work
+ ! { dg-do run }
+ ! { dg-options "-ff2c" }
+
+ function f(x)
+ f = x
+ end function f
+
+ complex function c(a,b)
+ c = cmplx (a,b)
+ end function c
+
+ double complex function d(e,f)
+ double precision e, f
+ d = cmplx (e, f, kind(d))
+ end function d
+
+ subroutine test_with_interface()
+ interface
+ real function f(x)
+ real::x
+ end function f
+ end interface
+
+ interface
+ complex function c(a,b)
+ real::a,b
+ end function c
+ end interface
+
+ interface
+ double complex function d(e,f)
+ double precision::e,f
+ end function d
+ end interface
+
+ double precision z, w
+
+ x = 8.625
+ if (x /= f(x)) call abort ()
+ y = f(x)
+ if (x /= y) call abort ()
+
+ a = 1.
+ b = -1.
+ if (c(a,b) /= cmplx(a,b)) call abort ()
+
+ z = 1.
+ w = -1.
+ if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+ end subroutine test_with_interface
+
+ external f, c, d
+ real f
+ complex c
+ double complex d
+ double precision z, w
+
+ x = 8.625
+ if (x /= f(x)) call abort ()
+ y = f(x)
+ if (x /= y) call abort ()
+
+ a = 1.
+ b = -1.
+ if (c(a,b) /= cmplx(a,b)) call abort ()
+
+ z = 1.
+ w = -1.
+ if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+
+ call test_with_interface ()
+ end
Index: gcc/testsuite/gfortran.dg/f2c_2.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_2.f90
diff -N gcc/testsuite/gfortran.dg/f2c_2.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_2.f90 1 Jun 2005 22:43:25 -0000
***************
*** 0 ****
--- 1,23 ----
+ ! Some basic testing that calls to the library still work correctly with
+ ! -ff2c
+ !
+ ! Once the library has support for f2c calling conventions (i.e. passing
+ ! a REAL*4 or COMPLEX-valued intrinsic as procedure argument works), we
+ ! can simply add -ff2c to the list of options to cycle through, and get
+ ! complete coverage. As of 2005-03-05 this doesn't work.
+ ! { dg-do run }
+ ! { dg-options "-ff2c" }
+
+ complex c
+ double complex d
+
+ x = 2.
+ if ((sqrt(x) - 1.41)**2 > 1.e-4) call abort ()
+ x = 1.
+ if ((atan(x) - 3.14/4) ** 2 > 1.e-4) call abort ()
+ c = (-1.,0.)
+ if (sqrt(c) /= (0., 1.)) call abort ()
+ d = c
+ if (sqrt(d) /= (0._8, 1._8)) call abort ()
+ end
+
Index: gcc/testsuite/gfortran.dg/f2c_3.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_3.f90
diff -N gcc/testsuite/gfortran.dg/f2c_3.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_3.f90 1 Jun 2005 22:43:25 -0000
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do run }
+ ! { dg-options "-ff2c" }
+ ! Verifies that internal functions are not broken by f2c calling conventions
+ program test
+ real, target :: f
+ real, pointer :: q
+ real :: g
+ f = 1.0
+ q=>f
+ g = foo(q)
+ if (g .ne. 1.0) call abort
+ contains
+ function foo (p)
+ real, pointer :: foo
+ real, pointer :: p
+ foo => p
+ end function
+ end program
Index: gcc/testsuite/gfortran.dg/func_result_2.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/func_result_2.f90
diff -N gcc/testsuite/gfortran.dg/func_result_2.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/func_result_2.f90 1 Jun 2005 22:43:25 -0000
***************
*** 0 ****
--- 1,10 ----
+ ! { dg-do run }
+ ! Character functions with a result clause were broken
+ program testch
+ if (ch().ne."hello ") call abort()
+ contains
+ function ch result(str)
+ character(len = 10) :: str
+ str ="hello"
+ end function ch
+ end program testch
Index: libgfortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/ChangeLog,v
retrieving revision 1.163.2.46
diff -c -3 -p -r1.163.2.46 ChangeLog
*** libgfortran/ChangeLog 30 May 2005 07:42:37 -0000 1.163.2.46
--- libgfortran/ChangeLog 1 Jun 2005 22:43:26 -0000
***************
*** 1,3 ****
--- 1,11 ----
+ 2005-06-01 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
+ to dependencies.
+ * aclocal.m4: Regenerate.
+ * Makefile.in: Regenerate.
+ * intrinsics/f2c_specific.F90: New file.
+
2005-05-30 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20179
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.29.10.4
diff -c -3 -p -r1.29.10.4 Makefile.am
*** libgfortran/Makefile.am 19 May 2005 22:06:33 -0000 1.29.10.4
--- libgfortran/Makefile.am 1 Jun 2005 22:43:26 -0000
*************** foo
*** 391,397 ****
gfor_specific_src= \
$(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
! intrinsics/dprod_r8.f90
gfor_cmath_src= $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c)
gfor_cmath_obj= $(gfor_math_trig_obj) $(gfor_math_exp_obj) \
--- 391,398 ----
gfor_specific_src= \
$(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
! intrinsics/dprod_r8.f90 \
! intrinsics/f2c_specifics.F90
gfor_cmath_src= $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c)
gfor_cmath_obj= $(gfor_math_trig_obj) $(gfor_math_exp_obj) \
Index: libgfortran/intrinsics/f2c_specifics.F90
===================================================================
RCS file: libgfortran/intrinsics/f2c_specifics.F90
diff -N libgfortran/intrinsics/f2c_specifics.F90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/intrinsics/f2c_specifics.F90 1 Jun 2005 22:43:29 -0000
***************
*** 0 ****
--- 1,169 ----
+ ! Copyright 2002, 2005 Free Software Foundation, Inc.
+ ! Contributed by Tobias Schl"uter
+ !
+ !This file is part of the GNU Fortran 95 runtime library (libgfortran).
+ !
+ !GNU libgfortran is free software; you can redistribute it and/or
+ !modify it under the terms of the GNU General Public
+ !License as published by the Free Software Foundation; either
+ !version 2 of the License, or (at your option) any later version.
+
+ !In addition to the permissions in the GNU General Public License, the
+ !Free Software Foundation gives you unlimited permission to link the
+ !compiled version of this file into combinations with other programs,
+ !and to distribute those combinations without any restriction coming
+ !from the use of this file. (The General Public License restrictions
+ !do apply in other respects; for example, they cover modification of
+ !the file, and distribution when not linked into a combine
+ !executable.)
+ !
+ !GNU libgfortran is distributed in the hope that it will be useful,
+ !but WITHOUT ANY WARRANTY; without even the implied warranty of
+ !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ !GNU General Public License for more details.
+ !
+ !You should have received a copy of the GNU General Public
+ !License along with libgfortran; see the file COPYING. If not,
+ !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ !Boston, MA 02111-1307, USA.
+ !
+ ! Specifics for the intrinsics whose calling conventions change if
+ ! -ff2c is used.
+ !
+ ! There are two annoyances WRT the preprocessor:
+ ! - we're using -traditional-cpp, so we can't use the ## operator.
+ ! - macros expand to a single line, and Fortran lines can't be wider
+ ! than 132 characters, therefore we use two macros to split the lines
+ !
+ ! The cases we need to implement are functions returning default REAL
+ ! or COMPLEX. The former need to return DOUBLE PRECISION instead of REAL,
+ ! the latter become subroutines returning via a hidden first argument.
+
+ ! one argument functions
+ #define REAL_HEAD(NAME) \
+ elemental function f2c_specific__/**/NAME/**/_r4 (parm) result(res);
+
+ #define REAL_BODY(NAME) \
+ REAL, intent (in) :: parm; \
+ DOUBLE PRECISION :: res; \
+ res = NAME (parm); \
+ end function
+
+ #define COMPLEX_HEAD(NAME) \
+ subroutine f2c_specific__/**/NAME/**/_c4 (res, parm);
+
+ #define COMPLEX_BODY(NAME) \
+ COMPLEX, intent (in) :: parm; \
+ COMPLEX, intent (out) :: res; \
+ res = NAME (parm); \
+ end subroutine
+
+ #define DCOMPLEX_HEAD(NAME) \
+ subroutine f2c_specific__/**/NAME/**/_c8 (res, parm);
+
+ #define DCOMPLEX_BODY(NAME) \
+ DOUBLE COMPLEX, intent (in) :: parm; \
+ DOUBLE COMPLEX, intent (out) :: res; \
+ res = NAME (parm); \
+ end subroutine
+
+ REAL_HEAD(abs)
+ REAL_BODY(abs)
+ ! abs is special in that the result is real
+ elemental function f2c_specific__abs_c4 (parm) result (res)
+ COMPLEX, intent(in) :: parm
+ DOUBLE PRECISION :: res
+ res = abs(parm)
+ end function
+
+ REAL_HEAD(exp)
+ REAL_BODY(exp)
+ COMPLEX_HEAD(exp)
+ COMPLEX_BODY(exp)
+ DCOMPLEX_HEAD(exp)
+ DCOMPLEX_BODY(exp)
+
+ REAL_HEAD(log)
+ REAL_BODY(log)
+ COMPLEX_HEAD(log)
+ COMPLEX_BODY(log)
+ DCOMPLEX_HEAD(log)
+ DCOMPLEX_BODY(log)
+
+ REAL_HEAD(log10)
+ REAL_BODY(log10)
+
+ REAL_HEAD(sqrt)
+ REAL_BODY(sqrt)
+ COMPLEX_HEAD(sqrt)
+ COMPLEX_BODY(sqrt)
+ DCOMPLEX_HEAD(sqrt)
+ DCOMPLEX_BODY(sqrt)
+
+ REAL_HEAD(asin)
+ REAL_BODY(asin)
+
+ REAL_HEAD(acos)
+ REAL_BODY(acos)
+
+ REAL_HEAD(atan)
+ REAL_BODY(atan)
+
+ REAL_HEAD(sin)
+ REAL_BODY(sin)
+ COMPLEX_HEAD(sin)
+ COMPLEX_BODY(sin)
+ DCOMPLEX_HEAD(sin)
+ DCOMPLEX_BODY(sin)
+
+ REAL_HEAD(cos)
+ REAL_BODY(cos)
+ COMPLEX_HEAD(cos)
+ COMPLEX_BODY(cos)
+ DCOMPLEX_HEAD(cos)
+ DCOMPLEX_BODY(cos)
+
+ REAL_HEAD(tan)
+ REAL_BODY(tan)
+
+ REAL_HEAD(sinh)
+ REAL_BODY(sinh)
+
+ REAL_HEAD(cosh)
+ REAL_BODY(cosh)
+
+ REAL_HEAD(tanh)
+ REAL_BODY(tanh)
+
+ COMPLEX_HEAD(conjg)
+ COMPLEX_BODY(conjg)
+ DCOMPLEX_HEAD(conjg)
+ DCOMPLEX_BODY(conjg)
+
+ REAL_HEAD(aint)
+ REAL_BODY(aint)
+
+ REAL_HEAD(anint)
+ REAL_BODY(anint)
+
+ ! two argument functions
+ #define REAL2_HEAD(NAME) \
+ elemental function f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res);
+
+ #define REAL2_BODY(NAME) \
+ REAL, intent (in) :: p1, p2; \
+ DOUBLE PRECISION :: res; \
+ res = NAME (p1, p2); \
+ end function
+
+ REAL2_HEAD(sign)
+ REAL2_BODY(sign)
+
+ REAL2_HEAD(dim)
+ REAL2_BODY(dim)
+
+ REAL2_HEAD(atan2)
+ REAL2_BODY(atan2)
+
+ REAL2_HEAD(mod)
+ REAL2_BODY(mod)