re PR fortran/52552 ([OOP] ICE when trying to allocate non-allocatable object giving...

2012-06-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/52552
	* match.c (gfc_match_allocate): Modify order of checks. Change wording
	of error message. Remove FIXME note.
	* resolve.c (resolve_allocate_expr): Add a comment.

2012-06-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/52552
	* gfortran.dg/allocate_alloc_opt_1.f90: Modified.
	* gfortran.dg/allocate_class_1.f90: Modified.
	* gfortran.dg/allocate_with_typespec_4.f90: Modified.
	* gfortran.dg/allocate_class_2.f90: New.

From-SVN: r188335

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e51d5071d8343ff3e58139d99ef6433dc8690659..02b644544a62d9c565537180c7ed85bbe3497884 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2012-06-08  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/52552
+       * match.c (gfc_match_allocate): Modify order of checks. Change wording
+       of error message. Remove FIXME note.
+       * resolve.c (resolve_allocate_expr): Add a comment.
+
 2012-06-07  Thomas König  <tkoenig@gcc.gnu.org>
 
        PR fortran/52861

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 29b6428ab9208e9351431bbf5bdb5ca495323333..3d63510b00bc604085b055f6eb6fd06aeb5eb775 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3533,6 +3533,28 @@ gfc_match_allocate (void)
            }
        }
 
+      /* Check for F08:C628.  */
+      sym = tail->expr->symtree->n.sym;
+      b1 = !(tail->expr->ref
+            && (tail->expr->ref->type == REF_COMPONENT
+                || tail->expr->ref->type == REF_ARRAY));
+      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
+       b2 = !(CLASS_DATA (sym)->attr.allocatable
+              || CLASS_DATA (sym)->attr.class_pointer);
+      else
+       b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
+                     || sym->attr.proc_pointer);
+      b3 = sym && sym->ns && sym->ns->proc_name
+          && (sym->ns->proc_name->attr.allocatable
+              || sym->ns->proc_name->attr.pointer
+              || sym->ns->proc_name->attr.proc_pointer);
+      if (b1 && b2 && !b3)
+       {
+         gfc_error ("Allocate-object at %L is neither a data pointer "
+                    "nor an allocatable variable", &tail->expr->where);
+         goto cleanup;
+       }
+
       /* The ALLOCATE statement had an optional typespec.  Check the
         constraints.  */
       if (ts.type != BT_UNKNOWN)
@@ -3558,28 +3580,6 @@ gfc_match_allocate (void)
       if (tail->expr->ts.type == BT_DERIVED)
        tail->expr->ts.u.derived = gfc_use_derived (tail->expr->ts.u.derived);
 
-      /* FIXME: disable the checking on derived types and arrays.  */
-      sym = tail->expr->symtree->n.sym;
-      b1 = !(tail->expr->ref
-          && (tail->expr->ref->type == REF_COMPONENT
-               || tail->expr->ref->type == REF_ARRAY));
-      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
-       b2 = !(CLASS_DATA (sym)->attr.allocatable
-              || CLASS_DATA (sym)->attr.class_pointer);
-      else
-       b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
-                     || sym->attr.proc_pointer);
-      b3 = sym && sym->ns && sym->ns->proc_name
-          && (sym->ns->proc_name->attr.allocatable
-               || sym->ns->proc_name->attr.pointer
-               || sym->ns->proc_name->attr.proc_pointer);
-      if (b1 && b2 && !b3)
-       {
-         gfc_error ("Allocate-object at %L is neither a nonprocedure pointer "
-                    "nor an allocatable variable", &tail->expr->where);
-         goto cleanup;
-       }
-
       if (gfc_peek_ascii_char () == '(' && !sym->attr.dimension)
        {
          gfc_error ("Shape specification for allocatable scalar at %C");

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 61a1381a073685f3760bcf482175cf58e8952a87..8531318669594f06759c677abd8786a8644adf24 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6986,6 +6986,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
        }
     }
 
+  /* Check for F08:C628.  */
   if (allocatable == 0 && pointer == 0)
     {
       gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER",

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 99585db8dfadca3849cd18ee815d3637489f6869..60c8e28a6d92f8f6d7897061d8cb89253b8205b6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2012-06-08  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/52552
+       * gfortran.dg/allocate_alloc_opt_1.f90: Modified.
+       * gfortran.dg/allocate_class_1.f90: Modified.
+       * gfortran.dg/allocate_with_typespec_4.f90: Modified.
+       * gfortran.dg/allocate_class_2.f90: New.
+
 2012-06-07  Hans-Peter Nilsson  <hp@axis.com>
 
        PR middle-end/53535

diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
index 3a05e8cff02fe9c7a7f3e4229fbce96f51410f18..95571fdfe124092ee0abe19db4aedfa6f69bb313 100644 (file)
--- a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
@@ -24,7 +24,7 @@ program a
   allocate(i(2), errmsg=err) ! { dg-warning "useless without a STAT" }
   allocate(i(2), stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" }
 
-  allocate(err) ! { dg-error "neither a nonprocedure pointer nor an allocatable" }
+  allocate(err) ! { dg-error "neither a data pointer nor an allocatable" }
 
   allocate(error(2),stat=j,errmsg=error(1)) ! { dg-error "shall not be ALLOCATEd within" }
   allocate(i(2), stat = i(1))  ! { dg-error "shall not be ALLOCATEd within" }

diff --git a/gcc/testsuite/gfortran.dg/allocate_class_1.f90 b/gcc/testsuite/gfortran.dg/allocate_class_1.f90
index 9a2a5cb2538c95da41307a841f80a94f84aacebf..d8f80ed5ec64e493871b60ebebb73d6450942bfc 100644 (file)
--- a/gcc/testsuite/gfortran.dg/allocate_class_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_class_1.f90
@@ -7,5 +7,5 @@
  type :: t0
  end type
  class(t0) :: x  ! { dg-error "must be dummy, allocatable or pointer" }
- allocate(x)     ! { dg-error "is neither a nonprocedure pointer nor an allocatable variable" }
+ allocate(x)     ! { dg-error "is neither a data pointer nor an allocatable variable" }
  end

diff --git a/gcc/testsuite/gfortran.dg/allocate_class_2.f90 b/gcc/testsuite/gfortran.dg/allocate_class_2.f90
new file mode 100644 (file)
index 0000000..733dca6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_class_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 52552: [OOP] ICE when trying to allocate non-allocatable object giving a dynamic type
+!
+! Contributed by <gccbgz.lionm@xoxy.net>
+
+
+  type t
+    integer :: i
+  end type
+  
+  class(t) :: o      ! { dg-error "must be dummy, allocatable or pointer" }
+
+  allocate(t::o)     ! { dg-error "is neither a data pointer nor an allocatable variable" }
+
+end 

diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
index 54ed109fc24c45309f01a261cf56c0afaf0f259d..cc09697f385997410b944e3d77b8fe3b95a443a1 100644 (file)
--- a/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
@@ -21,7 +21,7 @@ subroutine not_an_f03_intrinsic
    allocate(real*8 :: y(1))       ! { dg-error "Invalid type-spec at" }
    allocate(real*4 :: x8)         ! { dg-error "Invalid type-spec at" }
    allocate(real*4 :: y8(1))      ! { dg-error "Invalid type-spec at" }
-   allocate(double complex :: d1) ! { dg-error "neither a nonprocedure pointer nor an allocatable" }
+   allocate(double complex :: d1) ! { dg-error "neither a data pointer nor an allocatable" }
    allocate(real_type :: b)
    allocate(real_type :: c(1))