diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.texi | 2 | ||||
| -rw-r--r-- | gcc/fortran/primary.cc | 35 | ||||
| -rw-r--r-- | gcc/fortran/resolve.cc | 33 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 8 |
5 files changed, 82 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e7c7907..5501bca 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2025-11-01 Harald Anlauf <anlauf@gmx.de> + + PR fortran/78640 + * resolve.cc (resolve_fl_procedure): Check function result of a + pure function against F2018:C1585. + +2025-10-31 Yuao Ma <c8ef@outlook.com> + + * intrinsic.texi: Fix typo. + * trans-intrinsic.cc (conv_intrinsic_atomic_cas): Remove unreachable + code. + +2025-10-31 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/122452 + * primary.cc (gfc_match_rvalue): Give priority to specific + procedures in a generic interface with the same name as a + PDT template. If found, use as the procedure instead of the + constructor generated from the PDT template. + 2025-10-30 Mikael Morin <mikael@gcc.gnu.org> * trans-array.cc: Cleanup obsolete comment. diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 9012c2a..b2d1e45 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -2239,7 +2239,7 @@ is different, the value is converted to the kind of @var{ATOM}. program atomic use iso_fortran_env logical(atomic_logical_kind) :: atom[*], prev - call atomic_cas (atom[1], prev, .false., .true.)) + call atomic_cas (atom[1], prev, .false., .true.) end program atomic @end smallexample diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 0722c76d..1dcb1c3 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3835,6 +3835,9 @@ gfc_match_rvalue (gfc_expr **result) gfc_typespec *ts; bool implicit_char; gfc_ref *ref; + gfc_symtree *pdt_st; + gfc_symbol *found_specific = NULL; + m = gfc_match ("%%loc"); if (m == MATCH_YES) @@ -4082,22 +4085,36 @@ gfc_match_rvalue (gfc_expr **result) break; } + gfc_gobble_whitespace (); + found_specific = NULL; + + /* Even if 'name' is that of a PDT template, priority has to be given to + possible specific procedures in the generic interface. */ + gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); + if (sym->generic && sym->generic->next + && gfc_peek_ascii_char() != '(') + { + gfc_actual_arglist *arg = actual_arglist; + for (; arg && pdt_st; arg = arg->next) + gfc_resolve_expr (arg->expr); + found_specific = gfc_search_interface (sym->generic, 0, + &actual_arglist); + } + /* Check to see if this is a PDT constructor. The format of these constructors is rather unusual: name [(type_params)](component_values) where, component_values excludes the type_params. With the present gfortran representation this is rather awkward because the two are not distinguished, other than by their attributes. */ - if (sym->attr.generic) + if (sym->attr.generic && pdt_st != NULL && found_specific == NULL) { - gfc_symtree *pdt_st; gfc_symbol *pdt_sym; gfc_actual_arglist *ctr_arglist = NULL, *tmp; gfc_component *c; - /* Obtain the template. */ - gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); - if (pdt_st && pdt_st->n.sym && pdt_st->n.sym->attr.pdt_template) + /* Use the template. */ + if (pdt_st->n.sym && pdt_st->n.sym->attr.pdt_template) { bool type_spec_list = false; pdt_sym = pdt_st->n.sym; @@ -4155,8 +4172,12 @@ gfc_match_rvalue (gfc_expr **result) tmp = tmp->next; } - gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), - NULL, 1, &symtree); + if (found_specific) + gfc_find_sym_tree (found_specific->name, + NULL, 1, &symtree); + else + gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), + NULL, 1, &symtree); if (!symtree) { gfc_get_ha_sym_tree (gfc_dt_lower_string (pdt_sym->name) , diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ecd2ada..03e26f0 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15385,6 +15385,39 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) return false; } + /* F2018:C1585: "The function result of a pure function shall not be both + polymorphic and allocatable, or have a polymorphic allocatable ultimate + component." */ + if (sym->attr.pure && sym->result && sym->ts.u.derived) + { + if (sym->ts.type == BT_CLASS + && sym->attr.class_ok + && CLASS_DATA (sym->result) + && CLASS_DATA (sym->result)->attr.allocatable) + { + gfc_error ("Result variable %qs of pure function at %L is " + "polymorphic allocatable", + sym->result->name, &sym->result->declared_at); + return false; + } + + if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components) + { + gfc_component *c = sym->ts.u.derived->components; + for (; c; c = c->next) + if (c->ts.type == BT_CLASS + && CLASS_DATA (c) + && CLASS_DATA (c)->attr.allocatable) + { + gfc_error ("Result variable %qs of pure function at %L has " + "polymorphic allocatable component %qs", + sym->result->name, &sym->result->declared_at, + c->name); + return false; + } + } + } + if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1) { gfc_formal_arglist *curr_arg; diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 89a03d8..5b9111d3 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -12844,14 +12844,6 @@ conv_intrinsic_atomic_cas (gfc_code *code) new_val = gfc_build_addr_expr (NULL_TREE, tmp); } - /* Convert a constant to a pointer. */ - if (!POINTER_TYPE_P (TREE_TYPE (comp))) - { - tmp = gfc_create_var (TREE_TYPE (TREE_TYPE (old)), "comp"); - gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), comp)); - comp = gfc_build_addr_expr (NULL_TREE, tmp); - } - gfc_init_se (&argse, NULL); gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom, atom_expr); |