procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/32001 (MAX intrinsic with large number of arguments)

Browse source 
gcc/fortran:
2007-05-20  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/32001
        * check.c (check_rest): Improved argument conformance check and
        fixed error message generation.


gcc/testsuite:
2007-05-20  Daniel Franke  <franke.daniel@gmail.org>

	PR fortran/32001
	* gfortran.dg/min_max_conformance.f90: Added more testcases.

From-SVN: r124869
This commit is contained in:
Daniel Franke 2007-05-20 06:22:15 -04:00
parent 643827b29b
commit 6495bc0b8d
4 changed files with 48 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2007-05-20 Daniel Franke <franke.daniel@gmail.com>
PR fortran/32001
* check.c (check_rest): Improved argument conformance check and
fixed error message generation.
2007-05-19 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/30820

29
gcc/fortran/check.c
View file

@ -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)
gfc_expr *x;
int m, n;
if (min_max_args (arglist) == FAILURE)
return FAILURE;
n = 1;
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;

11
gcc/testsuite/ChangeLog
View file

@ -1,10 +1,15 @@
2006-05-20 Uros Bizjak <ubizjak@gmail.com>
2007-05-20 Daniel Franke <franke.daniel@gmail.org>
PR fortran/32001
* gfortran.dg/min_max_conformance.f90: Added more testcases.
2007-05-20 Uros Bizjak <ubizjak@gmail.com>
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 <manu@gcc.gnu.org>
2007-05-20 Manuel Lopez-Ibanez <manu@gcc.gnu.org>
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 <ubizjak@gmail.com>
2007-05-20 Uros Bizjak <ubizjak@gmail.com>
PR target/31585
* gcc.target/i386/sse-13.c: Use "-mssse3 -msse4a" compile options.

22
gcc/testsuite/gfortran.dg/min_max_conformance.f90
View file

@ -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