gcc/fortran:
authordfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 12 Dec 2008 13:22:55 +0000 (13:22 +0000)
committerdfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 12 Dec 2008 13:22:55 +0000 (13:22 +0000)
2008-12-12  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/36355
        * check.c (gfc_check_matmul): Fixed error message for invalid
        types to correctly identify the offending argument, added check
        for mismatching types.

gcc/testsuite:
2008-12-12 Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/36355
        * gfortran.dg/matmul_argument_types.f90: New.

git-svn-id: svn://gcc.gnu.org/svn/gcc/trunk@142709 138bc75d-0d04-0410-961f-82ee72b054a4

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

index 7fa2cf4..db1fe42 100644 (file)
@@ -1,3 +1,10 @@
+2008-12-12  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/36355
+       * check.c (gfc_check_matmul): Fixed error message for invalid
+       types to correctly identify the offending argument, added check
+       for mismatching types.
+
 2008-12-11  Richard Guenther  <rguenther@suse.de>
 
        * Make-lang.in (install-finclude-dir): Use correct mode argument
index de50767..8ca67f2 100644 (file)
@@ -1794,7 +1794,7 @@ gfc_check_malloc (gfc_expr *size)
 gfc_try
 gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 {
-  if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
+  if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
                 "or LOGICAL", gfc_current_intrinsic_arg[0],
@@ -1802,7 +1802,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
       return FAILURE;
     }
 
-  if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
+  if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
                 "or LOGICAL", gfc_current_intrinsic_arg[1],
@@ -1810,6 +1810,15 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
       return FAILURE;
     }
 
+  if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
+      || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
+    {
+      gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)",
+                gfc_current_intrinsic, &matrix_a->where,
+                gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts));
+       return FAILURE;
+    }
+
   switch (matrix_a->rank)
     {
     case 1:
index 0a8d28d..a3c9d7c 100644 (file)
@@ -1,3 +1,8 @@
+2008-12-12 Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/36355
+       * gfortran.dg/matmul_argument_types.f90: New.
+
 2008-12-11  Janis Johnson  <janis187@us.ibm.com>
 
        PR testsuite/29071
diff --git a/gcc/testsuite/gfortran.dg/matmul_argument_types.f90 b/gcc/testsuite/gfortran.dg/matmul_argument_types.f90
new file mode 100644 (file)
index 0000000..1480655
--- /dev/null
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/36355
+! Check MATMUL argument types:
+!
+!           numeric   logical   other
+! numeric      1         2        3
+! logical      2         1        3
+! other        3         3        3
+!
+! where
+!   1    ok
+!   2    argument type mismatch
+!   3    invalid argument types
+!
+
+  INTEGER :: a(2,2)
+  LOGICAL :: b(2,2)
+  CHARACTER :: c
+
+  a = MATMUL(a, a)            ! ok
+  a = MATMUL(a, b)            ! { dg-error "must match" }
+  a = MATMUL(a, c)            ! { dg-error "must be numeric or LOGICAL" }
+
+  b = MATMUL(b, a)            ! { dg-error "must match" }
+  b = MATMUL(b, b)            ! ok
+  b = MATMUL(b, c)            ! { dg-error "must be numeric or LOGICAL" }
+
+  c = MATMUL(c, a)            ! { dg-error "must be numeric or LOGICAL" }
+  c = MATMUL(c, b)            ! { dg-error "must be numeric or LOGICAL" }
+  c = MATMUL(c, c)            ! { dg-error "must be numeric or LOGICAL" }
+END