diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 78e3c2e164d..2c2aa2b8d90 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-02-25 Paul Thomas + + PR fortran/84523 + * trans-intrinsic.c (gfc_conv_allocated): If the argument se + has a pre block, add it to the expression pre block. + 2018-02-25 Thomas Koenig PR fortran/78238 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c4a3775d858..816f3b99ac1 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7606,6 +7606,11 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); } + + /* Components of pointer array references sometimes come back with a pre block. */ + if (arg1se.pre.head) + gfc_add_block_to_block (&se->pre, &arg1se.pre); + se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0f8219d0717..0a015c8ca59 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-02-25 Paul Thomas + + PR fortran/84523 + * gfortran.dg/pr84523.f90: New test. + 2018-02-25 Thomas Koenig PR fortran/78238 diff --git a/gcc/testsuite/gfortran.dg/pr84523.f90 b/gcc/testsuite/gfortran.dg/pr84523.f90 new file mode 100644 index 00000000000..69b9c27e503 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr84523.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! +! Test the fix for PR84523. +! +! Contributed by Harald Anlauf +! +program gfcbug148 + implicit none + integer, parameter :: nspots = 80 + type t_spot + real, allocatable :: vm(:,:,:) + end type t_spot + type t_rowcol + integer :: nh + type(t_spot), pointer :: spots(:) => NULL () + end type t_rowcol + type(t_rowcol) :: col + call construct (col, nspots) + call destruct (col) + !======================================================================== +contains + !======================================================================== + subroutine construct (rc, nh) + type(t_rowcol) ,intent(out) :: rc ! row or column to set + integer ,intent(in) :: nh ! number of spots in a row + rc%nh = nh + allocate (rc%spots(nh)) + end subroutine construct + !------------------------------------------------------------------------ + subroutine destruct (rc) + type(t_rowcol) ,intent(inout) :: rc ! row or column to free + integer :: k + if (associated (rc%spots)) then + if (size(rc%spots) .ne. nspots) stop 1 + do k=1, size(rc% spots) + if (allocated (rc%spots(k)%vm)) stop 2 ! Would segfault in runtime. + end do + deallocate (rc%spots) + endif + nullify (rc%spots) + end subroutine destruct +end program gfcbug148