A BOZ cannot be an actual argument in a subroutine or function
reference except those intrinsic function listed in the Fortran
standard. The attach patch checks for invalid BOZ. Built and
tested on x86_64-*-freebsd. OK to commit?
2019-09-30 Steven G. Kargl
PR fortran/91943
* match.c (gfc_match_call): BOZ cannot be an actual argument in
a subroutine reference.
* resolve.c (resolve_function): BOZ cannot be an actual argument in
a function reference.
2019-09-30 Steven G. Kargl
PR fortran/91943
gfortran.dg/pr91943.f90
--
Steve
Index: gcc/fortran/match.c
===
--- gcc/fortran/match.c (revision 276271)
+++ gcc/fortran/match.c (working copy)
@@ -4984,6 +4984,16 @@ gfc_match_call (void)
goto syntax;
}
+ /* Walk the argument list looking for invalid BOZ. */
+ for (a = arglist; a; a = a->next)
+if (a->expr && a->expr->ts.type == BT_BOZ)
+ {
+ gfc_error ("A BOZ literal constant at %L cannot appear as an actual "
+ "argument in a subroutine reference", &a->expr->where);
+ goto cleanup;
+ }
+
+
/* If any alternate return labels were found, construct a SELECT
statement that will jump to the right place. */
Index: gcc/fortran/resolve.c
===
--- gcc/fortran/resolve.c (revision 276271)
+++ gcc/fortran/resolve.c (working copy)
@@ -3242,6 +3242,21 @@ resolve_function (gfc_expr *expr)
if (expr->expr_type != EXPR_FUNCTION)
return t;
+ /* Walk the argument list looking for invalid BOZ. */
+ if (expr->value.function.esym)
+{
+ gfc_actual_arglist *a;
+
+ for (a = expr->value.function.actual; a; a = a->next)
+ if (a->expr && a->expr->ts.type == BT_BOZ)
+ {
+ gfc_error ("A BOZ literal constant at %L cannot appear as an "
+ "actual argument in a function reference",
+ &a->expr->where);
+ return false;
+ }
+}
+
temp = need_full_assumed_size;
need_full_assumed_size = 0;
Index: gcc/testsuite/gfortran.dg/pr91943.f90
===
--- gcc/testsuite/gfortran.dg/pr91943.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91943.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/91943
+! Code contributed by Gerhard Steinmetz
+program p
+ print *, f(b'1001') ! { dg-error "cannot appear as an actual argument" }
+ call sub(b'1001')! { dg-error "cannot appear as an actual argument" }
+end