diff options
| author | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2018-02-25 12:41:26 +0000 |
|---|---|---|
| committer | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2018-02-25 12:41:26 +0000 |
| commit | 0b0977e7360959d6f3b9d60ddb376ebbcfb71a63 (patch) | |
| tree | 7736367a759834239d9df93cb718fb1e4d2b44fe | |
| parent | 831f6bcc5690e206e55a7244065ff89a0863ca6b (diff) | |
| download | gcc-0b0977e7360959d6f3b9d60ddb376ebbcfb71a63.tar.gz | |
2018-02-25 Paul Thomas <pault@gcc.gnu.org>
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 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84523
* gfortran.dg/pr84523.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257970 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 5 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr84523.f90 | 42 |
4 files changed, 58 insertions, 0 deletions
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 <pault@gcc.gnu.org> + + 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 <tkoenig@gcc.gnu.org> 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 <pault@gcc.gnu.org> + + PR fortran/84523 + * gfortran.dg/pr84523.f90: New test. + 2018-02-25 Thomas Koenig <tkoenig@gcc.gnu.org> 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 <anlauf@gmx.de> +! +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 |