From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id F0EB7385840E; Mon, 22 Nov 2021 20:04:07 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org F0EB7385840E MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r10-10287] Fortran: fix lookup for gfortran builtin math intrinsics used by DEC extensions X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-10 X-Git-Oldrev: 959b662e0d0b91ac3bd8002f46a8d6c8159ea3b0 X-Git-Newrev: 3eeda9a3b5e932bad28ca870077185ced67eb27e Message-Id: <20211122200407.F0EB7385840E@sourceware.org> Date: Mon, 22 Nov 2021 20:04:07 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 22 Nov 2021 20:04:08 -0000 https://gcc.gnu.org/g:3eeda9a3b5e932bad28ca870077185ced67eb27e commit r10-10287-g3eeda9a3b5e932bad28ca870077185ced67eb27e Author: Harald Anlauf Date: Sun Nov 21 19:29:27 2021 +0100 Fortran: fix lookup for gfortran builtin math intrinsics used by DEC extensions gcc/fortran/ChangeLog: PR fortran/99061 * trans-intrinsic.c (gfc_lookup_intrinsic): Helper function for looking up gfortran builtin intrinsics. (gfc_conv_intrinsic_atrigd): Use it. (gfc_conv_intrinsic_cotan): Likewise. (gfc_conv_intrinsic_cotand): Likewise. (gfc_conv_intrinsic_atan2d): Likewise. gcc/testsuite/ChangeLog: PR fortran/99061 * gfortran.dg/dec_math_5.f90: New test. Co-authored-by: Steven G. Kargl (cherry picked from commit 8fef6f720a5a0a056abfa986ba870bb406ab4716) Diff: --- gcc/fortran/trans-intrinsic.c | 66 +++++++++++--------- gcc/testsuite/gfortran.dg/dec_math_5.f90 | 104 +++++++++++++++++++++++++++++++ 2 files changed, 139 insertions(+), 31 deletions(-) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 43eaba26a87..aa396691c9c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4411,6 +4411,18 @@ rad2deg (int kind) } +static gfc_intrinsic_map_t * +gfc_lookup_intrinsic (gfc_isym_id id) +{ + gfc_intrinsic_map_t *m = gfc_intrinsic_map; + for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) + if (id == m->id) + break; + gcc_assert (id == m->id); + return m; +} + + /* ACOSD(x) is translated into ACOS(x) * 180 / pi. ASIND(x) is translated into ASIN(x) * 180 / pi. ATAND(x) is translated into ATAN(x) * 180 / pi. */ @@ -4421,20 +4433,27 @@ gfc_conv_intrinsic_atrigd (gfc_se * se, gfc_expr * expr, gfc_isym_id id) tree arg; tree atrigd; tree type; + gfc_intrinsic_map_t *m; type = gfc_typenode_for_spec (&expr->ts); gfc_conv_intrinsic_function_args (se, expr, &arg, 1); - if (id == GFC_ISYM_ACOSD) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ACOS, expr->ts.kind); - else if (id == GFC_ISYM_ASIND) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ASIN, expr->ts.kind); - else if (id == GFC_ISYM_ATAND) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ATAN, expr->ts.kind); - else - gcc_unreachable (); - + switch (id) + { + case GFC_ISYM_ACOSD: + m = gfc_lookup_intrinsic (GFC_ISYM_ACOS); + break; + case GFC_ISYM_ASIND: + m = gfc_lookup_intrinsic (GFC_ISYM_ASIN); + break; + case GFC_ISYM_ATAND: + m = gfc_lookup_intrinsic (GFC_ISYM_ATAN); + break; + default: + gcc_unreachable (); + } + atrigd = gfc_get_intrinsic_lib_fndecl (m, expr); atrigd = build_call_expr_loc (input_location, atrigd, 1, arg); se->expr = fold_build2_loc (input_location, MULT_EXPR, type, atrigd, @@ -4470,13 +4489,9 @@ gfc_conv_intrinsic_cotan (gfc_se *se, gfc_expr *expr) mpfr_clear (pio2); /* Find tan builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_TAN == m->id) - break; - - tmp = fold_build2_loc (input_location, PLUS_EXPR, type, arg, tmp); + m = gfc_lookup_intrinsic (GFC_ISYM_TAN); tan = gfc_get_intrinsic_lib_fndecl (m, expr); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, arg, tmp); tan = build_call_expr_loc (input_location, tan, 1, tmp); se->expr = fold_build1_loc (input_location, NEGATE_EXPR, type, tan); } @@ -4486,20 +4501,12 @@ gfc_conv_intrinsic_cotan (gfc_se *se, gfc_expr *expr) tree cos; /* Find cos builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_COS == m->id) - break; - + m = gfc_lookup_intrinsic (GFC_ISYM_COS); cos = gfc_get_intrinsic_lib_fndecl (m, expr); cos = build_call_expr_loc (input_location, cos, 1, arg); /* Find sin builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_SIN == m->id) - break; - + m = gfc_lookup_intrinsic (GFC_ISYM_SIN); sin = gfc_get_intrinsic_lib_fndecl (m, expr); sin = build_call_expr_loc (input_location, sin, 1, arg); @@ -4531,11 +4538,7 @@ gfc_conv_intrinsic_cotand (gfc_se *se, gfc_expr *expr) mpfr_clear (ninety); /* Find tand. */ - gfc_intrinsic_map_t *m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_TAND == m->id) - break; - + gfc_intrinsic_map_t *m = gfc_lookup_intrinsic (GFC_ISYM_TAND); tree tand = gfc_get_intrinsic_lib_fndecl (m, expr); tand = build_call_expr_loc (input_location, tand, 1, arg); @@ -4555,7 +4558,8 @@ gfc_conv_intrinsic_atan2d (gfc_se *se, gfc_expr *expr) gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); - atan2d = gfc_builtin_decl_for_float_kind (BUILT_IN_ATAN2, expr->ts.kind); + gfc_intrinsic_map_t *m = gfc_lookup_intrinsic (GFC_ISYM_ATAN2); + atan2d = gfc_get_intrinsic_lib_fndecl (m, expr); atan2d = build_call_expr_loc (input_location, atan2d, 2, args[0], args[1]); se->expr = fold_build2_loc (input_location, MULT_EXPR, type, atan2d, diff --git a/gcc/testsuite/gfortran.dg/dec_math_5.f90 b/gcc/testsuite/gfortran.dg/dec_math_5.f90 new file mode 100644 index 00000000000..dee2de4e06b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_math_5.f90 @@ -0,0 +1,104 @@ +! { dg-do run } +! { dg-additional-options "-std=gnu" } +! { dg-require-effective-target fortran_real_10 } +! { dg-require-effective-target fortran_real_16 } + +program p + implicit none + integer, parameter :: ep = selected_real_kind (17) ! real(10) + real(4) :: a1, e1 = 1.e-5 + real(8) :: b1, e2 = 1.e-14 + real(ep) :: c1, e3 = 1.e-17 + real(16) :: d1, e4 = 1.e-30 + + a1 = 1; a1 = atand(a1) + b1 = 1; b1 = atand(b1) + c1 = 1; c1 = atand(c1) + d1 = 1; d1 = atand(d1) +! print '(4(F15.11))', a1, b1, c1, d1 + if (abs(a1 - 45) > e1) stop 1 + if (abs(b1 - 45) > e2) stop 2 + if (abs(c1 - 45) > e3) stop 3 + if (abs(d1 - 45) > e4) stop 4 + + a1 = 0.5; a1 = asind(a1) + b1 = 0.5; b1 = asind(b1) + c1 = 0.5; c1 = asind(c1) + d1 = 0.5; d1 = asind(d1) + if (abs(a1 - 30) > e1) stop 5 + if (abs(b1 - 30) > e2) stop 6 + if (abs(c1 - 30) > e3) stop 7 + if (abs(d1 - 30) > e4) stop 8 + + a1 = 0.5; a1 = acosd(a1) + b1 = 0.5; b1 = acosd(b1) + c1 = 0.5; c1 = acosd(c1) + d1 = 0.5; d1 = acosd(d1) + if (abs(a1 - 60) > e1) stop 9 + if (abs(b1 - 60) > e2) stop 10 + if (abs(c1 - 60) > e3) stop 11 + if (abs(d1 - 60) > e4) stop 12 + + a1 = 45; a1 = tand(a1) + b1 = 45; b1 = tand(b1) + c1 = 45; c1 = tand(c1) + d1 = 45; d1 = tand(d1) + if (abs(a1 - 1) > e1) stop 13 + if (abs(b1 - 1) > e2) stop 14 + if (abs(c1 - 1) > e3) stop 15 + if (abs(d1 - 1) > e4) stop 16 + + a1 = 60; a1 = tand(a1) + b1 = 60; b1 = tand(b1) + c1 = 60; c1 = tand(c1) + d1 = 60; d1 = tand(d1) + if (abs(a1 - sqrt (3._4) ) > e1) stop 17 + if (abs(b1 - sqrt (3._8) ) > e2) stop 18 + if (abs(c1 - sqrt (3._ep)) > e3) stop 19 + if (abs(d1 - sqrt (3._16)) > e4) stop 20 + + a1 = 45; a1 = cotand(a1) + b1 = 45; b1 = cotand(b1) + c1 = 45; c1 = cotand(c1) + d1 = 45; d1 = cotand(d1) + if (abs(a1 - 1) > e1) stop 21 + if (abs(b1 - 1) > e2) stop 22 + if (abs(c1 - 1) > e3) stop 23 + if (abs(d1 - 1) > e4) stop 24 + + a1 = 30; a1 = cotand(a1) + b1 = 30; b1 = cotand(b1) + c1 = 30; c1 = cotand(c1) + d1 = 30; d1 = cotand(d1) + if (abs(a1 - sqrt (3._4) ) > e1) stop 25 + if (abs(b1 - sqrt (3._8) ) > e2) stop 26 + if (abs(c1 - sqrt (3._ep)) > e3) stop 27 + if (abs(d1 - sqrt (3._16)) > e4) stop 28 + + a1 = 1; a1 = atan2d(a1, a1) + b1 = 1; b1 = atan2d(b1, b1) + c1 = 1; c1 = atan2d(c1, c1) + d1 = 1; d1 = atan2d(d1, d1) + if (abs(a1 - 45) > e1) stop 29 + if (abs(b1 - 45) > e2) stop 30 + if (abs(c1 - 45) > e3) stop 31 + if (abs(d1 - 45) > e4) stop 32 + + a1 = 30; a1 = sind(a1) + b1 = 30; b1 = sind(b1) + c1 = 30; c1 = sind(c1) + d1 = 30; d1 = sind(d1) + if (abs(a1 - 0.5) > e1) stop 33 + if (abs(b1 - 0.5) > e2) stop 34 + if (abs(c1 - 0.5) > e3) stop 35 + if (abs(d1 - 0.5) > e4) stop 36 + + a1 = 60; a1 = cosd(a1) + b1 = 60; b1 = cosd(b1) + c1 = 60; c1 = cosd(c1) + d1 = 60; d1 = cosd(d1) + if (abs(a1 - 0.5) > e1) stop 37 + if (abs(b1 - 0.5) > e2) stop 38 + if (abs(c1 - 0.5) > e3) stop 39 + if (abs(d1 - 0.5) > e4) stop 40 +end program p