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: 1555533 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=Od+khfDL; dkim-atps=neutral Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4HtMz63X1Jz9s5P for ; Tue, 16 Nov 2021 08:39:28 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C50FC385842E for ; Mon, 15 Nov 2021 21:39:24 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C50FC385842E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1637012364; 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=Od+khfDL72dqqKjPq3/lq1PZpyp6jgLX65IXKY5ydBsGXqm7J4PJG61KPTGzvGCY7 WT21Ewiv57riTgFMg5GOV70KZu4gtYg6cW/Zs2jAYTC6Nsyp9Z8ABlau+LzDp60BPX HQzueZ7IH8lOAMekg0JJC859uh0t8OHLZ22tRBzs= 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+incoming=patchwork.ozlabs.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