From: Harald Anlauf Date: Mon, 6 Jul 2026 18:50:18 +0000 (+0200) Subject: Fortran: degree trigonometric functions and procedure pointers [PR121366] X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=216d08b2cc1211dfd2b1710d2c8557f59035bef4;p=thirdparty%2Fgcc.git Fortran: degree trigonometric functions and procedure pointers [PR121366] While libgfortran already provides an implementation of the degree trigonometric functions and their inverses with argument passed by value, some situations (e.g. when used as procedure pointer target) need the variant with Fortran calling conventions where the argument is passed by reference. Provide the appropriate specific wrappers. PR fortran/121366 gcc/fortran/ChangeLog: * intrinsic.texi: Remove documentation of GNU intrinsic extensions (CCOSD,ZCOSD,CDCOSD) that were never implemented. * iresolve.cc (gfc_resolve_trig): Fix resolution of degree trigonometric functions and generate references to the proper library functions. (gfc_resolve_trig2): Likewise. * trans-decl.cc (gfc_get_extern_function_decl): Ensure that isym is set when resolving intrinsic procedures. libgfortran/ChangeLog: * Makefile.am: Add dependency on wrappers to degree trigonometric functions. * Makefile.in: Regenerate. * gfortran.map: Add references to new wrapper functions. * intrinsics/trigd_specific.F90: New file. gcc/testsuite/ChangeLog: * gfortran.dg/trigd_1.f90: New test. --- diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 64309fd852c..36efaadda45 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -4611,9 +4611,6 @@ Degrees function: @* @section @code{COSD} --- Cosine function, degrees @fnindex COSD @fnindex DCOSD -@fnindex CCOSD -@fnindex ZCOSD -@fnindex CDCOSD @cindex trigonometric function, cosine, degrees @cindex cosine, degrees @@ -4649,9 +4646,6 @@ end program test_cosd @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COSD(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 2023 @item @code{DCOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension -@item @code{CCOSD(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU extension -@item @code{ZCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension -@item @code{CDCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @item @emph{Standard}: @@ -14057,9 +14051,6 @@ Degrees function: @* @section @code{SIND} --- Sine function, degrees @fnindex SIND @fnindex DSIND -@fnindex CSIND -@fnindex ZSIND -@fnindex CDSIND @cindex trigonometric function, sine, degrees @cindex sine, degrees @@ -14094,9 +14085,6 @@ end program test_sind @headitem Name @tab Argument @tab Return type @tab Standard @item @code{SIND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 2023 @item @code{DSIND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension -@item @code{CSIND(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU extension -@item @code{ZSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension -@item @code{CDSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @item @emph{Standard}: diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index 7ec821baa9e..72cb6c81c4d 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -3477,25 +3477,40 @@ gfc_resolve_trim (gfc_expr *f, gfc_expr *string) /* 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. */ + library function names of the form _gfortran_specific__sind_r4. + Strip leading "d" from names of GNU extensions (dcosd, dsind, dtand, + and their inverses). */ void gfc_resolve_trig (gfc_expr *f, gfc_expr *x) { + const char *name; f->ts = x->ts; + + name = f->value.function.isym->name; + if (name[0] == 'd') + name = &f->value.function.isym->name[1]; + f->value.function.name - = gfc_get_string (PREFIX ("%s_%c%d"), f->value.function.isym->name, + = gfc_get_string ("__%s_%c%d", name, gfc_type_letter (x->ts.type), gfc_type_abi_kind (&x->ts)); } void -gfc_resolve_trig2 (gfc_expr *f, gfc_expr *y, gfc_expr *x) +gfc_resolve_trig2 (gfc_expr *f, gfc_expr *y, gfc_expr *x ATTRIBUTE_UNUSED) { + const char *name; f->ts = y->ts; + + name = f->value.function.isym->name; + if (name[0] == 'd') + name = &f->value.function.isym->name[1]; + f->value.function.name - = gfc_get_string (PREFIX ("%s_%d"), f->value.function.isym->name, - x->ts.kind); + = gfc_get_string ("__%s_%c%d", name, + gfc_type_letter (y->ts.type), + gfc_type_abi_kind (&y->ts)); } diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index eb957472920..38d033f520d 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2423,6 +2423,7 @@ module_sym: memset (&e, 0, sizeof (e)); e.expr_type = EXPR_FUNCTION; + e.value.function.isym = isym; memset (&argexpr, 0, sizeof (argexpr)); gcc_assert (isym->formal); diff --git a/gcc/testsuite/gfortran.dg/trigd_1.f90 b/gcc/testsuite/gfortran.dg/trigd_1.f90 new file mode 100644 index 00000000000..c8decd0e219 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trigd_1.f90 @@ -0,0 +1,133 @@ +! { dg-do run } +! { dg-additional-options "-O2 -std=f2023 -fall-intrinsics" +! +! PR fortran/121366 - degree trigonometric function and procedure pointers +! +! Test availability of degree trigonometric function from F2023 standard +! (cosd, sind, tand and their inverses) for procedure pointer assignment. +! Also test same for GNU extensions (dcosd, dsind, dtand and inverses) +! and for the two-argument versions (d)atan2d. + +subroutine pr121366 + implicit none + + interface + function func(x) + real :: func + real, intent (in) :: x + end function func + end interface + + type pp + procedure(func) ,pointer ,nopass :: f =>null() + end type pp + + type(pp) :: func_array(3) + real :: x = 30. + real :: y = 0.5 + intrinsic :: cosd, sind, tand, acosd, asind, atand + + func_array(1)%f => cosd + func_array(2)%f => sind + func_array(3)%f => tand + if (func_array(1)%f(x) /= cosd(x)) stop 1 + if (func_array(2)%f(x) /= sind(x)) stop 2 + if (func_array(3)%f(x) /= tand(x)) stop 3 + + func_array(1)%f => acosd + func_array(2)%f => asind + func_array(3)%f => atand + if (func_array(1)%f(y) /= acosd(y)) stop 4 + if (func_array(2)%f(y) /= asind(y)) stop 5 + if (func_array(3)%f(y) /= atand(y)) stop 6 +end + +subroutine pr121366_2 + implicit none + + interface + function func(x) + real(8) :: func + real(8), intent (in) :: x + end function func + end interface + + type pp + procedure(func) ,pointer ,nopass :: f =>null() + end type pp + + type(pp) :: func_array(3) + real(8) :: x = 30. + real(8) :: y = 0.5 + intrinsic :: dcosd, dsind, dtand, dacosd, dasind, datand + + func_array(1)%f => dcosd + func_array(2)%f => dsind + func_array(3)%f => dtand + + if (func_array(1)%f(x) /= cosd(x)) stop 11 + if (func_array(2)%f(x) /= sind(x)) stop 12 + if (func_array(3)%f(x) /= tand(x)) stop 13 + + func_array(1)%f => dacosd + func_array(2)%f => dasind + func_array(3)%f => datand + + if (func_array(1)%f(y) /= acosd(y)) stop 14 + if (func_array(2)%f(y) /= asind(y)) stop 15 + if (func_array(3)%f(y) /= atand(y)) stop 16 +end + +subroutine pr121366_3 + implicit none + + interface + function func2(x, y) + real :: func + real, intent (in) :: x, y + end function func2 + end interface + + type pp2 + procedure(func2) ,pointer ,nopass :: f =>null() + end type pp2 + + type(pp2) :: func2_array(1) + real :: x = 0.5, y = 1.0 + intrinsic :: atan2d + intrinsic :: atan2 !, atan2pi + + func2_array(1)%f => atan2d + + if (func2_array(1)%f(x,y) /= atan2d(x,y)) stop 21 +end + +subroutine pr121366_4 + implicit none + + interface + function func2(x, y) + real(8) :: func2 + real(8), intent (in) :: x, y + end function func2 + end interface + + type pp2 + procedure(func2) ,pointer ,nopass :: f =>null() + end type pp2 + + type(pp2) :: func2_array(1) + real(8) :: x = 0.5, y = 1.0 + intrinsic :: datan2d + + func2_array(1)%f => datan2d + + if (func2_array(1)%f(x,y) /= atan2d(x,y)) stop 31 +end + +program test + call pr121366 + call pr121366_2 + call pr121366_3 + call pr121366_4 +end diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index da865af51cf..e88c88d9e00 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -1067,7 +1067,8 @@ generated/_mod_r17.F90 \ generated/misc_specifics.F90 \ intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 \ -intrinsics/random_init.f90 +intrinsics/random_init.f90 \ +intrinsics/trigd_specific.F90 # Turn on vectorization and loop unrolling for matmul. $(patsubst %.c,%.lo,$(i_matmul_c)): AM_CFLAGS += -ffast-math -ftree-vectorize -funroll-loops --param max-unroll-times=4 diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 566fbff6125..8564b7de675 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -701,7 +701,7 @@ am__objects_17 = generated/_abs_c4.lo generated/_abs_c8.lo \ generated/_mod_r10.lo generated/_mod_r16.lo \ generated/_mod_r17.lo generated/misc_specifics.lo \ intrinsics/dprod_r8.lo intrinsics/f2c_specifics.lo \ - intrinsics/random_init.lo + intrinsics/random_init.lo intrinsics/trigd_specific.lo am_libgfortran_la_OBJECTS = $(am__objects_5) $(am__objects_9) \ $(am__objects_11) $(am__objects_14) $(am__objects_15) \ $(am__objects_16) $(am__objects_17) @@ -1865,7 +1865,8 @@ generated/_mod_r17.F90 \ generated/misc_specifics.F90 \ intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 \ -intrinsics/random_init.f90 +intrinsics/random_init.f90 \ +intrinsics/trigd_specific.F90 BUILT_SOURCES = $(gfor_built_src) libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ @@ -3845,6 +3846,8 @@ intrinsics/f2c_specifics.lo: intrinsics/$(am__dirstamp) \ intrinsics/$(DEPDIR)/$(am__dirstamp) intrinsics/random_init.lo: intrinsics/$(am__dirstamp) \ intrinsics/$(DEPDIR)/$(am__dirstamp) +intrinsics/trigd_specific.lo: intrinsics/$(am__dirstamp) \ + intrinsics/$(DEPDIR)/$(am__dirstamp) libgfortran.la: $(libgfortran_la_OBJECTS) $(libgfortran_la_DEPENDENCIES) $(EXTRA_libgfortran_la_DEPENDENCIES) $(AM_V_GEN)$(libgfortran_la_LINK) -rpath $(toolexeclibdir) $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) $(LIBS) diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index fc0166580d8..6e04842e953 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -2039,3 +2039,42 @@ GFORTRAN_16 { _gfortran_string_split_char4; _gfortran_cfi_deep_copy_array; } GFORTRAN_15.2; + +GFORTRAN_17 { + global: + _gfortran_specific__acosd_r10; + _gfortran_specific__acosd_r16; + _gfortran_specific__acosd_r17; + _gfortran_specific__acosd_r4; + _gfortran_specific__acosd_r8; + _gfortran_specific__asind_r10; + _gfortran_specific__asind_r16; + _gfortran_specific__asind_r17; + _gfortran_specific__asind_r4; + _gfortran_specific__asind_r8; + _gfortran_specific__atan2d_r10; + _gfortran_specific__atan2d_r16; + _gfortran_specific__atan2d_r17; + _gfortran_specific__atan2d_r4; + _gfortran_specific__atan2d_r8; + _gfortran_specific__atand_r10; + _gfortran_specific__atand_r16; + _gfortran_specific__atand_r17; + _gfortran_specific__atand_r4; + _gfortran_specific__atand_r8; + _gfortran_specific__cosd_r10; + _gfortran_specific__cosd_r16; + _gfortran_specific__cosd_r17; + _gfortran_specific__cosd_r4; + _gfortran_specific__cosd_r8; + _gfortran_specific__sind_r10; + _gfortran_specific__sind_r16; + _gfortran_specific__sind_r17; + _gfortran_specific__sind_r4; + _gfortran_specific__sind_r8; + _gfortran_specific__tand_r10; + _gfortran_specific__tand_r16; + _gfortran_specific__tand_r17; + _gfortran_specific__tand_r4; + _gfortran_specific__tand_r8; +} GFORTRAN_16; diff --git a/libgfortran/intrinsics/trigd_specific.F90 b/libgfortran/intrinsics/trigd_specific.F90 new file mode 100644 index 00000000000..b57d0f64e2d --- /dev/null +++ b/libgfortran/intrinsics/trigd_specific.F90 @@ -0,0 +1,298 @@ +! Fortran wrappers of the degree trigonometric functions COSD, SIND, TAND +! and their inverses ACOSD, ASIND, ATAND. +! Copyright (C) 2026 Free Software Foundation, Inc. +! +!This file is part of the GNU Fortran runtime library (libgfortran). +! +!GNU libgfortran is free software; you can redistribute it and/or +!modify it under the terms of the GNU General Public +!License as published by the Free Software Foundation; either +!version 3 of the License, or (at your option) any later version. + +!GNU libgfortran is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU General Public License for more details. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. + + +#include "config.h" +#include "kinds.inc" + + +#if defined (HAVE_GFC_REAL_4) + +elemental function _gfortran_specific__acosd_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__acosd_r4 + + _gfortran_specific__acosd_r4 = acosd (parm) +end function + +elemental function _gfortran_specific__asind_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__asind_r4 + + _gfortran_specific__asind_r4 = asind (parm) +end function + +elemental function _gfortran_specific__atan2d_r4 (y, x) + real (kind=4), intent (in) :: y, x + real (kind=4) :: _gfortran_specific__atan2d_r4 + + _gfortran_specific__atan2d_r4 = atan2d (y, x) +end function + +elemental function _gfortran_specific__atand_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__atand_r4 + + _gfortran_specific__atand_r4 = atand (parm) +end function + +elemental function _gfortran_specific__cosd_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__cosd_r4 + + _gfortran_specific__cosd_r4 = cosd (parm) +end function + +elemental function _gfortran_specific__sind_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__sind_r4 + + _gfortran_specific__sind_r4 = sind (parm) +end function + +elemental function _gfortran_specific__tand_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__tand_r4 + + _gfortran_specific__tand_r4 = tand (parm) +end function + +#endif + + +#if defined (HAVE_GFC_REAL_8) + +elemental function _gfortran_specific__acosd_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__acosd_r8 + + _gfortran_specific__acosd_r8 = acosd (parm) +end function + +elemental function _gfortran_specific__asind_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__asind_r8 + + _gfortran_specific__asind_r8 = asind (parm) +end function + +elemental function _gfortran_specific__atan2d_r8 (y, x) + real (kind=8), intent (in) :: y, x + real (kind=8) :: _gfortran_specific__atan2d_r8 + + _gfortran_specific__atan2d_r8 = atan2d (y, x) +end function + +elemental function _gfortran_specific__atand_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__atand_r8 + + _gfortran_specific__atand_r8 = atand (parm) +end function + +elemental function _gfortran_specific__cosd_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__cosd_r8 + + _gfortran_specific__cosd_r8 = cosd (parm) +end function + +elemental function _gfortran_specific__sind_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__sind_r8 + + _gfortran_specific__sind_r8 = sind (parm) +end function + +elemental function _gfortran_specific__tand_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__tand_r8 + + _gfortran_specific__tand_r8 = tand (parm) +end function + +#endif + + +#if defined (HAVE_GFC_REAL_10) + +elemental function _gfortran_specific__acosd_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__acosd_r10 + + _gfortran_specific__acosd_r10 = acosd (parm) +end function + +elemental function _gfortran_specific__asind_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__asind_r10 + + _gfortran_specific__asind_r10 = asind (parm) +end function + +elemental function _gfortran_specific__atan2d_r10 (y, x) + real (kind=10), intent (in) :: y, x + real (kind=10) :: _gfortran_specific__atan2d_r10 + + _gfortran_specific__atan2d_r10 = atan2d (y, x) +end function + +elemental function _gfortran_specific__atand_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__atand_r10 + + _gfortran_specific__atand_r10 = atand (parm) +end function + +elemental function _gfortran_specific__cosd_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__cosd_r10 + + _gfortran_specific__cosd_r10 = cosd (parm) +end function + +elemental function _gfortran_specific__sind_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__sind_r10 + + _gfortran_specific__sind_r10 = sind (parm) +end function + +elemental function _gfortran_specific__tand_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__tand_r10 + + _gfortran_specific__tand_r10 = tand (parm) +end function + +#endif + + +#if defined (HAVE_GFC_REAL_16) + +elemental function _gfortran_specific__acosd_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__acosd_r16 + + _gfortran_specific__acosd_r16 = acosd (parm) +end function + +elemental function _gfortran_specific__asind_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__asind_r16 + + _gfortran_specific__asind_r16 = asind (parm) +end function + +elemental function _gfortran_specific__atan2d_r16 (y, x) + real (kind=16), intent (in) :: y, x + real (kind=16) :: _gfortran_specific__atan2d_r16 + + _gfortran_specific__atan2d_r16 = atan2d (y, x) +end function + +elemental function _gfortran_specific__atand_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__atand_r16 + + _gfortran_specific__atand_r16 = atand (parm) +end function + +elemental function _gfortran_specific__cosd_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__cosd_r16 + + _gfortran_specific__cosd_r16 = cosd (parm) +end function + +elemental function _gfortran_specific__sind_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__sind_r16 + + _gfortran_specific__sind_r16 = sind (parm) +end function + +elemental function _gfortran_specific__tand_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__tand_r16 + + _gfortran_specific__tand_r16 = tand (parm) +end function + +#endif + + +#if defined (HAVE_GFC_REAL_17) + +elemental function _gfortran_specific__acosd_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__acosd_r17 + + _gfortran_specific__acosd_r17 = acosd (parm) +end function + +elemental function _gfortran_specific__asind_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__asind_r17 + + _gfortran_specific__asind_r17 = asind (parm) +end function + +elemental function _gfortran_specific__atan2d_r17 (y, x) + real (kind=16), intent (in) :: y, x + real (kind=16) :: _gfortran_specific__atan2d_r17 + + _gfortran_specific__atan2d_r17 = atan2d (y, x) +end function + +elemental function _gfortran_specific__atand_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__atand_r17 + + _gfortran_specific__atand_r17 = atand (parm) +end function + +elemental function _gfortran_specific__cosd_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__cosd_r17 + + _gfortran_specific__cosd_r17 = cosd (parm) +end function + +elemental function _gfortran_specific__sind_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__sind_r17 + + _gfortran_specific__sind_r17 = sind (parm) +end function + +elemental function _gfortran_specific__tand_r17 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__tand_r17 + + _gfortran_specific__tand_r17 = tand (parm) +end function + +#endif