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/check.cc4
-rw-r--r--gcc/fortran/data.cc8
-rw-r--r--gcc/fortran/expr.cc84
-rw-r--r--gcc/fortran/interface.cc9
-rw-r--r--gcc/fortran/parse.cc3
-rw-r--r--gcc/fortran/primary.cc3
-rw-r--r--gcc/fortran/trans-expr.cc16
8 files changed, 162 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0c4edf8..78f6002 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,48 @@
+2025-06-04 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/120483
+ * trans-expr.cc (gfc_conv_substring): Use pointer arithmetic on
+ static allocatable char arrays.
+
+2025-06-03 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/99838
+ * data.cc (gfc_assign_data_value): For a new initializer use the
+ location from the constructor as fallback.
+
+2025-05-30 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/102599
+ PR fortran/114022
+ * expr.cc (simplify_complex_array_inquiry_ref): Helper function for
+ simplification of inquiry references (%re/%im) of constant complex
+ arrays.
+ (find_inquiry_ref): Use it for handling %re/%im inquiry references
+ of complex arrays.
+ (scalarize_intrinsic_call): Fix frontend memleak.
+ * primary.cc (gfc_match_varspec): When the reference is NULL, the
+ previous simplification has succeeded in evaluating inquiry
+ references also of arrays.
+
+2025-05-30 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/120355
+ * interface.cc (compare_parameter): If the global function has a
+ result clause, take typespec from there for the comparison against
+ the dummy argument.
+
+2025-05-30 Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * parse.cc (tree.h, fold-const.h, tree-hash-traits.h): Add includes
+ (for additions to omp-general.h).
+
+2025-05-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/120049
+ * check.cc(check_c_ptr_2): Rephrase error message
+ for clarity.
+
2025-05-28 Tobias Burnus <tburnus@baylibre.com>
PR fortran/113152
@@ -6,7 +51,7 @@
2025-05-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
- PR fortran/119586
+ PR fortran/119856
* io.cc: Set missing comma error checks to STD_STD_LEGACY.
2025-05-28 Yuao Ma <c8ef@outlook.com>
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index c693e42..c8904df 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6037,8 +6037,8 @@ bool check_c_ptr_2 (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2)
check_2_error:
gfc_error ("Argument C_PTR_2 at %L to C_ASSOCIATED shall have the "
- "same type as C_PTR_1: %s instead of %s", &c_ptr_2->where,
- gfc_typename (&c_ptr_1->ts), gfc_typename (&c_ptr_2->ts));
+ "same type as C_PTR_1, found %s instead of %s", &c_ptr_2->where,
+ gfc_typename (&c_ptr_2->ts), gfc_typename (&c_ptr_1->ts));
return false;
}
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index 5c83f69..a438c26 100644
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -593,7 +593,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
{
/* Point the container at the new expression. */
if (last_con == NULL)
- symbol->value = expr;
+ {
+ symbol->value = expr;
+ /* For a new initializer use the location from the
+ constructor as fallback. */
+ if (!GFC_LOCUS_IS_SET(expr->where) && con != NULL)
+ symbol->value->where = con->where;
+ }
else
last_con->expr = expr;
}
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index bf858ea..b0495b7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1838,6 +1838,55 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
}
+/* Simplify inquiry references (%re/%im) of constant complex arrays.
+ Used by find_inquiry_ref. */
+
+static gfc_expr *
+simplify_complex_array_inquiry_ref (gfc_expr *p, inquiry_type inquiry)
+{
+ gfc_expr *e, *r, *result;
+ gfc_constructor_base base;
+ gfc_constructor *c;
+
+ if ((inquiry != INQUIRY_RE && inquiry != INQUIRY_IM)
+ || p->expr_type != EXPR_ARRAY
+ || p->ts.type != BT_COMPLEX
+ || p->rank <= 0
+ || p->value.constructor == NULL
+ || !gfc_is_constant_array_expr (p))
+ return NULL;
+
+ /* Simplify array sections. */
+ gfc_simplify_expr (p, 0);
+
+ result = gfc_get_array_expr (BT_REAL, p->ts.kind, &p->where);
+ result->rank = p->rank;
+ result->shape = gfc_copy_shape (p->shape, p->rank);
+
+ base = p->value.constructor;
+ for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+ {
+ e = c->expr;
+ if (e->expr_type != EXPR_CONSTANT)
+ goto fail;
+
+ r = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+ if (inquiry == INQUIRY_RE)
+ mpfr_set (r->value.real, mpc_realref (e->value.complex), GFC_RND_MODE);
+ else
+ mpfr_set (r->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE);
+
+ gfc_constructor_append_expr (&result->value.constructor, r, &e->where);
+ }
+
+ return result;
+
+fail:
+ gfc_free_expr (result);
+ return NULL;
+}
+
+
/* Pull an inquiry result out of an expression. */
static bool
@@ -1848,6 +1897,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
gfc_ref *inquiry_head;
gfc_ref *ref_ss = NULL;
gfc_expr *tmp;
+ bool nofail = false;
tmp = gfc_copy_expr (p);
@@ -1947,24 +1997,50 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
break;
case INQUIRY_RE:
- if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
+ if (tmp->ts.type != BT_COMPLEX)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C"))
goto cleanup;
+ if (tmp->expr_type == EXPR_ARRAY)
+ {
+ *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_RE);
+ if (*newp != NULL)
+ {
+ nofail = true;
+ break;
+ }
+ }
+
+ if (tmp->expr_type != EXPR_CONSTANT)
+ goto cleanup;
+
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_realref (tmp->value.complex), GFC_RND_MODE);
break;
case INQUIRY_IM:
- if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
+ if (tmp->ts.type != BT_COMPLEX)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C"))
goto cleanup;
+ if (tmp->expr_type == EXPR_ARRAY)
+ {
+ *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_IM);
+ if (*newp != NULL)
+ {
+ nofail = true;
+ break;
+ }
+ }
+
+ if (tmp->expr_type != EXPR_CONSTANT)
+ goto cleanup;
+
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_imagref (tmp->value.complex), GFC_RND_MODE);
@@ -1977,7 +2053,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
if (!(*newp))
goto cleanup;
- else if ((*newp)->expr_type != EXPR_CONSTANT)
+ else if ((*newp)->expr_type != EXPR_CONSTANT && !nofail)
{
gfc_free_expr (*newp);
goto cleanup;
@@ -2549,7 +2625,7 @@ scalarize_intrinsic_call (gfc_expr *e, bool init_flag)
rank[n] = a->expr->rank;
else
rank[n] = 1;
- ctor = gfc_constructor_copy (a->expr->value.constructor);
+ ctor = a->expr->value.constructor;
args[n] = gfc_constructor_first (ctor);
}
else
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 753f589..b854292 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2547,7 +2547,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
else if (formal->attr.function)
{
- if (!gfc_compare_types (&global_asym->ts,
+ gfc_typespec ts;
+
+ if (global_asym->result)
+ ts = global_asym->result->ts;
+ else
+ ts = global_asym->ts;
+
+ if (!gfc_compare_types (&ts,
&formal->ts))
{
gfc_error ("Type mismatch at %L passing global "
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 538eb65..8d4ca39 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -27,6 +27,9 @@ along with GCC; see the file COPYING3. If not see
#include "match.h"
#include "parse.h"
#include "tree-core.h"
+#include "tree.h"
+#include "fold-const.h"
+#include "tree-hash-traits.h"
#include "omp-general.h"
/* Current statement label. Zero means no statement label. Because new_st
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index db5fc5d..f0e1fef 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2716,6 +2716,9 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if (primary->expr_type == EXPR_CONSTANT)
goto check_done;
+ if (primary->ref == NULL)
+ goto check_done;
+
switch (tmp->u.i)
{
case INQUIRY_RE:
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8d9448e..74d4265 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2782,9 +2782,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
start.expr = gfc_evaluate_now (start.expr, &se->pre);
/* Change the start of the string. */
- if ((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
- || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+ if (((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
+ || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
+ && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+ || (POINTER_TYPE_P (TREE_TYPE (se->expr))
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (se->expr))) != ARRAY_TYPE))
tmp = se->expr;
else
tmp = build_fold_indirect_ref_loc (input_location,
@@ -2795,6 +2797,14 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
se->expr = gfc_build_addr_expr (type, tmp);
}
+ else if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+ {
+ tree diff;
+ diff = fold_build2 (MINUS_EXPR, size_type_node, start.expr,
+ build_one_cst (size_type_node));
+ se->expr
+ = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (tmp), tmp, diff);
+ }
}
/* Length = end + 1 - start. */
generated by cgit v1.1 at 2025-06-05 12:19:05 +0000