On Tue, Aug 25, 2020 at 12:50:46PM +0200, Tobias Burnus wrote:
> OK for mainline?

Generally, you know Fortran FE much more than I do, so just a few random
comments.

> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -355,6 +355,51 @@ gfc_has_alloc_comps (tree type, tree decl)
>    return false;
>  }
>  
> +/* Return true if TYPE is polymorphic but not with pointer attribute.  */
> +
> +static bool
> +gfc_is_polymorphic_nonptr (tree type)
> +{
> +  if (POINTER_TYPE_P (type))
> +    type = TREE_TYPE (type);
> +  if (TREE_CODE (type) != RECORD_TYPE)
> +    return false;
> +
> +  tree field = TYPE_FIELDS (type);
> +  if (!field || 0 != strcmp ("_data", IDENTIFIER_POINTER (DECL_NAME 
> (field))))
> +    return false;
> +  field = DECL_CHAIN (field);
> +  if (!field || 0 != strcmp ("_vptr", IDENTIFIER_POINTER (DECL_NAME 
> (field))))

Is it safe to just look at the field names?  Shouldn't it at least also
test that the fields are DECL_ARTIFICIAL, or somehow else ensure that it
isn't a user derived type with _data and _vptr fields in it.

  type foo
    integer :: _data
    integer :: _vptr
    integer :: _len
  end type
  type(foo) :: a
  a%_data = 1
  a%_vptr = 2
  a%_len = 3
end
compiles just fine with -fallow-leading-underscore ...

> @@ -740,6 +785,87 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree 
> src)
>    gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
>             || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
>  
> +  /* TODO: implement support for polymorphic arrays; reject for now.  */
> +  /* Void arrays appear as var.0 = var._data.data. A bit hackish to
> +     distinguish from 'type(c_ptr) :: var(5)' by scanning for '.';
> +     this assumes that ASM_FORMAT_PRIVATE_NAME uses a '.', which most
> +     systems do. */
> +  if (TREE_CODE (type) == ARRAY_TYPE
> +      && TREE_TYPE (type) == pvoid_type_node
> +      && TREE_CODE (dest) == MEM_REF
> +      && strchr (IDENTIFIER_POINTER (DECL_NAME (TREE_OPERAND (dest, 0))), 
> '.'))

This seems very fragile, there are targets that use $ instead, other targets
use only underscores.
$ grep NO_DOT_IN_LABEL config/* config/*/* 2>/dev/null
config/vx-common.h:# define NO_DOT_IN_LABEL
config/mmix/mmix.h:#define NO_DOT_IN_LABEL
config/nvptx/nvptx.h:#define NO_DOT_IN_LABEL
config/xtensa/elf.h:#define NO_DOT_IN_LABEL
$ grep -w NO_DOLLAR_IN_LABEL config/* config/*/* 2>/dev/null
config/dragonfly.h:#undef NO_DOLLAR_IN_LABEL
config/elfos.h:#define NO_DOLLAR_IN_LABEL
config/freebsd.h:#undef NO_DOLLAR_IN_LABEL
config/vx-common.h:# undef NO_DOLLAR_IN_LABEL
config/alpha/alpha.h:#undef NO_DOLLAR_IN_LABEL
config/arm/aout.h:#ifndef NO_DOLLAR_IN_LABEL
config/arm/aout.h:#define NO_DOLLAR_IN_LABEL 1
config/mips/n32-elf.h:#define NO_DOLLAR_IN_LABEL
config/mmix/mmix.h:#define NO_DOLLAR_IN_LABEL
config/rs6000/rs6000.c:#ifdef NO_DOLLAR_IN_LABEL
config/rs6000/rs6000-protos.h:#ifdef NO_DOLLAR_IN_LABEL
config/rs6000/xcoff.h:#define NO_DOLLAR_IN_LABEL
config/tilegx/tilegx.h:#undef NO_DOLLAR_IN_LABEL
config/tilepro/tilepro.h:#undef NO_DOLLAR_IN_LABEL
config/xtensa/elf.h:#undef NO_DOLLAR_IN_LABEL

Couldn't it be recorded somewhere in DECL_LANG_SPECIFIC of the decl?

> +    fatal_error (input_location,
> +              "Sorry, polymorphic arrays not yet supported for "
> +              "firstprivate");

Shouldn't this be sorry ("...") instead?

> +      /* var._data - _data is void* for scalars and descriptor for arrays.  
> */
> +      if (TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == RECORD_TYPE)
> +     fatal_error (input_location,
> +                  "Sorry, polymorphic arrays not yet supported for "
> +                  "firstprivate");

Likewise.

> +      /* Malloc memory + call class->_vpt->_copy.  */
> +      call = builtin_decl_explicit (BUILT_IN_MALLOC);

Is malloc what the FE uses elsewhere for it?  Will something free it
afterwards?

> +      if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
> +     {
> +       gfc_add_block_to_block (&block, &cond_block);
> +     }

Formatting, one stmt shouldn't be wrapped into {}s.

        Jakub

Reply via email to