aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog29
-rw-r--r--gcc/fortran/intrinsic.cc19
-rw-r--r--gcc/fortran/intrinsic.texi13
-rw-r--r--gcc/fortran/trans-intrinsic.cc51
4 files changed, 65 insertions, 47 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b3f63e0..8b82b20 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,32 @@
+2025-05-13 Yuao Ma <c8ef@outlook.com>
+ Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/113413
+ * intrinsic.cc (do_check): Minor doc polish.
+ (add_functions): Add atand(y, x) mapping.
+ * intrinsic.texi: Update atand example.
+
+2025-05-13 Jakub Jelinek <jakub@redhat.com>
+ Daniil Kochergin <daniil2472s@gmail.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ PR fortran/120191
+ * trans-intrinsic.cc (strip_kind_from_actual): Remove.
+ (gfc_conv_intrinsic_minmaxloc): Don't call strip_kind_from_actual.
+ Free and clear kind_arg->expr if non-NULL. Set back_arg->name to
+ "%VAL" instead of a loop looking for last argument. Remove actual
+ variable, use array_arg instead. Free and clear dim_arg->expr if
+ non-NULL for BT_CHARACTER cases instead of using a loop.
+
+2025-05-11 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/120163
+ * gfortran.h: Add formal_resolved to gfc_symbol.
+ * resolve.cc (gfc_resolve_formal_arglist): Set it.
+ (resolve_function): Do not call gfc_get_formal_from_actual_arglist
+ if we already resolved a formal arglist.
+ (resolve_call): Likewise.
+
2025-05-10 Harald Anlauf <anlauf@gmx.de>
PR fortran/102891
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 2eba209..908e1da 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -376,11 +376,11 @@ do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
Argument list:
char * name of function
- int whether function is elemental
- int If the function can be used as an actual argument [1]
- bt return type of function
- int kind of return type of function
- int Fortran standard version
+ int whether function is elemental
+ int If the function can be used as an actual argument [1]
+ bt return type of function
+ int kind of return type of function
+ int Fortran standard version
check pointer to check function
simplify pointer to simplification function
resolve pointer to resolution function
@@ -396,7 +396,7 @@ do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
[1] Whether a function can or cannot be used as an actual argument is
- determined by its presence on the 13.6 list in Fortran 2003. The
+ determined by its presence in the 13.6 list in Fortran 2003. The
following intrinsics, which are GNU extensions, are considered allowed
as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
@@ -3479,6 +3479,13 @@ add_functions (void)
gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
x, BT_REAL, dr, REQUIRED);
+ /* Two-argument version of atand, equivalent to atan2d. */
+ add_sym_2 ("atand", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
+ BT_REAL, dr, GFC_STD_F2023,
+ gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
+ y, BT_REAL, dr, REQUIRED,
+ x, BT_REAL, dr, REQUIRED);
+
make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_F2023);
add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 3a105bc..48c2d60 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -1547,7 +1547,7 @@ Fortran 90 and later
@node ATAN
-@section @code{ATAN} --- Arctangent function
+@section @code{ATAN} --- Arctangent function
@fnindex ATAN
@fnindex DATAN
@cindex trigonometric function, tangent, inverse
@@ -1619,6 +1619,7 @@ Degrees function: @*
@item @emph{Synopsis}:
@multitable @columnfractions .80
@item @code{RESULT = ATAND(X)}
+@item @code{RESULT = ATAND(Y, X)}
@end multitable
@item @emph{Description}:
@@ -1630,21 +1631,23 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{X} @tab The type shall be @code{REAL};
-if @var{Y} is present, @var{X} shall be REAL.
+@item @var{X} @tab The type shall be @code{REAL}.
@item @var{Y} @tab The type and kind type parameter shall be the same as @var{X}.
@end multitable
@item @emph{Return value}:
The return value is of the same type and kind as @var{X}.
-The result is in degrees and lies in the range
-@math{-90 \leq \Re \atand(x) \leq 90}.
+If @var{Y} is present, the result is identical to @code{ATAN2D(Y, X)}.
+Otherwise, the result is in degrees and lies in the range
+@math{-90 \leq \atand(x) \leq 90}.
@item @emph{Example}:
@smallexample
program test_atand
real(8) :: x = 2.866_8
+ real(4) :: x1 = 1.e0_4, y1 = 0.5e0_4
x = atand(x)
+ x1 = atand(y1, x1)
end program test_atand
@end smallexample
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 440cbdd..fce5ee2 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -4715,22 +4715,6 @@ maybe_absent_optional_variable (gfc_expr *e)
}
-/* Remove unneeded kind= argument from actual argument list when the
- result conversion is dealt with in a different place. */
-
-static void
-strip_kind_from_actual (gfc_actual_arglist * actual)
-{
- for (gfc_actual_arglist *a = actual; a; a = a->next)
- {
- if (a && a->name && strcmp (a->name, "kind") == 0)
- {
- gfc_free_expr (a->expr);
- a->expr = NULL;
- }
- }
-}
-
/* Emit code for minloc or maxloc intrinsic. There are many different cases
we need to handle. For performance reasons we sometimes create two
loops instead of one, where the second one is much simpler.
@@ -4925,7 +4909,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
tree b_if, b_else;
tree back;
gfc_loopinfo loop, *ploop;
- gfc_actual_arglist *actual, *array_arg, *dim_arg, *mask_arg, *kind_arg;
+ gfc_actual_arglist *array_arg, *dim_arg, *mask_arg, *kind_arg;
gfc_actual_arglist *back_arg;
gfc_ss *arrayss = nullptr;
gfc_ss *maskss = nullptr;
@@ -4944,8 +4928,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
int n;
bool optional_mask;
- actual = expr->value.function.actual;
- array_arg = actual;
+ array_arg = expr->value.function.actual;
dim_arg = array_arg->next;
mask_arg = dim_arg->next;
kind_arg = mask_arg->next;
@@ -4954,14 +4937,16 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
bool dim_present = dim_arg->expr != nullptr;
bool nested_loop = dim_present && expr->rank > 0;
- /* The last argument, BACK, is passed by value. Ensure that
- by setting its name to %VAL. */
- for (gfc_actual_arglist *a = actual; a; a = a->next)
+ /* Remove kind. */
+ if (kind_arg->expr)
{
- if (a->next == NULL)
- a->name = "%VAL";
+ gfc_free_expr (kind_arg->expr);
+ kind_arg->expr = NULL;
}
+ /* Pass BACK argument by value. */
+ back_arg->name = "%VAL";
+
if (se->ss)
{
if (se->ss->info->useflags)
@@ -4983,25 +4968,19 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
}
}
- arrayexpr = actual->expr;
+ arrayexpr = array_arg->expr;
- /* Special case for character maxloc. Remove unneeded actual
- arguments, then call a library function. */
+ /* Special case for character maxloc. Remove unneeded "dim" actual
+ argument, then call a library function. */
if (arrayexpr->ts.type == BT_CHARACTER)
{
gcc_assert (expr->rank == 0);
- gfc_actual_arglist *a = actual;
- strip_kind_from_actual (a);
- while (a)
+ if (dim_arg->expr)
{
- if (a->name && strcmp (a->name, "dim") == 0)
- {
- gfc_free_expr (a->expr);
- a->expr = NULL;
- }
- a = a->next;
+ gfc_free_expr (dim_arg->expr);
+ dim_arg->expr = NULL;
}
gfc_conv_intrinsic_funcall (se, expr);
return;
generated by cgit v1.1 at 2025-05-14 06:41:48 +0000