From 3b949026d4ceb442a3cd43a429b36c800970a2d6 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 11 Sep 2018 15:59:07 +0000 Subject: [PATCH] re PR fortran/87277 (Segfault on using array component of class scalar pointer as an actual argument) 2018-09-11 Paul Thomas PR fortran/87277 * expr.c (is_subref_array): Add the check of dimensionality for class, dummy, pointer arrays. 2018-09-11 Paul Thomas PR fortran/87277 * gfortran.dg/select_type_43.f90: New test. From-SVN: r264210 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/expr.c | 1 + gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/select_type_43.f90 | 48 ++++++++++++++++++++ 4 files changed, 60 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/select_type_43.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 64acb7a2735..c02276f7537 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-09-11 Paul Thomas + + PR fortran/87277 + * expr.c (is_subref_array): Add the check of dimensionality for + class, dummy, pointer arrays. + 2018-09-11 Janus Weil PR fortran/86830 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 97792fe32a7..3315bb840af 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1069,6 +1069,7 @@ is_subref_array (gfc_expr * e) if (e->symtree->n.sym->ts.type == BT_CLASS && e->symtree->n.sym->attr.dummy + && CLASS_DATA (e->symtree->n.sym)->attr.dimension && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer) return true; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 30b1156392e..3e35910699b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-11 Paul Thomas + + PR fortran/87277 + * gfortran.dg/select_type_43.f90: New test. + 2018-09-11 Nathan Sidwell * gcc.dg/driver-specs.c: New. diff --git a/gcc/testsuite/gfortran.dg/select_type_43.f90 b/gcc/testsuite/gfortran.dg/select_type_43.f90 new file mode 100644 index 00000000000..3bb71c39918 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_43.f90 @@ -0,0 +1,48 @@ +! { dg-do run } +! +! Tests the fix for PR87277 - runtime segfault as indicated. +! +! Contributed by Andrew Baldwin on clf. +! + MODULE INTS_TYPE_MODULE + TYPE INTS_TYPE + INTEGER, ALLOCATABLE :: INTS(:) + END TYPE INTS_TYPE + CONTAINS + SUBROUTINE ALLOCATE_INTS_TYPE (IT_OBJ) + CLASS (INTS_TYPE), POINTER, INTENT (OUT) :: IT_OBJ + + ALLOCATE (INTS_TYPE :: IT_OBJ) + + SELECT TYPE (IT_OBJ) + TYPE IS (INTS_TYPE) + CALL ALLOCATE_ARRAY (IT_OBJ%INTS) ! Sefaulted at runtime here. + if (.not.allocated (IT_OBJ%INTS)) stop 1 + if (any (IT_OBJ%INTS .ne. [1,2,3,4])) stop 2 + END SELECT + + RETURN + END SUBROUTINE ALLOCATE_INTS_TYPE + + SUBROUTINE ALLOCATE_ARRAY (ALLOC_ARR) + INTEGER, ALLOCATABLE, INTENT (OUT) :: ALLOC_ARR(:) + INTEGER :: I + + ALLOCATE (ALLOC_ARR(4)) + + DO I = 1, SIZE(ALLOC_ARR) + ALLOC_ARR(I) = I + END DO + + RETURN + END SUBROUTINE ALLOCATE_ARRAY + END MODULE INTS_TYPE_MODULE + + PROGRAM MFE + USE INTS_TYPE_MODULE + IMPLICIT NONE + + CLASS (INTS_TYPE), POINTER :: IT_OBJ + + CALL ALLOCATE_INTS_TYPE (IT_OBJ) + END PROGRAM MFE -- 2.30.2