From patchwork Wed Jul 3 12:05:15 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 256605 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 03C872C0315 for ; Wed, 3 Jul 2013 22:05:44 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=dLONlSqM+gI+DyVS6pPjL6tQWfVHzYbXOtdBQcuWLC/ICp GtKkEv2WF/mBLJQIlKdyN7FtfjobqgwEIyJj5wGUclcU2UGm5Sqp7J7kZEKsbCz+ yArbz65XK366lNashPMk+thLfY1GxYDsfsmMVFSAX4VElsqNiJgmXvndncjC4= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=R97Q9ucR3TUYV1IEEfok05c7sQ8=; b=ETGGnbh5FFKXB0weOGnX 4WgcwnYp8iSLSUfbHOBo4wn5Kj7gRyIP7XQp7+ijYvV4SxPZSm9dA83ye7fNApyY +H/1L1BBrnMeUpR5tu93oS4XiZ+/MeX3AoiuuCY23G2Gaf4w5Tkvn3sYUEuex4MN zfTcq7NULLFEy945fL74QxU= Received: (qmail 8699 invoked by alias); 3 Jul 2013 12:05:32 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 8616 invoked by uid 89); 3 Jul 2013 12:05:26 -0000 X-Spam-SWARE-Status: No, score=-2.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Wed, 03 Jul 2013 12:05:19 +0000 Received: from archimedes.net-b.de (port-92-206-14-23.dynamic.qsc.de [92.206.14.23]) by mx02.qsc.de (Postfix) with ESMTP id C1AE7276CB; Wed, 3 Jul 2013 14:05:16 +0200 (CEST) Message-ID: <51D4137B.4000405@net-b.de> Date: Wed, 03 Jul 2013 14:05:15 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR57785 - Fix folding of dot_product for complex vars X-Virus-Found: No Pending patches:http://gcc.gnu.org/ml/fortran/2013-07/msg00002.html Thanks goes to Dominique for debugging the issue! Build and regtested on x86-64-gnu-linux. OK for the trunk? I think one should also backport it to 4.7/4.8. (Folding - and hence the bug - exist since GCC 4.5.) Tobias 2013-07-03 Tobias Burnus PR fortran/57785 * simplify.c (compute_dot_product): Complex conjugate for dot_product. (gfc_simplify_dot_product, gfc_simplify_matmul): Update call. 2013-07-03 Tobias Burnus PR fortran/57785 * gfortran.dg/dot_product_2.f90: New. diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 41e1dfb..32b8332 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -333,13 +333,15 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array) } -/* Helper function for gfc_simplify_dot_product() and gfc_simplify_matmul. */ +/* Helper function for gfc_simplify_dot_product() and gfc_simplify_matmul; + if conj_a is true, the matrix_a is complex conjugated. */ static gfc_expr * compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a, - gfc_expr *matrix_b, int stride_b, int offset_b) + gfc_expr *matrix_b, int stride_b, int offset_b, + bool conj_a) { - gfc_expr *result, *a, *b; + gfc_expr *result, *a, *b, *c; result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind, &matrix_a->where); @@ -362,9 +364,11 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a, case BT_INTEGER: case BT_REAL: case BT_COMPLEX: - result = gfc_add (result, - gfc_multiply (gfc_copy_expr (a), - gfc_copy_expr (b))); + if (conj_a && a->ts.type == BT_COMPLEX) + c = gfc_simplify_conjg (a); + else + c = gfc_copy_expr (a); + result = gfc_add (result, gfc_multiply (c, gfc_copy_expr (b))); break; default: @@ -1882,7 +1886,7 @@ gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) gcc_assert (vector_b->rank == 1); gcc_assert (gfc_compare_types (&vector_a->ts, &vector_b->ts)); - return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0); + return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0, true); } @@ -3910,7 +3914,7 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) for (row = 0; row < result_rows; ++row) { gfc_expr *e = compute_dot_product (matrix_a, stride_a, offset_a, - matrix_b, 1, offset_b); + matrix_b, 1, offset_b, false); gfc_constructor_append_expr (&result->value.constructor, e, NULL); --- /dev/null 2013-07-03 08:52:40.042058079 +0200 +++ gcc/gcc/testsuite/gfortran.dg/dot_product_2.f90 2013-07-03 12:36:37.466598257 +0200 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/57785 +! +! Contributed by Kontantinos Anagnostopoulos +! +! The implicit complex conjugate was missing + +complex :: z +z = DOT_PRODUCT ((/ (1.0, 2.0), (2.0, 3.0) /), (/ (1.0, 1.0), (1.0, 4.0) /)) +end + +! { dg-final { scan-tree-dump "z = __complex__ \\(1.7e\\\+1, 4.0e\\\+0\\);" "original" } } +! { dg-final { cleanup-tree-dump "original" } }