2010-11-11 Tobias Burnus <burnus@net-b.de>

        PR fortran/46413
        * resolve.c (resolve_transfer): Reject I/O transfer of
        polymorphic type.

        PR fortran/46205
        * resolve.c (resolve_code): Reject nonscalar FORALL masks.

2010-11-11  Tobias Burnus  <burnus@net-b.de>

        PR fortran/46413
        * gfortran.dg/class_31.f90: New.

        PR fortran/46205
        * gfortran.dg/forall_14.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@166631 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ebabcb7..d6afdc4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2010-11-11  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/46413
+       * resolve.c (resolve_transfer): Reject I/O transfer of
+       polymorphic type.
+
+       PR fortran/46205
+       * resolve.c (resolve_code): Reject nonscalar FORALL masks.
+
 2010-11-11  Janus Weil  <janus@gcc.gnu.org>
 
        * resolve.c (resolve_procedure_interface): Copy 'is_bind_c' attribute.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1f5630d..60a15d8 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7949,6 +7949,15 @@ resolve_transfer (gfc_code *code)
     if (ref->type == REF_COMPONENT)
       ts = &ref->u.c.component->ts;
 
+  if (ts->type == BT_CLASS)
+    {
+      /* FIXME: Test for defined input/output.  */
+      gfc_error ("Data transfer element at %L cannot be polymorphic unless "
+                "it is processed by a defined input/output procedure",
+                &code->loc);
+      return;
+    }
+
   if (ts->type == BT_DERIVED)
     {
       /* Check that transferred derived type doesn't contain POINTER
@@ -9099,8 +9108,9 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
        case EXEC_FORALL:
          resolve_forall_iterators (code->ext.forall_iterator);
 
-         if (code->expr1 != NULL && code->expr1->ts.type != BT_LOGICAL)
-           gfc_error ("FORALL mask clause at %L requires a LOGICAL "
+         if (code->expr1 != NULL
+             && (code->expr1->ts.type != BT_LOGICAL || code->expr1->rank))
+           gfc_error ("FORALL mask clause at %L requires a scalar LOGICAL "
                       "expression", &code->expr1->where);
          break;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a63ed7c..381b9c2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2010-11-11  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/46413
+       * gfortran.dg/class_31.f90: New.
+
+       PR fortran/46205
+       * gfortran.dg/forall_14.f90: New.
+
 2010-11-11  Jakub Jelinek <jakub@redhat.com>
            Tobias Burnus <burnus@net-b.de>
 

diff --git a/gcc/testsuite/gfortran.dg/class_31.f90 b/gcc/testsuite/gfortran.dg/class_31.f90
new file mode 100644 (file)
index 0000000..eddf13f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_31.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/46413
+!
+type t
+  integer :: ii =5
+end type t
+class(t), allocatable :: x
+allocate (t :: x)
+
+print *,x  ! { dg-error "Data transfer element at .1. cannot be polymorphic" }
+end

diff --git a/gcc/testsuite/gfortran.dg/forall_14.f90 b/gcc/testsuite/gfortran.dg/forall_14.f90
new file mode 100644 (file)
index 0000000..a3fb392
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_14.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/46205
+!
+! Contributed by Jonathan Stott
+!
+
+program forallBug
+  logical :: valid(4) = (/ .true., .true., .false., .true. /)
+  real    :: vec(4)
+  integer :: j
+
+  ! This is an illegal statement.  It should read valid(j), not valid.
+  forall (j = 1:4, valid) ! { dg-error "requires a scalar LOGICAL expression" }
+     vec(j) = sin(2*3.14159/j)
+  end forall
+end program forallBug