resolve.c (conformable_arrays): Avoid segfault when ar.start[i] == NULL.

2013-05-05  Tobias Burnus  <burnus@net-b.de>

        * resolve.c (conformable_arrays): Avoid segfault
        when ar.start[i] == NULL.

2013-05-05  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/allocate_with_source_3.f90: New.

From-SVN: r198610

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d595cf29f7ac64cd7c7a09b0da071b9582986654..66b20c0457ce94517fc13e1e3420bf9cdfd49412 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-05  Tobias Burnus  <burnus@net-b.de>
+
+       * resolve.c (conformable_arrays): Avoid segfault
+       when ar.start[i] == NULL.
+
 2013-05-05  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57141

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2860e4127b5c5d21ae17989b7be9e22bbf7f09d8..e27b23b2a5436e493890283d9da24c9651bd18ef 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6508,6 +6508,9 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2)
 
       for (i = 0; i < e1->rank; i++)
        {
+         if (tail->u.ar.start[i] == NULL)
+           break;
+
          if (tail->u.ar.end[i])
            {
              mpz_set (s, tail->u.ar.end[i]->value.integer);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2dde9c6482ebc359a032718474a288efbb011696..e383f089e72873c8fe255ee4ff4399ace643850e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2013-05-05  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/allocate_with_source_3.f90: New.
+
 2013-05-05  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57141

diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_3.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_3.f90
new file mode 100644 (file)
index 0000000..f7e0109
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_3.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! Contributed by Reinhold Bader
+!
+program assumed_shape_01
+  use, intrinsic :: iso_c_binding
+  implicit none
+  type, bind(c) :: cstruct
+     integer(c_int) :: i
+     real(c_float) :: r(2)
+  end type cstruct
+  interface
+     subroutine psub(this, that) bind(c, name='Psub')
+       import :: c_float, cstruct
+       real(c_float) :: this(:,:)
+       type(cstruct) :: that(:)
+     end subroutine psub
+  end interface
+
+  real(c_float) :: t(3,7)
+  type(cstruct), pointer :: u(:)
+
+! The following is VALID Fortran 2008 but NOT YET supported 
+  allocate(u, source=[cstruct( 4, [1.1,2.2] ) ]) ! { dg-error "Array specification required in ALLOCATE statement" }
+  call psub(t, u)
+  deallocate (u)
+
+end program assumed_shape_01