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

re PR fortran/35740 (a = conjg(transpose(a)) still gives wrong results, see bug 31994)

Browse source 
2008-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35740
	* resolve.c (resolve_function, resolve_call): If the procedure
	is elemental do not look for noncopying intrinsics.

2008-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35740
	* gfortran.dg/transpose_conjg_1.f90: New test.

From-SVN: r133729
This commit is contained in:
Paul Thomas 2008-03-30 14:13:21 +00:00
parent 05c7cda337
commit 23d1b451d0
4 changed files with 55 additions and 2 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 @@
2008-03-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35740
* resolve.c (resolve_function, resolve_call): If the procedure
is elemental do not look for noncopying intrinsics.
2008-03-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35698

9
gcc/fortran/resolve.c
View file

@ -2374,7 +2374,12 @@ resolve_function (gfc_expr *expr)
gfc_expr_set_symbols_referenced (expr->ts.cl->length);
}
if (t == SUCCESS)
if (t == SUCCESS
&& !((expr->value.function.esym
&& expr->value.function.esym->attr.elemental)
||
(expr->value.function.isym
&& expr->value.function.isym->elemental)))
find_noncopying_intrinsics (expr->value.function.esym,
expr->value.function.actual);
@ -2845,7 +2850,7 @@ resolve_call (gfc_code *c)
if (resolve_elemental_actual (NULL, c) == FAILURE)
return FAILURE;
if (t == SUCCESS)
if (t == SUCCESS && !(c->resolved_sym && c->resolved_sym->attr.elemental))
find_noncopying_intrinsics (c->resolved_sym, c->ext.actual);
return t;
}

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2008-03-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35740
* gfortran.dg/transpose_conjg_1.f90: New test.
2008-03-29 Laurent GUERBY <laurent@guerby.net>
* gnat.dg/socket2.adb: Remove since identical to socket1.adb.

37
gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 Normal file
View file

@ -0,0 +1,37 @@
! { dg-do run }
! Tests the fix for PR35740, where the trick of interchanging the descriptor
! dimensions to implement TRANSPOSE did not work if it is an argument of
! an elemental function - eg. CONJG. The fix forces a library call for such
! cases. During the diagnosis of the PR, it was found that the scalarizer was
! completely thrown if the argument of TRANSPOSE was a non-variable
! expression; eg a + c below. This is also fixed by the library call.
!
! Contributed by Dominik Muth <dominik.muth@gmx.de>
!
program main
implicit none
complex, dimension(2,2) :: a,b,c,d
a(1,1) = (1.,1.)
a(2,1) = (2.,2.)
a(1,2) = (3.,3.)
a(2,2) = (4.,4.)
!
b = a
b = conjg(transpose(b))
d = a
d = transpose(conjg(d))
if (any (b /= d)) call abort ()
!
d = matmul (b, a )
if (any (d /= matmul (transpose(conjg(a)), a))) call abort ()
if (any (d /= matmul (conjg(transpose(a)), a))) call abort ()
!
c = (0.0,1.0)
b = conjg(transpose(a + c))
d = transpose(conjg(a + c))
if (any (b /= d)) call abort ()
!
d = matmul (b, a + c)
if (any (d /= matmul (transpose(conjg(a + c)), a + c))) call abort ()
if (any (d /= matmul (conjg(transpose(a + c)), a + c))) call abort ()
END program main