https://gcc.gnu.org/g:8387f1160d28c21592d29f70282eb38104b27356
commit r16-5933-g8387f1160d28c21592d29f70282eb38104b27356 Author: Paul Thomas <[email protected]> Date: Sat Dec 6 07:51:21 2025 +0000 Fortran: [PDT] Unresolved component and generic binding [PR122578] 2025-12-06 Paul Thomas <[email protected]> gcc/fortran PR fortran/122578 * primary.cc (gfc_match_varspec): Try to resolve a typebound generic procedure selector expression to provide the associate name with a type. Also, resolve component calls. In both cases, make a copy of the selector expression to guard against changes made by gfc_resolve_expr. gcc/testsuite PR fortran/122578 * gfortran.dg/pdt_72.f03: New test. Diff: --- gcc/fortran/primary.cc | 40 +++++++++++++ gcc/testsuite/gfortran.dg/pdt_72.f03 | 110 +++++++++++++++++++++++++++++++++++ 2 files changed, 150 insertions(+) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 729e3b523fa4..e5e84e897ffa 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2261,6 +2261,32 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && !sym->attr.select_rank_temporary) inferred_type = true; + /* Try to resolve a typebound generic procedure so that the associate name + has a chance to get a type before being used in a second, nested associate + statement. Note that a copy is used for resolution so that failure does + not result in a mutilated selector expression further down the line. */ + if (tgt_expr && !sym->assoc->dangling + && tgt_expr->ts.type == BT_UNKNOWN + && tgt_expr->symtree + && tgt_expr->symtree->n.sym + && gfc_expr_attr (tgt_expr).generic + && ((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_template) + || (sym->ts.type == BT_CLASS + && CLASS_DATA (sym)->ts.u.derived->attr.pdt_template))) + { + gfc_expr *cpy = gfc_copy_expr (tgt_expr); + if (gfc_resolve_expr (cpy) + && cpy->ts.type != BT_UNKNOWN) + { + gfc_replace_expr (tgt_expr, cpy); + sym->ts = tgt_expr->ts; + } + else + gfc_free_expr (cpy); + if (gfc_expr_attr (tgt_expr).generic) + inferred_type = true; + } + /* For associate names, we may not yet know whether they are arrays or not. If the selector expression is unambiguously an array; eg. a full array or an array section, then the associate name must be an array and we can @@ -2493,6 +2519,20 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && !gfc_find_derived_types (sym, gfc_current_ns, name)) primary->ts.type = BT_UNKNOWN; + /* Otherwise try resolving a copy of a component call. If it succeeds, + use that for the selector expression. */ + else if (tgt_expr && tgt_expr->expr_type == EXPR_COMPCALL) + { + gfc_expr *cpy = gfc_copy_expr (tgt_expr); + if (gfc_resolve_expr (cpy)) + { + gfc_replace_expr (tgt_expr, cpy); + sym->ts = tgt_expr->ts; + } + else + gfc_free_expr (cpy); + } + /* An inquiry reference might determine the type, otherwise we have an error. */ if (sym->ts.type == BT_UNKNOWN && !inquiry) diff --git a/gcc/testsuite/gfortran.dg/pdt_72.f03 b/gcc/testsuite/gfortran.dg/pdt_72.f03 new file mode 100644 index 000000000000..57640bd02001 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_72.f03 @@ -0,0 +1,110 @@ +! { dg-do compile } +! +! Tests the fix for pr122578, which failed in compilation with the errors +! shown below. +! +! Contributed by Damian Rouson <[email protected]> +! +module tensor_map_m + use iso_c_binding, only : c_int + implicit none + + type tensor_t(k) + integer, kind :: k = kind(1.) + real(k), allocatable :: values_(:) ! Error: Cannot convert REAL(0) to REAL(4) at (1) + contains + generic :: values => default_real_values + procedure default_real_values + end type + + interface + pure module function default_real_values(self) result(tensor_values) + implicit none + class(tensor_t), intent(in) :: self + real, allocatable :: tensor_values(:) + end function + end interface + + type tensor_map_t(k) + integer, kind :: k = kind(1.) + real(k), dimension(:), allocatable :: intercept_, slope_ + contains + generic :: map_to_training_range => default_real_map_to_training_range + procedure :: default_real_map_to_training_range + generic :: map_from_training_range => default_real_map_from_training_range + procedure :: default_real_map_from_training_range + end type + + interface + elemental module function default_real_map_to_training_range(self, tensor) result(normalized_tensor) + implicit none + class(tensor_map_t), intent(in) :: self + type(tensor_t), intent(in) :: tensor + type(tensor_t) normalized_tensor + end function + + elemental module function default_real_map_from_training_range(self, tensor) result(unnormalized_tensor) + implicit none + class(tensor_map_t), intent(in) :: self + type(tensor_t), intent(in) :: tensor + type(tensor_t) unnormalized_tensor + end function + end interface + + type activation_t + integer(c_int) :: selection_ + contains + generic :: evaluate => default_real_evaluate + procedure default_real_evaluate + end type + + interface + elemental module function default_real_evaluate(self, x) result(y) + implicit none + class(activation_t), intent(in) :: self + real, intent(in) :: x + real y + end function + end interface + + type neural_network_t(k) + integer, kind :: k = kind(1.) + type(tensor_map_t(k)) input_map_, output_map_ + real(k), allocatable :: weights_(:,:,:), biases_(:,:) + integer, allocatable :: nodes_(:) + type(activation_t) :: activation_ + contains + generic :: infer => default_real_infer + procedure default_real_infer + end type + + integer, parameter :: input_layer = 0 +contains + elemental function default_real_infer(self, inputs) result(outputs) + class(neural_network_t), intent(in) :: self + type(tensor_t), intent(in) :: inputs + type(tensor_t) outputs + real, allocatable :: a(:,:) + integer l + associate(w => self%weights_, b => self%biases_, n => self%nodes_, output_layer => ubound(self%nodes_,1)) + allocate(a(maxval(n), input_layer:output_layer)) + associate(normalized_inputs => self%input_map_%map_to_training_range(inputs)) + a(1:n(input_layer),input_layer) = normalized_inputs%values() ! Error: Symbol ‘normalized_inputs’ + ! at (1) has no IMPLICIT type + + end associate + feed_forward: & + do l = input_layer+1, output_layer + associate(z => matmul(w(1:n(l),1:n(l-1),l), a(1:n(l-1),l-1)) + b(1:n(l),l)) + a(1:n(l),l) = self%activation_%evaluate(z) + end associate + end do feed_forward + associate(normalized_outputs => tensor_t(a(1:n(output_layer), output_layer))) + outputs = self%output_map_%map_from_training_range(normalized_outputs) ! Error: Found no matching specific + ! binding for the call to the GENERIC + ! ‘map_from_training_range’ at (1) + + end associate + end associate + end function +end module
