From 23d1b451d0d02e953eaffadd977fca12d93a780a Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 30 Mar 2008 14:13:21 +0000 Subject: [PATCH] re PR fortran/35740 (a = conjg(transpose(a)) still gives wrong results, see bug 31994) 2008-03-30 Paul Thomas 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 PR fortran/35740 * gfortran.dg/transpose_conjg_1.f90: New test. From-SVN: r133729 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/resolve.c | 9 ++++- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/transpose_conjg_1.f90 | 37 +++++++++++++++++++ 4 files changed, 55 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6615fd35051..b56aa730e68 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-03-30 Paul Thomas + + 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 PR fortran/35698 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 41b1addbab3..af9ef55ce41 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4f4b404f6d2..5b61aee5536 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-03-30 Paul Thomas + + PR fortran/35740 + * gfortran.dg/transpose_conjg_1.f90: New test. + 2008-03-29 Laurent GUERBY * gnat.dg/socket2.adb: Remove since identical to socket1.adb. diff --git a/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 b/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 new file mode 100644 index 00000000000..3b28827b38a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 @@ -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 +! +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 -- 2.30.2