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

Steve Kargl sgk@troutmask.apl.washington.edu
Tue Aug 6 19:38:00 GMT 2019


It looks like a backwards compatibility issue.
F95, 13.14.9 ALLOCATED (ARRAY).
F2003, 13.7.9 ALLOCATED (ARRAY) or ALLOCATED (SCALAR)

Thanks for the quick peek.

-- 
steve

On Tue, Aug 06, 2019 at 08:20:28PM +0100, Paul Richard Thomas wrote:
> 
> Who thought of that one in the standard? Uuugh!
> 
> The solution looks good to commit - again as far back as you feel
> inclined to do.
> 
> Regards
> 
> Paul
> 
> On Tue, 6 Aug 2019 at 19:27, Steve Kargl
> <sgk@troutmask.apl.washington.edu> wrote:
> >
> > 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
> 
> 
> 
> -- 
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein

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



More information about the Gcc-patches mailing list