diff options
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/fortran/f95-lang.cc | 1 | ||||
-rw-r--r-- | gcc/fortran/resolve.cc | 11 | ||||
-rw-r--r-- | gcc/fortran/trans-const.cc | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.cc | 28 |
5 files changed, 49 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b84ce2f..c5eb7f2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2025-10-17 Josef Melcr <jmelcr02@gmail.com> + + * f95-lang.cc (ATTR_CALLBACK_GOMP_LIST): New attr list + corresponding to the list in builtin-attrs.def. + 2025-10-13 Paul Thomas <pault@gcc.gnu.org> PR fortran/121191 diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index bb4ce6d..06ffc67 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -580,6 +580,7 @@ gfc_builtin_function (tree decl) #define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \ (ECF_COLD | ECF_NORETURN | \ ECF_NOTHROW | ECF_LEAF) +#define ATTR_CALLBACK_GOMP_LIST (ECF_CB_1_2 | ATTR_NOTHROW_LIST) #define ATTR_PURE_NOTHROW_LIST (ECF_PURE | ECF_NOTHROW) static void diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index f419f5c..1c49ccf 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5060,14 +5060,17 @@ resolve_conditional (gfc_expr *expr) /* TODO: support more data types for conditional expressions */ if (true_expr->ts.type != BT_INTEGER && true_expr->ts.type != BT_LOGICAL - && true_expr->ts.type != BT_REAL && true_expr->ts.type != BT_COMPLEX) + && true_expr->ts.type != BT_REAL && true_expr->ts.type != BT_COMPLEX + && true_expr->ts.type != BT_CHARACTER) { - gfc_error ("Sorry, only integer, logical, real and complex types " - "are currently supported for conditional expressions at %L", - &expr->where); + gfc_error ( + "Sorry, only integer, logical, real, complex and character types are " + "currently supported for conditional expressions at %L", + &expr->where); return false; } + /* TODO: support arrays in conditional expressions */ if (true_expr->rank > 0) { gfc_error ("Sorry, array is currently unsupported for conditional " diff --git a/gcc/fortran/trans-const.cc b/gcc/fortran/trans-const.cc index ea1501a..f70f362 100644 --- a/gcc/fortran/trans-const.cc +++ b/gcc/fortran/trans-const.cc @@ -438,4 +438,12 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) structure, too. */ if (expr->ts.type == BT_CHARACTER) se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr))); + + if (se->want_pointer) + { + if (expr->ts.type == BT_CHARACTER) + gfc_conv_string_parameter (se); + else + se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); + } } diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 271d263..21f256b 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -4418,6 +4418,11 @@ gfc_conv_conditional_expr (gfc_se *se, gfc_expr *expr) se->expr = fold_build3_loc (input_location, COND_EXPR, type, condition, true_val, false_val); + if (expr->ts.type == BT_CHARACTER) + se->string_length + = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node, + condition, true_se.string_length, + false_se.string_length); } /* If a string's length is one, we convert it to a single character. */ @@ -11546,6 +11551,29 @@ gfc_conv_string_parameter (gfc_se * se) return; } + if (TREE_CODE (se->expr) == COND_EXPR) + { + tree cond = TREE_OPERAND (se->expr, 0); + tree lhs = TREE_OPERAND (se->expr, 1); + tree rhs = TREE_OPERAND (se->expr, 2); + + gfc_se lse, rse; + gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + + lse.expr = lhs; + lse.string_length = se->string_length; + gfc_conv_string_parameter (&lse); + + rse.expr = rhs; + rse.string_length = se->string_length; + gfc_conv_string_parameter (&rse); + + se->expr + = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (lse.expr), + cond, lse.expr, rse.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))) |