Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin <mikael dot morin at sfr dot fr>]

Hello,

On Tuesday 02 August 2011 18:08:05 Tobias Burnus wrote:
> This patch fixes two issues:
> 
> a) LOCK(coarray%lock_type_comp) is also a coarray.
> 
> b) The following constraint was incompletely checked for: C1302. For
> reference, I also list C1303/C1304.

[...]

> 
> PS: It somehow took me quite some time to understand "subcomponent" even
> though the standard is rather clear about it. 
Is it? It seems I haven't understood the constraint as you did.
And by the way, are there cases of direct components that are not 
subcomponents? I find it hard to distinguish them.

> For reference:
> 
> "1.3.33.3 subcomponent -- <structure> direct component that is a
> subobject of the structure (6.4.2)
> 
> "1.3.33.1 direct component -- one of the components, or one of the
> direct components of a nonpointer nonallocatable component (4.5.1)"
> 
and:
> C1302 A named variable of type LOCK TYPE shall be a coarray. A named
> variable with a noncoarray subcomponent of type LOCK TYPE shall be a
> coarray.
> 
So basically, one looks at the components of a structure, and the components 
of all the non-allocatable non-pointer derived type components (and so on 
recursively...).
Among those components, if one has type LOCK_TYPE and is not a coarray, then 
the enclosing variable shall be a coarray (which seems to mean that all 
variables of this type have to be a coarray).
Though variables in the general case can be components, I don't think it is 
the case here as only named variables are involved here.
Does that sound right?
Then, ...

> lock-check.diff
>   2011-08-02  Tobias Burnus  <burnus@net-b.de>
> 
>         PR fortran/18918
>         * parse.c (parse_derived): Add lock_type
>         checks, improve coarray_comp handling.
>         * resolve.c (resolve_allocate_expr,
>         resolve_lock_unlock, resolve_symbol): Fix lock_type
>         constraint checks.
> 
> 2011-08-02  Tobias Burnus  <burnus@net-b.de>
> 
>         PR fortran/18918
>         * gfortran.dg/coarray_lock_1.f90: Update dg-error.
>         * gfortran.dg/coarray_lock_3.f90: Fix test.
>         * gfortran.dg/coarray_lock_4.f90: New.
>         * gfortran.dg/coarray_lock_5.f90: New.
>         * gfortran.dg/coarray_lock_6.f90: New.
> 
> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index ba28648..6fca032 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -2010,7 +2010,7 @@ parse_derived (void)
>    gfc_statement st;
>    gfc_state_data s;
>    gfc_symbol *sym;
> -  gfc_component *c;
> +  gfc_component *c, *lock_comp = NULL;
>  
>    accept_statement (ST_DERIVED_DECL);
>    push_state (&s, COMP_DERIVED, gfc_new_block);
> @@ -2118,19 +2118,28 @@ endType:
>    sym = gfc_current_block ();
>    for (c = sym->components; c; c = c->next)
>      {
> +      bool coarray, lock_type, allocatable, pointer;
> +      coarray = lock_type = allocatable = pointer = false;
> +
>        /* Look for allocatable components.  */
>        if (c->attr.allocatable
>           || (c->ts.type == BT_CLASS && c->attr.class_ok
>               && CLASS_DATA (c)->attr.allocatable)
>           || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
> -       sym->attr.alloc_comp = 1;
> +       {
> +         allocatable = true;
> +         sym->attr.alloc_comp = 1;
> +       }
>  
>        /* Look for pointer components.  */
>        if (c->attr.pointer
>           || (c->ts.type == BT_CLASS && c->attr.class_ok
>               && CLASS_DATA (c)->attr.class_pointer)
>           || (c->ts.type == BT_DERIVED && c->ts.u.derived-
>attr.pointer_comp))
> -       sym->attr.pointer_comp = 1;
> +       {
> +         pointer = true;
> +         sym->attr.pointer_comp = 1;
> +       }
>  
>        /* Look for procedure pointer components.  */
>        if (c->attr.proc_pointer
> @@ -2140,15 +2149,62 @@ endType:
>  
>        /* Looking for coarray components.  */
>        if (c->attr.codimension
> -         || (c->attr.coarray_comp && !c->attr.pointer && !c-
>attr.allocatable))
> -       sym->attr.coarray_comp = 1;
> +         || (c->ts.type == BT_CLASS && c->attr.class_ok
> +             && CLASS_DATA (c)->attr.codimension))
> +       {
> +         coarray = true;
> +         sym->attr.coarray_comp = 1;
> +       }
> +     
> +      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.codimension)
> +       {
> +         coarray = true;
> +         if (!pointer && !allocatable)
> +           sym->attr.coarray_comp = 1;
> +       }
>  
>        /* Looking for lock_type components.  */
> -      if (c->attr.lock_comp
> -         || (sym->ts.type == BT_DERIVED
> +      if ((c->ts.type == BT_DERIVED
>               && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
> -             && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE))
> -       sym->attr.lock_comp = 1;
> +             && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
> +         || (c->ts.type == BT_CLASS && c->attr.class_ok
> +             && CLASS_DATA (c)->ts.u.derived->from_intmod
> +                == INTMOD_ISO_FORTRAN_ENV
> +             && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
> +                == ISOFORTRAN_LOCK_TYPE))
> +       {
> +         if (pointer)
> +           gfc_error ("Pointer component %s at %L of LOCK_TYPE must be a "
> +                      "coarray", c->name, &c->loc);
... this is wrong as the constraint should be on the variable, not on the 
components of its type.

> +         lock_type = 1;
> +         lock_comp = c;
> +         sym->attr.lock_comp = 1;
> +       }
> +
> +      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
> +         && !allocatable && !pointer)
> +       {
> +         lock_type = 1;
> +         lock_comp = c;
> +         sym->attr.lock_comp = 1;
> +       }
> +
> +      /* F2008, C1302.  */
> +
> +      if (lock_type && allocatable && !coarray)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE "
> +                  "component is allocatable but not a coarray",
> +                  c->name, &c->loc);
> +
> +      if (sym->attr.coarray_comp && !coarray && lock_type)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE is not 
a "
> +                  "coarray, but other coarray components exist", c->name,
> +                  &c->loc);
> +
> +      if (sym->attr.lock_comp && coarray && !lock_type)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE has to 
"
> +                  "be a coarray as %s at %L has a codimension",
> +                  lock_comp->name, &lock_comp->loc, c->name, &c->loc); 
Same here (the three of them) the constraint is not on components.

About the wording, I think it should be `[...] of type LOCK_TYPE or with a 
subcomponent of type LOCK_TYPE...', that is drop neither the "a subcomponent" 
after "with" nor the "type" before "LOCK_TYPE" (even if the latter sounds 
odd).
Maybe it can be (slightly) simplified to `[...] of type or with a subcomponent 
of type LOCK_TYPE...'?


Random comments on the rest of the patch below:
>  
>        /* Look for private components.  */
>        if (sym->component_access == ACCESS_PRIVATE
> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
> index b4d66cc..fcd6583 100644
> --- a/gcc/fortran/resolve.c
> +++ b/gcc/fortran/resolve.c
> @@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
>  
>        /* Check F2008, C642.  */
>        if (code->expr3->ts.type == BT_DERIVED
> -         && ((codimension &&  gfc_expr_attr (code->expr3).lock_comp)
> +         && ((codimension && gfc_expr_attr (code->expr3).lock_comp)
>               || (code->expr3->ts.u.derived->from_intmod
>                      == INTMOD_ISO_FORTRAN_ENV
>                   && code->expr3->ts.u.derived->intmod_sym_id
> @@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
>        || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
>        || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
>        || code->expr1->rank != 0
> -      || !(gfc_expr_attr (code->expr1).codimension
> -          || gfc_is_coindexed (code->expr1)))
> -    gfc_error ("Lock variable at %L must be a scalar coarray of type "
> -              "LOCK_TYPE", &code->expr1->where);
> +      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code-
>expr1)))
> +    gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
> +              &code->expr1->where);
>  
>    /* Check STAT.  */
>    if (code->expr2
This part is quite OK.
I have the feeling that !gfc_is_coindexed is superfluous once one has 
!gfc_is_coarray.
I'm also not sure that the removal of `coarray' in the error message is 
needed as C1302 forces LOCK_TYPE entities to be coarrays or subobjects of 
coarrays.


> @@ -12403,12 +12402,13 @@ resolve_symbol (gfc_symbol *sym)
>  
>    /* F2008, C1302.  */
>    if (sym->ts.type == BT_DERIVED
> -      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
> -      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
> -      && !sym->attr.codimension)
> +      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
> +          && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
> +         || sym->ts.u.derived->attr.lock_comp)
> +      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
>      {
> -      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
> -                sym->name, &sym->declared_at);
> +      gfc_error ("Variable %s at %L of LOCK_TYPE or with LOCK_TYPE 
component "
> +                "must be a coarray", sym->name, &sym->declared_at);
>        return;
>      }
>  
Looks like it's not sufficient.
One can have a non-coarray LOCK_TYPE component and an other component that is 
a coarray.
Then the error won't trigger as attr.coarray_comp is set by the other 
component.


[...]
> --- /dev/null   2011-08-02 08:54:55.563886097 +0200
> +++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90    2011-07-29 
01:00:14.000000000 +0200
> @@ -0,0 +1,7 @@
> +! { dg-do compile }
> +! { dg-options "-fcoarray=single" }
> +!
> +!
> +! LOCK/LOCK_TYPE checks 
> +!
> +

This one was passing already, wasn't it? ;-)


Mikael