From 7e2dcd7ea93cadaf358e8dcbeec726bef029fc76 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 11 Nov 2010 23:07:23 +0000 Subject: [PATCH] 2010-11-11 Tobias Burnus 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 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 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/resolve.c | 14 ++++++++++++-- gcc/testsuite/ChangeLog | 8 ++++++++ gcc/testsuite/gfortran.dg/class_31.f90 | 12 ++++++++++++ gcc/testsuite/gfortran.dg/forall_14.f90 | 17 +++++++++++++++++ 5 files changed, 58 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_31.f90 create mode 100644 gcc/testsuite/gfortran.dg/forall_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ebabcb7ff7c..d6afdc4a575 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2010-11-11 Tobias Burnus + + 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 * resolve.c (resolve_procedure_interface): Copy 'is_bind_c' attribute. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1f5630d4535..60a15d8b76a 100644 --- 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 a63ed7c5704..381b9c2375b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2010-11-11 Tobias Burnus + + PR fortran/46413 + * gfortran.dg/class_31.f90: New. + + PR fortran/46205 + * gfortran.dg/forall_14.f90: New. + 2010-11-11 Jakub Jelinek Tobias Burnus diff --git a/gcc/testsuite/gfortran.dg/class_31.f90 b/gcc/testsuite/gfortran.dg/class_31.f90 new file mode 100644 index 00000000000..eddf13f1bea --- /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 00000000000..a3fb3921de1 --- /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 -- 2.11.4.GIT