From patchwork Mon Nov 15 21:38:23 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 47728 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E18C9385802E for ; Mon, 15 Nov 2021 21:39:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E18C9385802E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1637012352; bh=v+KwqXPnmyQlIRl12lQmLSFS8VOYMRsI2BLXW2/bAEk=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=MjHuFWgkxMq9eK4u2p2jpx+5Bxj857tTRadcHFibrASpbim0Y0JLXlkgPoCKbzyMY NGVCJdo1r0ebmwncGn1VNUXHSqU2DFVLtBSLBckD8V0SgucSFwhPmzfdUYFns5cDuD 36iuPOmW01WY5ZC1yoOw0GSe1EA0AN86zTUqDz5U= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.22]) by sourceware.org (Postfix) with ESMTPS id 38D073858405; Mon, 15 Nov 2021 21:38:25 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 38D073858405 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.14.191] ([79.251.14.191]) by web-mail.gmx.net (3c-app-gmx-bap64.server.lan [172.19.172.134]) (via HTTP); Mon, 15 Nov 2021 22:38:23 +0100 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] PR fortran/99061 - [10/11/12 Regression] ICE in gfc_conv_intrinsic_atan2d, at fortran/trans-intrinsic.c:4728 Date: Mon, 15 Nov 2021 22:38:23 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:5v02odMUwCS9CidHsULlfj7x5G+ms1BLcglSdF4Ct6cvG8TF3YyUfb8vUXZHe/GK7HZ0S 6WXbli6xhsCDeieArZ09HXYXJha+Hty8qlxbOse3p1daRNoUBEJcQjVN9Gfeep2hTfiUuc5SICXp X4gr8Zi3AWeT5WnR3Dh7ayssyANKVPzSDUtOojr4biKSmAktGFzUCdXHaBpX23Vx/i/umIKCFYlX qu0+W3QxGx1e46YKy9Nzu03zVrNUioj0rXW87HtbDUVs6tmWXLRzosKEt5gE5qkmJnoo7YOqsvC7 jo= X-UI-Out-Filterresults: notjunk:1;V03:K0:BvJk2xE4hs0=:WOblcMulITCIvNSSTEJkVi u8msF5QWPtw8yObtAcBvlcextwNmf7mLo1u56VUyH7z5UzMG+YedOUX7xDLhvQnd+heekfgCA MOySlZLdU+J51g8zXlQlVJxfRj0iRRfxNrgKcKFYdTtq6XyLYFmAQVTFwS8KjFw3BcEjGeJL/ bO15h1LDNedcexI3p41/LuafgJMtY+t7EVAqctzKDYU9hYAIeARJLXEszrWLg3VC//QQE/U+a W9/i2joi8kX/AgTz9F9gyqn03VFdQ+Ezp14Mfbeg3Ee9Vb7dUeDgQNMEozOpKg3pyGDDUn26m WwTJJFFNvrS+Vllzki66+iQehwiwNV2gGLhx23Ol+CMNNY6hH1S6DtX/pjOEMBwA3Us8yAHWv eN7aAWXswkHFn8YmUfM6JnOakY+vA88Bwdy5SQ4Ih6LFBvwv5SWZCWdxnYk1HQJ7rKAtqm9sj gSea4nQHDvRpTtdsuTIYsGa+zM81MW4ehmbLI5LY8W4+Da5NOeSbJuBpJvhSnvUE4O9blBks+ udKl2uFDdmukUD4FMGV7laZV3tIvmoYCspCy/cJb9YG3V0hS/7vI69v3lEpPeMfniomhYp2Qv lgdxJI/FMUPmHi7kgiVV9kJEIspj60+rPXzKC5eLFGKP29cyimhbwPngfJZpi5cNnMBQn3wTe dgRIcfxdhteiJxdlkh9DYGKQaWoJOqjjSij4yLSoQQT4WkvkmLARkU0yggdAwSqB5O+o1VgGv stV0ORZ3/1VMk/w6Mj8BgefbzpyuWTHmzvkGgq/MnNHzRmQ6ggK+uvOCj39RY/AlrPLjr+yaK MIbBRii X-Spam-Status: No, score=-10.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, SCC_5_SHORT_WORD_LINES, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Dear Fortranners, the attached patch fixes the handling of the DEC trigonometric intrinsics for different argument kinds. It is based on the original patch by Steve, which fixes the lookup for the needed intrinsics. Regtested on x86_64-pc-linux-gnu. OK for affected branches? Thanks, Harald From e979db00b8e84333c53bc0b8f1c89cd8ce18d72c Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 15 Nov 2021 22:32:17 +0100 Subject: [PATCH] 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. --- gcc/fortran/trans-intrinsic.c | 66 ++++++++------- gcc/testsuite/gfortran.dg/dec_math_5.f90 | 103 +++++++++++++++++++++++ 2 files changed, 138 insertions(+), 31 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_math_5.f90 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3f867911af5..bd67f4f44da 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4555,6 +4555,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. */ @@ -4565,20 +4577,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, @@ -4614,13 +4633,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); } @@ -4630,20 +4645,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); @@ -4675,11 +4682,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); @@ -4699,7 +4702,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..1417a4fed29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_math_5.f90 @@ -0,0 +1,103 @@ +! { 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 + real(4) :: a1, e1 = 1.e-5 + real(8) :: b1, e2 = 1.e-14 + real(10) :: 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 = 1._4 / 2; a1 = asind(a1) + b1 = 1._8 / 2; b1 = asind(b1) + c1 = 1._10/ 2; c1 = asind(c1) + d1 = 1._16/ 2; 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 = 1._4 / 2; a1 = acosd(a1) + b1 = 1._8 / 2; b1 = acosd(b1) + c1 = 1._10/ 2; c1 = acosd(c1) + d1 = 1._16/ 2; 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._10)) > 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._10)) > 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 -- 2.26.2