The attached patch has been tested on x86_64-*-freebsd.
OK to commit?
The patch adds additional check for the ARRAY and VALUE
arguments. First, ARRAY and VALUE need to be type
conformant, but gfortran did not check for the CHARACTER
type nor for numeric types. Second, ARRAY must be an
intrinsic type, which implies that VALUE must also be
an intrinsic type.
2019-10-10 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91649
check.c (gfc_check_findloc): Additional checking for valid arguments
2019-10-10 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91649
* gfortran.dg/pr91649.f90
--
Steve
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 276837)
+++ gcc/fortran/check.c (working copy)
@@ -3879,26 +3921,27 @@ bool
gfc_check_findloc (gfc_actual_arglist *ap)
{
gfc_expr *a, *v, *m, *d, *k, *b;
+ bool a1, v1;
a = ap->expr;
if (!intrinsic_type_check (a, 0) || !array_check (a, 0))
return false;
v = ap->next->expr;
- if (!scalar_check (v,1))
+ if (!intrinsic_type_check (v, 1) || !scalar_check (v,1))
return false;
- /* Check if the type is compatible. */
+ /* Check if the type are both logical. */
+ a1 = a->ts.type == BT_LOGICAL;
+ v1 = v->ts.type == BT_LOGICAL;
+ if ((a1 && !v1) || (!a1 && v1))
+ goto incompat;
- if ((a->ts.type == BT_LOGICAL && v->ts.type != BT_LOGICAL)
- || (a->ts.type != BT_LOGICAL && v->ts.type == BT_LOGICAL))
- {
- gfc_error ("Argument %qs of %qs intrinsic at %L must be in type "
- "conformance to argument %qs at %L",
- gfc_current_intrinsic_arg[0]->name,
- gfc_current_intrinsic, &a->where,
- gfc_current_intrinsic_arg[1]->name, &v->where);
- }
+ /* Check if the type are both character. */
+ a1 = a->ts.type == BT_CHARACTER;
+ v1 = v->ts.type == BT_CHARACTER;
+ if ((a1 && !v1) || (!a1 && v1))
+ goto incompat;
d = ap->next->next->expr;
m = ap->next->next->next->expr;
@@ -3946,6 +3989,14 @@ gfc_check_findloc (gfc_actual_arglist *ap)
return false;
return true;
+
+incompat:
+ gfc_error ("Argument %qs of %qs intrinsic at %L must be in type "
+ "conformance to argument %qs at %L",
+ gfc_current_intrinsic_arg[0]->name,
+ gfc_current_intrinsic, &a->where,
+ gfc_current_intrinsic_arg[1]->name, &v->where);
+ return false;
}
Index: gcc/testsuite/gfortran.dg/pr91649.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr91649.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91649.f90 (working copy)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! PR fortran/91649
+! Code originally contributed by Gerhard Steinmetz
+subroutine p
+ logical :: back = .true.
+ integer :: x(1) = findloc([1, 2, 1], '1', back=back) ! { dg-error "must be in type conformance" }
+ print *, x
+end
+
+subroutine q
+ type t
+ end type
+ logical :: back = .false.
+ integer :: x(1) = findloc([1, 2, 1], t(), back=back) ! { dg-error "must be of intrinsic type" }
+ print *, x
+end
+
+subroutine s
+ character(4) :: c = '1234'
+ integer :: x(1) = findloc([1, 2, 1], c, back=.true.) ! { dg-error "must be in type conformance" }
+ print *, x
+end
+
