diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 9 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_call_7.f03 | 50 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_call_8.f03 | 32 |
5 files changed, 104 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4cabf02..c8f1aaf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,12 @@ 2008-09-09 Daniel Kraft <d@domob.eu> + PR fortran/37429 + * resolve.c (expression_rank): Added assertion to guard against + EXPR_COMPCALL expressions. + (resolve_compcall): Set expression's rank from the target procedure's. + +2008-09-09 Daniel Kraft <d@domob.eu> + PR fortran/37411 * trans-array.c (gfc_conv_array_parameter): Added assertion that the symbol has an array spec. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 05f2c14..69245f2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4021,6 +4021,10 @@ expression_rank (gfc_expr *e) gfc_ref *ref; int i, rank; + /* Just to make sure, because EXPR_COMPCALL's also have an e->ref and that + could lead to serious confusion... */ + gcc_assert (e->expr_type != EXPR_COMPCALL); + if (e->ref == NULL) { if (e->expr_type == EXPR_ARRAY) @@ -4550,6 +4554,11 @@ resolve_compcall (gfc_expr* e) if (resolve_typebound_generic_call (e) == FAILURE) return FAILURE; + gcc_assert (!e->value.compcall.tbp->is_generic); + + /* Take the rank from the function's symbol. */ + if (e->value.compcall.tbp->u.specific->n.sym->as) + e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank; /* For now, we simply transform it into an EXPR_FUNCTION call with the same arglist to the TBP's binding target. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 311b03e..185c066 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-09-09 Daniel Kraft <d@domob.eu> + + PR fortran/37429 + * gfortran.dg/typebound_call_7.f03: New test. + * gfortran.dg/typebound_call_8.f03: New test. + 2008-09-09 Richard Guenther <rguenther@suse.de> PR middle-end/37354 diff --git a/gcc/testsuite/gfortran.dg/typebound_call_7.f03 b/gcc/testsuite/gfortran.dg/typebound_call_7.f03 new file mode 100644 index 0000000..c429dc7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_7.f03 @@ -0,0 +1,50 @@ +! { dg-do compile} + +! PR fortran/37429 +! Checks for assignments from type-bound functions. + +MODULE touching + IMPLICIT NONE + + TYPE :: EqnSys33 + CONTAINS + PROCEDURE, NOPASS :: solve1 + PROCEDURE, NOPASS :: solve2 + PROCEDURE, NOPASS :: solve3 + END TYPE EqnSys33 + +CONTAINS + + FUNCTION solve1 () + IMPLICIT NONE + REAL :: solve1(3) + solve1 = 0.0 + END FUNCTION solve1 + + CHARACTER(len=5) FUNCTION solve2 () + IMPLICIT NONE + solve2 = "hello" + END FUNCTION solve2 + + REAL FUNCTION solve3 () + IMPLICIT NONE + solve3 = 4.2 + END FUNCTION solve3 + + SUBROUTINE fill_gap () + IMPLICIT NONE + TYPE(EqnSys33) :: sys + REAL :: res + REAL :: resArr(3), resSmall(2) + + res = sys%solve1 () ! { dg-error "Incompatible rank" } + res = sys%solve2 () ! { dg-error "Can't convert" } + resSmall = sys%solve1 () ! { dg-error "Different shape" } + + res = sys%solve3 () + resArr = sys%solve1 () + END SUBROUTINE fill_gap + +END MODULE touching + +! { dg-final { cleanup-modules "touching" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_call_8.f03 b/gcc/testsuite/gfortran.dg/typebound_call_8.f03 new file mode 100644 index 0000000..c8bf8d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_8.f03 @@ -0,0 +1,32 @@ +! { dg-do compile} + +! PR fortran/37429 +! This used to ICE, check that is fixed. + +MODULE touching + IMPLICIT NONE + + TYPE :: EqnSys33 + CONTAINS + PROCEDURE, NOPASS :: solve1 + END TYPE EqnSys33 + +CONTAINS + + FUNCTION solve1 () + IMPLICIT NONE + REAL :: solve1(3) + solve1 = 0.0 + END FUNCTION solve1 + + SUBROUTINE fill_gap () + IMPLICIT NONE + TYPE(EqnSys33) :: sys + REAL :: res + + res = sys%solve1 () ! { dg-error "Incompatible rank" } + END SUBROUTINE fill_gap + +END MODULE touching + +! { dg-final { cleanup-modules "touching" } } |