Skip to content

R
riscv-gcc-1
Commit f489fba1 by François-Xavier Coudert
Options

re PR fortran/33197 (Fortran 2008: math functions) 

	PR fortran/33197

gcc/fortran/
	* intrinsic.c (add_functions): Modify intrinsics ACOSH, ASINH,
	ATANH, ERF, ERFC and GAMMA. Add intrinsics BESSEL_{J,Y}{0,1,N},
	ERFC_SCALED, LOG_GAMMA and HYPOT.
	* intrinsic.h (gfc_check_hypot, gfc_simplify_hypot,
	gfc_resolve_hypot): New prototypes.
	* mathbuiltins.def: Add HYPOT builtin. Make complex versions of
	ACOSH, ASINH and ATANH available.
	* gfortran.h (GFC_ISYM_ERFC_SCALED, GFC_ISYM_HYPOT): New values.
	* lang.opt: Add -std=f2008 option.
	* libgfortran.h: Define GFC_STD_F2008.
	* lang-specs.h: Add .f08 and .F08 file suffixes.
	* iresolve.c (gfc_resolve_hypot): New function.
	* parse.c (parse_contained): Allow empty CONTAINS for Fortran 2008.
	* check.c (gfc_check_hypot): New function.
	* trans-intrinsic.c (gfc_intrinsic_map): Define ERFC_SCALE builtin.
	* options.c (set_default_std_flags): Allow Fortran 2008 by default.
	(form_from_filename): Add .f08 suffix.
	(gfc_handle_option): Handle -std=f2008 option.
	* simplify.c (gfc_simplify_hypot): New function.
	* gfortran.texi: Document Fortran 2008 status and file extensions.
	* intrinsic.texi: Document new BESSEL_{J,Y}{0,1,N} intrinsics,
	as well as HYPOT and ERFC_SCALED. Update documentation of ERF,
	ERFC, GAMMA, LGAMMA, ASINH, ACOSH and ATANH.
	* invoke.texi: Document the new -std=f2008 option.

libgomp/
	* testsuite/libgomp.fortran/fortran.exp: Add .f08 and
	.F08 file suffixes.

gcc/testsuite/
	* gfortran.dg/gomp/gomp.exp: Add .f08 and .F08 file suffixes.
	* gfortran.dg/dg.exp: Likewise.
	* gfortran.dg/vect/vect.exp: Likewise.
	* gfortran.fortran-torture/execute/execute.exp: Likewise.
	* gfortran.fortran-torture/compile/compile.exp: Likewise.
	* gfortran.dg/gamma_1.f90: Also check log_gamma.
	* gfortran.dg/invalid_contains_1.f90: Remove warning about
	empty CONTAINS.
	* gfortran.dg/gamma_2.f90: Add a few error messages.
	* gfortran.dg/invalid_contains_2.f90: Remove warning about
	empty CONTAINS.
	* gfortran.dg/gamma_3.f90: Adjust error message.
	* gfortran.dg/gamma_4.f90: Test for log_gamma instead of lgamma.
	* gfortran.dg/bind_c_usage_9.f03: Adjust error messages.
	* gfortran.dg/bessel_1.f90: New test.
	* gfortran.dg/recursive_check_3.f90: Remove warnings.
	* gfortran.dg/besxy.f90: Also check for new F2008 intrinsics.
	* gfortran.dg/derived_function_interface_1.f90: Remove warning.
	* gfortran.dg/contains_empty_1.f03: New test.
	* gfortran.dg/erfc_scaled_1.f90: New test.
	* gfortran.dg/hypot_1.f90: New test.
	* gfortran.dg/contains_empty_2.f03: New test.

libgfortran/
	* intrinsics/erfc_scaled_inc.c: New file.
	* intrinsics/erfc_scaled.c: New file.
	* gfortran.map (GFORTRAN_1.0): Add _gfortran_erfc_scaled_r*.
	* Makefile.am: Add intrinsics/erfc_scaled.c.
	* config.h.in: Regenerate.
	* configure: Regenerate.
	* Makefile.in: Regenerate.

From-SVN: r132846
parent a1b25e49
Showing with 796 additions and 138 deletions
gcc/fortran/ChangeLog
2008-03-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33197
* intrinsic.c (add_functions): Modify intrinsics ACOSH, ASINH,
ATANH, ERF, ERFC and GAMMA. Add intrinsics BESSEL_{J,Y}{0,1,N},
ERFC_SCALED, LOG_GAMMA and HYPOT.
* intrinsic.h (gfc_check_hypot, gfc_simplify_hypot,
gfc_resolve_hypot): New prototypes.
* mathbuiltins.def: Add HYPOT builtin. Make complex versions of
ACOSH, ASINH and ATANH available.
* gfortran.h (GFC_ISYM_ERFC_SCALED, GFC_ISYM_HYPOT): New values.
* lang.opt: Add -std=f2008 option.
* libgfortran.h: Define GFC_STD_F2008.
* lang-specs.h: Add .f08 and .F08 file suffixes.
* iresolve.c (gfc_resolve_hypot): New function.
* parse.c (parse_contained): Allow empty CONTAINS for Fortran 2008.
* check.c (gfc_check_hypot): New function.
* trans-intrinsic.c (gfc_intrinsic_map): Define ERFC_SCALE builtin.
* options.c (set_default_std_flags): Allow Fortran 2008 by default.
(form_from_filename): Add .f08 suffix.
(gfc_handle_option): Handle -std=f2008 option.
* simplify.c (gfc_simplify_hypot): New function.
* gfortran.texi: Document Fortran 2008 status and file extensions.
* intrinsic.texi: Document new BESSEL_{J,Y}{0,1,N} intrinsics,
as well as HYPOT and ERFC_SCALED. Update documentation of ERF,
ERFC, GAMMA, LGAMMA, ASINH, ACOSH and ATANH.
* invoke.texi: Document the new -std=f2008 option.
2008-03-02 Jakub Jelinek <jakub@redhat.com> 2008-03-02 Jakub Jelinek <jakub@redhat.com>
* gfortranspec.c (lang_specific_driver): Update copyright notice * gfortranspec.c (lang_specific_driver): Update copyright notice
......
gcc/fortran/check.c
...@@ -1111,6 +1111,18 @@ gfc_check_huge (gfc_expr *x) ...@@ -1111,6 +1111,18 @@ gfc_check_huge (gfc_expr *x)
} }
try
gfc_check_hypot (gfc_expr *x, gfc_expr *y)
{
if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE;
if (same_type_check (x, 0, y, 1) == FAILURE)
return FAILURE;
return SUCCESS;
}
/* Check that the single argument is an integer. */ /* Check that the single argument is an integer. */
try try
......
gcc/fortran/gfortran.h
...@@ -347,6 +347,7 @@ enum gfc_isym_id ...@@ -347,6 +347,7 @@ enum gfc_isym_id
GFC_ISYM_EPSILON, GFC_ISYM_EPSILON,
GFC_ISYM_ERF, GFC_ISYM_ERF,
GFC_ISYM_ERFC, GFC_ISYM_ERFC,
GFC_ISYM_ERFC_SCALED,
GFC_ISYM_ETIME, GFC_ISYM_ETIME,
GFC_ISYM_EXIT, GFC_ISYM_EXIT,
GFC_ISYM_EXP, GFC_ISYM_EXP,
...@@ -379,6 +380,7 @@ enum gfc_isym_id ...@@ -379,6 +380,7 @@ enum gfc_isym_id
GFC_ISYM_GMTIME, GFC_ISYM_GMTIME,
GFC_ISYM_HOSTNM, GFC_ISYM_HOSTNM,
GFC_ISYM_HUGE, GFC_ISYM_HUGE,
GFC_ISYM_HYPOT,
GFC_ISYM_IACHAR, GFC_ISYM_IACHAR,
GFC_ISYM_IAND, GFC_ISYM_IAND,
GFC_ISYM_IARGC, GFC_ISYM_IARGC,
......
gcc/fortran/gfortran.texi
...@@ -181,7 +181,7 @@ Part I: Invoking GNU Fortran ...@@ -181,7 +181,7 @@ Part I: Invoking GNU Fortran
* Runtime:: Influencing runtime behavior with environment variables. * Runtime:: Influencing runtime behavior with environment variables.
Part II: Language Reference Part II: Language Reference
* Fortran 2003 status:: Fortran 2003 features supported by GNU Fortran. * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran.
* Extensions:: Language extensions implemented by GNU Fortran. * Extensions:: Language extensions implemented by GNU Fortran.
* Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran.
* Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran.
...@@ -251,7 +251,7 @@ it will do everything you expect from any decent compiler: ...@@ -251,7 +251,7 @@ it will do everything you expect from any decent compiler:
@item @item
Read a user's program, Read a user's program,
stored in a file and containing instructions written stored in a file and containing instructions written
in Fortran 77, Fortran 90, Fortran 95 or Fortran 2003. in Fortran 77, Fortran 90, Fortran 95, Fortran 2003 or Fortran 2008.
This file contains @dfn{source code}. This file contains @dfn{source code}.
@item @item
...@@ -369,17 +369,19 @@ Fortran) for each file in the source code, and then calls the assembler ...@@ -369,17 +369,19 @@ Fortran) for each file in the source code, and then calls the assembler
and linker as appropriate to produce the compiled output. In a copy of and linker as appropriate to produce the compiled output. In a copy of
GCC which has been compiled with Fortran language support enabled, GCC which has been compiled with Fortran language support enabled,
@command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn}, @command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn},
@file{.f90}, @file{.f95}, and @file{.f03} extensions as Fortran source code, @file{.f90}, @file{.f95}, @file{.f03} and @file{.f08} extensions as
and compile it accordingly. A @command{gfortran} driver program is also Fortran source code, and compile it accordingly. A @command{gfortran}
provided, which is identical to @command{gcc} except that it automatically driver program is also provided, which is identical to @command{gcc}
links the Fortran runtime libraries into the compiled program. except that it automatically links the Fortran runtime libraries into the
compiled program.
Source files with @file{.f}, @file{.for}, @file{.fpp}, @file{.ftn}, @file{.F}, Source files with @file{.f}, @file{.for}, @file{.fpp}, @file{.ftn}, @file{.F},
@file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form. @file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form.
Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.F90}, Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.f08},
@file{.F95}, and @file{.F03} extensions are treated as free form. The @file{.F90}, @file{.F95}, @file{.F03} and @file{.F08} extensions are
capitalized versions of either form are run through preprocessing. Source files treated as free form. The capitalized versions of either form are run
with the lower case @file{.fpp} extension are also run through preprocessing. through preprocessing. Source files with the lower case @file{.fpp}
extension are also run through preprocessing.
This manual specifically documents the Fortran front end, which handles This manual specifically documents the Fortran front end, which handles
the programming language's syntax and semantics. The aspects of GCC the programming language's syntax and semantics. The aspects of GCC
...@@ -407,10 +409,10 @@ FPP) to allow for conditional compilation. In the case of GNU Fortran, ...@@ -407,10 +409,10 @@ FPP) to allow for conditional compilation. In the case of GNU Fortran,
this is the GNU C Preprocessor in the traditional mode. On systems with this is the GNU C Preprocessor in the traditional mode. On systems with
case-preserving file names, the preprocessor is automatically invoked if the case-preserving file names, the preprocessor is automatically invoked if the
file extension is @code{.F}, @code{.FOR}, @code{.FTN}, @code{.F90}, file extension is @code{.F}, @code{.FOR}, @code{.FTN}, @code{.F90},
@code{.F95} or @code{.F03}; otherwise use for fixed-format code the option @code{.F95}, @code{.F03} or @code{.F08}; otherwise use for fixed-format
@code{-x f77-cpp-input} and for free-format code @code{-x f95-cpp-input}. code the option @code{-x f77-cpp-input} and for free-format code @code{-x
Invocation of the preprocessor can be suppressed using @code{-x f77} or f95-cpp-input}. Invocation of the preprocessor can be suppressed using
@code{-x f95}. @code{-x f77} or @code{-x f95}.
If the GNU Fortran invoked the preprocessor, @code{__GFORTRAN__} If the GNU Fortran invoked the preprocessor, @code{__GFORTRAN__}
is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and
...@@ -468,10 +470,10 @@ The GNU Fortran compiler is able to compile nearly all ...@@ -468,10 +470,10 @@ The GNU Fortran compiler is able to compile nearly all
standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs,
including a number of standard and non-standard extensions, and can be including a number of standard and non-standard extensions, and can be
used on real-world programs. In particular, the supported extensions used on real-world programs. In particular, the supported extensions
include OpenMP, Cray-style pointers, and several Fortran 2003 features include OpenMP, Cray-style pointers, and several Fortran 2003 and Fortran
such as enumeration, stream I/O, and some of the enhancements to 2008 features such as enumeration, stream I/O, and some of the
allocatable array support from TR 15581. However, it is still under enhancements to allocatable array support from TR 15581. However, it is
development and has a few remaining rough edges. still under development and has a few remaining rough edges.
At present, the GNU Fortran compiler passes the At present, the GNU Fortran compiler passes the
@uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, @uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html,
...@@ -516,9 +518,18 @@ the ISO/IEC TR-15581 enhancements to allocatable arrays, and ...@@ -516,9 +518,18 @@ the ISO/IEC TR-15581 enhancements to allocatable arrays, and
the @uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf, the @uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf,
OpenMP Application Program Interface v2.5} specification. OpenMP Application Program Interface v2.5} specification.
In the future, the GNU Fortran compiler may also support other standard In the future, the GNU Fortran compiler will also support ISO/IEC
variants of and extensions to the Fortran language. These include 1539-1:2004 (Fortran 2003) and future Fortran standards. Partial support
ISO/IEC 1539-1:2004 (Fortran 2003). of that standard is already provided; the current status of Fortran 2003
support is reported in the @ref{Fortran 2003 status} section of the
documentation.
The next version of the Fortran standard after Fortran 2003 is currently
being developped and the GNU Fortran compiler supports some of its new
features. This support is based on the latest draft of the standard
(available from @url{http://www.nag.co.uk/sc22wg5/}) and no guarantee of
future compatibility is made, as the final standard might differ from the
draft. For more information, see the @ref{Fortran 2008 status} section.
@c ===================================================================== @c =====================================================================
...@@ -758,11 +769,19 @@ was used. ...@@ -758,11 +769,19 @@ was used.
@end tex @end tex
@c --------------------------------------------------------------------- @c ---------------------------------------------------------------------
@c Fortran 2003 Status @c Fortran 2003 and 2008 Status
@c --------------------------------------------------------------------- @c ---------------------------------------------------------------------
@node Fortran 2003 and 2008 status
@chapter Fortran 2003 and 2008 Status
@menu
* Fortran 2003 status::
* Fortran 2008 status::
@end menu
@node Fortran 2003 status @node Fortran 2003 status
@chapter Fortran 2003 Status @section Fortran 2003 status
Although GNU Fortran focuses on implementing the Fortran 95 Although GNU Fortran focuses on implementing the Fortran 95
standard for the time being, a few Fortran 2003 features are currently standard for the time being, a few Fortran 2003 features are currently
...@@ -867,6 +886,22 @@ BOZ as argument of INT, REAL, DBLE and CMPLX. ...@@ -867,6 +886,22 @@ BOZ as argument of INT, REAL, DBLE and CMPLX.
@end itemize @end itemize
@node Fortran 2008 status
@section Fortran 2008 status
The next version of the Fortran standard after Fortran 2003 is currently
being worked on by the Working Group 5 of Sub-Committee 22 of the Joint
Technical Committee 1 of the International Organization for
Standardization (ISO) and the International Electrotechnical Commission
(IEC). This group is known at @uref{http://www.nag.co.uk/sc22wg5/, WG5}.
The next revision of the Fortran standard is informally referred to as
Fortran 2008, reflecting its planned release year. The GNU Fortran
compiler has support for some of the new features in Fortran 2008. This
support is based on the latest draft, available from
@url{http://www.nag.co.uk/sc22wg5/}. However, as the final standard may
differ from the drafts, no guarantee of backward compatibility can be
made and you should only use it for experimental purposes.
@c --------------------------------------------------------------------- @c ---------------------------------------------------------------------
@c Extensions @c Extensions
@c --------------------------------------------------------------------- @c ---------------------------------------------------------------------
...@@ -903,8 +938,9 @@ by any standard, and those that are supported by GNU Fortran ...@@ -903,8 +938,9 @@ by any standard, and those that are supported by GNU Fortran
purely for backward compatibility with legacy compilers. By default, purely for backward compatibility with legacy compilers. By default,
@option{-std=gnu} allows the compiler to accept both types of @option{-std=gnu} allows the compiler to accept both types of
extensions, but to warn about the use of the latter. Specifying extensions, but to warn about the use of the latter. Specifying
either @option{-std=f95} or @option{-std=f2003} disables both types either @option{-std=f95}, @option{-std=f2003} or @option{-std=f2008}
of extensions, and @option{-std=legacy} allows both without warning. disables both types of extensions, and @option{-std=legacy} allows both
without warning.
@menu @menu
* Old-style kind specifications:: * Old-style kind specifications::
......
gcc/fortran/intrinsic.h
...@@ -67,6 +67,7 @@ try gfc_check_fn_rc (gfc_expr *); ...@@ -67,6 +67,7 @@ try gfc_check_fn_rc (gfc_expr *);
try gfc_check_fnum (gfc_expr *); try gfc_check_fnum (gfc_expr *);
try gfc_check_hostnm (gfc_expr *); try gfc_check_hostnm (gfc_expr *);
try gfc_check_huge (gfc_expr *); try gfc_check_huge (gfc_expr *);
try gfc_check_hypot (gfc_expr *, gfc_expr *);
try gfc_check_i (gfc_expr *); try gfc_check_i (gfc_expr *);
try gfc_check_iand (gfc_expr *, gfc_expr *); try gfc_check_iand (gfc_expr *, gfc_expr *);
try gfc_check_and (gfc_expr *, gfc_expr *); try gfc_check_and (gfc_expr *, gfc_expr *);
...@@ -228,6 +229,7 @@ gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *); ...@@ -228,6 +229,7 @@ gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_fraction (gfc_expr *); gfc_expr *gfc_simplify_fraction (gfc_expr *);
gfc_expr *gfc_simplify_gamma (gfc_expr *); gfc_expr *gfc_simplify_gamma (gfc_expr *);
gfc_expr *gfc_simplify_huge (gfc_expr *); gfc_expr *gfc_simplify_huge (gfc_expr *);
gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *);
...@@ -368,6 +370,7 @@ void gfc_resolve_getgid (gfc_expr *); ...@@ -368,6 +370,7 @@ void gfc_resolve_getgid (gfc_expr *);
void gfc_resolve_getpid (gfc_expr *); void gfc_resolve_getpid (gfc_expr *);
void gfc_resolve_getuid (gfc_expr *); void gfc_resolve_getuid (gfc_expr *);
void gfc_resolve_hostnm (gfc_expr *, gfc_expr *); void gfc_resolve_hostnm (gfc_expr *, gfc_expr *);
void gfc_resolve_hypot (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
......
gcc/fortran/invoke.texi
...@@ -281,7 +281,7 @@ lines in the source file. The default value is 132. ...@@ -281,7 +281,7 @@ lines in the source file. The default value is 132.
@item -fmax-identifier-length=@var{n} @item -fmax-identifier-length=@var{n}
@opindex @code{fmax-identifier-length=}@var{n} @opindex @code{fmax-identifier-length=}@var{n}
Specify the maximum allowed identifier length. Typical values are Specify the maximum allowed identifier length. Typical values are
31 (Fortran 95) and 63 (Fortran 2003). 31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008).
@item -fimplicit-none @item -fimplicit-none
@opindex @code{fimplicit-none} @opindex @code{fimplicit-none}
...@@ -322,18 +322,18 @@ on most systems, but with @option{-fno-range-check} the value will ...@@ -322,18 +322,18 @@ on most systems, but with @option{-fno-range-check} the value will
@item -std=@var{std} @item -std=@var{std}
@opindex @code{std=}@var{std} option @opindex @code{std=}@var{std} option
Specify the standard to which the program is expected to conform, which Specify the standard to which the program is expected to conform, which
may be one of @samp{f95}, @samp{f2003}, @samp{gnu}, or @samp{legacy}. may be one of @samp{f95}, @samp{f2003}, @samp{f2008}, @samp{gnu}, or
The default value for @var{std} is @samp{gnu}, which specifies a @samp{legacy}. The default value for @var{std} is @samp{gnu}, which
superset of the Fortran 95 standard that includes all of the extensions specifies a superset of the Fortran 95 standard that includes all of the
supported by GNU Fortran, although warnings will be given for obsolete extensions supported by GNU Fortran, although warnings will be given for
extensions not recommended for use in new code. The @samp{legacy} value obsolete extensions not recommended for use in new code. The
is equivalent but without the warnings for obsolete extensions, and may @samp{legacy} value is equivalent but without the warnings for obsolete
be useful for old non-standard programs. The @samp{f95} and extensions, and may be useful for old non-standard programs. The
@samp{f2003} values specify strict conformance to the Fortran 95 and @samp{f95}, @samp{f2003} and @samp{f2008} values specify strict
Fortran 2003 standards, respectively; errors are given for all conformance to the Fortran 95, Fortran 2003 and Fortran 2008 standards,
extensions beyond the relevant language standard, and warnings are given respectively; errors are given for all extensions beyond the relevant
for the Fortran 77 features that are permitted but obsolescent in later language standard, and warnings are given for the Fortran 77 features
standards. that are permitted but obsolescent in later standards.
@end table @end table
...@@ -400,8 +400,8 @@ They soon find that it does not do quite what they want---it finds some ...@@ -400,8 +400,8 @@ They soon find that it does not do quite what they want---it finds some
nonstandard practices, but not all. nonstandard practices, but not all.
However, improvements to GNU Fortran in this area are welcome. However, improvements to GNU Fortran in this area are welcome.
This should be used in conjunction with @option{-std=f95} or This should be used in conjunction with @option{-std=f95},
@option{-std=f2003}. @option{-std=f2003} or @option{-std=f2008}.
@item -pedantic-errors @item -pedantic-errors
@opindex @code{pedantic-errors} @opindex @code{pedantic-errors}
...@@ -445,10 +445,11 @@ The following example will trigger the warning. ...@@ -445,10 +445,11 @@ The following example will trigger the warning.
@cindex warnings, ampersand @cindex warnings, ampersand
@cindex & @cindex &
Warn about missing ampersand in continued character constants. The warning is Warn about missing ampersand in continued character constants. The warning is
given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95}, and given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95},
@option{-std=f2003}. Note: With no ampersand given in a continued character @option{-std=f2003} and @option{-std=f2008}. Note: With no ampersand
constant, GNU Fortran assumes continuation at the first non-comment, given in a continued character constant, GNU Fortran assumes continuation
non-whitespace character after the ampersand that initiated the continuation. at the first non-comment, non-whitespace character after the ampersand
that initiated the continuation.
@item -Wcharacter-truncation @item -Wcharacter-truncation
@opindex @code{Wcharacter-truncation} @opindex @code{Wcharacter-truncation}
...@@ -503,7 +504,7 @@ of the Fortran Character Set. For continuation lines, a tab followed ...@@ -503,7 +504,7 @@ of the Fortran Character Set. For continuation lines, a tab followed
by a digit between 1 and 9 is supported. @option{-Wno-tabs} will cause by a digit between 1 and 9 is supported. @option{-Wno-tabs} will cause
a warning to be issued if a tab is encountered. Note, @option{-Wno-tabs} a warning to be issued if a tab is encountered. Note, @option{-Wno-tabs}
is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003}, is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003},
and @option{-Wall}. @option{-std=f2008} and @option{-Wall}.
@item -Wunderflow @item -Wunderflow
@opindex @code{Wunderflow} @opindex @code{Wunderflow}
......
gcc/fortran/iresolve.c
...@@ -880,6 +880,14 @@ gfc_resolve_hostnm (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED) ...@@ -880,6 +880,14 @@ gfc_resolve_hostnm (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
void void
gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
{
f->ts = x->ts;
f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind);
}
void
gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j) gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
{ {
/* If the kind of i and j are different, then g77 cross-promoted the /* If the kind of i and j are different, then g77 cross-promoted the
......
gcc/fortran/lang-specs.h
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
{".F90", "@f95-cpp-input", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0},
{".F95", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0},
{".F03", "@f95-cpp-input", 0, 0, 0}, {".F03", "@f95-cpp-input", 0, 0, 0},
{".F08", "@f95-cpp-input", 0, 0, 0},
{"@f95-cpp-input", {"@f95-cpp-input",
"cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ "cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
%{E|M|MM:%(cpp_debug_options)}\ %{E|M|MM:%(cpp_debug_options)}\
...@@ -43,6 +44,7 @@ ...@@ -43,6 +44,7 @@
{".f90", "@f95", 0, 0, 0}, {".f90", "@f95", 0, 0, 0},
{".f95", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0},
{".f03", "@f95", 0, 0, 0}, {".f03", "@f95", 0, 0, 0},
{".f08", "@f95", 0, 0, 0},
{"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\ {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\
%{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0}, %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
{".f", "@f77", 0, 0, 0}, {".f", "@f77", 0, 0, 0},
......
gcc/fortran/lang.opt
...@@ -297,6 +297,10 @@ std=f2003 ...@@ -297,6 +297,10 @@ std=f2003
Fortran Fortran
Conform to the ISO Fortran 2003 standard Conform to the ISO Fortran 2003 standard
std=f2008
Fortran
Conform to the ISO Fortran 2008 standard
std=f95 std=f95
Fortran Fortran
Conform to the ISO Fortran 95 standard Conform to the ISO Fortran 95 standard
......
gcc/fortran/libgfortran.h
...@@ -20,6 +20,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -20,6 +20,7 @@ along with GCC; see the file COPYING3. If not see
/* Flags to specify which standard/extension contains a feature. /* Flags to specify which standard/extension contains a feature.
Note that no features were obsoleted nor deleted in F2003. */ Note that no features were obsoleted nor deleted in F2003. */
#define GFC_STD_F2008 (1<<7) /* New in F2008. */
#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ #define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */
#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ #define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
#define GFC_STD_F2003 (1<<4) /* New in F2003. */ #define GFC_STD_F2003 (1<<4) /* New in F2003. */
......
gcc/fortran/mathbuiltins.def
...@@ -6,11 +6,11 @@ ...@@ -6,11 +6,11 @@
Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are
also available. */ also available. */
DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0)
DEFINE_MATH_BUILTIN (ACOSH, "acosh", 0) DEFINE_MATH_BUILTIN_C (ACOSH, "acosh", 0)
DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0)
DEFINE_MATH_BUILTIN (ASINH, "asinh", 0) DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0)
DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0)
DEFINE_MATH_BUILTIN (ATANH, "atanh", 0) DEFINE_MATH_BUILTIN_C (ATANH, "atanh", 0)
DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1)
DEFINE_MATH_BUILTIN_C (COS, "cos", 0) DEFINE_MATH_BUILTIN_C (COS, "cos", 0)
DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0)
...@@ -32,3 +32,4 @@ DEFINE_MATH_BUILTIN (ERF, "erf", 0) ...@@ -32,3 +32,4 @@ DEFINE_MATH_BUILTIN (ERF, "erf", 0)
DEFINE_MATH_BUILTIN (ERFC, "erfc", 0) DEFINE_MATH_BUILTIN (ERFC, "erfc", 0)
DEFINE_MATH_BUILTIN (GAMMA, "tgamma", 0) DEFINE_MATH_BUILTIN (GAMMA, "tgamma", 0)
DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0) DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0)
DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1)
gcc/fortran/options.c
...@@ -42,8 +42,8 @@ static void ...@@ -42,8 +42,8 @@ static void
set_default_std_flags (void) set_default_std_flags (void)
{ {
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
| GFC_STD_LEGACY; | GFC_STD_GNU | GFC_STD_LEGACY;
gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
} }
...@@ -155,6 +155,9 @@ form_from_filename (const char *filename) ...@@ -155,6 +155,9 @@ form_from_filename (const char *filename)
".f03", FORM_FREE} ".f03", FORM_FREE}
, ,
{ {
".f08", FORM_FREE}
,
{
".f", FORM_FIXED} ".f", FORM_FIXED}
, ,
{ {
...@@ -752,6 +755,17 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -752,6 +755,17 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.warn_tabs = 0; gfc_option.warn_tabs = 0;
break; break;
case OPT_std_f2008:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008;
gfc_option.warn_std = GFC_STD_F95_OBS;
gfc_option.max_continue_fixed = 255;
gfc_option.max_continue_free = 255;
gfc_option.max_identifier_length = 63;
gfc_option.warn_ampersand = 1;
gfc_option.warn_tabs = 0;
break;
case OPT_std_gnu: case OPT_std_gnu:
set_default_std_flags (); set_default_std_flags ();
break; break;
......
gcc/fortran/parse.c
...@@ -3197,8 +3197,7 @@ parse_contained (int module) ...@@ -3197,8 +3197,7 @@ parse_contained (int module)
pop_state (); pop_state ();
if (!contains_statements) if (!contains_statements)
/* This is valid in Fortran 2008. */ gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTAINS statement without "
gfc_notify_std (GFC_STD_GNU, "Extension: CONTAINS statement without "
"FUNCTION or SUBROUTINE statement at %C"); "FUNCTION or SUBROUTINE statement at %C");
} }
......
gcc/fortran/simplify.c
...@@ -1280,6 +1280,21 @@ gfc_simplify_huge (gfc_expr *e) ...@@ -1280,6 +1280,21 @@ gfc_simplify_huge (gfc_expr *e)
return result; return result;
} }
gfc_expr *
gfc_simplify_hypot (gfc_expr *x, gfc_expr *y)
{
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
return NULL;
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_hypot (result->value.real, x->value.real, y->value.real, GFC_RND_MODE);
return range_check (result, "HYPOT");
}
/* We use the processor's collating sequence, because all /* We use the processor's collating sequence, because all
systems that gfortran currently works on are ASCII. */ systems that gfortran currently works on are ASCII. */
......
gcc/fortran/trans-intrinsic.c
...@@ -104,17 +104,25 @@ gfc_intrinsic_map_t; ...@@ -104,17 +104,25 @@ gfc_intrinsic_map_t;
true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \ true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) \
{ GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] = static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
{ {
/* Functions built into gcc itself. */ /* Functions built into gcc itself. */
#include "mathbuiltins.def" #include "mathbuiltins.def"
/* Functions in libgfortran. */
LIB_FUNCTION (ERFC_SCALED, "erfc_scaled", false),
/* End the list. */ /* End the list. */
{ GFC_ISYM_NONE, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, LIB_FUNCTION (NONE, NULL, false)
END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS,
true, false, true, NULL, NULL_TREE, NULL_TREE, NULL_TREE,
NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
}; };
#undef LIB_FUNCTION
#undef DEFINE_MATH_BUILTIN #undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C #undef DEFINE_MATH_BUILTIN_C
......
gcc/testsuite/ChangeLog
2008-03-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33197
* gfortran.dg/gomp/gomp.exp: Add .f08 and .F08 file suffixes.
* gfortran.dg/dg.exp: Likewise.
* gfortran.dg/vect/vect.exp: Likewise.
* gfortran.fortran-torture/execute/execute.exp: Likewise.
* gfortran.fortran-torture/compile/compile.exp: Likewise.
* gfortran.dg/gamma_1.f90: Also check log_gamma.
* gfortran.dg/invalid_contains_1.f90: Remove warning about
empty CONTAINS.
* gfortran.dg/gamma_2.f90: Add a few error messages.
* gfortran.dg/invalid_contains_2.f90: Remove warning about
empty CONTAINS.
* gfortran.dg/gamma_3.f90: Adjust error message.
* gfortran.dg/gamma_4.f90: Test for log_gamma instead of lgamma.
* gfortran.dg/bind_c_usage_9.f03: Adjust error messages.
* gfortran.dg/bessel_1.f90: New test.
* gfortran.dg/recursive_check_3.f90: Remove warnings.
* gfortran.dg/besxy.f90: Also check for new F2008 intrinsics.
* gfortran.dg/derived_function_interface_1.f90: Remove warning.
* gfortran.dg/contains_empty_1.f03: New test.
* gfortran.dg/erfc_scaled_1.f90: New test.
* gfortran.dg/hypot_1.f90: New test.
* gfortran.dg/contains_empty_2.f03: New test.
2007-03-03 Uros Bizjak <ubizjak@gmail.com> 2007-03-03 Uros Bizjak <ubizjak@gmail.com>
* gcc.target/i386/builtin-apply-mmx.c: Do not XFAIL on Darwin. * gcc.target/i386/builtin-apply-mmx.c: Do not XFAIL on Darwin.
gcc/testsuite/gfortran.dg/bessel_1.f90 0 → 100644
! { dg-do run }
program test
implicit none
interface check
procedure check_r4
procedure check_r8
end interface check
real(kind=4) :: x4
real(kind=8) :: x8
x8 = 1.9_8 ; x4 = 1.9_4
call check(bessel_j0 (x8), bessel_j0 (1.9_8))
call check(bessel_j0 (x4), bessel_j0 (1.9_4))
call check(bessel_j1 (x8), bessel_j1 (1.9_8))
call check(bessel_j1 (x4), bessel_j1 (1.9_4))
call check(bessel_jn (3,x8), bessel_jn (3,1.9_8))
call check(bessel_jn (3,x4), bessel_jn (3,1.9_4))
call check(bessel_y0 (x8), bessel_y0 (1.9_8))
call check(bessel_y0 (x4), bessel_y0 (1.9_4))
call check(bessel_y1 (x8), bessel_y1 (1.9_8))
call check(bessel_y1 (x4), bessel_y1 (1.9_4))
call check(bessel_yn (3,x8), bessel_yn (3,1.9_8))
call check(bessel_yn (3,x4), bessel_yn (3,1.9_4))
contains
subroutine check_r4 (a, b)
real(kind=4), intent(in) :: a, b
if (abs(a - b) > 1.e-5 * abs(b)) call abort
end subroutine
subroutine check_r8 (a, b)
real(kind=8), intent(in) :: a, b
if (abs(a - b) > 1.e-7 * abs(b)) call abort
end subroutine
end program test
gcc/testsuite/gfortran.dg/besxy.f90
...@@ -21,4 +21,21 @@ PROGRAM test_erf ...@@ -21,4 +21,21 @@ PROGRAM test_erf
ra = BESY0(ra) ra = BESY0(ra)
ra = BESY1(ra) ra = BESY1(ra)
ra = BESYN(0, ra) ra = BESYN(0, ra)
r = BESSEL_J0(r)
r = BESSEL_J1(r)
r = BESSEL_JN(0, r)
r = BESSEL_Y0(r)
r = BESSEL_Y1(r)
r = BESSEL_YN(0, r)
ra = BESSEL_J0(ra)
ra = BESSEL_J1(ra)
ra = BESSEL_JN(0, ra)
ra = BESSEL_Y0(ra)
ra = BESSEL_Y1(ra)
ra = BESSEL_YN(0, ra)
END PROGRAM END PROGRAM
gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
...@@ -9,14 +9,14 @@ subroutine foo() bind(c) ...@@ -9,14 +9,14 @@ subroutine foo() bind(c)
contains contains
subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" } subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
end subroutine bar ! { dg-error "Expected label" } end subroutine bar ! { dg-error "Expected label" }
end subroutine foo ! { dg-warning "Extension: CONTAINS statement" } end subroutine foo ! { dg-error "Fortran 2008: CONTAINS statement" }
subroutine foo2() bind(c) subroutine foo2() bind(c)
use iso_c_binding use iso_c_binding
contains contains
integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" } integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" }
end function barbar ! { dg-error "Expecting END SUBROUTINE" } end function barbar ! { dg-error "Expecting END SUBROUTINE" }
end subroutine foo2 ! { dg-warning "Extension: CONTAINS statement" } end subroutine foo2 ! { dg-error "Fortran 2008: CONTAINS statement" }
function one() bind(c) function one() bind(c)
use iso_c_binding use iso_c_binding
...@@ -25,7 +25,7 @@ function one() bind(c) ...@@ -25,7 +25,7 @@ function one() bind(c)
contains contains
integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" } integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" }
end function two ! { dg-error "Expected label" } end function two ! { dg-error "Expected label" }
end function one ! { dg-warning "Extension: CONTAINS statement" } end function one ! { dg-error "Fortran 2008: CONTAINS statement" }
function one2() bind(c) function one2() bind(c)
use iso_c_binding use iso_c_binding
...@@ -34,7 +34,7 @@ function one2() bind(c) ...@@ -34,7 +34,7 @@ function one2() bind(c)
contains contains
subroutine three() bind (c) ! { dg-error "may not be specified for an internal" } subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
end subroutine three ! { dg-error "Expecting END FUNCTION statement" } end subroutine three ! { dg-error "Expecting END FUNCTION statement" }
end function one2 ! { dg-warning "Extension: CONTAINS statement" } end function one2 ! { dg-error "Fortran 2008: CONTAINS statement" }
program main program main
use iso_c_binding use iso_c_binding
...@@ -44,4 +44,4 @@ contains ...@@ -44,4 +44,4 @@ contains
end subroutine test ! { dg-error "Expecting END PROGRAM" } end subroutine test ! { dg-error "Expecting END PROGRAM" }
integer(c_int) function test2() bind (c) ! { dg-error "may not be specified for an internal" } integer(c_int) function test2() bind (c) ! { dg-error "may not be specified for an internal" }
end function test2 ! { dg-error "Expecting END PROGRAM" } end function test2 ! { dg-error "Expecting END PROGRAM" }
end program main ! { dg-warning "Extension: CONTAINS statement" } end program main ! { dg-error "Fortran 2008: CONTAINS statement" }
gcc/testsuite/gfortran.dg/contains_empty_1.f03 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003 -pedantic" }
program test
print *, 'hello there'
contains
end program test ! { dg-error "Fortran 2008: CONTAINS statement without" }
module truc
integer, parameter :: answer = 42
contains
end module truc ! { dg-error "Fortran 2008: CONTAINS statement without" }
gcc/testsuite/gfortran.dg/contains_empty_2.f03 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2008 -pedantic" }
program test
print *, 'hello there'
contains
end program test
module truc
integer, parameter :: answer = 42
contains
end module truc
! { dg-final { cleanup-modules "truc" } }
gcc/testsuite/gfortran.dg/derived_function_interface_1.f90
...@@ -41,5 +41,5 @@ contains ...@@ -41,5 +41,5 @@ contains
type(foo) function fun() ! { dg-error "already has an explicit interface" } type(foo) function fun() ! { dg-error "already has an explicit interface" }
end function fun ! { dg-error "Expecting END PROGRAM" } end function fun ! { dg-error "Expecting END PROGRAM" }
end ! { dg-warning "CONTAINS statement without FUNCTION or SUBROUTINE statement" } end
! { dg-final { cleanup-modules "kinds" } } ! { dg-final { cleanup-modules "kinds" } }
gcc/testsuite/gfortran.dg/dg.exp
...@@ -30,7 +30,7 @@ dg-init ...@@ -30,7 +30,7 @@ dg-init
# Main loop. # Main loop.
gfortran-dg-runtest [lsort \ gfortran-dg-runtest [lsort \
[glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03} ] ] $DEFAULT_FFLAGS [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ] ] $DEFAULT_FFLAGS
gfortran-dg-runtest [lsort \ gfortran-dg-runtest [lsort \
[glob -nocomplain $srcdir/$subdir/g77/*.\[fF\] ] ] $DEFAULT_FFLAGS [glob -nocomplain $srcdir/$subdir/g77/*.\[fF\] ] ] $DEFAULT_FFLAGS
......
gcc/testsuite/gfortran.dg/erfc_scaled_1.f90 0 → 100644
! { dg-do run }
program test
implicit none
interface check
procedure check_r4
procedure check_r8
end interface check
real(kind=4) :: x4
real(kind=8) :: x8
x8 = 1.9_8 ; x4 = 1.9_4
call check(erfc_scaled(x8), erfc_scaled(1.9_8))
call check(erfc_scaled(x4), erfc_scaled(1.9_4))
contains
subroutine check_r4 (a, b)
real(kind=4), intent(in) :: a, b
if (abs(a - b) > 1.e-5 * abs(b)) call abort
end subroutine
subroutine check_r8 (a, b)
real(kind=8), intent(in) :: a, b
if (abs(a - b) > 1.e-7 * abs(b)) call abort
end subroutine
end program test
gcc/testsuite/gfortran.dg/gamma_1.f90
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
! !
program gamma_test program gamma_test
implicit none implicit none
intrinsic :: gamma, lgamma intrinsic :: gamma, lgamma, log_gamma
integer, parameter :: sp = kind(1.0) integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0) integer, parameter :: dp = kind(1.0d0)
...@@ -21,6 +21,8 @@ if (abs(dgamma(1.0_dp) - 1.0_dp) > tiny(1.0_dp)) call abort() ...@@ -21,6 +21,8 @@ if (abs(dgamma(1.0_dp) - 1.0_dp) > tiny(1.0_dp)) call abort()
if (abs(lgamma(1.0_sp)) > tiny(1.0_sp)) call abort() if (abs(lgamma(1.0_sp)) > tiny(1.0_sp)) call abort()
if (abs(lgamma(1.0_dp)) > tiny(1.0_dp)) call abort() if (abs(lgamma(1.0_dp)) > tiny(1.0_dp)) call abort()
if (abs(log_gamma(1.0_sp)) > tiny(1.0_sp)) call abort()
if (abs(log_gamma(1.0_dp)) > tiny(1.0_dp)) call abort()
if (abs(algama(1.0_sp)) > tiny(1.0_sp)) call abort() if (abs(algama(1.0_sp)) > tiny(1.0_sp)) call abort()
if (abs(dlgama(1.0_dp)) > tiny(1.0_dp)) call abort() if (abs(dlgama(1.0_dp)) > tiny(1.0_dp)) call abort()
end program gamma_test end program gamma_test
......
gcc/testsuite/gfortran.dg/gamma_2.f90
...@@ -20,12 +20,12 @@ integer, parameter :: dp = kind(1.0d0) ...@@ -20,12 +20,12 @@ integer, parameter :: dp = kind(1.0d0)
real(sp) :: rsp = 1.0_sp real(sp) :: rsp = 1.0_sp
real(dp) :: rdp = 1.0_dp real(dp) :: rdp = 1.0_dp
rsp = gamma(rsp) ! FIXME: "is not included in the selected standard" rsp = gamma(rsp) ! FIXME "is not included in the selected standard"
rdp = gamma(rdp) ! FIXME: "is not included in the selected standard" rdp = gamma(rdp) ! FIXME "is not included in the selected standard"
rdp = dgamma(rdp) ! { dg-error "is not included in the selected standard" } rdp = dgamma(rdp) ! { dg-error "is not included in the selected standard" }
rsp = lgamma(rsp) ! FIXME: "is not included in the selected standard" rsp = lgamma(rsp) ! { dg-error "is not included in the selected standard" }
rdp = lgamma(rdp) ! FIXME: "is not included in the selected standard" rdp = lgamma(rdp) ! { dg-error "is not included in the selected standard" }
rsp = algama(rsp) ! { dg-error "is not included in the selected standard" } rsp = algama(rsp) ! { dg-error "is not included in the selected standard" }
rdp = dlgama(rdp) ! { dg-error "is not included in the selected standard" } rdp = dlgama(rdp) ! { dg-error "is not included in the selected standard" }
end subroutine foo end subroutine foo
......
gcc/testsuite/gfortran.dg/gamma_3.f90
...@@ -16,11 +16,11 @@ x = dgamma(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" } ...@@ -16,11 +16,11 @@ x = dgamma(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" }
x = gamma(int(1)) ! { dg-error "is not consistent with a specific intrinsic interface" } x = gamma(int(1)) ! { dg-error "is not consistent with a specific intrinsic interface" }
x = dgamma(int(1)) ! { dg-error "must be REAL" } x = dgamma(int(1)) ! { dg-error "must be REAL" }
x = lgamma(cmplx(1.0,0.0)) ! { dg-error "is not consistent with a specific intrinsic interface" } x = lgamma(cmplx(1.0,0.0)) ! { dg-error "must be REAL" }
x = algama(cmplx(1.0,0.0)) ! { dg-error "must be REAL" } x = algama(cmplx(1.0,0.0)) ! { dg-error "must be REAL" }
x = dlgama(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" } x = dlgama(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" }
x = lgamma(int(1)) ! { dg-error "is not consistent with a specific intrinsic interface" } x = lgamma(int(1)) ! { dg-error "must be REAL" }
x = algama(int(1)) ! { dg-error "must be REAL" } x = algama(int(1)) ! { dg-error "must be REAL" }
x = dlgama(int(1)) ! { dg-error "must be REAL" } x = dlgama(int(1)) ! { dg-error "must be REAL" }
end program gamma_test end program gamma_test
......
gcc/testsuite/gfortran.dg/gamma_4.f90
! { dg-do run } ! { dg-do run }
! { dg-require-effective-target fortran_large_real } ! { dg-require-effective-target fortran_large_real }
! !
! Test the vendor intrinsic (d)gamma, lgamma and algama/dlgama ! Test the Fortran 2008 intrinsics gamma and log_gamma
! gamma is also part of the Fortran 2008 draft; lgamma is called
! log_gamma in the Fortran 2008 draft.
! !
! PR fortran/32980 ! PR fortran/32980
! !
program gamma_test program gamma_test
implicit none implicit none
intrinsic :: gamma, lgamma intrinsic :: gamma, log_gamma
integer, parameter :: qp = selected_real_kind(precision (0.0_8) + 1) integer, parameter :: qp = selected_real_kind(precision (0.0_8) + 1)
real(qp) :: rqp real(qp) :: rqp
if (abs(gamma(1.0_qp) - 1.0_qp) > tiny(1.0_qp)) call abort() if (abs(gamma(1.0_qp) - 1.0_qp) > tiny(1.0_qp)) call abort()
if (abs(lgamma(1.0_qp)) > tiny(1.0_qp)) call abort() if (abs(log_gamma(1.0_qp)) > tiny(1.0_qp)) call abort()
end program gamma_test end program gamma_test
gcc/testsuite/gfortran.dg/gomp/gomp.exp
...@@ -12,7 +12,7 @@ dg-init ...@@ -12,7 +12,7 @@ dg-init
# Main loop. # Main loop.
gfortran-dg-runtest [lsort \ gfortran-dg-runtest [lsort \
[find $srcdir/$subdir *.\[fF\]{,90,95,03} ] ] " -fopenmp" [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenmp"
# All done. # All done.
dg-finish dg-finish
gcc/testsuite/gfortran.dg/hypot_1.f90 0 → 100644
! { dg-do run }
program test
implicit none
interface check
procedure check_r4
procedure check_r8
end interface check
real(kind=4) :: x4, y4
real(kind=8) :: x8, y8
x8 = 1.9_8 ; x4 = 1.9_4
y8 = -2.1_8 ; y4 = -2.1_4
call check(hypot(x8,y8), hypot(1.9_8,-2.1_8))
call check(hypot(x4,y4), hypot(1.9_4,-2.1_4))
contains
subroutine check_r4 (a, b)
real(kind=4), intent(in) :: a, b
if (abs(a - b) > 1.e-5 * abs(b)) call abort
end subroutine
subroutine check_r8 (a, b)
real(kind=8), intent(in) :: a, b
if (abs(a - b) > 1.e-7 * abs(b)) call abort
end subroutine
end program test
gcc/testsuite/gfortran.dg/invalid_contains_1.f90
...@@ -5,4 +5,4 @@ contains ...@@ -5,4 +5,4 @@ contains
subroutine FOO ! { dg-error "conflicts with PROCEDURE" } subroutine FOO ! { dg-error "conflicts with PROCEDURE" }
character(len=selected_int_kind(0)) :: C ! { dg-error "data declaration statement" } character(len=selected_int_kind(0)) :: C ! { dg-error "data declaration statement" }
end subroutine ! { dg-error "Expecting END MODULE statement" } end subroutine ! { dg-error "Expecting END MODULE statement" }
end ! { dg-warning "CONTAINS statement without FUNCTION" } end
\ No newline at end of file
gcc/testsuite/gfortran.dg/invalid_contains_2.f90
...@@ -6,4 +6,4 @@ contains ...@@ -6,4 +6,4 @@ contains
integer :: i ! { dg-error "data declaration statement" } integer :: i ! { dg-error "data declaration statement" }
character(len=selected_int_kind(i)) :: c ! { dg-error "data declaration statement" } character(len=selected_int_kind(i)) :: c ! { dg-error "data declaration statement" }
end subroutine ! { dg-error "Expecting END PROGRAM statement" } end subroutine ! { dg-error "Expecting END PROGRAM statement" }
end program foo ! { dg-warning "CONTAINS statement without FUNCTION" } end program foo
gcc/testsuite/gfortran.dg/recursive_check_3.f90
...@@ -5,18 +5,18 @@ contains ...@@ -5,18 +5,18 @@ contains
pure pure subroutine a1(b) ! { dg-error "Duplicate PURE attribute specified" } pure pure subroutine a1(b) ! { dg-error "Duplicate PURE attribute specified" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" } real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a1 ! { dg-error "Expecting END MODULE" } end subroutine a1 ! { dg-error "Expecting END MODULE" }
end module m1 ! { dg-warning "CONTAINS statement without FUNCTION" } end module m1
module m2 module m2
contains contains
elemental elemental subroutine a2(b) ! { dg-error "Duplicate ELEMENTAL attribute" } elemental elemental subroutine a2(b) ! { dg-error "Duplicate ELEMENTAL attribute" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" } real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a2 ! { dg-error "Expecting END MODULE" } end subroutine a2 ! { dg-error "Expecting END MODULE" }
end module m2 ! { dg-warning "CONTAINS statement without FUNCTION" } end module m2
module m3 module m3
contains contains
recursive recursive subroutine a3(b) ! { dg-error "Duplicate RECURSIVE attribute" } recursive recursive subroutine a3(b) ! { dg-error "Duplicate RECURSIVE attribute" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" } real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a3 ! { dg-error "Expecting END MODULE" } end subroutine a3 ! { dg-error "Expecting END MODULE" }
end module m3 ! { dg-warning "CONTAINS statement without FUNCTION" } end module m3
gcc/testsuite/gfortran.dg/vect/vect.exp
...@@ -90,8 +90,8 @@ proc check_effective_target_lp64_or_vect_no_align { } { ...@@ -90,8 +90,8 @@ proc check_effective_target_lp64_or_vect_no_align { } {
dg-init dg-init
# Main loop. # Main loop.
gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/vect-*.\[fF\]{,90,95,03} ]] $DEFAULT_VECTCFLAGS gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/vect-*.\[fF\]{,90,95,03,08} ]] $DEFAULT_VECTCFLAGS
gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/pr*.\[fF\]{,90,95,03} ]] $DEFAULT_VECTCFLAGS gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/pr*.\[fF\]{,90,95,03,08} ]] $DEFAULT_VECTCFLAGS
#### Tests with special options #### Tests with special options
global SAVED_DEFAULT_VECTCFLAGS global SAVED_DEFAULT_VECTCFLAGS
...@@ -100,19 +100,19 @@ set SAVED_DEFAULT_VECTCFLAGS $DEFAULT_VECTCFLAGS ...@@ -100,19 +100,19 @@ set SAVED_DEFAULT_VECTCFLAGS $DEFAULT_VECTCFLAGS
# -ffast-math tests # -ffast-math tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
lappend DEFAULT_VECTCFLAGS "-ffast-math" lappend DEFAULT_VECTCFLAGS "-ffast-math"
dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/fast-math-*.\[fF\]{,90,95,03} ]] \ dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/fast-math-*.\[fF\]{,90,95,03,08} ]] \
"" $DEFAULT_VECTCFLAGS "" $DEFAULT_VECTCFLAGS
# -fvect-cost-model tests # -fvect-cost-model tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
lappend DEFAULT_VECTCFLAGS "-fvect-cost-model" lappend DEFAULT_VECTCFLAGS "-fvect-cost-model"
dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/cost-model-*.\[fF\]{,90,95,03} ]] \ dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/cost-model-*.\[fF\]{,90,95,03,08} ]] \
"" $DEFAULT_VECTCFLAGS "" $DEFAULT_VECTCFLAGS
# --param vect-max-version-for-alias-checks=0 tests # --param vect-max-version-for-alias-checks=0 tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
lappend DEFAULT_VECTCFLAGS "--param" "vect-max-version-for-alias-checks=0" lappend DEFAULT_VECTCFLAGS "--param" "vect-max-version-for-alias-checks=0"
dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/no-vfa-*.\[fF\]{,90,95,03} ]] \ dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/no-vfa-*.\[fF\]{,90,95,03,08} ]] \
"" $DEFAULT_VECTCFLAGS "" $DEFAULT_VECTCFLAGS
# Clean up. # Clean up.
......
gcc/testsuite/gfortran.fortran-torture/compile/compile.exp
...@@ -46,6 +46,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] { ...@@ -46,6 +46,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
fortran-torture $testcase fortran-torture $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F90]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
if ![runtest_file_p $runtests $testcase] then { if ![runtest_file_p $runtests $testcase] then {
continue continue
...@@ -53,9 +60,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { ...@@ -53,9 +60,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
fortran-torture $testcase fortran-torture $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F95]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] { foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] {
if ![runtest_file_p $runtests $testcase] then { if ![runtest_file_p $runtests $testcase] then {
continue continue
} }
fortran-torture $testcase fortran-torture $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F03]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f08]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F08]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture $testcase
}
gcc/testsuite/gfortran.fortran-torture/execute/execute.exp
...@@ -50,6 +50,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] { ...@@ -50,6 +50,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
fortran-torture-execute $testcase fortran-torture-execute $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F90]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture-execute $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
if ![runtest_file_p $runtests $testcase] then { if ![runtest_file_p $runtests $testcase] then {
continue continue
...@@ -57,9 +64,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { ...@@ -57,9 +64,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
fortran-torture-execute $testcase fortran-torture-execute $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F95]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture-execute $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] { foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] {
if ![runtest_file_p $runtests $testcase] then { if ![runtest_file_p $runtests $testcase] then {
continue continue
} }
fortran-torture-execute $testcase fortran-torture-execute $testcase
} }
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F03]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture-execute $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f08]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture-execute $testcase
}
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F08]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
fortran-torture-execute $testcase
}
libgfortran/ChangeLog
2008-03-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33197
* intrinsics/erfc_scaled_inc.c: New file.
* intrinsics/erfc_scaled.c: New file.
* gfortran.map (GFORTRAN_1.0): Add _gfortran_erfc_scaled_r*.
* Makefile.am: Add intrinsics/erfc_scaled.c.
* config.h.in: Regenerate.
* configure: Regenerate.
* Makefile.in: Regenerate.
2008-03-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2008-03-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR libfortran/35355 PR libfortran/35355
......
libgfortran/Makefile.am
...@@ -67,6 +67,7 @@ intrinsics/dtime.c \ ...@@ -67,6 +67,7 @@ intrinsics/dtime.c \
intrinsics/env.c \ intrinsics/env.c \
intrinsics/eoshift0.c \ intrinsics/eoshift0.c \
intrinsics/eoshift2.c \ intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c \
intrinsics/etime.c \ intrinsics/etime.c \
intrinsics/exit.c \ intrinsics/exit.c \
intrinsics/fnum.c \ intrinsics/fnum.c \
......
libgfortran/Makefile.in
...@@ -361,10 +361,11 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \ ...@@ -361,10 +361,11 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \ intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
intrinsics/cshift0.c intrinsics/ctime.c \ intrinsics/cshift0.c intrinsics/ctime.c \
intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \ intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \
intrinsics/eoshift0.c intrinsics/eoshift2.c intrinsics/etime.c \ intrinsics/eoshift0.c intrinsics/eoshift2.c \
intrinsics/exit.c intrinsics/fnum.c intrinsics/gerror.c \ intrinsics/erfc_scaled.c intrinsics/etime.c intrinsics/exit.c \
intrinsics/getcwd.c intrinsics/getlog.c intrinsics/getXid.c \ intrinsics/fnum.c intrinsics/gerror.c intrinsics/getcwd.c \
intrinsics/hostnm.c intrinsics/ierrno.c intrinsics/ishftc.c \ intrinsics/getlog.c intrinsics/getXid.c intrinsics/hostnm.c \
intrinsics/ierrno.c intrinsics/ishftc.c \
intrinsics/iso_c_generated_procs.c intrinsics/iso_c_binding.c \ intrinsics/iso_c_generated_procs.c intrinsics/iso_c_binding.c \
intrinsics/kill.c intrinsics/link.c intrinsics/malloc.c \ intrinsics/kill.c intrinsics/link.c intrinsics/malloc.c \
intrinsics/mvbits.c intrinsics/move_alloc.c \ intrinsics/mvbits.c intrinsics/move_alloc.c \
...@@ -631,16 +632,17 @@ am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \ ...@@ -631,16 +632,17 @@ am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \
am__objects_32 = associated.lo abort.lo access.lo args.lo \ am__objects_32 = associated.lo abort.lo access.lo args.lo \
c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \ c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \ cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
eoshift0.lo eoshift2.lo etime.lo exit.lo fnum.lo gerror.lo \ eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \
getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo ishftc.lo \ fnum.lo gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo \
iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \ ierrno.lo ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo \
malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \ kill.lo link.lo malloc.lo mvbits.lo move_alloc.lo \
signal.lo size.lo sleep.lo spread_generic.lo \ pack_generic.lo perror.lo signal.lo size.lo sleep.lo \
string_intrinsics.lo system.lo rand.lo random.lo rename.lo \ spread_generic.lo string_intrinsics.lo system.lo rand.lo \
reshape_generic.lo reshape_packed.lo selected_int_kind.lo \ random.lo rename.lo reshape_generic.lo reshape_packed.lo \
selected_real_kind.lo stat.lo symlnk.lo system_clock.lo \ selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
time.lo transpose_generic.lo umask.lo unlink.lo \ system_clock.lo time.lo transpose_generic.lo umask.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo unlink.lo unpack_generic.lo in_pack_generic.lo \
in_unpack_generic.lo
am__objects_33 = am__objects_33 =
am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \ _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
...@@ -905,6 +907,7 @@ intrinsics/dtime.c \ ...@@ -905,6 +907,7 @@ intrinsics/dtime.c \
intrinsics/env.c \ intrinsics/env.c \
intrinsics/eoshift0.c \ intrinsics/eoshift0.c \
intrinsics/eoshift2.c \ intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c \
intrinsics/etime.c \ intrinsics/etime.c \
intrinsics/exit.c \ intrinsics/exit.c \
intrinsics/fnum.c \ intrinsics/fnum.c \
...@@ -1660,6 +1663,7 @@ distclean-compile: ...@@ -1660,6 +1663,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/erfc_scaled.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/etime.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/etime.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@
...@@ -4703,6 +4707,13 @@ eoshift2.lo: intrinsics/eoshift2.c ...@@ -4703,6 +4707,13 @@ eoshift2.lo: intrinsics/eoshift2.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c
erfc_scaled.lo: intrinsics/erfc_scaled.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT erfc_scaled.lo -MD -MP -MF "$(DEPDIR)/erfc_scaled.Tpo" -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/erfc_scaled.Tpo" "$(DEPDIR)/erfc_scaled.Plo"; else rm -f "$(DEPDIR)/erfc_scaled.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/erfc_scaled.c' object='erfc_scaled.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c
etime.lo: intrinsics/etime.c etime.lo: intrinsics/etime.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT etime.lo -MD -MP -MF "$(DEPDIR)/etime.Tpo" -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c; \ @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT etime.lo -MD -MP -MF "$(DEPDIR)/etime.Tpo" -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/etime.Tpo" "$(DEPDIR)/etime.Plo"; else rm -f "$(DEPDIR)/etime.Tpo"; exit 1; fi @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/etime.Tpo" "$(DEPDIR)/etime.Plo"; else rm -f "$(DEPDIR)/etime.Tpo"; exit 1; fi
......
libgfortran/config.h.in
...@@ -805,19 +805,19 @@ ...@@ -805,19 +805,19 @@
/* Define to the version of this package. */ /* Define to the version of this package. */
#undef PACKAGE_VERSION #undef PACKAGE_VERSION
/* The size of a `char', as computed by sizeof. */ /* The size of `char', as computed by sizeof. */
#undef SIZEOF_CHAR #undef SIZEOF_CHAR
/* The size of a `int', as computed by sizeof. */ /* The size of `int', as computed by sizeof. */
#undef SIZEOF_INT #undef SIZEOF_INT
/* The size of a `long', as computed by sizeof. */ /* The size of `long', as computed by sizeof. */
#undef SIZEOF_LONG #undef SIZEOF_LONG
/* The size of a `short', as computed by sizeof. */ /* The size of `short', as computed by sizeof. */
#undef SIZEOF_SHORT #undef SIZEOF_SHORT
/* The size of a `void *', as computed by sizeof. */ /* The size of `void *', as computed by sizeof. */
#undef SIZEOF_VOID_P #undef SIZEOF_VOID_P
/* Define to 1 if you have the ANSI C header files. */ /* Define to 1 if you have the ANSI C header files. */
...@@ -835,5 +835,5 @@ ...@@ -835,5 +835,5 @@
/* Define for large files, on AIX-style hosts. */ /* Define for large files, on AIX-style hosts. */
#undef _LARGE_FILES #undef _LARGE_FILES
/* Define to `long' if <sys/types.h> does not define. */ /* Define to `long int' if <sys/types.h> does not define. */
#undef off_t #undef off_t
libgfortran/configure
This source diff could not be displayed because it is too large. You can view the blob instead.
libgfortran/gfortran.map
...@@ -88,6 +88,10 @@ GFORTRAN_1.0 { ...@@ -88,6 +88,10 @@ GFORTRAN_1.0 {
_gfortran_eoshift3_4_char; _gfortran_eoshift3_4_char;
_gfortran_eoshift3_8; _gfortran_eoshift3_8;
_gfortran_eoshift3_8_char; _gfortran_eoshift3_8_char;
_gfortran_erfc_scaled_r4;
_gfortran_erfc_scaled_r8;
_gfortran_erfc_scaled_r10;
_gfortran_erfc_scaled_r16;
_gfortran_etime; _gfortran_etime;
_gfortran_etime_sub; _gfortran_etime_sub;
_gfortran_exit_i4; _gfortran_exit_i4;
......
libgfortran/intrinsics/erfc_scaled.c 0 → 100644
/* Implementation of the ERFC_SCALED intrinsic.
Copyright (C) 2008 Free Software Foundation, Inc.
This file is part of the GNU Fortran runtime library (libgfortran).
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.)
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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
/* This implementation of ERFC_SCALED is based on the netlib algorithm
available at http://www.netlib.org/specfun/erf */
#ifdef HAVE_GFC_REAL_4
#undef KIND
#define KIND 4
#include "erfc_scaled_inc.c"
#endif
#ifdef HAVE_GFC_REAL_8
#undef KIND
#define KIND 8
#include "erfc_scaled_inc.c"
#endif
#ifdef HAVE_GFC_REAL_10
#undef KIND
#define KIND 10
#include "erfc_scaled_inc.c"
#endif
#ifdef HAVE_GFC_REAL_16
#undef KIND
#define KIND 16
#include "erfc_scaled_inc.c"
#endif
libgfortran/intrinsics/erfc_scaled_inc.c 0 → 100644
/* Implementation of the ERFC_SCALED intrinsic, to be included by erfc_scaled.c
Copyright (c) 2008 Free Software Foundation, Inc.
This file is part of the GNU Fortran runtime library (libgfortran).
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.)
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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
/* This implementation of ERFC_SCALED is based on the netlib algorithm
available at http://www.netlib.org/specfun/erf */
#define TYPE KIND_SUFFIX(GFC_REAL_,KIND)
#define CONCAT(x,y) x ## y
#define KIND_SUFFIX(x,y) CONCAT(x,y)
#if (KIND == 4)
# define EXP(x) expf(x)
# define TRUNC(x) truncf(x)
#elif (KIND == 8)
# define EXP(x) exp(x)
# define TRUNC(x) trunc(x)
#else
# define EXP(x) expl(x)
# define TRUNC(x) truncl(x)
#endif
extern TYPE KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE);
export_proto(KIND_SUFFIX(erfc_scaled_r,KIND));
TYPE
KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE x)
{
/* The main computation evaluates near-minimax approximations
from "Rational Chebyshev approximations for the error function"
by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
transportable program uses rational functions that theoretically
approximate erf(x) and erfc(x) to at least 18 significant
decimal digits. The accuracy achieved depends on the arithmetic
system, the compiler, the intrinsic functions, and proper
selection of the machine-dependent constants. */
int i;
TYPE del, res, xden, xnum, y, ysq;
#if (KIND == 4)
static TYPE xneg = -9.382, xsmall = 5.96e-8,
xbig = 9.194, xhuge = 2.90e+3, xmax = 4.79e+37;
#else
static TYPE xneg = -26.628, xsmall = 1.11e-16,
xbig = 26.543, xhuge = 6.71e+7, xmax = 2.53e+307;
#endif
#define SQRPI ((TYPE) 0.56418958354775628695L)
#define THRESH ((TYPE) 0.46875L)
static TYPE a[5] = { 3.16112374387056560l, 113.864154151050156l,
377.485237685302021l, 3209.37758913846947l, 0.185777706184603153l };
static TYPE b[4] = { 23.6012909523441209l, 244.024637934444173l,
1282.61652607737228l, 2844.23683343917062l };
static TYPE c[9] = { 0.564188496988670089l, 8.88314979438837594l,
66.1191906371416295l, 298.635138197400131l, 881.952221241769090l,
1712.04761263407058l, 2051.07837782607147l, 1230.33935479799725l,
2.15311535474403846e-8l };
static TYPE d[8] = { 15.7449261107098347l, 117.693950891312499l,
537.181101862009858l, 1621.38957456669019l, 3290.79923573345963l,
4362.61909014324716l, 3439.36767414372164l, 1230.33935480374942l };
static TYPE p[6] = { 0.305326634961232344l, 0.360344899949804439l,
0.125781726111229246l, 0.0160837851487422766l,
0.000658749161529837803l, 0.0163153871373020978l };
static TYPE q[5] = { 2.56852019228982242l, 1.87295284992346047l,
0.527905102951428412l, 0.0605183413124413191l,
0.00233520497626869185l };
y = (x > 0 ? x : -x);
if (y <= THRESH)
{
ysq = 0;
if (y > xsmall)
ysq = y * y;
xnum = a[4]*ysq;
xden = ysq;
for (i = 0; i <= 2; i++)
{
xnum = (xnum + a[i]) * ysq;
xden = (xden + b[i]) * ysq;
}
res = x * (xnum + a[3]) / (xden + b[3]);
res = 1 - res;
res = EXP(ysq) * res;
return res;
}
else if (y <= 4)
{
xnum = c[8]*y;
xden = y;
for (i = 0; i <= 6; i++)
{
xnum = (xnum + c[i]) * y;
xden = (xden + d[i]) * y;
}
res = (xnum + c[7]) / (xden + d[7]);
}
else
{
res = 0;
if (y >= xbig)
{
if (y >= xmax)
goto finish;
if (y >= xhuge)
{
res = SQRPI / y;
goto finish;
}
}
ysq = ((TYPE) 1) / (y * y);
xnum = p[5]*ysq;
xden = ysq;
for (i = 0; i <= 3; i++)
{
xnum = (xnum + p[i]) * ysq;
xden = (xden + q[i]) * ysq;
}
res = ysq *(xnum + p[4]) / (xden + q[4]);
res = (SQRPI - res) / y;
}
finish:
if (x < 0)
{
if (x < xneg)
res = __builtin_inf ();
else
{
ysq = TRUNC (x*((TYPE) 16))/((TYPE) 16);
del = (x-ysq)*(x+ysq);
y = EXP(ysq*ysq) * EXP(del);
res = (y+y) - res;
}
}
return res;
}
#undef EXP
#undef TRUNC
#undef CONCAT
#undef TYPE
#undef KIND_SUFFIX
libgomp/ChangeLog
2008-03-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33197
* libgomp/testsuite/libgomp.fortran/fortran.exp: Add .f08 and
.F08 file suffixes.
2008-03-03 Peter O'Gorman <pogma@thewrittenword.com> 2008-03-03 Peter O'Gorman <pogma@thewrittenword.com>
PR libgomp/33131 PR libgomp/33131
......
libgomp/testsuite/libgomp.fortran/fortran.exp
...@@ -10,7 +10,7 @@ dg-init ...@@ -10,7 +10,7 @@ dg-init
if [file exists "${blddir}/${lang_test_file}"] { if [file exists "${blddir}/${lang_test_file}"] {
# Gather a list of all tests. # Gather a list of all tests.
set tests [lsort [find $srcdir/$subdir *.\[fF\]{,90,95,03}]] set tests [lsort [find $srcdir/$subdir *.\[fF\]{,90,95,03,08}]]
set ld_library_path "$always_ld_library_path:${blddir}/${lang_library_path}" set ld_library_path "$always_ld_library_path:${blddir}/${lang_library_path}"
set_ld_library_path_env_vars set_ld_library_path_env_vars
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment