From 4bedc700db9fd152bbe855cd540e161964523bdf Mon Sep 17 00:00:00 2001 From: Yuao Ma Date: Wed, 28 May 2025 23:13:45 +0800 Subject: [PATCH] fortran: add constant input support for trig functions with half-revolutions This patch introduces constant input support for trigonometric functions, including those involving half-revolutions. Both valid and invalid inputs have been thoroughly tested, as have mpfr versions greater than or equal to 4.2 and less than 4.2. Inspired by Steve's previous work, this patch also fixes subtle bugs revealed by newly added test cases. If this patch is merged, I plan to work on middle-end optimization support for previously added GCC built-ins and libgfortran intrinsics. PR fortran/113152 gcc/fortran/ChangeLog: * gfortran.h (enum gfc_isym_id): Add new enum. * intrinsic.cc (add_functions): Register new intrinsics. Changing the call from gfc_resolve_trigd{,2} to gfc_resolve_trig{,2}. * intrinsic.h (gfc_simplify_acospi, gfc_simplify_asinpi, gfc_simplify_asinpi, gfc_simplify_atanpi, gfc_simplify_atan2pi, gfc_simplify_cospi, gfc_simplify_sinpi, gfc_simplify_tanpi): New. (gfc_resolve_trig): Rename from gfc_resolve_trigd. (gfc_resolve_trig2): Rename from gfc_resolve_trigd2. * iresolve.cc (gfc_resolve_trig): Rename from gfc_resolve_trigd. (gfc_resolve_trig2): Rename from gfc_resolve_trigd2. * mathbuiltins.def: Add 7 new math builtins and re-align. * simplify.cc (gfc_simplify_acos, gfc_simplify_asin, gfc_simplify_acosd, gfc_simplify_asind): Revise error message. (gfc_simplify_acospi, gfc_simplify_asinpi, gfc_simplify_asinpi, gfc_simplify_atanpi, gfc_simplify_atan2pi, gfc_simplify_cospi, gfc_simplify_sinpi, gfc_simplify_tanpi): New. gcc/testsuite/ChangeLog: * gfortran.dg/dec_math_3.f90: Test invalid input. * gfortran.dg/dec_math_5.f90: Test valid output. * gfortran.dg/dec_math_6.f90: New test. Signed-off-by: Yuao Ma Co-authored-by: Steven G. Kargl --- gcc/fortran/gfortran.h | 8 + gcc/fortran/intrinsic.cc | 93 ++++++-- gcc/fortran/intrinsic.h | 11 +- gcc/fortran/iresolve.cc | 8 +- gcc/fortran/mathbuiltins.def | 63 +++--- gcc/fortran/simplify.cc | 262 ++++++++++++++++++++++- gcc/testsuite/gfortran.dg/dec_math_3.f90 | 15 +- gcc/testsuite/gfortran.dg/dec_math_5.f90 | 63 ++++++ gcc/testsuite/gfortran.dg/dec_math_6.f90 | 12 ++ 9 files changed, 468 insertions(+), 67 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_math_6.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4740c3676d9..e461aa68470 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -721,6 +721,14 @@ enum gfc_isym_id remains compatible. */ GFC_ISYM_SU_KIND, GFC_ISYM_UINT, + + GFC_ISYM_ACOSPI, + GFC_ISYM_ASINPI, + GFC_ISYM_ATANPI, + GFC_ISYM_ATAN2PI, + GFC_ISYM_COSPI, + GFC_ISYM_SINPI, + GFC_ISYM_TANPI, }; enum init_local_logical diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc index 908e1dae128..9e07627503d 100644 --- a/gcc/fortran/intrinsic.cc +++ b/gcc/fortran/intrinsic.cc @@ -3452,37 +3452,37 @@ add_functions (void) add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_F2023); add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_F2023); add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); /* Two-argument version of atand, equivalent to atan2d. */ add_sym_2 ("atand", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2, + gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED); @@ -3490,12 +3490,12 @@ add_functions (void) add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2, + gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED); @@ -3503,78 +3503,78 @@ add_functions (void) add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2, + gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trig2, y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED); add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_F2023); add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU, - gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd, + gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_1 ("ccotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_GNU, - NULL, gfc_simplify_cotan, gfc_resolve_trigd, + NULL, gfc_simplify_cotan, gfc_resolve_trig, x, BT_COMPLEX, dz, REQUIRED); add_sym_1 ("zcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU, - NULL, gfc_simplify_cotan, gfc_resolve_trigd, + NULL, gfc_simplify_cotan, gfc_resolve_trig, x, BT_COMPLEX, dd, REQUIRED); make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU); add_sym_1 ("cotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU, - gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dcotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU); add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); make_generic ("sind", GFC_ISYM_SIND, GFC_STD_F2023); add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2023, - gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd, + gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); make_generic ("tand", GFC_ISYM_TAND, GFC_STD_F2023); add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd, + gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trig, x, BT_REAL, dd, REQUIRED); /* The following function is internally used for coarray libray functions. @@ -3590,6 +3590,57 @@ add_functions (void) REQUIRED, val, BT_INTEGER, di, REQUIRED, i, BT_INTEGER, di, REQUIRED); make_from_module (); + + /* The half-cycle trigonometric functions were added by Fortran 2023. */ + + add_sym_1 ("acospi", GFC_ISYM_ACOSPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_acospi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + make_generic ("acospi", GFC_ISYM_ACOSPI, GFC_STD_F2023); + + add_sym_1 ("asinpi", GFC_ISYM_ASINPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_asinpi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + make_generic ("asinpi", GFC_ISYM_ASINPI, GFC_STD_F2023); + + add_sym_1 ("atanpi", GFC_ISYM_ATANPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_atanpi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + /* Two-argument version of atanpi, equivalent to atan2pi. */ + add_sym_2 ("atanpi", GFC_ISYM_ATAN2PI, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_F2023, gfc_check_atan2, gfc_simplify_atan2pi, + gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, + REQUIRED); + + make_generic ("atanpi", GFC_ISYM_ATANPI, GFC_STD_F2023); + + add_sym_2 ("atan2pi", GFC_ISYM_ATAN2PI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, + dr, GFC_STD_F2023, gfc_check_atan2, gfc_simplify_atan2pi, + gfc_resolve_trig2, y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, + REQUIRED); + + make_generic ("atan2pi", GFC_ISYM_ATAN2PI, GFC_STD_F2023); + + add_sym_1 ("cospi", GFC_ISYM_COSPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_cospi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + make_generic ("cospi", GFC_ISYM_COSPI, GFC_STD_F2023); + + add_sym_1 ("sinpi", GFC_ISYM_SINPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_sinpi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + make_generic ("sinpi", GFC_ISYM_SINPI, GFC_STD_F2023); + + add_sym_1 ("tanpi", GFC_ISYM_TANPI, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F2023, gfc_check_fn_r, gfc_simplify_tanpi, + gfc_resolve_trig, x, BT_REAL, dr, REQUIRED); + + make_generic ("tanpi", GFC_ISYM_TANPI, GFC_STD_F2023); } diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 767792ceb23..fd54588054f 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -246,6 +246,7 @@ gfc_expr *gfc_simplify_achar (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_acos (gfc_expr *); gfc_expr *gfc_simplify_acosd (gfc_expr *); gfc_expr *gfc_simplify_acosh (gfc_expr *); +gfc_expr *gfc_simplify_acospi (gfc_expr *); gfc_expr *gfc_simplify_adjustl (gfc_expr *); gfc_expr *gfc_simplify_adjustr (gfc_expr *); gfc_expr *gfc_simplify_aimag (gfc_expr *); @@ -259,11 +260,14 @@ gfc_expr *gfc_simplify_and (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_any (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_asin (gfc_expr *); gfc_expr *gfc_simplify_asinh (gfc_expr *); +gfc_expr *gfc_simplify_asinpi (gfc_expr *); gfc_expr *gfc_simplify_atan (gfc_expr *); gfc_expr *gfc_simplify_atand (gfc_expr *); gfc_expr *gfc_simplify_atanh (gfc_expr *); +gfc_expr *gfc_simplify_atanpi (gfc_expr *); gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_atan2d (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_atan2pi (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_bessel_j0 (gfc_expr *); gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *); gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *); @@ -288,6 +292,7 @@ gfc_expr *gfc_simplify_conjg (gfc_expr *); gfc_expr *gfc_simplify_cos (gfc_expr *); gfc_expr *gfc_simplify_cosd (gfc_expr *); gfc_expr *gfc_simplify_cosh (gfc_expr *); +gfc_expr *gfc_simplify_cospi (gfc_expr *); gfc_expr *gfc_simplify_cotan (gfc_expr *); gfc_expr *gfc_simplify_cotand (gfc_expr *); gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *); @@ -421,6 +426,7 @@ gfc_expr *gfc_simplify_shiftr (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_sin (gfc_expr *); gfc_expr *gfc_simplify_sind (gfc_expr *); gfc_expr *gfc_simplify_sinh (gfc_expr *); +gfc_expr *gfc_simplify_sinpi (gfc_expr *); gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_sizeof (gfc_expr *); gfc_expr *gfc_simplify_storage_size (gfc_expr *, gfc_expr *); @@ -432,6 +438,7 @@ gfc_expr *gfc_simplify_sum (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_tan (gfc_expr *); gfc_expr *gfc_simplify_tand (gfc_expr *); gfc_expr *gfc_simplify_tanh (gfc_expr *); +gfc_expr *gfc_simplify_tanpi (gfc_expr *); gfc_expr *gfc_simplify_this_image (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_tiny (gfc_expr *); gfc_expr *gfc_simplify_trailz (gfc_expr *); @@ -631,8 +638,8 @@ void gfc_resolve_time (gfc_expr *); void gfc_resolve_time8 (gfc_expr *); void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_transpose (gfc_expr *, gfc_expr *); -void gfc_resolve_trigd (gfc_expr *, gfc_expr *); -void gfc_resolve_trigd2 (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_trig (gfc_expr *, gfc_expr *); +void gfc_resolve_trig2 (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_trim (gfc_expr *, gfc_expr *); void gfc_resolve_ttynam (gfc_expr *, gfc_expr *); void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index 6930e2c3622..10013096c70 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -3435,13 +3435,12 @@ gfc_resolve_trim (gfc_expr *f, gfc_expr *string) f->value.function.name = gfc_get_string ("__trim_%d", string->ts.kind); } - -/* Resolve the degree trigonometric functions. This amounts to setting +/* Resolve the trigonometric functions. This amounts to setting the function return type-spec from its argument and building a library function names of the form _gfortran_sind_r4. */ void -gfc_resolve_trigd (gfc_expr *f, gfc_expr *x) +gfc_resolve_trig (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name @@ -3450,9 +3449,8 @@ gfc_resolve_trigd (gfc_expr *f, gfc_expr *x) gfc_type_abi_kind (&x->ts)); } - void -gfc_resolve_trigd2 (gfc_expr *f, gfc_expr *y, gfc_expr *x) +gfc_resolve_trig2 (gfc_expr *f, gfc_expr *y, gfc_expr *x) { f->ts = y->ts; f->value.function.name diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index 2d475a2fa3c..bdc90581652 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -23,34 +23,41 @@ along with GCC; see the file COPYING3. If not see 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_C (ACOSH, "acosh", 0) -DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) -DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0) -DEFINE_MATH_BUILTIN_C (ATAN, "atan", 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) -DEFINE_MATH_BUILTIN_C (EXP, "exp", 0) -DEFINE_MATH_BUILTIN_C (LOG, "log", 0) -DEFINE_MATH_BUILTIN_C (LOG10, "log10", 0) -DEFINE_MATH_BUILTIN_C (SIN, "sin", 0) -DEFINE_MATH_BUILTIN_C (SINH, "sinh", 0) -DEFINE_MATH_BUILTIN_C (SQRT, "sqrt", 0) -DEFINE_MATH_BUILTIN_C (TAN, "tan", 0) -DEFINE_MATH_BUILTIN_C (TANH, "tanh", 0) -DEFINE_MATH_BUILTIN (J0, "j0", 0) -DEFINE_MATH_BUILTIN (J1, "j1", 0) -DEFINE_MATH_BUILTIN (JN, "jn", 5) -DEFINE_MATH_BUILTIN (Y0, "y0", 0) -DEFINE_MATH_BUILTIN (Y1, "y1", 0) -DEFINE_MATH_BUILTIN (YN, "yn", 5) -DEFINE_MATH_BUILTIN (ERF, "erf", 0) -DEFINE_MATH_BUILTIN (ERFC, "erfc", 0) -DEFINE_MATH_BUILTIN (TGAMMA,"tgamma", 0) -DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0) -DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1) +DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) +DEFINE_MATH_BUILTIN_C (ACOSH, "acosh", 0) +DEFINE_MATH_BUILTIN (ACOSPI, "acospi", 0) +DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) +DEFINE_MATH_BUILTIN_C (ASINH, "asinh", 0) +DEFINE_MATH_BUILTIN (ASINPI, "asinpi", 0) +DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) +DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) +DEFINE_MATH_BUILTIN (ATAN2PI, "atan2pi", 1) +DEFINE_MATH_BUILTIN_C (ATANH, "atanh", 0) +DEFINE_MATH_BUILTIN (ATANPI, "atanpi", 0) +DEFINE_MATH_BUILTIN_C (COS, "cos", 0) +DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) +DEFINE_MATH_BUILTIN (COSPI, "cospi", 0) +DEFINE_MATH_BUILTIN (ERF, "erf", 0) +DEFINE_MATH_BUILTIN (ERFC, "erfc", 0) +DEFINE_MATH_BUILTIN_C (EXP, "exp", 0) +DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1) +DEFINE_MATH_BUILTIN (J0, "j0", 0) +DEFINE_MATH_BUILTIN (J1, "j1", 0) +DEFINE_MATH_BUILTIN (JN, "jn", 5) +DEFINE_MATH_BUILTIN (LGAMMA, "lgamma", 0) +DEFINE_MATH_BUILTIN_C (LOG, "log", 0) +DEFINE_MATH_BUILTIN_C (LOG10, "log10", 0) +DEFINE_MATH_BUILTIN_C (SIN, "sin", 0) +DEFINE_MATH_BUILTIN_C (SINH, "sinh", 0) +DEFINE_MATH_BUILTIN (SINPI, "sinpi", 0) +DEFINE_MATH_BUILTIN_C (SQRT, "sqrt", 0) +DEFINE_MATH_BUILTIN_C (TAN, "tan", 0) +DEFINE_MATH_BUILTIN_C (TANH, "tanh", 0) +DEFINE_MATH_BUILTIN (TANPI, "tanpi", 0) +DEFINE_MATH_BUILTIN (TGAMMA, "tgamma", 0) +DEFINE_MATH_BUILTIN (Y0, "y0", 0) +DEFINE_MATH_BUILTIN (Y1, "y1", 0) +DEFINE_MATH_BUILTIN (YN, "yn", 5) /* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE, CONST) For floating-point builtins that do not directly correspond to a diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 1927097c190..2ceb479faf5 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -885,7 +885,8 @@ gfc_simplify_acos (gfc_expr *x) if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) { - gfc_error ("Argument of ACOS at %L must be between -1 and 1", + gfc_error ("Argument of ACOS at %L must be within the closed " + "interval [-1, 1]", &x->where); return &gfc_bad_expr; } @@ -1162,7 +1163,8 @@ gfc_simplify_asin (gfc_expr *x) if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) { - gfc_error ("Argument of ASIN at %L must be between -1 and 1", + gfc_error ("Argument of ASIN at %L must be within the closed " + "interval [-1, 1]", &x->where); return &gfc_bad_expr; } @@ -1213,8 +1215,9 @@ gfc_simplify_acosd (gfc_expr *x) if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) { - gfc_error ("Argument of ACOSD at %L must be between -1 and 1", - &x->where); + gfc_error ( + "Argument of ACOSD at %L must be within the closed interval [-1, 1]", + &x->where); return &gfc_bad_expr; } @@ -1243,8 +1246,9 @@ gfc_simplify_asind (gfc_expr *x) if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) { - gfc_error ("Argument of ASIND at %L must be between -1 and 1", - &x->where); + gfc_error ( + "Argument of ASIND at %L must be within the closed interval [-1, 1]", + &x->where); return &gfc_bad_expr; } @@ -1383,7 +1387,7 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x) if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real)) { - gfc_error ("If first argument of ATAN2 at %L is zero, then the " + gfc_error ("If the first argument of ATAN2 at %L is zero, then the " "second argument must not be zero", &y->where); return &gfc_bad_expr; } @@ -1962,7 +1966,7 @@ gfc_simplify_atan2d (gfc_expr *y, gfc_expr *x) if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real)) { - gfc_error ("If first argument of ATAN2D at %L is zero, then the " + gfc_error ("If the first argument of ATAN2D at %L is zero, then the " "second argument must not be zero", &y->where); return &gfc_bad_expr; } @@ -2151,6 +2155,248 @@ gfc_simplify_cosh (gfc_expr *x) return range_check (result, "COSH"); } +gfc_expr * +gfc_simplify_acospi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) + { + gfc_error ( + "Argument of ACOSPI at %L must be within the closed interval [-1, 1]", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_acospi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t pi, tmp; + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL); + mpfr_const_pi (pi, GFC_RND_MODE); + mpfr_acos (tmp, x->value.real, GFC_RND_MODE); + mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE); + mpfr_clears (pi, tmp, NULL); +#endif + + return result; +} + +gfc_expr * +gfc_simplify_asinpi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) > 0 || mpfr_cmp_si (x->value.real, -1) < 0) + { + gfc_error ( + "Argument of ASINPI at %L must be within the closed interval [-1, 1]", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_asinpi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t pi, tmp; + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL); + mpfr_const_pi (pi, GFC_RND_MODE); + mpfr_asin (tmp, x->value.real, GFC_RND_MODE); + mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE); + mpfr_clears (pi, tmp, NULL); +#endif + + return result; +} + +gfc_expr * +gfc_simplify_atanpi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_atanpi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t pi, tmp; + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL); + mpfr_const_pi (pi, GFC_RND_MODE); + mpfr_atan (tmp, x->value.real, GFC_RND_MODE); + mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE); + mpfr_clears (pi, tmp, NULL); +#endif + + return range_check (result, "ATANPI"); +} + +gfc_expr * +gfc_simplify_atan2pi (gfc_expr *y, gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real)) + { + gfc_error ("If the first argument of ATAN2PI at %L is zero, then the " + "second argument must not be zero", + &y->where); + return &gfc_bad_expr; + } + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_atan2pi (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t pi, tmp; + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), pi, tmp, NULL); + mpfr_const_pi (pi, GFC_RND_MODE); + mpfr_atan2 (tmp, y->value.real, x->value.real, GFC_RND_MODE); + mpfr_div (result->value.real, tmp, pi, GFC_RND_MODE); + mpfr_clears (pi, tmp, NULL); +#endif + + return range_check (result, "ATAN2PI"); +} + +gfc_expr * +gfc_simplify_cospi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_cospi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t cs, n, r; + int s; + + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), cs, n, r, NULL); + + mpfr_abs (r, x->value.real, GFC_RND_MODE); + mpfr_modf (n, r, r, GFC_RND_MODE); + + if (mpfr_cmp_d (r, 0.5) == 0) + { + mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); + return result; + } + + mpfr_fmod_ui (cs, n, 2, GFC_RND_MODE); + s = mpfr_cmp_ui (cs, 0) == 0 ? 1 : -1; + + mpfr_const_pi (cs, GFC_RND_MODE); + mpfr_mul (cs, cs, r, GFC_RND_MODE); + mpfr_cos (cs, cs, GFC_RND_MODE); + mpfr_mul_si (result->value.real, cs, s, GFC_RND_MODE); + + mpfr_clears (cs, n, r, NULL); +#endif + + return range_check (result, "COSPI"); +} + +gfc_expr * +gfc_simplify_sinpi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_sinpi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t sn, n, r; + int s; + + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), sn, n, r, NULL); + + mpfr_abs (r, x->value.real, GFC_RND_MODE); + mpfr_modf (n, r, r, GFC_RND_MODE); + + if (mpfr_cmp_d (r, 0.0) == 0) + { + mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); + return result; + } + + mpfr_fmod_ui (sn, n, 2, GFC_RND_MODE); + s = mpfr_cmp_si (x->value.real, 0) < 0 ? -1 : 1; + s *= mpfr_cmp_ui (sn, 0) == 0 ? 1 : -1; + + mpfr_const_pi (sn, GFC_RND_MODE); + mpfr_mul (sn, sn, r, GFC_RND_MODE); + mpfr_sin (sn, sn, GFC_RND_MODE); + mpfr_mul_si (result->value.real, sn, s, GFC_RND_MODE); + + mpfr_clears (sn, n, r, NULL); +#endif + + return range_check (result, "SINPI"); +} + +gfc_expr * +gfc_simplify_tanpi (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + +#if MPFR_VERSION >= MPFR_VERSION_NUM(4, 2, 0) + mpfr_tanpi (result->value.real, x->value.real, GFC_RND_MODE); +#else + mpfr_t tn, n, r; + int s; + + mpfr_inits2 (2 * mpfr_get_prec (x->value.real), tn, n, r, NULL); + + mpfr_abs (r, x->value.real, GFC_RND_MODE); + mpfr_modf (n, r, r, GFC_RND_MODE); + + if (mpfr_cmp_d (r, 0.0) == 0) + { + mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); + return result; + } + + s = mpfr_cmp_si (x->value.real, 0) < 0 ? -1 : 1; + + mpfr_const_pi (tn, GFC_RND_MODE); + mpfr_mul (tn, tn, r, GFC_RND_MODE); + mpfr_tan (tn, tn, GFC_RND_MODE); + mpfr_mul_si (result->value.real, tn, s, GFC_RND_MODE); + + mpfr_clears (tn, n, r, NULL); +#endif + + return range_check (result, "TANPI"); +} gfc_expr * gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) diff --git a/gcc/testsuite/gfortran.dg/dec_math_3.f90 b/gcc/testsuite/gfortran.dg/dec_math_3.f90 index 5bf4398d0f2..d2f57e24cb5 100644 --- a/gcc/testsuite/gfortran.dg/dec_math_3.f90 +++ b/gcc/testsuite/gfortran.dg/dec_math_3.f90 @@ -1,8 +1,17 @@ ! { dg-options "-std=gnu" } ! { dg-do compile } -! Former ICE when simplifying asind, plus wrong function name in error message -real, parameter :: d = asind(1.1) ! { dg-error "Argument of ASIND at.*must be between -1 and 1" } -print *, d +real, parameter :: dacos = acosd(1.1) ! { dg-error "Argument of ACOSD at .1. must be within the closed interval \\\[-1, 1\\\]" } +print *, dacos +real, parameter :: dasin = asind(-1.1) ! { dg-error "Argument of ASIND at .1. must be within the closed interval \\\[-1, 1\\\]" } +print *, dasin +real, parameter :: datan2 = atan2d(0.0, 0.0) ! { dg-error "If the first argument of ATAN2D at .1. is zero, then the second argument must not be zero" } +print *, datan2 +real, parameter :: piacos = acospi(-1.1) ! { dg-error "Argument of ACOSPI at .1. must be within the closed interval \\\[-1, 1\\\]" } +print *, piacos +real, parameter :: piasin = asinpi(1.1) ! { dg-error "Argument of ASINPI at .1. must be within the closed interval \\\[-1, 1\\\]" } +print *, piasin +real, parameter :: piatan2 = atan2pi(0.0, 0.0) ! { dg-error "If the first argument of ATAN2PI at .1. is zero, then the second argument must not be zero" } +print *, piatan2 end diff --git a/gcc/testsuite/gfortran.dg/dec_math_5.f90 b/gcc/testsuite/gfortran.dg/dec_math_5.f90 index dee2de4e06b..a7ff3275236 100644 --- a/gcc/testsuite/gfortran.dg/dec_math_5.f90 +++ b/gcc/testsuite/gfortran.dg/dec_math_5.f90 @@ -101,4 +101,67 @@ program p if (abs(b1 - 0.5) > e2) stop 38 if (abs(c1 - 0.5) > e3) stop 39 if (abs(d1 - 0.5) > e4) stop 40 + + a1 = acospi(0.5) + b1 = acospi(-0.5) + c1 = acospi(0.5) + d1 = acospi(-0.5) + if (abs(a1 - 1.0 / 3) > e1) stop 41 + if (abs(b1 - 2.0 / 3) > e2) stop 42 + if (abs(c1 - 1.0 / 3) > e3) stop 43 + if (abs(d1 - 2.0 / 3) > e4) stop 44 + + a1 = asinpi(0.5) + b1 = asinpi(-0.5) + c1 = asinpi(0.5) + d1 = asinpi(-0.5) + if (abs(a1 - 1.0 / 6) > e1) stop 45 + if (abs(b1 + 1.0 / 6) > e2) stop 46 + if (abs(c1 - 1.0 / 6) > e3) stop 47 + if (abs(d1 + 1.0 / 6) > e4) stop 48 + + a1 = atanpi(1.0) + b1 = atanpi(-1.0) + c1 = atanpi(1.0) + d1 = atanpi(-1.0) + if (abs(a1 - 0.25) > e1) stop 49 + if (abs(b1 + 0.25) > e2) stop 50 + if (abs(c1 - 0.25) > e3) stop 51 + if (abs(d1 + 0.25) > e4) stop 52 + + a1 = atan2pi(1.0, 1.0) + b1 = atan2pi(1.0, 1.0) + c1 = atan2pi(1.0, 1.0) + d1 = atan2pi(1.0, 1.0) + if (abs(a1 - 0.25) > e1) stop 53 + if (abs(b1 - 0.25) > e2) stop 54 + if (abs(c1 - 0.25) > e3) stop 55 + if (abs(d1 - 0.25) > e4) stop 56 + + a1 = cospi(1._4 / 3) + b1 = cospi(-1._8 / 3) + c1 = cospi(4._ep / 3) + d1 = cospi(-4._16 / 3) + if (abs(a1 - 0.5) > e1) stop 57 + if (abs(b1 - 0.5) > e2) stop 58 + if (abs(c1 + 0.5) > e3) stop 59 + if (abs(d1 + 0.5) > e4) stop 60 + + a1 = sinpi(1._4 / 6) + b1 = sinpi(-1._8 / 6) + c1 = sinpi(5._ep / 6) + d1 = sinpi(-7._16 / 6) + if (abs(a1 - 0.5) > e1) stop 61 + if (abs(b1 + 0.5) > e2) stop 62 + if (abs(c1 - 0.5) > e3) stop 63 + if (abs(d1 - 0.5) > e4) stop 64 + + a1 = tanpi(0.25) + b1 = tanpi(-0.25) + c1 = tanpi(1.25) + d1 = tanpi(-1.25) + if (abs(a1 - 1.0) > e1) stop 65 + if (abs(b1 + 1.0) > e2) stop 66 + if (abs(c1 - 1.0) > e3) stop 67 + if (abs(d1 + 1.0) > e4) stop 68 end program p diff --git a/gcc/testsuite/gfortran.dg/dec_math_6.f90 b/gcc/testsuite/gfortran.dg/dec_math_6.f90 new file mode 100644 index 00000000000..dfb8b068d9b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_math_6.f90 @@ -0,0 +1,12 @@ +! { dg-options "-std=f2018" } +! { dg-do compile } + +intrinsic :: acospi ! { dg-error "The intrinsic 'acospi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: asinpi ! { dg-error "The intrinsic 'asinpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: atanpi ! { dg-error "The intrinsic 'atanpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: atan2pi ! { dg-error "The intrinsic 'atan2pi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: cospi ! { dg-error "The intrinsic 'cospi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: sinpi ! { dg-error "The intrinsic 'sinpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } +intrinsic :: tanpi ! { dg-error "The intrinsic 'tanpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" } + +end -- 2.43.0