re PR fortran/87277 (Segfault on using array component of class scalar pointer as...

2018-09-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87277
	* expr.c (is_subref_array): Add the check of dimensionality for
	class, dummy, pointer arrays.

2018-09-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87277
	* gfortran.dg/select_type_43.f90: New test.

From-SVN: r264210

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 64acb7a..c02276f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2018-09-11  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/87277
+       * expr.c (is_subref_array): Add the check of dimensionality for
+       class, dummy, pointer arrays.
+
 2018-09-11  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/86830

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 97792fe..3315bb8 100644 (file)
--- 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 30b1156..3e35910 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-09-11  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/87277
+       * gfortran.dg/select_type_43.f90: New test.
+
 2018-09-11  Nathan Sidwell  <nathan@acm.org>
 
        * 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 (file)
index 0000000..3bb71c3
--- /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