This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [patch, fortran] PR36355: fix argument type checking for matmul


2008/5/28, Tobias Burnus <burnus@net-b.de>:
> a) a=[logical/numeric], b = invalid(e.g. character)
> b) a = invalid(e.g. character), b=[logical/numeric]
> c) a=logical, b = numerical
> d) a=numerical, b = logical.
>
> Test program, which should be rejected:
>
>   integer :: a(4,4)
>   logical :: b(4,4)
>   print *, matmul(a,b)
>   end

matmul.f90:12.19:

   print *, matmul(a,b)
                  1
Error: Argument types of 'matmul' intrinsic at (1) must match
(INTEGER(4)/LOGICAL(4))

Updated patch attached, not regression tested yet.
Index: check.c
===================================================================
--- check.c	(revision 136058)
+++ check.c	(working copy)
@@ -1761,7 +1761,7 @@ gfc_check_malloc (gfc_expr *size)
 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],
@@ -1769,7 +1769,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
       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],
@@ -1777,6 +1777,14 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
       return FAILURE;
     }
 
+  if (matrix_a->ts.type != matrix_b->ts.type)
+    {
+      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 Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]