diff options
| author | Tobias Burnus <burnus@net-b.de> | 2010-11-12 00:07:23 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-11-12 00:07:23 +0100 |
| commit | d5656544848558da436c8f33055b2ca2cc3a18ef (patch) | |
| tree | 125b58d69b7782f92437df2511f9119e7000cc4d | |
| parent | dc09b1077d0acd283afffd5eb09dda34b9f6ba95 (diff) | |
| download | gcc-d5656544848558da436c8f33055b2ca2cc3a18ef.zip gcc-d5656544848558da436c8f33055b2ca2cc3a18ef.tar.gz gcc-d5656544848558da436c8f33055b2ca2cc3a18ef.tar.bz2 | |
re PR fortran/46413 ([OOP] ICE when printing a polymorphic type)
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.
From-SVN: r166631
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 14 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_31.f90 | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/forall_14.f90 | 17 |
5 files changed, 58 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ebabcb7..d6afdc4 100644 --- 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 --- 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 --- 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 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..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 |