From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id 8A1843858D20; Sun, 7 Apr 2024 18:13:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8A1843858D20 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1712513625; bh=dh1fRe+nQnyUVkbiYB+posSXTzAvspDDMv0GtKJoRqc=; h=From:To:Subject:Date:From; b=T2UmG9B3XfWz4Cy00RKs0Q2O+eX9MfwoHUinXfk80hyWuNaYNicQP/bFXM7AtLIz5 CBn0tGAlW+Kg97P0Ur07EjugiIY+ag/LJBrutbt+tSBOyqxADWjN7OJYypRezAPgBe hrGdzEBrVHRgNrGhwl9Uz9DVFBxszO3+nL0fulxM= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-11311] Fortran: fix DATA and derived types with pointer components [PR114474] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-11 X-Git-Oldrev: b755a7af1f2ef1f5348d04db20f751e898abcd9d X-Git-Newrev: 619fc13043c86d616ef57cb31f8ac5d29b059ade Message-Id: <20240407181345.8A1843858D20@sourceware.org> Date: Sun, 7 Apr 2024 18:13:45 +0000 (GMT) List-Id: https://gcc.gnu.org/g:619fc13043c86d616ef57cb31f8ac5d29b059ade commit r11-11311-g619fc13043c86d616ef57cb31f8ac5d29b059ade Author: Harald Anlauf Date: Wed Mar 27 21:18:04 2024 +0100 Fortran: fix DATA and derived types with pointer components [PR114474] When matching actual arguments in match_actual_arg, these are initially treated as a possible dummy procedure, assuming that the correct type is determined later. This resolution could fail when the procedure is a derived type constructor with a pointer component and appears in a DATA statement, where the pointer shall be associated with an initial data target. Check for those cases where the type obviously has not been resolved yet, and which were missed because there was no component reference. gcc/fortran/ChangeLog: PR fortran/114474 * primary.c (gfc_variable_attr): Catch variables used in structure constructors within DATA statements that are still tagged with a temporary type BT_PROCEDURE from match_actual_arg and which have the target attribute, and fix their typespec. gcc/testsuite/ChangeLog: PR fortran/114474 * gfortran.dg/data_pointer_3.f90: New test. (cherry picked from commit bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e) Diff: --- gcc/fortran/primary.c | 12 +++++ gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77 ++++++++++++++++++++++++++++ 2 files changed, 89 insertions(+) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 5cad2d2682b..79a2201c812 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2663,6 +2663,18 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (ts != NULL && expr->ts.type == BT_UNKNOWN) *ts = sym->ts; + /* Catch left-overs from match_actual_arg, where an actual argument of a + procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is + needed for structure constructors in DATA statements, where a pointer + is associated with a data target, and the argument has not been fully + resolved yet. Components references are dealt with further below. */ + if (ts != NULL + && expr->ts.type == BT_PROCEDURE + && expr->ref == NULL + && attr.flavor != FL_PROCEDURE + && attr.target) + *ts = sym->ts; + has_inquiry_part = false; for (ref = expr->ref; ref; ref = ref->next) if (ref->type == REF_INQUIRY) diff --git a/gcc/testsuite/gfortran.dg/data_pointer_3.f90 b/gcc/testsuite/gfortran.dg/data_pointer_3.f90 new file mode 100644 index 00000000000..49c288e93b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_pointer_3.f90 @@ -0,0 +1,77 @@ +! { dg-do compile } +! PR fortran/114474 - DATA and derived types with pointer components + +program pr114474 + implicit none + integer, target :: ii = 42 ! initial data target + + integer, target :: jj = 24 + integer, pointer :: qq => jj + ! ii and jj resolve slightly differently when the data statement below + ! is reached, as jj is resolved outside the structure constructor first + + type t + integer, pointer :: h + end type t + + integer, target :: kk(7) = 23 + integer, pointer :: ll(:) => kk + + type t1 + integer :: m(7) + end type t1 + + type(t) :: x1, x2, x3, x4, x5 + type(t), parameter :: z1 = t(null()) + + type(t1), target :: tt = t1([1,2,3,4,5,6,7]) + type(t1), parameter :: vv = t1(22) + type(t1) :: w1, w2 + integer, pointer :: p1(:) => tt% m + + data x1 / t(null()) / + data x2 / t(ii) / ! ii is initial data target + data x3 / t(jj) / ! jj is resolved differently... + data x4 / t(tt%m(3)) / ! pointer association with 3rd element + + data w1 / t1(12) / + data w2 / t1(vv%m) / + + if ( associated (x1% h)) stop 1 + if (.not. associated (x2% h)) stop 2 + if (.not. associated (x3% h)) stop 3 + if (.not. associated (x4% h)) stop 4 + if (x2% h /= 42) stop 5 + if (x3% h /= 24) stop 6 + if (x4% h /= 3) stop 7 + + if (any (w1%m /= 12 )) stop 8 + if (any (w2%m /= vv%m)) stop 9 +end + + +subroutine sub + implicit none + + interface + real function myfun (x) + real, intent(in) :: x + end function myfun + end interface + + type u + procedure(myfun), pointer, nopass :: p + end type u + + type(u) :: u3 = u(null()) + type(u), parameter :: u4 = u(null()) + type(u) :: u1, u2 + + data u1 / u(null()) / + data u2 / u(myfun) / +end + +real function myfun (x) + real, intent(in) :: x + myfun = x +end function myfun