From 488520a7cf03b3117d4f35a39cffb5dc9ad99cef Mon Sep 17 00:00:00 2001 From: dfranke Date: Sun, 20 May 2007 10:22:15 +0000 Subject: [PATCH] gcc/fortran: 2007-05-20 Daniel Franke PR fortran/32001 * check.c (check_rest): Improved argument conformance check and fixed error message generation. gcc/testsuite: 2007-05-20 Daniel Franke PR fortran/32001 * gfortran.dg/min_max_conformance.f90: Added more testcases. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@124869 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 +++++ gcc/fortran/check.c | 29 ++++++++++++----------- gcc/testsuite/ChangeLog | 11 ++++++--- gcc/testsuite/gfortran.dg/min_max_conformance.f90 | 22 ++++++++++++++--- 4 files changed, 48 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b0c8fbac0d4..0e7bc69b47f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-05-20 Daniel Franke + + PR fortran/32001 + * check.c (check_rest): Improved argument conformance check and + fixed error message generation. + 2007-05-19 Francois-Xavier Coudert PR fortran/30820 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 4c0a5920b55..682dc8b90a2 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1486,19 +1486,17 @@ min_max_args (gfc_actual_arglist *arg) static try -check_rest (bt type, int kind, gfc_actual_arglist *arg) +check_rest (bt type, int kind, gfc_actual_arglist *arglist) { - gfc_expr *x, *first_arg; - int n; - char buffer[80]; + gfc_actual_arglist *arg, *tmp; - if (min_max_args (arg) == FAILURE) - return FAILURE; + gfc_expr *x; + int m, n; - n = 1; + if (min_max_args (arglist) == FAILURE) + return FAILURE; - first_arg = arg->expr; - for (; arg; arg = arg->next, n++) + for (arg = arglist, n=1; arg; arg = arg->next, n++) { x = arg->expr; if (x->ts.type != type || x->ts.kind != kind) @@ -1518,11 +1516,14 @@ check_rest (bt type, int kind, gfc_actual_arglist *arg) } } - snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'", - gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n-1], - gfc_current_intrinsic); - if (gfc_check_conformance (buffer, first_arg, x) == FAILURE) - return FAILURE; + for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) + { + char buffer[80]; + snprintf (buffer, 80, "arguments 'a%d' and 'a%d' for intrinsic '%s'", + m, n, gfc_current_intrinsic); + if (gfc_check_conformance (buffer, tmp->expr, x) == FAILURE) + return FAILURE; + } } return SUCCESS; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3a39a0f2893..db279f426a2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,10 +1,15 @@ -2006-05-20 Uros Bizjak +2007-05-20 Daniel Franke + + PR fortran/32001 + * gfortran.dg/min_max_conformance.f90: Added more testcases. + +2007-05-20 Uros Bizjak PR target/31585 * gcc.target/i386/sse-vect-types.c: Do not redefine "static" and "__inline". Use "-msse" instead of "-msse2". -2006-05-20 Manuel Lopez-Ibanez +2007-05-20 Manuel Lopez-Ibanez PR middle-end/7651 * gcc.dg/20030906-1.c: Replace Wextra with Wreturn-type. @@ -12,7 +17,7 @@ * objc.dg/method-17.m: Add -Wreturn-type. * obj-c++.dg/method-21.mm: Likewise. -2006-05-20 Uros Bizjak +2007-05-20 Uros Bizjak PR target/31585 * gcc.target/i386/sse-13.c: Use "-mssse3 -msse4a" compile options. diff --git a/gcc/testsuite/gfortran.dg/min_max_conformance.f90 b/gcc/testsuite/gfortran.dg/min_max_conformance.f90 index 565408cd26a..4ab249472a7 100644 --- a/gcc/testsuite/gfortran.dg/min_max_conformance.f90 +++ b/gcc/testsuite/gfortran.dg/min_max_conformance.f90 @@ -1,9 +1,10 @@ ! { dg-compile } +! { dg-options "-fmax-errors=0" } ! PR 31919: Tests for different ranks in min/max were missing. program pr31919 - integer :: i4a(2, 2), i4b(2), i4c(4) - real(4) :: r4a(2, 2), r4b(2), r4c(4) - real(8) :: r8a(2, 2), r8b(2), r8c(4) + integer :: i4, i4a(2, 2), i4b(2), i4c(4) + real(4) :: r4, r4a(2, 2), r4b(2), r4c(4) + real(8) :: r8, r8a(2, 2), r8b(2), r8c(4) i4a = max(i4a, i4b) ! { dg-error "Incompatible ranks" } i4a = max0(i4a, i4b) ! { dg-error "Incompatible ranks" } @@ -32,4 +33,19 @@ program pr31919 r4a = min1(r4b, r4c) ! { dg-error "different shape for arguments" } r4a = amin1(r4b, r4c) ! { dg-error "different shape for arguments" } r8a = dmin1(r8b, r8c) ! { dg-error "different shape for arguments" } + + ! checking needs to be position independent + i4a = min(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } + r4a = min(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } + r8a = min(r8, r8a, r8, r8b) ! { dg-error "Incompatible ranks" } + i4a = min(i4, i4b, i4, i4c) ! { dg-error "different shape for arguments" } + r4a = min(r4, r4b, r4, r4c) ! { dg-error "different shape for arguments" } + r8a = min(r8, r8b, r8, r8c) ! { dg-error "different shape for arguments" } + + i4a = max(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } + r4a = max(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } + r8a = max(r8, r8a, r8, r8b) ! { dg-error "Incompatible ranks" } + i4a = max(i4, i4b, i4, i4c) ! { dg-error "different shape for arguments" } + r4a = max(r4, r4b, r4, r4c) ! { dg-error "different shape for arguments" } + r8a = max(r8, r8b, r8, r8c) ! { dg-error "different shape for arguments" } end program -- 2.11.0