From 3b56ca2f629291fe088c5c7cf4f68f66b660ba05 Mon Sep 17 00:00:00 2001 From: Yuao Ma Date: Tue, 27 May 2025 22:10:31 +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. PR113152 gcc/fortran/ChangeLog: * gfortran.h (enum gfc_isym_id): Add new enum. * intrinsic.cc (add_functions): Register new intrinsics. Reformatted certain lines that utilize 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 | 258 ++++++++++++++++++++++- 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 | 19 ++ 9 files changed, 473 insertions(+), 65 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..27096c9b347 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; } @@ -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 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..ee5df0a50e3 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" } +print *, dacos +real, parameter :: dasin = asind(-1.1) ! { dg-error "Argument of ASIND at" } +print *, dasin +real, parameter :: datan2 = atan2d(0.0, 0.0) ! { dg-error "If first argument of ATAN2D at" } +print *, datan2 +real, parameter :: piacos = acospi(-1.1) ! { dg-error "Argument of ACOSPI at" } +print *, piacos +real, parameter :: piasin = asinpi(1.1) ! { dg-error "Argument of ASINPI at" } +print *, piasin +real, parameter :: piatan2 = atan2pi(0.0, 0.0) ! { dg-error "If first argument of ATAN2PI at" } +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..6ff50b80af1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_math_6.f90 @@ -0,0 +1,19 @@ +! { dg-options "-std=f2018" } +! { dg-do compile } + +real, parameter :: piacos = acospi(0.0) ! { dg-error "Function 'acospi' in initialization expression at" } +print *, piacos +real, parameter :: piasin = asinpi(0.0) ! { dg-error "Function 'asinpi' in initialization expression at" } +print *, piasin +real, parameter :: piatan = atanpi(0.0) ! { dg-error "Function 'atanpi' in initialization expression at" } +print *, piasin +real, parameter :: piatan2 = atan2pi(1.0, 1.0) ! { dg-error "Function 'atan2pi' in initialization expression at" } +print *, piatan2 +real, parameter :: picos = cospi(0.0) ! { dg-error "Function 'cospi' in initialization expression at" } +print *, piacos +real, parameter :: pisin = sinpi(0.0) ! { dg-error "Function 'sinpi' in initialization expression at" } +print *, piasin +real, parameter :: pitan = tanpi(0.0) ! { dg-error "Function 'tanpi' in initialization expression at" } +print *, piasin + +end -- 2.43.0