mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-08 18:40:53 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/39304 (ICE with MATMUL, specific/generic functions and rank checking)

Browse Source 
2010-01-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39304
        * array.c (gfc_array_dimen_size): Use correct specific
        function in the check.

2010-01-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39304
        * gfortran.dg/generic_20.f90: New test.

From-SVN: r156195
This commit is contained in:
Tobias Burnus 2010-01-24 09:10:47 +01:00 committed by Tobias Burnus
parent 48634cdbed
commit 23f6293ee8
4 changed files with 51 additions and 1 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 @@
2010-01-24 Tobias Burnus <burnus@net-b.de>
PR fortran/39304
* array.c (gfc_array_dimen_size): Use correct specific
function in the check.
2010-01-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/42736

10
gcc/fortran/array.c
View File

@ -2053,7 +2053,15 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
return SUCCESS;
}
if (spec_dimen_size (array->symtree->n.sym->as, dimen, result) == FAILURE)
if (array->symtree->n.sym->attr.generic
&& !array->symtree->n.sym->attr.intrinsic)
{
if (spec_dimen_size (array->value.function.esym->as, dimen, result)
== FAILURE)
return FAILURE;
}
else if (spec_dimen_size (array->symtree->n.sym->as, dimen, result)
== FAILURE)
return FAILURE;
break;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-01-24 Tobias Burnus <burnus@net-b.de>
PR fortran/39304
* gfortran.dg/generic_20.f90: New test.
2010-01-22 Michael Matz <matz@suse.de>
* gfortran.dg/vect/fast-math-mgrid-resid.f: Limit to x86, add

31
gcc/testsuite/gfortran.dg/generic_20.f90 Normal file
View File

@ -0,0 +1,31 @@
! { dg-do run }
!
! PR fortran/39304
!
! matmul checking was checking the wrong specific function
! ("one" instead of "two")
!
module m
implicit none
interface one
module procedure one, two
end interface one
contains
function one()
real :: one(1)
one = 0.0
end function one
function two(x)
real :: x
real :: two(1,1)
two = reshape ( (/ x /), (/ 1, 1 /) )
end function two
end module m
use m
real :: res(1)
res = matmul (one(2.0), (/ 2.0/))
if (abs (res(1)-4.0) > epsilon (res)) call abort ()
end
! { dg-final { cleanup-modules "m" } }