aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog47
-rw-r--r--gcc/fortran/dump-parse-tree.cc7
-rw-r--r--gcc/fortran/intrinsic.cc19
-rw-r--r--gcc/fortran/intrinsic.texi13
-rw-r--r--gcc/fortran/resolve.cc8
-rw-r--r--gcc/fortran/simplify.cc41
-rw-r--r--gcc/fortran/trans-intrinsic.cc51
-rw-r--r--gcc/fortran/trans-openmp.cc20
8 files changed, 152 insertions, 54 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aa6d6cb..15b51e1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,50 @@
+2025-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/120139
+ * dump-parse-tree.cc (get_c_type_name): If no constant
+ size of an array exists, output an asterisk.
+
+2025-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/120107
+ * dump-parse-tree.cc (write_type): Do not dump non-interoperable
+ types.
+
+2025-05-14 Tobias Burnus <tburnus@baylibre.com>
+
+ PR fortran/120225
+ * simplify.cc (gfc_simplify_cotand): Fix used argument in
+ mpfr_tanu call.
+
+2025-05-14 Tobias Burnus <tburnus@baylibre.com>
+
+ PR fortran/120225
+ * simplify.cc: Include "trigd_fe.inc" only with MPFR < 4.2.0.
+ (rad2deg, rad2deg): Only define if MPFR < 4.2.0.
+ (gfc_simplify_acosd, gfc_simplify_asind, gfc_simplify_atand,
+ gfc_simplify_atan2d, gfc_simplify_cosd, gfc_simplify_tand,
+ gfc_simplify_cotand): Use mpfr_...u functions with MPFR >= 4.2.0.
+
+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
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index dd920f3..3cd2eee 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -4371,6 +4371,8 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
mpz_clear (sz);
*asterisk = false;
}
+ else
+ *asterisk = true;
}
return ret;
}
@@ -4415,10 +4417,11 @@ write_type (gfc_symbol *sym)
{
gfc_component *c;
- /* Don't dump our iso c module, nor vtypes. */
+ /* Don't dump types that are not interoperable, our very own ISO C Binding
+ module, or vtypes. */
if (sym->from_intmod == INTMOD_ISO_C_BINDING || sym->attr.flavor != FL_DERIVED
- || sym->attr.vtype)
+ || sym->attr.vtype || !sym->attr.is_bind_c)
return;
fprintf (dumpfile, "typedef struct %s {\n", sym->name);
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/resolve.cc b/gcc/fortran/resolve.cc
index bf1aa70..d09aef0 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -18059,16 +18059,16 @@ skip_interfaces:
|| (a->dummy && !a->pointer && a->intent == INTENT_OUT
&& sym->ns->proc_name->attr.if_source != IFSRC_IFBODY))
apply_default_init (sym);
+ else if (a->function && !a->pointer && !a->allocatable && !a->use_assoc
+ && sym->result)
+ /* Default initialization for function results. */
+ apply_default_init (sym->result);
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
&& (sym->ts.u.derived->attr.alloc_comp
|| sym->ts.u.derived->attr.pointer_comp))
/* Mark the result symbol to be referenced, when it has allocatable
components. */
sym->result->attr.referenced = 1;
- else if (a->function && !a->pointer && !a->allocatable && !a->use_assoc
- && sym->result)
- /* Default initialization for function results. */
- apply_default_init (sym->result);
}
if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 208251b..1927097 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -1183,6 +1183,7 @@ gfc_simplify_asin (gfc_expr *x)
}
+#if MPFR_VERSION < MPFR_VERSION_NUM(4,2,0)
/* Convert radians to degrees, i.e., x * 180 / pi. */
static void
@@ -1196,6 +1197,7 @@ rad2deg (mpfr_t x)
mpfr_div (x, x, tmp, GFC_RND_MODE);
mpfr_clear (tmp);
}
+#endif
/* Simplify ACOSD(X) where the returned value has units of degree. */
@@ -1217,8 +1219,12 @@ gfc_simplify_acosd (gfc_expr *x)
}
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_acosu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_acos (result->value.real, x->value.real, GFC_RND_MODE);
rad2deg (result->value.real);
+#endif
return range_check (result, "ACOSD");
}
@@ -1243,8 +1249,12 @@ gfc_simplify_asind (gfc_expr *x)
}
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_asinu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
rad2deg (result->value.real);
+#endif
return range_check (result, "ASIND");
}
@@ -1261,8 +1271,12 @@ gfc_simplify_atand (gfc_expr *x)
return NULL;
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_atanu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
rad2deg (result->value.real);
+#endif
return range_check (result, "ATAND");
}
@@ -1954,8 +1968,13 @@ gfc_simplify_atan2d (gfc_expr *y, gfc_expr *x)
}
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_atan2u (result->value.real, y->value.real, x->value.real, 360,
+ GFC_RND_MODE);
+#else
mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
rad2deg (result->value.real);
+#endif
return range_check (result, "ATAN2D");
}
@@ -1990,6 +2009,8 @@ gfc_simplify_cos (gfc_expr *x)
}
+#if MPFR_VERSION < MPFR_VERSION_NUM(4,2,0)
+/* Used by trigd_fe.inc. */
static void
deg2rad (mpfr_t x)
{
@@ -2001,11 +2022,13 @@ deg2rad (mpfr_t x)
mpfr_mul (x, x, d2r, GFC_RND_MODE);
mpfr_clear (d2r);
}
+#endif
+#if MPFR_VERSION < MPFR_VERSION_NUM(4,2,0)
/* Simplification routines for SIND, COSD, TAND. */
#include "trigd_fe.inc"
-
+#endif
/* Simplify COSD(X) where X has the unit of degree. */
@@ -2018,8 +2041,12 @@ gfc_simplify_cosd (gfc_expr *x)
return NULL;
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_cosu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
simplify_cosd (result->value.real);
+#endif
return range_check (result, "COSD");
}
@@ -2036,8 +2063,12 @@ gfc_simplify_sind (gfc_expr *x)
return NULL;
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_sinu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
simplify_sind (result->value.real);
+#endif
return range_check (result, "SIND");
}
@@ -2054,8 +2085,12 @@ gfc_simplify_tand (gfc_expr *x)
return NULL;
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_tanu (result->value.real, x->value.real, 360, GFC_RND_MODE);
+#else
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
simplify_tand (result->value.real);
+#endif
return range_check (result, "TAND");
}
@@ -2078,7 +2113,11 @@ gfc_simplify_cotand (gfc_expr *x)
result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
mpfr_add_ui (result->value.real, result->value.real, 90, GFC_RND_MODE);
+#if MPFR_VERSION >= MPFR_VERSION_NUM(4,2,0)
+ mpfr_tanu (result->value.real, result->value.real, 360, GFC_RND_MODE);
+#else
simplify_tand (result->value.real);
+#endif
mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
return range_check (result, "COTAND");
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;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 0b8150f..2a48d4a 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2478,6 +2478,26 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
else
while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+ if (TREE_CODE (tmp) == MEM_REF)
+ tmp = TREE_OPERAND (tmp, 0);
+ if (TREE_CODE (tmp) == SSA_NAME)
+ {
+ gimple *def_stmt = SSA_NAME_DEF_STMT (tmp);
+ if (gimple_code (def_stmt) == GIMPLE_ASSIGN)
+ {
+ tmp = gimple_assign_rhs1 (def_stmt);
+ if (poly)
+ {
+ tmp = TYPE_FIELDS (type);
+ type = TREE_TYPE (tmp);
+ }
+ else
+ while (TREE_CODE (tmp) == COMPONENT_REF
+ || TREE_CODE (tmp) == ARRAY_REF)
+ tmp = TREE_OPERAND (tmp,
+ TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+ }
+ }
/* If the clause argument is nonallocatable, skip is-allocate check. */
if (GFC_DECL_GET_SCALAR_ALLOCATABLE (tmp)
|| GFC_DECL_GET_SCALAR_POINTER (tmp)
generated by cgit v1.1 at 2025-05-16 05:49:40 +0000