OSDN Git Service

gcc/fortran/
authortobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 10 May 2005 22:06:55 +0000 (22:06 +0000)
committertobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 10 May 2005 22:06:55 +0000 (22:06 +0000)
PR fortran/20178
* 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.  Mark -fsecond-underscore unset.
(gfc_post_options): Set -fsecond-underscore if not explicitly set
by user.
(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.
libgfortran/
PR fortran/20178
* Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
to dependencies.
* Makefile.in: Regenerate.
* intrinsics/f2c_specific.F90: New file.
gcc/testsuite/
PR fortran/20178
* gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
gfortran.dg/f2c_3.f90: New tests.

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

17 files changed:
gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/invoke.texi
gcc/fortran/lang.opt
gcc/fortran/options.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-expr.c
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/f2c_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/f2c_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/f2c_3.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/aclocal.m4
libgfortran/intrinsics/f2c_specifics.F90 [new file with mode: 0644]

index 1210aab..ee08d1f 100644 (file)
@@ -1,3 +1,34 @@
+2005-05-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/20178
+       * 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.  Mark -fsecond-underscore unset.
+       (gfc_post_options): Set -fsecond-underscore if not explicitly set
+       by user.        
+       (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.
+
 2005-05-09  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
        * match.c (gfc_match_return): Only require space after keyword when
 2005-05-09  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
        * match.c (gfc_match_return): Only require space after keyword when
index 641e492..d17f388 100644 (file)
@@ -1419,6 +1419,7 @@ typedef struct
   int flag_no_backend;
   int flag_pack_derived;
   int flag_repack_arrays;
   int flag_no_backend;
   int flag_pack_derived;
   int flag_repack_arrays;
+  int flag_f2c;
 
   int q_kind;
 
 
   int q_kind;
 
index 22f20dc..5385bba 100644 (file)
@@ -143,7 +143,7 @@ by type.  Explanations are in the following sections.
 @item Code Generation Options
 @xref{Code Gen Options,,Options for Code Generation Conventions}.
 @gccoptlist{
 @item Code Generation Options
 @xref{Code Gen Options,,Options for Code Generation Conventions}.
 @gccoptlist{
--fno-underscoring  -fno-second-underscore @gol
+-ff2c -fno-underscoring  -fsecond-underscore @gol
 -fbounds-check  -fmax-stack-var-size=@var{n} @gol
 -fpackderived  -frepack-arrays}
 @end table
 -fbounds-check  -fmax-stack-var-size=@var{n} @gol
 -fpackderived  -frepack-arrays}
 @end table
@@ -518,8 +518,43 @@ it.
 
 
 @table @gcctabopt
 
 
 @table @gcctabopt
-@cindex -fno-underscoring option
-@cindex options, -fno-underscoring
+@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 @options{-fsecond-underscore}
+option, unless @options{-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
 @item -fno-underscoring
 @cindex underscore
 @cindex symbol names, underscores
@@ -528,16 +563,17 @@ it.
 Do not transform names of entities specified in the Fortran
 source file by appending underscores to them.
 
 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.)
+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
 
 This is done to ensure compatibility with code produced by many
-UNIX Fortran compilers, including @command{f2c} which perform the
-same transformations.
+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
 
 Use of @option{-fno-underscoring} is not recommended unless you are
 experimenting with issues such as integration of (GNU) Fortran into
@@ -593,22 +629,31 @@ in the source, even if the names as seen by the linker are mangled to
 prevent accidental linking between procedures with incompatible
 interfaces.
 
 prevent accidental linking between procedures with incompatible
 interfaces.
 
-@cindex -fno-second-underscore option
-@cindex options, -fno-second-underscore
-@item -fno-second-underscore
+@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 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.
+@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
 
 This option has no effect if @option{-fno-underscoring} is
-in effect.
+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
 
 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__}.
+@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
 
 
 @cindex -fbounds-check option
index 645b3e9..d1ca5f0 100644 (file)
@@ -89,6 +89,10 @@ fdump-parse-tree
 F95
 Display the code tree after parsing.
 
 F95
 Display the code tree after parsing.
 
+ff2c
+F95
+Use f2c calling convention.
+
 ffixed-form
 F95
 Assume that the source file is fixed form
 ffixed-form
 F95
 Assume that the source file is fixed form
index 21fb0a8..2603caa 100644 (file)
@@ -62,7 +62,8 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
   gfc_option.flag_default_real = 0;
   gfc_option.flag_dollar_ok = 0;
   gfc_option.flag_underscoring = 1;
   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_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_option.flag_implicit_none = 0;
   gfc_option.flag_max_stack_var_size = 32768;
   gfc_option.flag_module_access_private = 0;
@@ -113,6 +114,12 @@ gfc_post_options (const char **pfilename)
   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
     gfc_option.warn_std |= GFC_STD_GNU;
 
   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;
 }
 
   return false;
 }
 
@@ -214,6 +221,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       gfc_option.warn_unused_labels = value;
       break;
 
       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;
     case OPT_fdollar_ok:
       gfc_option.flag_dollar_ok = value;
       break;
index d5075b9..3d89eff 100644 (file)
@@ -901,7 +901,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
   gfc_expr e;
   gfc_intrinsic_sym *isym;
   gfc_expr argexpr;
   gfc_expr e;
   gfc_intrinsic_sym *isym;
   gfc_expr argexpr;
-  char s[GFC_MAX_SYMBOL_LEN];
+  char s[GFC_MAX_SYMBOL_LEN + 13]; /* "f2c_specific" and '\0'.  */
   tree name;
   tree mangled_name;
 
   tree name;
   tree mangled_name;
 
@@ -937,7 +937,18 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
          gcc_assert (isym->formal->next->next == NULL);
          isym->resolve.f2 (&e, &argexpr, NULL);
        }
          gcc_assert (isym->formal->next->next == NULL);
          isym->resolve.f2 (&e, &argexpr, NULL);
        }
-      sprintf (s, "specific%s", e.value.function.name);
+
+      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;
     }
       name = get_identifier (s);
       mangled_name = name;
     }
@@ -2030,7 +2041,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
            fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
        }
       else
            fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
        }
       else
-       gfc_todo_error ("Deferred non-array return by reference");
+       gcc_assert (gfc_option.flag_f2c
+                   && proc_sym->ts.type == BT_COMPLEX);
     }
 
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     }
 
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
index caf3d75..35c3f12 100644 (file)
@@ -362,6 +362,13 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
          && !sym->attr.dimension)
        se->expr = gfc_build_indirect_ref (se->expr);
 
          && !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
       /* Dereference pointer variables.  */
       if ((sym->attr.pointer || sym->attr.allocatable)
          && (sym->attr.dummy
@@ -1138,7 +1145,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
                                      convert (gfc_charlen_type_node, len));
        }
       else
                                      convert (gfc_charlen_type_node, len));
        }
       else
-       gcc_unreachable ();
+       {
+         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;
     }
 
   formal = sym->formal;
@@ -1240,14 +1253,25 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
                     arglist, NULL_TREE);
 
   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 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)))
+  if (!se->want_pointer && !byref && sym->attr.pointer)
     se->expr = gfc_build_indirect_ref (se->expr);
 
     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;
   /* A pure function may still have side-effects - it may modify its
      parameters.  */
   TREE_SIDE_EFFECTS (se->expr) = 1;
@@ -1282,7 +1306,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
              se->string_length = len;
            }
          else
              se->string_length = len;
            }
          else
-           gcc_unreachable ();
+           {
+             gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+             se->expr = gfc_build_indirect_ref (var);
+           }
        }
     }
 }
        }
     }
 }
index d63917a..b2c5169 100644 (file)
@@ -1272,6 +1272,18 @@ gfc_sym_type (gfc_symbol * sym)
     sym = sym->result;
 
   type = gfc_typenode_for_spec (&sym->ts);
     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;
 
   if (sym->attr.dummy && !sym->attr.function)
     byref = 1;
@@ -1453,19 +1465,29 @@ gfc_get_derived_type (gfc_symbol * derived)
 int
 gfc_return_by_reference (gfc_symbol * sym)
 {
 int
 gfc_return_by_reference (gfc_symbol * sym)
 {
+  gfc_symbol *result;
+
   if (!sym->attr.function)
     return 0;
 
   if (!sym->attr.function)
     return 0;
 
-  if (sym->result)
-    sym = sym->result;
+  result = sym->result ? sym->result : sym;
 
 
-  if (sym->attr.dimension)
+  if (result->attr.dimension)
     return 1;
 
     return 1;
 
-  if (sym->ts.type == BT_CHARACTER)
+  if (result->ts.type == BT_CHARACTER)
     return 1;
 
     return 1;
 
-  /* Possibly return complex numbers by reference for g77 compatibility.  */
+  /* 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;
 }
 \f
   return 0;
 }
 \f
@@ -1551,7 +1573,7 @@ gfc_get_function_type (gfc_symbol * sym)
        gfc_conv_const_charlen (arg->ts.cl);
 
       type = gfc_sym_type (arg);
        gfc_conv_const_charlen (arg->ts.cl);
 
       type = gfc_sym_type (arg);
-      if (arg->ts.type == BT_DERIVED
+      if (arg->ts.type == BT_COMPLEX
          || arg->attr.dimension
          || arg->ts.type == BT_CHARACTER)
        type = build_reference_type (type);
          || arg->attr.dimension
          || arg->ts.type == BT_CHARACTER)
        type = build_reference_type (type);
index 55363ea..7065773 100644 (file)
@@ -1,3 +1,9 @@
+2005-05-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/20178
+       * gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
+       gfortran.dg/f2c_3.f90: New tests.
+
 2005-05-10  Diego Novillo  <dnovillo@redhat.com>
 
        * gcc.c-torture/compile/20050510-1.c: New test.
 2005-05-10  Diego Novillo  <dnovillo@redhat.com>
 
        * gcc.c-torture/compile/20050510-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/f2c_1.f90 b/gcc/testsuite/gfortran.dg/f2c_1.f90
new file mode 100644 (file)
index 0000000..9f45d05
--- /dev/null
@@ -0,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
diff --git a/gcc/testsuite/gfortran.dg/f2c_2.f90 b/gcc/testsuite/gfortran.dg/f2c_2.f90
new file mode 100644 (file)
index 0000000..82ab5f0
--- /dev/null
@@ -0,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
diff --git a/gcc/testsuite/gfortran.dg/f2c_3.f90 b/gcc/testsuite/gfortran.dg/f2c_3.f90
new file mode 100644 (file)
index 0000000..6854457
--- /dev/null
@@ -0,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 496da2e..95884c1 100644 (file)
@@ -1,3 +1,11 @@
+2005-05-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/20178
+       * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
+       to dependencies.
+       * Makefile.in: Regenerate.
+       * intrinsics/f2c_specific.F90: New file.
+
 2005-05-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR libfortran/20788
 2005-05-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR libfortran/20788
index a738598..fe1b607 100644 (file)
@@ -394,7 +394,8 @@ foo
 gfor_specific_src= \
 $(gfor_built_specific_src) \
 $(gfor_built_specific2_src) \
 gfor_specific_src= \
 $(gfor_built_specific_src) \
 $(gfor_built_specific2_src) \
-intrinsics/dprod_r8.f90
+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) \
 
 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 8d369fe..eace54e 100644 (file)
@@ -1,4 +1,4 @@
-# Makefile.in generated by automake 1.9.4 from Makefile.am.
+# Makefile.in generated by automake 1.9.2 from Makefile.am.
 # @configure_input@
 
 # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
 # @configure_input@
 
 # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
@@ -39,12 +39,12 @@ POST_UNINSTALL = :
 build_triplet = @build@
 host_triplet = @host@
 target_triplet = @target@
 build_triplet = @build@
 host_triplet = @host@
 target_triplet = @target@
-DIST_COMMON = README $(am__configure_deps) $(srcdir)/../config.guess \
+DIST_COMMON = $(am__configure_deps) $(srcdir)/../config.guess \
        $(srcdir)/../config.sub $(srcdir)/../install-sh \
        $(srcdir)/../ltmain.sh $(srcdir)/../missing \
        $(srcdir)/../mkinstalldirs $(srcdir)/Makefile.am \
        $(srcdir)/Makefile.in $(srcdir)/config.h.in \
        $(srcdir)/../config.sub $(srcdir)/../install-sh \
        $(srcdir)/../ltmain.sh $(srcdir)/../missing \
        $(srcdir)/../mkinstalldirs $(srcdir)/Makefile.am \
        $(srcdir)/Makefile.in $(srcdir)/config.h.in \
-       $(top_srcdir)/configure AUTHORS COPYING ChangeLog INSTALL NEWS
+       $(top_srcdir)/configure ChangeLog
 subdir = .
 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
 am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
 subdir = .
 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
 am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
@@ -151,7 +151,8 @@ am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
 am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \
        _dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \
        _atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo
 am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \
        _dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \
        _atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo
-am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo
+am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \
+       f2c_specifics.lo
 am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \
        $(am__objects_32) $(am__objects_33) $(am__objects_34) \
        $(am__objects_37)
 am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \
        $(am__objects_32) $(am__objects_33) $(am__objects_34) \
        $(am__objects_37)
@@ -162,6 +163,14 @@ libgfortranbegin_la_OBJECTS = $(am_libgfortranbegin_la_OBJECTS)
 DEFAULT_INCLUDES = -I. -I$(srcdir) -I.
 depcomp =
 am__depfiles_maybe =
 DEFAULT_INCLUDES = -I. -I$(srcdir) -I.
 depcomp =
 am__depfiles_maybe =
+PPFCCOMPILE = $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+       $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS)
+LTPPFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(DEFS) \
+       $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+       $(AM_FCFLAGS) $(FCFLAGS)
+FCLD = $(FC)
+FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FFLAGS) $(FCFLAGS) \
+       $(AM_LDFLAGS) $(LDFLAGS) -o $@
 COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
        $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
 LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) \
 COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
        $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
 LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) \
@@ -172,9 +181,6 @@ LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
        $(AM_LDFLAGS) $(LDFLAGS) -o $@
 FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS)
 LTFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS)
        $(AM_LDFLAGS) $(LDFLAGS) -o $@
 FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS)
 LTFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS)
-FCLD = $(FC)
-FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
-       $(AM_LDFLAGS) $(LDFLAGS) -o $@
 SOURCES = $(libgfortran_la_SOURCES) $(EXTRA_libgfortran_la_SOURCES) \
        $(libgfortranbegin_la_SOURCES)
 DIST_SOURCES = $(libgfortran_la_SOURCES) \
 SOURCES = $(libgfortran_la_SOURCES) $(EXTRA_libgfortran_la_SOURCES) \
        $(libgfortranbegin_la_SOURCES)
 DIST_SOURCES = $(libgfortran_la_SOURCES) \
@@ -680,7 +686,8 @@ generated/_mod_r8.f90
 gfor_specific_src = \
 $(gfor_built_specific_src) \
 $(gfor_built_specific2_src) \
 gfor_specific_src = \
 $(gfor_built_specific_src) \
 $(gfor_built_specific2_src) \
-intrinsics/dprod_r8.f90
+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) \
 
 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) \
@@ -703,7 +710,7 @@ all: $(BUILT_SOURCES) config.h
        $(MAKE) $(AM_MAKEFLAGS) all-am
 
 .SUFFIXES:
        $(MAKE) $(AM_MAKEFLAGS) all-am
 
 .SUFFIXES:
-.SUFFIXES: .c .f90 .lo .o .obj
+.SUFFIXES: .F90 .c .f90 .lo .o .obj
 am--refresh:
        @:
 $(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
 am--refresh:
        @:
 $(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
@@ -792,6 +799,18 @@ mostlyclean-compile:
 distclean-compile:
        -rm -f *.tab.c
 
 distclean-compile:
        -rm -f *.tab.c
 
+.F90.o:
+       $(PPFCCOMPILE) -c -o $@ $<
+
+.F90.obj:
+       $(PPFCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.F90.lo:
+       $(LTPPFCCOMPILE) -c -o $@ $<
+
+f2c_specifics.lo: intrinsics/f2c_specifics.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o f2c_specifics.lo `test -f 'intrinsics/f2c_specifics.F90' || echo '$(srcdir)/'`intrinsics/f2c_specifics.F90
+
 .c.o:
        $(COMPILE) -c $<
 
 .c.o:
        $(COMPILE) -c $<
 
index b67612a..b8fcca0 100644 (file)
@@ -1,4 +1,4 @@
-# generated automatically by aclocal 1.9.4 -*- Autoconf -*-
+# generated automatically by aclocal 1.9.2 -*- Autoconf -*-
 
 # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 # Free Software Foundation, Inc.
 
 # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 # Free Software Foundation, Inc.
@@ -40,7 +40,7 @@ AC_DEFUN([AM_AUTOMAKE_VERSION], [am__api_version="1.9"])
 # Call AM_AUTOMAKE_VERSION so it can be traced.
 # This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
 AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
 # Call AM_AUTOMAKE_VERSION so it can be traced.
 # This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
 AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
-        [AM_AUTOMAKE_VERSION([1.9.4])])
+        [AM_AUTOMAKE_VERSION([1.9.2])])
 
 # AM_AUX_DIR_EXPAND
 
 
 # AM_AUX_DIR_EXPAND
 
diff --git a/libgfortran/intrinsics/f2c_specifics.F90 b/libgfortran/intrinsics/f2c_specifics.F90
new file mode 100644 (file)
index 0000000..8a2a8ac
--- /dev/null
@@ -0,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)