diff options
| author | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-12-12 13:22:55 +0000 |
|---|---|---|
| committer | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-12-12 13:22:55 +0000 |
| commit | de97c566b69124551dbc19a97c5357156eca4949 (patch) | |
| tree | 6233022947a448d11526ea2c684fa00b7374445f /gcc/fortran/check.c | |
| parent | 957fb0fc90e9cec509798c8858f4a86b86213ee2 (diff) | |
| download | gcc-de97c566b69124551dbc19a97c5357156eca4949.tar.gz | |
gcc/fortran:
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+ssh://gcc.gnu.org/svn/gcc/trunk@142709 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 13 |
1 files changed, 11 insertions, 2 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index de507676491..8ca67f2c495 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -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: |