Patchwork [Fortran] PRs 46413, 46205 - ICE with polymorphic I/O and nonscalar FORALL mask

login
register
mail settings
Submitter Tobias Burnus
Date Nov. 11, 2010, 10:47 p.m.
Message ID <4CDC7295.9080402@net-b.de>
Download mbox | patch
Permalink /patch/70886/
State New
Headers show

Comments

Tobias Burnus - Nov. 11, 2010, 10:47 p.m.
The attached patches are rather trivial, fixing two ice-on-invalid PRs.

Build and currently regtesting on x86-64-linux.
OK for the trunk?

Tobias
Steve Kargl - Nov. 11, 2010, 10:53 p.m.
On Thu, Nov 11, 2010 at 11:47:49PM +0100, Tobias Burnus wrote:
> The attached patches are rather trivial, fixing two ice-on-invalid PRs.
> 
> Build and currently regtesting on x86-64-linux.
> OK for the trunk?

OK.

Patch

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.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2c9d6f6..47562d9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7948,6 +7948,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
@@ -9098,8 +9107,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/gfortran.dg/class_31.f90 b/gcc/testsuite/gfortran.dg/class_31.f90
new file mode 100644
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
index 0000000..16d47ca
--- /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