From: Tobias Burnus Date: Fri, 15 Feb 2013 14:20:49 +0000 (+0100) Subject: re PR fortran/56318 (Wrong result with MATMUL of PARAMETER) X-Git-Tag: releases/gcc-4.6.4~141 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3b0f071e99d4b78687bc27a2e58d74e75d1a500b;p=thirdparty%2Fgcc.git re PR fortran/56318 (Wrong result with MATMUL of PARAMETER) 2013-02-15 Tobias Burnus Mikael Morin PR fortran/56318 * simplify.c (gfc_simplify_matmul): Fix result shape and matmul result. 2013-02-15 Tobias Burnus PR fortran/56318 * gcc/testsuite/gfortran.dg/matmul_9.f90: New. From-SVN: r196079 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d1d42ff07dda..417106ef4486 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-02-15 Tobias Burnus + Mikael Morin + + PR fortran/56318 + * simplify.c (gfc_simplify_matmul): Fix result shape + and matmul result. + 2013-02-13 Tobias Burnus Backported from mainline diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 4257fc754ba0..57ffa1b82697 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3884,7 +3884,7 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) if (matrix_a->rank == 1 && matrix_b->rank == 2) { result_rows = 1; - result_columns = mpz_get_si (matrix_b->shape[0]); + result_columns = mpz_get_si (matrix_b->shape[1]); stride_a = 1; stride_b = mpz_get_si (matrix_b->shape[0]); @@ -3894,7 +3894,7 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) } else if (matrix_a->rank == 2 && matrix_b->rank == 1) { - result_rows = mpz_get_si (matrix_b->shape[0]); + result_rows = mpz_get_si (matrix_a->shape[0]); result_columns = 1; stride_a = mpz_get_si (matrix_a->shape[0]); stride_b = 1; @@ -3907,7 +3907,7 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) { result_rows = mpz_get_si (matrix_a->shape[0]); result_columns = mpz_get_si (matrix_b->shape[1]); - stride_a = mpz_get_si (matrix_a->shape[1]); + stride_a = mpz_get_si (matrix_a->shape[0]); stride_b = mpz_get_si (matrix_b->shape[0]); result->rank = 2; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2a43fe081600..7e7942dc424d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-02-15 Tobias Burnus + + PR fortran/56318 + * gcc/testsuite/gfortran.dg/matmul_9.f90: New. + 2013-02-13 Tobias Burnus Backported from mainline @@ -47,7 +52,7 @@ Backport from mainline 2013-01-17 Martin Jambor - PR tree-optimizations/55264 + PR tree-optimizations/55264 * g++.dg/ipa/pr55264.C: New test. 2013-01-14 Janus Weil diff --git a/gcc/testsuite/gfortran.dg/matmul_9.f90 b/gcc/testsuite/gfortran.dg/matmul_9.f90 new file mode 100644 index 000000000000..bf2a299c8211 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_9.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/56318 +! +! Contributed by Alberto Luaces +! +SUBROUTINE mass_matrix + DOUBLE PRECISION,PARAMETER::m1=1.d0 + DOUBLE PRECISION,DIMENSION(3,2),PARAMETER::A1=reshape([1.d0,0.d0, 0.d0, & + 0.d0,1.d0, 0.d0],[3,2]) + DOUBLE PRECISION,DIMENSION(2,2),PARAMETER::Mel=reshape([1.d0/3.d0, 0.d0, & + 0.d0, 1.d0/3.d0],[2,2]) + + DOUBLE PRECISION,DIMENSION(3,3)::MM1 + + MM1=m1*matmul(A1,matmul(Mel,transpose(A1))) + !print '(3f8.3)', MM1 + if (any (abs (MM1 & + - reshape ([1.d0/3.d0, 0.d0, 0.d0, & + 0.d0, 1.d0/3.d0, 0.d0, & + 0.d0, 0.d0, 0.d0], & + [3,3])) > epsilon(1.0d0))) & + call abort () +END SUBROUTINE mass_matrix + +program name + implicit none + integer, parameter :: A(3,2) = reshape([1,2,3,4,5,6],[3,2]) + integer, parameter :: B(2,3) = reshape([3,17,23,31,43,71],[2,3]) + integer, parameter :: C(3) = [-5,-7,-21] + integer, parameter :: m1 = 1 + +! print *, matmul(B,C) + if (any (matmul(B,C) /= [-1079, -1793])) call abort() +! print *, matmul(C,A) + if (any (matmul(C,A) /= [-82, -181])) call abort() +! print '(3i5)', m1*matmul(A,B) + if (any (m1*matmul(A,B) /= reshape([71,91,111, 147,201,255, 327,441,555],& + [3,3]))) & + call abort() + call mass_matrix +end program name + +! { dg-final { scan-tree-dump-times "matmul" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +