diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 23 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 | 35 |
5 files changed, 72 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bcdd799..517535b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2006-01-31 Thomas Koenig <Thomas.Koenig@online.de> + + PR fortran/26039 + expr.c (gfc_check_conformance): Reorder error message + to avoid plural. + check.c(gfc_check_minloc_maxloc): Call gfc_check_conformance + for checking arguments array and mask. + (check_reduction): Likewise. + 2005-01-30 Erik Edelmann <eedelman@gcc.gnu.org> PR fortran/24266 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index feb07f0..8b56d52 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1526,6 +1526,16 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap) if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; + if (m != NULL) + { + char buffer[80]; + snprintf(buffer, sizeof(buffer), "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], + gfc_current_intrinsic); + if (gfc_check_conformance (buffer, a, m) == FAILURE) + return FAILURE; + } + return SUCCESS; } @@ -1548,8 +1558,9 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap) static try check_reduction (gfc_actual_arglist * ap) { - gfc_expr *m, *d; + gfc_expr *a, *m, *d; + a = ap->expr; d = ap->next->expr; m = ap->next->next->expr; @@ -1571,6 +1582,16 @@ check_reduction (gfc_actual_arglist * ap) if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; + if (m != NULL) + { + char buffer[80]; + snprintf(buffer, sizeof(buffer), "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], + gfc_current_intrinsic); + if (gfc_check_conformance (buffer, a, m) == FAILURE) + return FAILURE; + } + return SUCCESS; } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 0e699c2..92a7dc0 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1821,7 +1821,7 @@ gfc_check_conformance (const char *optype_msgid, if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { - gfc_error ("%s at %L has different shape on dimension %d (%d/%d)", + gfc_error ("different shape for %s at %L on dimension %d (%d/%d)", _(optype_msgid), &op1->where, d + 1, (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 47f6623..6b5c659 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-01-31 Thomas Koenig <Thomas.Koenig@online.de> + + PR fortran/26039 + maxval_maxloc_conformance_1.f90: New test. + 2006-01-31 Richard Guenther <rguenther@suse.de> * gcc.target/i386/sselibm-1.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 new file mode 100644 index 0000000..828655c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! PR 26039: Tests for different ranks for (min|max)loc, (min|max)val, product +! and sum were missing. +program main + integer, dimension(2) :: a + logical, dimension(2,1) :: lo + logical, dimension(3) :: lo2 + a = (/ 1, 2 /) + lo = .true. + print *,minloc(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,maxloc(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,minval(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,maxval(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,sum(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,product(a,mask=lo) ! { dg-error "Incompatible ranks" } + print *,minloc(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + print *,maxloc(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + print *,minval(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + print *,maxval(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + print *,sum(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + print *,product(a,1,mask=lo) ! { dg-error "Incompatible ranks" } + + print *,minloc(a,mask=lo2) ! { dg-error "different shape" } + print *,maxloc(a,mask=lo2) ! { dg-error "different shape" } + print *,minval(a,mask=lo2) ! { dg-error "different shape" } + print *,maxval(a,mask=lo2) ! { dg-error "different shape" } + print *,sum(a,mask=lo2) ! { dg-error "different shape" } + print *,product(a,mask=lo2) ! { dg-error "different shape" } + print *,minloc(a,1,mask=lo2) ! { dg-error "different shape" } + print *,maxloc(a,1,mask=lo2) ! { dg-error "different shape" } + print *,minval(a,1,mask=lo2) ! { dg-error "different shape" } + print *,maxval(a,1,mask=lo2) ! { dg-error "different shape" } + print *,sum(a,1,mask=lo2) ! { dg-error "different shape" } + print *,product(a,1,mask=lo2) ! { dg-error "different shape" } +end program main |