diff options
author | Harald Anlauf <anlauf@gmx.de> | 2024-03-27 21:18:04 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2024-03-28 18:43:47 +0100 |
commit | bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e (patch) | |
tree | 0ea96455d06df5e9598a94b0245d407b53ed8491 /gcc/testsuite/gfortran.dg | |
parent | c1424628dc95829408882f01cbf0dd61566dc312 (diff) | |
download | gcc-bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e.zip gcc-bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e.tar.gz gcc-bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e.tar.bz2 |
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.cc (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.
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
-rw-r--r-- | gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77 |
1 files changed, 77 insertions, 0 deletions
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 0000000..49c288e --- /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 |