re PR fortran/42546 (ALLOCATED statement typo in the docs and for scalar variables)

2019-08-01  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/42546
	* check.c(gfc_check_allocated): Add comment pointing to ...
	* intrinsic.c(sort_actual): ... the checking done here.
 
2019-08-01  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/42546
	* gfortran.dg/allocated_1.f90: New test.
	* gfortran.dg/allocated_2.f90: Ditto.

From-SVN: r274147

1 files changed, 35 insertions, 0 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index c21fbdd..d0f7c10 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4180,6 +4180,40 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
   if (f == NULL && a == NULL)	/* No arguments */
     return true;
 
+  /* ALLOCATED has two mutually exclusive keywords, but only one
+     can be present at time and neither is optional. */
+  if (strcmp (name, "allocated") == 0 && a->name)
+    {
+      if (strcmp (a->name, "scalar") == 0)
+	{
+          if (a->next)
+	    goto whoops;
+	  if (a->expr->rank != 0)
+	    {
+	      gfc_error ("Scalar entity required at %L", &a->expr->where);
+	      return false;
+	    }
+          return true;
+	}
+      else if (strcmp (a->name, "array") == 0)
+	{
+          if (a->next)
+	    goto whoops;
+	  if (a->expr->rank == 0)
+	    {
+	      gfc_error ("Array entity required at %L", &a->expr->where);
+	      return false;
+	    }
+          return true;
+	}
+      else
+	{
+	  gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
+		     a->name, name, &a->expr->where);
+	  return false;
+	}
+    }
+
   for (;;)
     {		/* Put the nonkeyword arguments in a 1:1 correspondence */
       if (f == NULL)
@@ -4199,6 +4233,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
   if (a == NULL)
     goto do_sort;
 
+whoops:
   gfc_error ("Too many arguments in call to %qs at %L", name, where);
   return false;