procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
François-Xavier Coudert 2008-03-03 23:46:20 +00:00
parent a1b25e49f8
commit f489fba128
48 changed files with 10906 additions and 10020 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gcc/fortran/ChangeLog
View file

@ -1,3 +1,31 @@
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>
* gfortranspec.c (lang_specific_driver): Update copyright notice

12
gcc/fortran/check.c
View file

@ -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. */
try

2
gcc/fortran/gfortran.h
View file

@ -347,6 +347,7 @@ enum gfc_isym_id
GFC_ISYM_EPSILON,
GFC_ISYM_ERF,
GFC_ISYM_ERFC,
GFC_ISYM_ERFC_SCALED,
GFC_ISYM_ETIME,
GFC_ISYM_EXIT,
GFC_ISYM_EXP,
@ -379,6 +380,7 @@ enum gfc_isym_id
GFC_ISYM_GMTIME,
GFC_ISYM_HOSTNM,
GFC_ISYM_HUGE,
GFC_ISYM_HYPOT,
GFC_ISYM_IACHAR,
GFC_ISYM_IAND,
GFC_ISYM_IARGC,

86
gcc/fortran/gfortran.texi
View file

@ -181,7 +181,7 @@ Part I: Invoking GNU Fortran
* Runtime:: Influencing runtime behavior with environment variables.
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.
* Intrinsic Procedures:: Intrinsic procedures 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:
@item
Read a user's program,
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}.
@item
@ -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
GCC which has been compiled with Fortran language support enabled,
@command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn},
@file{.f90}, @file{.f95}, and @file{.f03} extensions as Fortran source code,
and compile it accordingly. A @command{gfortran} driver program is also
provided, which is identical to @command{gcc} except that it automatically
links the Fortran runtime libraries into the compiled program.
@file{.f90}, @file{.f95}, @file{.f03} and @file{.f08} extensions as
Fortran source code, and compile it accordingly. A @command{gfortran}
driver program is also provided, which is identical to @command{gcc}
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},
@file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form.
Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.F90},
@file{.F95}, and @file{.F03} extensions are treated as free form. The
capitalized versions of either form are run through preprocessing. Source files
with the lower case @file{.fpp} extension are also run through preprocessing.
Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.f08},
@file{.F90}, @file{.F95}, @file{.F03} and @file{.F08} extensions are
treated as free form. The capitalized versions of either form are run
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
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,
this is the GNU C Preprocessor in the traditional mode. On systems with
case-preserving file names, the preprocessor is automatically invoked if the
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{-x f77-cpp-input} and for free-format code @code{-x f95-cpp-input}.
Invocation of the preprocessor can be suppressed using @code{-x f77} or
@code{-x f95}.
@code{.F95}, @code{.F03} or @code{.F08}; otherwise use for fixed-format
code the option @code{-x f77-cpp-input} and for free-format code @code{-x
f95-cpp-input}. Invocation of the preprocessor can be suppressed using
@code{-x f77} or @code{-x f95}.
If the GNU Fortran invoked the preprocessor, @code{__GFORTRAN__}
is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and
@ -468,10 +470,10 @@ The GNU Fortran compiler is able to compile nearly all
standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs,
including a number of standard and non-standard extensions, and can be
used on real-world programs. In particular, the supported extensions
include OpenMP, Cray-style pointers, and several Fortran 2003 features
such as enumeration, stream I/O, and some of the enhancements to
allocatable array support from TR 15581. However, it is still under
development and has a few remaining rough edges.
include OpenMP, Cray-style pointers, and several Fortran 2003 and Fortran
2008 features such as enumeration, stream I/O, and some of the
enhancements to allocatable array support from TR 15581. However, it is
still under development and has a few remaining rough edges.
At present, the GNU Fortran compiler passes the
@uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html,
@ -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,
OpenMP Application Program Interface v2.5} specification.
In the future, the GNU Fortran compiler may also support other standard
variants of and extensions to the Fortran language. These include
ISO/IEC 1539-1:2004 (Fortran 2003).
In the future, the GNU Fortran compiler will also support ISO/IEC
1539-1:2004 (Fortran 2003) and future Fortran standards. Partial support
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 =====================================================================
@ -758,11 +769,19 @@ was used.
@end tex
@c ---------------------------------------------------------------------
@c Fortran 2003 Status
@c Fortran 2003 and 2008 Status
@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
@chapter Fortran 2003 Status
@section Fortran 2003 status
Although GNU Fortran focuses on implementing the Fortran 95
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.
@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 Extensions
@c ---------------------------------------------------------------------
@ -903,8 +938,9 @@ by any standard, and those that are supported by GNU Fortran
purely for backward compatibility with legacy compilers. By default,
@option{-std=gnu} allows the compiler to accept both types of
extensions, but to warn about the use of the latter. Specifying
either @option{-std=f95} or @option{-std=f2003} disables both types
of extensions, and @option{-std=legacy} allows both without warning.
either @option{-std=f95}, @option{-std=f2003} or @option{-std=f2008}
disables both types of extensions, and @option{-std=legacy} allows both
without warning.
@menu
* Old-style kind specifications::

88
gcc/fortran/intrinsic.c
View file

@ -964,15 +964,15 @@ add_functions (void)
make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh,
gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
x, BT_REAL, dd, REQUIRED);
make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU);
make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
NULL, gfc_simplify_adjustl, NULL,
@ -1047,15 +1047,15 @@ add_functions (void)
make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh,
gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
x, BT_REAL, dd, REQUIRED);
make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU);
make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
GFC_STD_F95, gfc_check_associated, NULL, NULL,
@ -1073,15 +1073,15 @@ add_functions (void)
make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh,
gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
x, BT_REAL, dd, REQUIRED);
make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU);
make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
@ -1098,61 +1098,73 @@ add_functions (void)
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_j0", GFC_STD_F2008);
add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_j1", GFC_STD_F2008);
add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_besn, NULL, gfc_resolve_besn,
n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_jn", GFC_STD_F2008);
add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_besn, NULL, gfc_resolve_besn,
n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU);
make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_y0", GFC_STD_F2008);
add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_y1", GFC_STD_F2008);
add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_besn, NULL, gfc_resolve_besn,
n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
make_alias ("bessel_yn", GFC_STD_F2008);
add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_besn, NULL, gfc_resolve_besn,
n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
make_generic ("besyn", GFC_ISYM_YN, GFC_STD_GNU);
make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
gfc_check_i, gfc_simplify_bit_size, NULL,
@ -1339,25 +1351,31 @@ add_functions (void)
make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
/* G77 compatibility for the ERF() and ERFC() functions. */
add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r, NULL,
gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
/* G77 compatibility */
add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
@ -1458,15 +1476,15 @@ add_functions (void)
make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
add_sym_1 ("gamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_gamma, gfc_resolve_gamma,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("gamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dgamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
x, BT_REAL, dr, REQUIRED);
make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_GNU);
make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_F2008);
/* Unix IDs (g77 compatibility) */
add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
@ -1502,6 +1520,13 @@ add_functions (void)
make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
BT_REAL, dr, GFC_STD_F2008,
gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F95,
gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
@ -1717,10 +1742,13 @@ add_functions (void)
make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
x, BT_REAL, dr, REQUIRED);
make_alias ("log_gamma", GFC_STD_F2008);
add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
x, BT_REAL, dr, REQUIRED);
@ -1729,7 +1757,7 @@ add_functions (void)
gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
x, BT_REAL, dr, REQUIRED);
make_generic ("lgamma", GFC_ISYM_LGAMMA, GFC_STD_GNU);
make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,

3
gcc/fortran/intrinsic.h
View file

@ -67,6 +67,7 @@ try gfc_check_fn_rc (gfc_expr *);
try gfc_check_fnum (gfc_expr *);
try gfc_check_hostnm (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_iand (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 *);
gfc_expr *gfc_simplify_fraction (gfc_expr *);
gfc_expr *gfc_simplify_gamma (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_iand (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *);
@ -368,6 +370,7 @@ void gfc_resolve_getgid (gfc_expr *);
void gfc_resolve_getpid (gfc_expr *);
void gfc_resolve_getuid (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_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);

301
gcc/fortran/intrinsic.texi
View file

@ -62,12 +62,12 @@ Some basic guidelines for editing this document:
* @code{ATAN}: ATAN, Arctangent function
* @code{ATAN2}: ATAN2, Arctangent function
* @code{ATANH}: ATANH, Hyperbolic arctangent function
* @code{BESJ0}: BESJ0, Bessel function of the first kind of order 0
* @code{BESJ1}: BESJ1, Bessel function of the first kind of order 1
* @code{BESJN}: BESJN, Bessel function of the first kind
* @code{BESY0}: BESY0, Bessel function of the second kind of order 0
* @code{BESY1}: BESY1, Bessel function of the second kind of order 1
* @code{BESYN}: BESYN, Bessel function of the second kind
* @code{BESSEL_J0}: BESSEL_J0, Bessel function of the first kind of order 0
* @code{BESSEL_J1}: BESSEL_J1, Bessel function of the first kind of order 1
* @code{BESSEL_JN}: BESSEL_JN, Bessel function of the first kind
* @code{BESSEL_Y0}: BESSEL_Y0, Bessel function of the second kind of order 0
* @code{BESSEL_Y1}: BESSEL_Y1, Bessel function of the second kind of order 1
* @code{BESSEL_YN}: BESSEL_YN, Bessel function of the second kind
* @code{BIT_SIZE}: BIT_SIZE, Bit size inquiry function
* @code{BTEST}: BTEST, Bit test function
* @code{C_ASSOCIATED}: C_ASSOCIATED, Status of a C pointer
@ -103,6 +103,7 @@ Some basic guidelines for editing this document:
* @code{EPSILON}: EPSILON, Epsilon function
* @code{ERF}: ERF, Error function
* @code{ERFC}: ERFC, Complementary error function
* @code{ERFC_SCALED}: ERFC_SCALED, Exponentially-scaled complementary error function
* @code{ETIME}: ETIME, Execution time subroutine (or function)
* @code{EXIT}: EXIT, Exit the program with status.
* @code{EXP}: EXP, Exponential function
@ -136,6 +137,7 @@ Some basic guidelines for editing this document:
* @code{GMTIME}: GMTIME, Convert time to GMT info
* @code{HOSTNM}: HOSTNM, Get system host name
* @code{HUGE}: HUGE, Largest number of a kind
* @code{HYPOT}: HYPOT, Euclidian distance function
* @code{IACHAR}: IACHAR, Code in @acronym{ASCII} collating sequence
* @code{IAND}: IAND, Bitwise logical and
* @code{IARGC}: IARGC, Get the number of command line arguments
@ -164,7 +166,7 @@ Some basic guidelines for editing this document:
* @code{LBOUND}: LBOUND, Lower dimension bounds of an array
* @code{LEN}: LEN, Length of a character entity
* @code{LEN_TRIM}: LEN_TRIM, Length of a character entity without trailing blank characters
* @code{LGAMMA}: LGAMMA, Logarithm of the Gamma function
* @code{LOG_GAMMA}: LOG_GAMMA, Logarithm of the Gamma function
* @code{LGE}: LGE, Lexical greater than or equal
* @code{LGT}: LGT, Lexical greater than
* @code{LINK}: LINK, Create a hard link
@ -266,11 +268,12 @@ Some basic guidelines for editing this document:
The intrinsic procedures provided by GNU Fortran include all of the
intrinsic procedures required by the Fortran 95 standard, a set of
intrinsic procedures for backwards compatibility with G77, and a small
selection of intrinsic procedures from the Fortran 2003 standard. Any
conflict between a description here and a description in either the
Fortran 95 standard or the Fortran 2003 standard is unintentional, and
the standard(s) should be considered authoritative.
intrinsic procedures for backwards compatibility with G77, and a
selection of intrinsic procedures from the Fortran 2003 and Fortran 2008
standards. Any conflict between a description here and a description in
either the Fortran 95 standard, the Fortran 2003 standard or the Fortran
2008 standard is unintentional, and the standard(s) should be considered
authoritative.
The enumeration of the @code{KIND} type parameter is processor defined in
the Fortran 95 standard. GNU Fortran defines the default integer type and
@ -574,7 +577,7 @@ Inverse function: @ref{COS}
@code{COSH(X)}).
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -584,13 +587,11 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL(*)} with a magnitude that is
greater or equal to one.
@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL(*)} and it lies in the
range @math{0 \leq \acosh (x) \leq \infty}.
The return value has the same type and kind as @var{X}
@item @emph{Example}:
@smallexample
@ -1213,7 +1214,7 @@ Inverse function: @ref{SIN}
@code{ASINH(X)} computes the hyperbolic arcsine of @var{X} (inverse of @code{SINH(X)}).
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -1223,12 +1224,11 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL(*)}, with @var{X} a real number.
@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL(*)} and it lies in the
range @math{-\infty \leq \asinh (x) \leq \infty}.
The return value is of the same type and kind as @var{X}.
@item @emph{Example}:
@smallexample
@ -1445,7 +1445,7 @@ end program test_atan2
of @code{TANH(X)}).
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -1455,13 +1455,11 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL(*)} with a magnitude
that is less than or equal to one.
@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL(*)} and it lies in the
range @math{-\infty \leq \atanh(x) \leq \infty}.
The return value has same type and kind as @var{X}.
@item @emph{Example}:
@smallexample
@ -1483,25 +1481,27 @@ Inverse function: @ref{TANH}
@node BESJ0
@section @code{BESJ0} --- Bessel function of the first kind of order 0
@node BESSEL_J0
@section @code{BESSEL_J0} --- Bessel function of the first kind of order 0
@fnindex BESSEL_J0
@fnindex BESJ0
@fnindex DBESJ0
@cindex Bessel function, first kind
@table @asis
@item @emph{Description}:
@code{BESJ0(X)} computes the Bessel function of the first kind of order 0
of @var{X}.
@code{BESSEL_J0(X)} computes the Bessel function of the first kind of
order 0 of @var{X}. This function is available under the name
@code{BESJ0} as a GNU extension.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESJ0(X)}
@code{RESULT = BESSEL_J0(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1516,7 +1516,7 @@ range @math{ - 0.4027... \leq Bessel (0,x) \leq 1}.
@smallexample
program test_besj0
real(8) :: x = 0.0_8
x = besj0(x)
x = bessel_j0(x)
end program test_besj0
@end smallexample
@ -1529,25 +1529,27 @@ end program test_besj0
@node BESJ1
@section @code{BESJ1} --- Bessel function of the first kind of order 1
@node BESSEL_J1
@section @code{BESEL_J1} --- Bessel function of the first kind of order 1
@fnindex BESSEL_J1
@fnindex BESJ1
@fnindex DBESJ1
@cindex Bessel function, first kind
@table @asis
@item @emph{Description}:
@code{BESJ1(X)} computes the Bessel function of the first kind of order 1
of @var{X}.
@code{BESSEL_J1(X)} computes the Bessel function of the first kind of
order 1 of @var{X}. This function is available under the name
@code{BESJ1} as a GNU extension.
@item @emph{Standard}:
GNU extension
Fortran 2008
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESJ1(X)}
@code{RESULT = BESSEL_J1(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1562,7 +1564,7 @@ range @math{ - 0.5818... \leq Bessel (0,x) \leq 0.5818 }.
@smallexample
program test_besj1
real(8) :: x = 1.0_8
x = besj1(x)
x = bessel_j1(x)
end program test_besj1
@end smallexample
@ -1575,27 +1577,29 @@ end program test_besj1
@node BESJN
@section @code{BESJN} --- Bessel function of the first kind
@node BESSEL_JN
@section @code{BESSEL_JN} --- Bessel function of the first kind
@fnindex BESSEL_JN
@fnindex BESJN
@fnindex DBESJN
@cindex Bessel function, first kind
@table @asis
@item @emph{Description}:
@code{BESJN(N, X)} computes the Bessel function of the first kind of order
@var{N} of @var{X}.
@code{BESSEL_JN(N, X)} computes the Bessel function of the first kind of
order @var{N} of @var{X}. This function is available under the name
@code{BESJN} as a GNU extension.
If both arguments are arrays, their ranks and shapes shall conform.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESJN(N, X)}
@code{RESULT = BESSEL_JN(N, X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1610,7 +1614,7 @@ The return value is a scalar of type @code{REAL(*)}.
@smallexample
program test_besjn
real(8) :: x = 1.0_8
x = besjn(5,x)
x = bessel_jn(5,x)
end program test_besjn
@end smallexample
@ -1624,25 +1628,27 @@ end program test_besjn
@node BESY0
@section @code{BESY0} --- Bessel function of the second kind of order 0
@node BESSEL_Y0
@section @code{BESSEL_Y0} --- Bessel function of the second kind of order 0
@fnindex BESSEL_Y0
@fnindex BESY0
@fnindex DBESY0
@cindex Bessel function, second kind
@table @asis
@item @emph{Description}:
@code{BESY0(X)} computes the Bessel function of the second kind of order 0
of @var{X}.
@code{BESSEL_Y0(X)} computes the Bessel function of the second kind of
order 0 of @var{X}. This function is available under the name
@code{BESY0} as a GNU extension.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESY0(X)}
@code{RESULT = BESSEL_Y0(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1656,7 +1662,7 @@ The return value is a scalar of type @code{REAL(*)}.
@smallexample
program test_besy0
real(8) :: x = 0.0_8
x = besy0(x)
x = bessel_y0(x)
end program test_besy0
@end smallexample
@ -1669,25 +1675,27 @@ end program test_besy0
@node BESY1
@section @code{BESY1} --- Bessel function of the second kind of order 1
@node BESSEL_Y1
@section @code{BESSEL_Y1} --- Bessel function of the second kind of order 1
@fnindex BESSEL_Y1
@fnindex BESY1
@fnindex DBESY1
@cindex Bessel function, second kind
@table @asis
@item @emph{Description}:
@code{BESY1(X)} computes the Bessel function of the second kind of order 1
of @var{X}.
@code{BESSEL_Y1(X)} computes the Bessel function of the second kind of
order 1 of @var{X}. This function is available under the name
@code{BESY1} as a GNU extension.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESY1(X)}
@code{RESULT = BESSEL_Y1(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1701,7 +1709,7 @@ The return value is a scalar of type @code{REAL(*)}.
@smallexample
program test_besy1
real(8) :: x = 1.0_8
x = besy1(x)
x = bessel_y1(x)
end program test_besy1
@end smallexample
@ -1714,27 +1722,29 @@ end program test_besy1
@node BESYN
@section @code{BESYN} --- Bessel function of the second kind
@node BESSEL_YN
@section @code{BESSEL_YN} --- Bessel function of the second kind
@fnindex BESSEL_YN
@fnindex BESYN
@fnindex DBESYN
@cindex Bessel function, second kind
@table @asis
@item @emph{Description}:
@code{BESYN(N, X)} computes the Bessel function of the second kind of order
@var{N} of @var{X}.
@code{BESSEL_YN(N, X)} computes the Bessel function of the second kind of
order @var{N} of @var{X}. This function is available under the name
@code{BESYN} as a GNU extension.
If both arguments are arrays, their ranks and shapes shall conform.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = BESYN(N, X)}
@code{RESULT = BESSEL_YN(N, X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -1749,7 +1759,7 @@ The return value is a scalar of type @code{REAL(*)}.
@smallexample
program test_besyn
real(8) :: x = 1.0_8
x = besyn(5,x)
x = bessel_yn(5,x)
end program test_besyn
@end smallexample
@ -1859,7 +1869,7 @@ end program test_btest
or if @var{c_ptr1} is associated with the target @var{c_ptr2}.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Inquiry function
@ -1905,7 +1915,7 @@ end subroutine association_test
@code{C_FUNLOC(x)} determines the C address of the argument.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Inquiry function
@ -1966,7 +1976,7 @@ Note: Due to the currently lacking support of procedure pointers in GNU Fortran
this function is not fully operable.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -2024,7 +2034,7 @@ end program main
shape.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -2077,7 +2087,7 @@ end program main
@code{C_LOC(x)} determines the C address of the argument.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Inquiry function
@ -2399,7 +2409,7 @@ end program test_cmplx
command line when the containing program was invoked.
@item @emph{Standard}:
F2003
Fortran 2003 and later
@item @emph{Class}:
Inquiry function
@ -3511,7 +3521,7 @@ end program test_epsilon
@code{ERF(X)} computes the error function of @var{X}.
@item @emph{Standard}:
GNU Extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -3521,12 +3531,12 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar.
@item @var{X} @tab The type shall be @code{REAL}.
@end multitable
@item @emph{Return value}:
The return value is a scalar of type @code{REAL(*)} and it is positive
(@math{ - 1 \leq erf (x) \leq 1 }.
The return value is of type @code{REAL}, of the same kind as
@var{X} and lies in the range @math{-1 \leq erf (x) \leq 1 }.
@item @emph{Example}:
@smallexample
@ -3555,7 +3565,7 @@ end program test_erf
@code{ERFC(X)} computes the complementary error function of @var{X}.
@item @emph{Standard}:
GNU extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -3565,12 +3575,12 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL(*)}, and it shall be scalar.
@item @var{X} @tab The type shall be @code{REAL}.
@end multitable
@item @emph{Return value}:
The return value is a scalar of type @code{REAL(*)} and it is positive
(@math{ 0 \leq erfc (x) \leq 2 }.
The return value is of type @code{REAL} and of the same kind as @var{X}.
It lies in the range @math{ 0 \leq erfc (x) \leq 2 }.
@item @emph{Example}:
@smallexample
@ -3589,6 +3599,44 @@ end program test_erfc
@node ERFC_SCALED
@section @code{ERFC_SCALED} --- Error function
@fnindex ERFC_SCALED
@cindex error function, complementary, exponentially-scaled
@table @asis
@item @emph{Description}:
@code{ERFC_SCALED(X)} computes the exponentially-scaled complementary
error function of @var{X}.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = ERFC_SCALED(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL} and of the same kind as @var{X}.
@item @emph{Example}:
@smallexample
program test_erfc_scaled
real(8) :: x = 0.17_8
x = erfc_scaled(x)
end program test_erfc_scaled
@end smallexample
@end table
@node ETIME
@section @code{ETIME} --- Execution time subroutine (or function)
@fnindex ETIME
@ -4529,7 +4577,7 @@ $$
@end tex
@item @emph{Standard}:
GNU Extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@ -4562,7 +4610,7 @@ end program test_gamma
@end multitable
@item @emph{See also}:
Logarithm of the Gamma function: @ref{LGAMMA}
Logarithm of the Gamma function: @ref{LOG_GAMMA}
@end table
@ -4663,8 +4711,8 @@ END PROGRAM
@item @emph{See also}:
GNU Fortran 77 compatibility function: @ref{IARGC}
F2003 functions and subroutines: @ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT},
@ref{COMMAND_ARGUMENT_COUNT}
Fortran 2003 functions and subroutines: @ref{GET_COMMAND},
@ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT}
@end table
@ -4680,7 +4728,7 @@ F2003 functions and subroutines: @ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT},
Retrieve the entire command line that was used to invoke the program.
@item @emph{Standard}:
F2003
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -4724,7 +4772,7 @@ Retrieve the @var{N}th argument that was passed on the
command line when the containing program was invoked.
@item @emph{Standard}:
F2003
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -4871,7 +4919,7 @@ END PROGRAM
Get the @var{VALUE} of the environmental variable @var{ENVVAR}.
@item @emph{Standard}:
F2003
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -5184,6 +5232,46 @@ end program test_huge_tiny
@node HYPOT
@section @code{HYPOT} --- Euclidean distance function
@fnindex HYPOT
@cindex Euclidean distance
@table @asis
@item @emph{Description}:
@code{HYPOT(X,Y)} is the Euclidean distance function. It is equal to
@math{\sqrt{X^2 + Y^2}}, without undue underflow or overflow.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = HYPOT(X,Y)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL}.
@item @var{Y} @tab The type and kind type parameter shall be the same as
@var{X}.
@end multitable
@item @emph{Return value}:
The return value has the same type and kind type parameter as @var{X}.
@item @emph{Example}:
@smallexample
program test_hypot
real(4) :: x = 1.e0_4, y = 0.5e0_4
x = hypot(x,y)
end program test_hypot
@end smallexample
@end table
@node IACHAR
@section @code{IACHAR} --- Code in @acronym{ASCII} collating sequence
@fnindex IACHAR
@ -5322,8 +5410,8 @@ See @ref{GETARG}
@item @emph{See also}:
GNU Fortran 77 compatibility subroutine: @ref{GETARG}
F2003 functions and subroutines: @ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT},
@ref{COMMAND_ARGUMENT_COUNT}
Fortran 2003 functions and subroutines: @ref{GET_COMMAND},
@ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT}
@end table
@ -5915,7 +6003,7 @@ with the @code{IOSTAT_END} parameter of the intrinsic module
@code{ISO_FORTRAN_ENV}.
@item @emph{Standard}:
Fortran 2003.
Fortran 2003 and later
@item @emph{Class}:
Elemental function
@ -5960,7 +6048,7 @@ variable with the @code{IOSTAT_EOR} parameter of the intrinsic module
@code{ISO_FORTRAN_ENV}.
@item @emph{Standard}:
Fortran 2003.
Fortran 2003 and later
@item @emph{Class}:
Elemental function
@ -6405,26 +6493,27 @@ The return value is of type @code{INTEGER} and of kind @var{KIND}. If
@node LGAMMA
@section @code{LGAMMA} --- Logarithm of the Gamma function
@fnindex GAMMA
@node LOG_GAMMA
@section @code{LOG_GAMMA} --- Logarithm of the Gamma function
@fnindex LOG_GAMMA
@fnindex LGAMMA
@fnindex ALGAMA
@fnindex DLGAMA
@cindex Gamma function, logarithm of
@table @asis
@item @emph{Description}:
@code{GAMMA(X)} computes the natural logarithm of the absolute value of the
Gamma (@math{\Gamma}) function.
@code{LOG_GAMMA(X)} computes the natural logarithm of the absolute value
of the Gamma (@math{\Gamma}) function.
@item @emph{Standard}:
GNU Extension
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{X = LGAMMA(X)}
@code{X = LOG_GAMMA(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@ -7840,7 +7929,7 @@ end program
@var{DEST}. @var{SRC} will become deallocated in the process.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Subroutine
@ -7972,7 +8061,7 @@ end program test_nearest
@code{NEW_LINE(C)} returns the new-line character.
@item @emph{Standard}:
F2003 and later
Fortran 2003 and later
@item @emph{Class}:
Inquiry function
@ -8103,8 +8192,8 @@ Returns a disassociated pointer.
If @var{MOLD} is present, a dissassociated pointer of the same type is
returned, otherwise the type is determined by context.
In Fortran 95, @var{MOLD} is optional. Please note that F2003 includes
cases where it is required.
In Fortran 95, @var{MOLD} is optional. Please note that Fortran 2003
includes cases where it is required.
@item @emph{Standard}:
F95 and later
@ -10892,7 +10981,7 @@ F95 elemental function: @ref{IEOR}
@section @code{ISO_FORTRAN_ENV}
@table @asis
@item @emph{Standard}:
Fortran 2003
Fortran 2003 and later
@end table
The @code{ISO_FORTRAN_ENV} module provides the following scalar default-integer
@ -10932,7 +11021,7 @@ Identifies the preconnected unit identified by the asterisk
@section @code{ISO_C_BINDING}
@table @asis
@item @emph{Standard}:
Fortran 2003
Fortran 2003 and later
@end table
The following intrinsic procedures are provided by the module; their

41
gcc/fortran/invoke.texi
View file

@ -281,7 +281,7 @@ lines in the source file. The default value is 132.
@item -fmax-identifier-length=@var{n}
@opindex @code{fmax-identifier-length=}@var{n}
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
@opindex @code{fimplicit-none}
@ -322,18 +322,18 @@ on most systems, but with @option{-fno-range-check} the value will
@item -std=@var{std}
@opindex @code{std=}@var{std} option
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}.
The default value for @var{std} is @samp{gnu}, which specifies a
superset of the Fortran 95 standard that includes all of the extensions
supported by GNU Fortran, although warnings will be given for obsolete
extensions not recommended for use in new code. The @samp{legacy} value
is equivalent but without the warnings for obsolete extensions, and may
be useful for old non-standard programs. The @samp{f95} and
@samp{f2003} values specify strict conformance to the Fortran 95 and
Fortran 2003 standards, respectively; errors are given for all
extensions beyond the relevant language standard, and warnings are given
for the Fortran 77 features that are permitted but obsolescent in later
standards.
may be one of @samp{f95}, @samp{f2003}, @samp{f2008}, @samp{gnu}, or
@samp{legacy}. The default value for @var{std} is @samp{gnu}, which
specifies a superset of the Fortran 95 standard that includes all of the
extensions supported by GNU Fortran, although warnings will be given for
obsolete extensions not recommended for use in new code. The
@samp{legacy} value is equivalent but without the warnings for obsolete
extensions, and may be useful for old non-standard programs. The
@samp{f95}, @samp{f2003} and @samp{f2008} values specify strict
conformance to the Fortran 95, Fortran 2003 and Fortran 2008 standards,
respectively; errors are given for all extensions beyond the relevant
language standard, and warnings are given for the Fortran 77 features
that are permitted but obsolescent in later standards.
@end table
@ -400,8 +400,8 @@ They soon find that it does not do quite what they want---it finds some
nonstandard practices, but not all.
However, improvements to GNU Fortran in this area are welcome.
This should be used in conjunction with @option{-std=f95} or
@option{-std=f2003}.
This should be used in conjunction with @option{-std=f95},
@option{-std=f2003} or @option{-std=f2008}.
@item -pedantic-errors
@opindex @code{pedantic-errors}
@ -445,10 +445,11 @@ The following example will trigger the warning.
@cindex warnings, ampersand
@cindex &
Warn about missing ampersand in continued character constants. The warning is
given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95}, and
@option{-std=f2003}. Note: With no ampersand given in a continued character
constant, GNU Fortran assumes continuation at the first non-comment,
non-whitespace character after the ampersand that initiated the continuation.
given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95},
@option{-std=f2003} and @option{-std=f2008}. Note: With no ampersand
given in a continued character constant, GNU Fortran assumes continuation
at the first non-comment, non-whitespace character after the ampersand
that initiated the continuation.
@item -Wcharacter-truncation
@opindex @code{Wcharacter-truncation}
@ -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
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},
and @option{-Wall}.
@option{-std=f2008} and @option{-Wall}.
@item -Wunderflow
@opindex @code{Wunderflow}

8
gcc/fortran/iresolve.c
View file

@ -879,6 +879,14 @@ gfc_resolve_hostnm (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
}
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)
{

2
gcc/fortran/lang-specs.h
View file

@ -34,6 +34,7 @@
{".F90", "@f95-cpp-input", 0, 0, 0},
{".F95", "@f95-cpp-input", 0, 0, 0},
{".F03", "@f95-cpp-input", 0, 0, 0},
{".F08", "@f95-cpp-input", 0, 0, 0},
{"@f95-cpp-input",
"cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
%{E|M|MM:%(cpp_debug_options)}\
@ -43,6 +44,7 @@
{".f90", "@f95", 0, 0, 0},
{".f95", "@f95", 0, 0, 0},
{".f03", "@f95", 0, 0, 0},
{".f08", "@f95", 0, 0, 0},
{"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\
%{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
{".f", "@f77", 0, 0, 0},

4
gcc/fortran/lang.opt
View file

@ -297,6 +297,10 @@ std=f2003
Fortran
Conform to the ISO Fortran 2003 standard
std=f2008
Fortran
Conform to the ISO Fortran 2008 standard
std=f95
Fortran
Conform to the ISO Fortran 95 standard

1
gcc/fortran/libgfortran.h
View file

@ -20,6 +20,7 @@ along with GCC; see the file COPYING3. If not see
/* Flags to specify which standard/extension contains a feature.
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_GNU (1<<5) /* GNU Fortran extension. */
#define GFC_STD_F2003 (1<<4) /* New in F2003. */

7
gcc/fortran/mathbuiltins.def
View file

@ -6,11 +6,11 @@
Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are
also available. */
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 (ASINH, "asinh", 0)
DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 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_C (COS, "cos", 0)
DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0)
@ -32,3 +32,4 @@ DEFINE_MATH_BUILTIN (ERF, "erf", 0)
DEFINE_MATH_BUILTIN (ERFC, "erfc", 0)
DEFINE_MATH_BUILTIN (GAMMA, "tgamma", 0)
DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0)
DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1)

18
gcc/fortran/options.c
View file

@ -42,8 +42,8 @@ static void
set_default_std_flags (void)
{
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_LEGACY;
| GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
| GFC_STD_GNU | GFC_STD_LEGACY;
gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
}
@ -155,6 +155,9 @@ form_from_filename (const char *filename)
".f03", FORM_FREE}
,
{
".f08", FORM_FREE}
,
{
".f", FORM_FIXED}
,
{
@ -752,6 +755,17 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.warn_tabs = 0;
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:
set_default_std_flags ();
break;

3
gcc/fortran/parse.c
View file

@ -3197,8 +3197,7 @@ parse_contained (int module)
pop_state ();
if (!contains_statements)
/* This is valid in Fortran 2008. */
gfc_notify_std (GFC_STD_GNU, "Extension: CONTAINS statement without "
gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTAINS statement without "
"FUNCTION or SUBROUTINE statement at %C");
}

15
gcc/fortran/simplify.c
View file

@ -1280,6 +1280,21 @@ gfc_simplify_huge (gfc_expr *e)
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
systems that gfortran currently works on are ASCII. */

16
gcc/fortran/trans-intrinsic.c
View file

@ -104,17 +104,25 @@ gfc_intrinsic_map_t;
true, true, NAME, 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[] =
{
/* Functions built into gcc itself. */
#include "mathbuiltins.def"
/* Functions in libgfortran. */
LIB_FUNCTION (ERFC_SCALED, "erfc_scaled", false),
/* End the list. */
{ GFC_ISYM_NONE, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS,
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 }
LIB_FUNCTION (NONE, NULL, false)
};
#undef LIB_FUNCTION
#undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C

26
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,29 @@
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>
* gcc.target/i386/builtin-apply-mmx.c: Do not XFAIL on Darwin.

37
gcc/testsuite/gfortran.dg/bessel_1.f90 Normal file
View file

@ -0,0 +1,37 @@
! { 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

19
gcc/testsuite/gfortran.dg/besxy.f90
View file

@ -21,4 +21,21 @@ PROGRAM test_erf
ra = BESY0(ra)
ra = BESY1(ra)
ra = BESYN(0, ra)
END PROGRAM
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

10
gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
View file

@ -9,14 +9,14 @@ subroutine foo() bind(c)
contains
subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
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)
use iso_c_binding
contains
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 subroutine foo2 ! { dg-warning "Extension: CONTAINS statement" }
end subroutine foo2 ! { dg-error "Fortran 2008: CONTAINS statement" }
function one() bind(c)
use iso_c_binding
@ -25,7 +25,7 @@ function one() bind(c)
contains
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 one ! { dg-warning "Extension: CONTAINS statement" }
end function one ! { dg-error "Fortran 2008: CONTAINS statement" }
function one2() bind(c)
use iso_c_binding
@ -34,7 +34,7 @@ function one2() bind(c)
contains
subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
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
use iso_c_binding
@ -44,4 +44,4 @@ contains
end subroutine test ! { dg-error "Expecting END PROGRAM" }
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 program main ! { dg-warning "Extension: CONTAINS statement" }
end program main ! { dg-error "Fortran 2008: CONTAINS statement" }

11
gcc/testsuite/gfortran.dg/contains_empty_1.f03 Normal file
View file

@ -0,0 +1,11 @@
! { 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" }

14
gcc/testsuite/gfortran.dg/contains_empty_2.f03 Normal file
View file

@ -0,0 +1,14 @@
! { 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" } }

2
gcc/testsuite/gfortran.dg/derived_function_interface_1.f90
View file

@ -41,5 +41,5 @@ contains
type(foo) function fun() ! { dg-error "already has an explicit interface" }
end function fun ! { dg-error "Expecting END PROGRAM" }
end ! { dg-warning "CONTAINS statement without FUNCTION or SUBROUTINE statement" }
end
! { dg-final { cleanup-modules "kinds" } }

2
gcc/testsuite/gfortran.dg/dg.exp
View file

@ -30,7 +30,7 @@ dg-init
# Main loop.
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 \
[glob -nocomplain $srcdir/$subdir/g77/*.\[fF\] ] ] $DEFAULT_FFLAGS

28
gcc/testsuite/gfortran.dg/erfc_scaled_1.f90 Normal file
View file

@ -0,0 +1,28 @@
! { 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

4
gcc/testsuite/gfortran.dg/gamma_1.f90
View file

@ -8,7 +8,7 @@
!
program gamma_test
implicit none
intrinsic :: gamma, lgamma
intrinsic :: gamma, lgamma, log_gamma
integer, parameter :: sp = kind(1.0)
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()
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(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(dlgama(1.0_dp)) > tiny(1.0_dp)) call abort()
end program gamma_test

8
gcc/testsuite/gfortran.dg/gamma_2.f90
View file

@ -20,12 +20,12 @@ integer, parameter :: dp = kind(1.0d0)
real(sp) :: rsp = 1.0_sp
real(dp) :: rdp = 1.0_dp
rsp = gamma(rsp) ! FIXME: "is not included in the selected standard"
rdp = gamma(rdp) ! 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 = dgamma(rdp) ! { dg-error "is not included in the selected standard" }
rsp = lgamma(rsp) ! FIXME: "is not included in the selected standard"
rdp = lgamma(rdp) ! FIXME: "is not included in the selected standard"
rsp = lgamma(rsp) ! { dg-error "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" }
rdp = dlgama(rdp) ! { dg-error "is not included in the selected standard" }
end subroutine foo

4
gcc/testsuite/gfortran.dg/gamma_3.f90
View file

@ -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 = 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 = 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 = dlgama(int(1)) ! { dg-error "must be REAL" }
end program gamma_test

8
gcc/testsuite/gfortran.dg/gamma_4.f90
View file

@ -1,20 +1,18 @@
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
!
! Test the vendor intrinsic (d)gamma, lgamma and algama/dlgama
! gamma is also part of the Fortran 2008 draft; lgamma is called
! log_gamma in the Fortran 2008 draft.
! Test the Fortran 2008 intrinsics gamma and log_gamma
!
! PR fortran/32980
!
program gamma_test
implicit none
intrinsic :: gamma, lgamma
intrinsic :: gamma, log_gamma
integer, parameter :: qp = selected_real_kind(precision (0.0_8) + 1)
real(qp) :: rqp
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

2
gcc/testsuite/gfortran.dg/gomp/gomp.exp
View file

@ -12,7 +12,7 @@ dg-init
# Main loop.
gfortran-dg-runtest [lsort \
[find $srcdir/$subdir *.\[fF\]{,90,95,03} ] ] " -fopenmp"
[find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenmp"
# All done.
dg-finish

29
gcc/testsuite/gfortran.dg/hypot_1.f90 Normal file
View file

@ -0,0 +1,29 @@
! { 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

2
gcc/testsuite/gfortran.dg/invalid_contains_1.f90
View file

@ -5,4 +5,4 @@ contains
subroutine FOO ! { dg-error "conflicts with PROCEDURE" }
character(len=selected_int_kind(0)) :: C ! { dg-error "data declaration statement" }
end subroutine ! { dg-error "Expecting END MODULE statement" }
end ! { dg-warning "CONTAINS statement without FUNCTION" }
end

2
gcc/testsuite/gfortran.dg/invalid_contains_2.f90
View file

@ -6,4 +6,4 @@ contains
integer :: i ! { 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 program foo ! { dg-warning "CONTAINS statement without FUNCTION" }
end program foo

6
gcc/testsuite/gfortran.dg/recursive_check_3.f90
View file

@ -5,18 +5,18 @@ contains
pure pure subroutine a1(b) ! { dg-error "Duplicate PURE attribute specified" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a1 ! { dg-error "Expecting END MODULE" }
end module m1 ! { dg-warning "CONTAINS statement without FUNCTION" }
end module m1
module m2
contains
elemental elemental subroutine a2(b) ! { dg-error "Duplicate ELEMENTAL attribute" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a2 ! { dg-error "Expecting END MODULE" }
end module m2 ! { dg-warning "CONTAINS statement without FUNCTION" }
end module m2
module m3
contains
recursive recursive subroutine a3(b) ! { dg-error "Duplicate RECURSIVE attribute" }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a3 ! { dg-error "Expecting END MODULE" }
end module m3 ! { dg-warning "CONTAINS statement without FUNCTION" }
end module m3

10
gcc/testsuite/gfortran.dg/vect/vect.exp
View file

@ -90,8 +90,8 @@ proc check_effective_target_lp64_or_vect_no_align { } {
dg-init
# 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/pr*.\[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,08} ]] $DEFAULT_VECTCFLAGS
#### Tests with special options
global SAVED_DEFAULT_VECTCFLAGS
@ -100,19 +100,19 @@ set SAVED_DEFAULT_VECTCFLAGS $DEFAULT_VECTCFLAGS
# -ffast-math tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
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
# -fvect-cost-model tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
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
# --param vect-max-version-for-alias-checks=0 tests
set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
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
# Clean up.

35
gcc/testsuite/gfortran.fortran-torture/compile/compile.exp
View file

@ -46,6 +46,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
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]] {
if ![runtest_file_p $runtests $testcase] then {
continue
@ -53,9 +60,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
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]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
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
}

35
gcc/testsuite/gfortran.fortran-torture/execute/execute.exp
View file

@ -50,6 +50,13 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
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]] {
if ![runtest_file_p $runtests $testcase] then {
continue
@ -57,9 +64,37 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
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]] {
if ![runtest_file_p $runtests $testcase] then {
continue
}
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
}

17
libgfortran/ChangeLog
View file

@ -1,3 +1,14 @@
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>
PR libfortran/35355
@ -13,9 +24,9 @@
2008-02-25 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/29549
* Makefile.am: Add -fcx-fortran-rules to AM_CFLAGS for all of
libgfortran.
* Makefile.in: Regenerated.
* Makefile.am: Add -fcx-fortran-rules to AM_CFLAGS for all of
libgfortran.
* Makefile.in: Regenerated.
2008-02-25 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

1
libgfortran/Makefile.am
View file

@ -67,6 +67,7 @@ intrinsics/dtime.c \
intrinsics/env.c \
intrinsics/eoshift0.c \
intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c \
intrinsics/etime.c \
intrinsics/exit.c \
intrinsics/fnum.c \

39
libgfortran/Makefile.in
View file

@ -361,10 +361,11 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
intrinsics/cshift0.c intrinsics/ctime.c \
intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \
intrinsics/eoshift0.c intrinsics/eoshift2.c intrinsics/etime.c \
intrinsics/exit.c intrinsics/fnum.c intrinsics/gerror.c \
intrinsics/getcwd.c intrinsics/getlog.c intrinsics/getXid.c \
intrinsics/hostnm.c intrinsics/ierrno.c intrinsics/ishftc.c \
intrinsics/eoshift0.c intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c intrinsics/etime.c intrinsics/exit.c \
intrinsics/fnum.c intrinsics/gerror.c intrinsics/getcwd.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/kill.c intrinsics/link.c intrinsics/malloc.c \
intrinsics/mvbits.c intrinsics/move_alloc.c \
@ -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 \
c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.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 \
getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo ishftc.lo \
iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \
malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \
signal.lo size.lo sleep.lo spread_generic.lo \
string_intrinsics.lo system.lo rand.lo random.lo rename.lo \
reshape_generic.lo reshape_packed.lo selected_int_kind.lo \
selected_real_kind.lo stat.lo symlnk.lo system_clock.lo \
time.lo transpose_generic.lo umask.lo unlink.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo
eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \
fnum.lo gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo \
ierrno.lo ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo \
kill.lo link.lo malloc.lo mvbits.lo move_alloc.lo \
pack_generic.lo perror.lo signal.lo size.lo sleep.lo \
spread_generic.lo string_intrinsics.lo system.lo rand.lo \
random.lo rename.lo reshape_generic.lo reshape_packed.lo \
selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
system_clock.lo time.lo transpose_generic.lo umask.lo \
unlink.lo unpack_generic.lo in_pack_generic.lo \
in_unpack_generic.lo
am__objects_33 =
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 \
@ -905,6 +907,7 @@ intrinsics/dtime.c \
intrinsics/env.c \
intrinsics/eoshift0.c \
intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c \
intrinsics/etime.c \
intrinsics/exit.c \
intrinsics/fnum.c \
@ -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_4.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)/etime.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@
@ -4703,6 +4707,13 @@ eoshift2.lo: intrinsics/eoshift2.c
@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
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
@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

12
libgfortran/config.h.in
View file

@ -805,19 +805,19 @@
/* Define to the version of this package. */
#undef PACKAGE_VERSION
/* The size of a `char', as computed by sizeof. */
/* The size of `char', as computed by sizeof. */
#undef SIZEOF_CHAR
/* The size of a `int', as computed by sizeof. */
/* The size of `int', as computed by sizeof. */
#undef SIZEOF_INT
/* The size of a `long', as computed by sizeof. */
/* The size of `long', as computed by sizeof. */
#undef SIZEOF_LONG
/* The size of a `short', as computed by sizeof. */
/* The size of `short', as computed by sizeof. */
#undef SIZEOF_SHORT
/* The size of a `void *', as computed by sizeof. */
/* The size of `void *', as computed by sizeof. */
#undef SIZEOF_VOID_P
/* Define to 1 if you have the ANSI C header files. */
@ -835,5 +835,5 @@
/* Define for large files, on AIX-style hosts. */
#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

19684
libgfortran/configure vendored
View file

File diff suppressed because it is too large Load diff

4
libgfortran/gfortran.map
View file

@ -88,6 +88,10 @@ GFORTRAN_1.0 {
_gfortran_eoshift3_4_char;
_gfortran_eoshift3_8;
_gfortran_eoshift3_8_char;
_gfortran_erfc_scaled_r4;
_gfortran_erfc_scaled_r8;
_gfortran_erfc_scaled_r10;
_gfortran_erfc_scaled_r16;
_gfortran_etime;
_gfortran_etime_sub;
_gfortran_exit_i4;

57
libgfortran/intrinsics/erfc_scaled.c Normal file
View file

@ -0,0 +1,57 @@
/* 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

175
libgfortran/intrinsics/erfc_scaled_inc.c Normal file
View file

@ -0,0 +1,175 @@
/* 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

6
libgomp/ChangeLog
View file

@ -1,3 +1,9 @@
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>
PR libgomp/33131

2
libgomp/testsuite/libgomp.fortran/fortran.exp
View file

@ -10,7 +10,7 @@ dg-init
if [file exists "${blddir}/${lang_test_file}"] {
# 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_env_vars