2012-11-24 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/55314
	Backport from trunk
	* resolve.c (resolve_allocate_deallocate):  Compare all
	subscripts when deciding if to reject a (de)allocate
	statement.

2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/55314
	Backport from trunk
	* gfortran.dg/allocate_error_4.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@193780 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 380be47..e276653 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/55314
+       Backport from trunk
+       * resolve.c (resolve_allocate_deallocate):  Compare all
+       subscripts when deciding if to reject a (de)allocate
+       statement.
+
 2012-11-23  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/55352

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 33913aa..bbc1c22 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7280,8 +7280,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
          }
     }
 
-  /* Check that an allocate-object appears only once in the statement.  
-     FIXME: Checking derived types is disabled.  */
+  /* Check that an allocate-object appears only once in the statement.  */
+
   for (p = code->ext.alloc.list; p; p = p->next)
     {
       pe = p->expr;
@@ -7329,11 +7329,18 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 
                      if (pr->next && qr->next)
                        {
+                         int i;
                          gfc_array_ref *par = &(pr->u.ar);
                          gfc_array_ref *qar = &(qr->u.ar);
-                         if (gfc_dep_compare_expr (par->start[0],
-                                                   qar->start[0]) != 0)
-                             break;
+
+                         for (i=0; i<par->dimen; i++)
+                           {
+                             if ((par->start[i] != NULL
+                                  || qar->start[i] != NULL)
+                                 && gfc_dep_compare_expr (par->start[i],
+                                                          qar->start[i]) != 0)
+                               goto break_label;
+                           }
                        }
                    }
                  else
@@ -7345,6 +7352,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
                  pr = pr->next;
                  qr = qr->next;
                }
+           break_label:
+             ;
            }
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bf76bc7..d5dd471 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/55314
+       Backport from trunk
+       * gfortran.dg/allocate_error_4.f90:  New test.
+
 2012-11-23  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/55352

diff --git a/gcc/testsuite/gfortran.dg/allocate_error_4.f90 b/gcc/testsuite/gfortran.dg/allocate_error_4.f90
new file mode 100644 (file)
index 0000000..6652b47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/55314 - the second allocate statement was rejected.
+
+program main
+  implicit none
+  integer :: max_nb
+  type comm_mask
+    integer(4), pointer :: mask(:)
+  end type comm_mask
+  type (comm_mask), allocatable, save :: encode(:,:)
+  max_nb=2
+  allocate( encode(1:1,1:max_nb))
+  allocate( encode(1,1)%mask(1),encode(1,2)%mask(1))
+  deallocate( encode(1,1)%mask,encode(1,2)%mask)
+  allocate( encode(1,1)%mask(1),encode(1,1)%mask(1))  ! { dg-error "also appears at" }
+end program main