diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 | 31 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 | 6 |
7 files changed, 54 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 73dcbf8..0484460 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,12 @@ 2007-09-13 Tobias Burnus <burnus@net-b.de> + PR fortran/33343 + * expr.c (gfc_check_conformance): Print ranks in the error message. + * resolve.c (resolve_elemental_actual): Check also conformance of + the actual arguments for elemental functions. + +2007-09-13 Tobias Burnus <burnus@net-b.de> + * symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive): Allow prefixes only to be specified once. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index ebed1f2..6ffcf7e 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2513,8 +2513,8 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) if (op1->rank != op2->rank) { - gfc_error ("Incompatible ranks in %s at %L", _(optype_msgid), - &op1->where); + gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(optype_msgid), + op1->rank, op2->rank, &op1->where); return FAILURE; } @@ -2527,7 +2527,7 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { - gfc_error ("different shape for %s at %L on dimension %d (%d/%d)", + gfc_error ("different shape for %s at %L on dimension %d (%d and %d)", _(optype_msgid), &op1->where, d + 1, (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 76a20a4..55d087f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1275,13 +1275,10 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) if (resolve_assumed_size_actual (arg->expr)) return FAILURE; - if (expr) - continue; - - /* Elemental subroutine array actual arguments must conform. */ + /* Elemental procedure's array actual arguments must conform. */ if (e != NULL) { - if (gfc_check_conformance ("elemental subroutine", arg->expr, e) + if (gfc_check_conformance ("elemental procedure", arg->expr, e) == FAILURE) return FAILURE; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9df45f8..90cbdad 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,12 @@ 2007-09-13 Tobias Burnus <burnus@net-b.de> + PR fortran/33343 + * gfortran.dg/elemental_args_check_1.f90: New. + * gfortran.dg/assumed_size_refs_1.f90: Update error message. + * gfortran.dg/elemental_subroutine_4.f90: Ditto. + +2007-09-13 Tobias Burnus <burnus@net-b.de> + * gfortran.dg/recursive_check_3.f90: New. 2007-09-13 Tobias Burnus <burnus@net-b.de> diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 index 1590ec5..1adfd3d 100644 --- a/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 @@ -35,7 +35,7 @@ contains x = fcn (m) ! { dg-error "upper bound in the last dimension" } m(:, 1:2) = fcn (q) call sub (m, x) ! { dg-error "upper bound in the last dimension" } - call sub (m(1:2, 1:2), x) ! { dg-error "Incompatible ranks in elemental subroutine" } + call sub (m(1:2, 1:2), x) ! { dg-error "Incompatible ranks in elemental procedure" } print *, p call DHSEQR(x) diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 new file mode 100644 index 0000000..caf4d17 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } +! PR fortran/33343 +! +! Check conformance of array actual arguments to +! elemental function. +! +! Contributed by Mikael Morin <mikael.morin@tele2.fr> +! + module geometry + implicit none + integer, parameter :: prec = 8 + integer, parameter :: length = 10 + contains + elemental function Mul(a, b) + real(kind=prec) :: a + real(kind=prec) :: b, Mul + intent(in) :: a, b + Mul = a * b + end function Mul + + pure subroutine calcdAcc2(vectors, angles) + real(kind=prec), dimension(:) :: vectors + real(kind=prec), dimension(size(vectors),2) :: angles + intent(in) :: vectors, angles + real(kind=prec), dimension(size(vectors)) :: ax + real(kind=prec), dimension(size(vectors),2) :: tmpAcc + tmpAcc(1,:) = Mul(angles(1,1:2),ax(1)) ! Ok + tmpAcc(:,1) = Mul(angles(:,1),ax) ! OK + tmpAcc(:,:) = Mul(angles(:,:),ax) ! { dg-error "Incompatible ranks in elemental procedure" } + end subroutine calcdAcc2 + end module geometry diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 index 1a34462..1c5b1f7 100644 --- a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 +++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 @@ -24,10 +24,10 @@ end module elem_assign integer :: I(2,2),J(2) type (mytype) :: w(2,2), x(4), y(5), z(4) ! The original PR - CALL S(I,J) ! { dg-error "Incompatible ranks in elemental subroutine" } + CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" } ! Check interface assignments - x = w ! { dg-error "Incompatible ranks in elemental subroutine" } - x = y ! { dg-error "different shape for elemental subroutine" } + x = w ! { dg-error "Incompatible ranks in elemental procedure" } + x = y ! { dg-error "different shape for elemental procedure" } x = z CONTAINS ELEMENTAL SUBROUTINE S(I,J) |