Re: [PATCH] PR fortran/42546 -- ALLOCATED has 2 mutually exclusive keywords

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

Ping.

On Thu, Aug 01, 2019 at 02:11:39PM -0700, Steve Kargl wrote:
> The attached patch fixed the issues raised in the
> PR fortran/42546.  Namely, ALLOCATED has two possible
> keywords: ALLOCATE(ARRAY=...) or ALLOCATED(SCALAR=...)
> 
> In Tobias' original patch (attached to the PR), he 
> tried to make both ARRAY and SCALAR options, then 
> in gfc_check_allocated() appropriate checking was
> added.  I started down that road, but intrinsic.c(
> sort_actual) got in the way.  Fortunately, the 
> checking for ARRAY or SCALAR can be special-cased
> in sort_actual.  See the patch.
> 
> Regression tested on x86_64-*-freebsd.  OK to commit?
> 
> 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.
> 
> -- 
> Steve

> Index: gcc/fortran/check.c
> ===================================================================
> --- gcc/fortran/check.c	(revision 273950)
> +++ gcc/fortran/check.c	(working copy)
> @@ -1168,6 +1168,10 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim)
>  }
>  
>  
> +/* Limited checking for ALLOCATED intrinsic.  Additional checking
> +   is performed in intrinsic.c(sort_actual), because ALLOCATED
> +   has two mutually exclusive non-optional arguments.  */
> +
>  bool
>  gfc_check_allocated (gfc_expr *array)
>  {
> Index: gcc/fortran/intrinsic.c
> ===================================================================
> --- gcc/fortran/intrinsic.c	(revision 273950)
> +++ gcc/fortran/intrinsic.c	(working copy)
> @@ -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;
>  
> Index: gcc/testsuite/gfortran.dg/allocated_1.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/allocated_1.f90	(nonexistent)
> +++ gcc/testsuite/gfortran.dg/allocated_1.f90	(working copy)
> @@ -0,0 +1,24 @@
> +! { dg-do run }
> +program foo
> +
> +   implicit none
> +
> +   integer, allocatable :: x
> +   integer, allocatable :: a(:)
> +
> +   logical a1, a2
> +
> +   a1 = allocated(scalar=x)
> +   if (a1 .neqv. .false.) stop 1
> +   a2 = allocated(array=a)
> +   if (a2 .neqv. .false.) stop 2
> +
> +   allocate(x)
> +   allocate(a(2))
> +
> +   a1 = allocated(scalar=x)
> +   if (a1 .neqv. .true.) stop 3
> +   a2 = allocated(array=a)
> +   if (a2 .neqv. .true.) stop 4
> +
> +end program foo
> Index: gcc/testsuite/gfortran.dg/allocated_2.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/allocated_2.f90	(nonexistent)
> +++ gcc/testsuite/gfortran.dg/allocated_2.f90	(working copy)
> @@ -0,0 +1,16 @@
> +! { dg-do compile }
> +program foo
> +
> +   implicit none
> +
> +   integer, allocatable :: x
> +   integer, allocatable :: a(:)
> +
> +   logical a1, a2
> +
> +   a1 = allocated(scalar=a)   ! { dg-error "Scalar entity required" }
> +   a2 = allocated(array=x)    ! { dg-error "Array entity required" }
> +   a1 = allocated(scalar=x, array=a)   ! { dg-error "Too many arguments" }
> +   a1 = allocated(array=a, scalar=x)   ! { dg-error "Too many arguments" }
> +
> +end program foo


-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow