Fortran: Diagnose all operands/arguments with constraint violations

04-Nov-2021  Sandra Loosemore <sandra@codesourcery.com>
	     Bernhard Reutner-Fischer <aldot@gcc.gnu.org>

	 PR fortran/101337

gcc/fortran/ChangeLog:
	* interface.c (gfc_compare_actual_formal): Continue checking
	all arguments after encountering an error.
	* intrinsic.c (do_ts29113_check): Likewise.
	* resolve.c (resolve_operator): Continue resolving on op2 error.

gcc/testsuite/ChangeLog:
	* gfortran.dg/bessel_3.f90: Expect additional diagnostics from
	multiple bad arguments in the call.
	* gfortran.dg/pr24823.f: Likewise.
	* gfortran.dg/pr39937.f: Likewise.
	* gfortran.dg/pr41011.f: Likewise.
	* gfortran.dg/pr61318.f90: Likewise.
	* gfortran.dg/c-interop/c407b-2.f90: Remove xfails.
	* gfortran.dg/c-interop/c535b-2.f90: Likewise.

1 files changed, 9 insertions, 8 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index f5c88d9..54d2d33 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -223,6 +223,7 @@ static bool
 do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 {
   gfc_actual_arglist *a;
+  bool ok = true;
 
   for (a = arg; a; a = a->next)
     {
@@ -238,7 +239,7 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 	  gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
 		     "permitted as argument to the intrinsic functions "
 		     "C_LOC and PRESENT", &a->expr->where);
-	  return false;
+	  ok = false;
 	}
       else if (a->expr->ts.type == BT_ASSUMED
 	       && specific->id != GFC_ISYM_LBOUND
@@ -254,32 +255,32 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 	  gfc_error ("Assumed-type argument at %L is not permitted as actual"
 		     " argument to the intrinsic %s", &a->expr->where,
 		     gfc_current_intrinsic);
-	  return false;
+	  ok = false;
 	}
       else if (a->expr->ts.type == BT_ASSUMED && a != arg)
 	{
 	  gfc_error ("Assumed-type argument at %L is only permitted as "
 		     "first actual argument to the intrinsic %s",
 		     &a->expr->where, gfc_current_intrinsic);
-	  return false;
+	  ok = false;
 	}
-      if (a->expr->rank == -1 && !specific->inquiry)
+      else if (a->expr->rank == -1 && !specific->inquiry)
 	{
 	  gfc_error ("Assumed-rank argument at %L is only permitted as actual "
 		     "argument to intrinsic inquiry functions",
 		     &a->expr->where);
-	  return false;
+	  ok = false;
 	}
-      if (a->expr->rank == -1 && arg != a)
+      else if (a->expr->rank == -1 && arg != a)
 	{
 	  gfc_error ("Assumed-rank argument at %L is only permitted as first "
 		     "actual argument to the intrinsic inquiry function %s",
 		     &a->expr->where, gfc_current_intrinsic);
-	  return false;
+	  ok = false;
 	}
     }
 
-  return true;
+  return ok;
 }