https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93871
--- Comment #9 from Steve Kargl <sgk at troutmask dot apl.washington.edu> --- On Fri, Feb 21, 2020 at 08:33:04PM +0000, sgk at troutmask dot apl.washington.edu wrote: > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93871 > > --- Comment #8 from Steve Kargl <sgk at troutmask dot apl.washington.edu> --- > On Fri, Feb 21, 2020 at 08:19:01PM +0000, sgk at troutmask dot > apl.washington.edu wrote: > > > > program foo > > complex, parameter :: z = cotan((1.,1.)) > > print *, z > > end program foo > > > > Something is definitely broken. I'll need to > revisit intrinsic.c. To get to the first > executable statement in gfc_simplify_cotan, > > (gdb) b simplify.c:7793 > (gdb) p *x > $6 = {expr_type = EXPR_FUNCTION, ts = {type = BT_UNKNOWN, kind = 0, u = > {derived = 0x0, > cl = 0x0, pad = 0}, interface = 0x0, is_c_interop = 0, is_iso_c = 0, > f90_type = BT_UNKNOWN, deferred = false, interop_kind = 0x0}, rank = 0, > shape = 0x0, > symtree = 0x2024e8570, ref = 0x0, where = {nextc = 0x202db65cc, lb = > 0x202db6540}, > base_expr = 0x0, is_snan = 0, error = 0, user_operator = 0, mold = 0, > must_finalize = 0, > no_bounds_check = 0, external_blas = 0, do_not_resolve_again = 0, > do_not_warn > = 0, > from_constructor = 0, representation = {length = 0, string = 0x0}, boz = > {len > = 0, > rdx = 0, str = 0x0}, value = {logical = 38700448, iokind = 38700448, > integer = {{ > _mp_alloc = 38700448, _mp_size = 2, _mp_d = 0x0}}, real = {{ > _mpfr_prec = 8628635040, _mpfr_sign = 0, _mpfr_exp = 8647423552, > _mpfr_d = 0x0}}, > complex = {{re = {{_mpfr_prec = 8628635040, _mpfr_sign = 0, _mpfr_exp = > 8647423552, > _mpfr_d = 0x0}}, im = {{_mpfr_prec = 0, _mpfr_sign = 0, _mpfr_exp > = > 0, > _mpfr_d = 0x0}}}}, op = {op = 38700448, uop = 0x0, op1 = > 0x2036d3640, > op2 = 0x0}, function = {actual = 0x2024e85a0, name = 0x0, isym = > 0x2036d3640, > esym = 0x0}, compcall = {actual = 0x2024e85a0, name = 0x0, > base_object = 0x2036d3640, tbp = 0x0, ignore_pass = 0, assign = 0}, > character = { > length = 8628635040, string = 0x0}, constructor = 0x2024e85a0}, > param_list = 0x0} > > Hmmm, x should be the argument to cotan. > > (gdb) p *x->value.function->isym > $9 = {name = 0x20344fa88 "cotan", lib_name = 0x20346a130 "_gfortran_cotan", > formal = 0x2036e6928, ts = {type = BT_REAL, kind = 4, u = {derived = 0x0, cl > = 0x0, > pad = 0}, interface = 0x0, is_c_interop = 0, is_iso_c = 0, f90_type = > BT_UNKNOWN, > deferred = false, interop_kind = 0x0}, elemental = 1, inquiry = 0, > transformational = 0, pure = 1, generic = 1, specific = 1, actual_ok = 1, > noreturn = 0, > > but it apprears to be the function itself! > > (gdb) p *x->value.function->actual->expr > $11 = {expr_type = EXPR_CONSTANT, ts = {type = BT_COMPLEX, kind = 4, u = > {derived = 0x0, > cl = 0x0, pad = 0}, interface = 0x0, is_c_interop = 0, is_iso_c = 0, > Ugh, this diff fixes constant-folding (without your mpc_sincos) patch. Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 280157) +++ gcc/fortran/simplify.c (working copy) @@ -7782,26 +7787,32 @@ gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_ gfc_expr * gfc_simplify_cotan (gfc_expr *x) { - gfc_expr *result; + gfc_expr *arg, *result; mpc_t swp, *val; - if (x->expr_type != EXPR_CONSTANT) + if (x->expr_type == EXPR_FUNCTION + && strcmp(x->value.function.isym->name, "cotan") == 0) + arg = x->value.function.actual->expr; + else + arg = x; + + if (arg->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + result = gfc_get_constant_expr (arg->ts.type, arg->ts.kind, &arg->where); - switch (x->ts.type) + switch (arg->ts.type) { case BT_REAL: - mpfr_cot (result->value.real, x->value.real, GFC_RND_MODE); + mpfr_cot (result->value.real, arg->value.real, GFC_RND_MODE); break; case BT_COMPLEX: /* There is no builtin mpc_cot, so compute cot = cos / sin. */ val = &result->value.complex; mpc_init2 (swp, mpfr_get_default_prec ()); - mpc_cos (swp, x->value.complex, GFC_MPC_RND_MODE); - mpc_sin (*val, x->value.complex, GFC_MPC_RND_MODE); + mpc_cos (swp, arg->value.complex, GFC_MPC_RND_MODE); + mpc_sin (*val, arg->value.complex, GFC_MPC_RND_MODE); mpc_div (*val, swp, *val, GFC_MPC_RND_MODE); mpc_clear (swp); break; But, as I stated something is broken, and I suspect it affects all -fdec functions.
