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
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);
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);
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.
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);
}
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 *);
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 *);
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 *);
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 *);
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 *);
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 *);
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
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
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
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;
}
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;
}
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;
}
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;
}
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;
}
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;
}
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)
! { 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
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
--- /dev/null
+! { 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
projects / thirdparty / gcc.git / commitdiff
