OSDN Git Service

2013-07-08 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 8 Jul 2013 19:12:08 +0000 (19:12 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 8 Jul 2013 19:12:08 +0000 (19:12 +0000)
        PR fortran/57785
        * simplify.c (compute_dot_product): Complex conjugate for
        dot_product.
        (gfc_simplify_dot_product, gfc_simplify_matmul): Update call.

2013-07-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57785
        * gfortran.dg/dot_product_2.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@200796 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/simplify.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/dot_product_2.f90 [new file with mode: 0644]

index f76ec6b..bb59837 100644 (file)
@@ -1,3 +1,10 @@
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57785
+       * simplify.c (compute_dot_product): Complex conjugate for
+       dot_product.
+       (gfc_simplify_dot_product, gfc_simplify_matmul): Update call.
+
 2013-06-06  Tobias Burnus  <burnus@net-b.de>
 
        Backport from mainline
index bf17673..515528d 100644 (file)
@@ -332,13 +332,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);
@@ -361,9 +363,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:
@@ -1877,7 +1881,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);
 }
 
 
@@ -3883,7 +3887,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);
 
index a0b8748..10df7f3 100644 (file)
@@ -1,3 +1,8 @@
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57785
+       * gfortran.dg/dot_product_2.f90: New.
+
 2013-07-08  Jakub Jelinek  <jakub@redhat.com>
 
        PR rtl-optimization/57829
diff --git a/gcc/testsuite/gfortran.dg/dot_product_2.f90 b/gcc/testsuite/gfortran.dg/dot_product_2.f90
new file mode 100644 (file)
index 0000000..a5fe3b0
--- /dev/null
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/57785
+!
+! Contributed by Kontantinos Anagnostopoulos
+!
+! The implicit complex conjugate was missing for DOT_PRODUCT
+
+
+! For the following, the compile-time simplification fails for SUM;
+! see PR fortran/56342. Hence, a manually expanded SUM is used.
+
+!if (DOT_PRODUCT ((/ (1.0, 2.0), (2.0, 3.0) /), (/ (1.0, 1.0), (1.0, 4.0) /))   &
+!   /= SUM (CONJG ((/ (1.0, 2.0), (2.0, 3.0) /))*(/ (1.0, 1.0), (1.0, 4.0) /))) &
+!   call abort ()
+!
+!if (ANY (MATMUL ((/ (1.0, 2.0), (2.0, 3.0) /),                                 &
+!                 RESHAPE ((/ (1.0, 1.0), (1.0, 4.0) /),(/2, 1/))) /=           &
+!         SUM ((/ (1.0, 2.0), (2.0, 3.0) /)*(/ (1.0, 1.0), (1.0, 4.0) /))))     &
+!    call abort ()      
+
+
+if (DOT_PRODUCT ((/ (1.0, 2.0), (2.0, 3.0) /), (/ (1.0, 1.0), (1.0, 4.0) /))  &
+    /= CONJG (cmplx(1.0, 2.0)) * cmplx(1.0, 1.0)                              &
+     + CONJG (cmplx(2.0, 3.0)) * cmplx(1.0, 4.0)) &
+  call abort ()
+
+if (ANY (MATMUL ((/ (1.0, 2.0), (2.0, 3.0) /),                                &
+                 RESHAPE ((/ (1.0, 1.0), (1.0, 4.0) /),(/2, 1/)))             &
+         /= cmplx(1.0, 2.0) * cmplx(1.0, 1.0)                                 &
+          + cmplx(2.0, 3.0) * cmplx(1.0, 4.0)))                               &
+  call abort ()      
+end
+
+
+! { dg-final { scan-tree-dump-not "abort" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }