public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gmx.de>
To: Paul Richard Thomas <paul.richard.thomas@gmail.com>,
	"fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
	gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression
Date: Sat, 24 Jun 2023 21:50:53 +0200	[thread overview]
Message-ID: <d343bfea-b284-664f-6cbf-e6a4cb870802@gmx.de> (raw)
In-Reply-To: <CAGkQGiKPvpOMQSbx5tm9UGVvyGuDoEcQAR7WJMo7iQiYh9pL+A@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 3165 bytes --]

Hi Paul!

On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> extra blank line, introduced by my last patch. I played safe and went
> exclusively for class functions with attr.class_pointer set on the
> grounds that these have had all the accoutrements checked and built
> (ie. class_ok). I am still not sure if this is necessary or not.

maybe it is my fault, but I find the version in the patch confusing:

@@ -816,7 +816,7 @@ bool
  gfc_is_ptr_fcn (gfc_expr *e)
  {
    return e != NULL && e->expr_type == EXPR_FUNCTION
-             && (gfc_expr_attr (e).pointer
+             && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
                   || (e->ts.type == BT_CLASS
                       && CLASS_DATA (e)->attr.class_pointer));
  }

The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
gfc_expr_attr (e) boils down to:

       if (e->value.function.esym && e->value.function.esym->result)
	{
	  gfc_symbol *sym = e->value.function.esym->result;
	  attr = sym->attr;
	  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
	    {
	      attr.dimension = CLASS_DATA (sym)->attr.dimension;
	      attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
	    }
	}
...
       else if (e->symtree)
	attr = gfc_variable_attr (e, NULL);

So I thought this should already do what you want if you do

gfc_is_ptr_fcn (gfc_expr *e)
{
   return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr
(e).pointer;
}

or what am I missing?  The additional checks in gfc_expr_attr are
there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
know Gerhard who showed that he is an expert in exploiting this.

To sum up, I'd prefer to use the safer form if it works.  If it
doesn't, I would expect a latent issue.

The rest of the code looked good to me, but I was suspicious about
the handling of CHARACTER.

Nasty as I am, I modified the testcase to use character(kind=4)
instead of kind=1 (see attached).  This either fails here (stop 10),
or if I activate the marked line

!    cont = tContainer('hello!')       ! ### ICE! ###

I get an ICE.

Can you have another look?

Thanks,
Harald

>

> OK for trunk?
>
> Paul
>
> Fortran: Enable class expressions in structure constructors [PR49213]
>
> 2023-06-24  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/49213
> * expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
> class expressions.
> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> associate names with pointer function targets to be used in
> variable definition context.
> * trans-decl.cc (get_symbol_decl): Remove extraneous line.
> * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> size of intrinsic and character expressions.
> (gfc_trans_subcomponent_assign): Expand assignment to class
> components to include intrinsic and character expressions.
>
> gcc/testsuite/
> PR fortran/49213
> * gfortran.dg/pr49213.f90 : New test

[-- Attachment #2: pr49213-kind4.f90 --]
[-- Type: text/x-fortran, Size: 2013 bytes --]

! { dg-do run }
!
! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
!
program main
! character(2) :: c
  character(2,kind=4) :: c

  type :: S
    integer :: n
  end type
  type(S) :: Sobj

  type, extends(S) :: S2
    integer :: m
  end type
  type(S2) :: S2obj

  type :: T
    class(S), allocatable :: x
  end type
  type(T) :: Tobj

  Sobj = S(1)
  Tobj = T(Sobj)

  S2obj = S2(1,2)
  Tobj = T(S2obj)            ! Failed here
  select type (x => Tobj%x)
    type is (S2)
      if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 1
    class default
      stop 2
  end select

  c = 4_"  "
  call pass_it (T(Sobj))
  if (c .ne. 4_"S ") stop 3
  call pass_it (T(S2obj))    ! and here
  if (c .ne. 4_"S2") stop 4

  call bar

contains

  subroutine pass_it (foo)
    type(T), intent(in) :: foo
    select type (x => foo%x)
      type is (S)
        c = 4_"S "
        if (x%n .ne. 1) stop 5
      type is (S2)
        c = 4_"S2"
        if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6
      class default
        stop 7
    end select
  end subroutine

  subroutine bar
   ! Test from comment #29 of the PR - due to Janus Weil
    type tContainer
      class(*), allocatable :: x
    end type
    integer, parameter :: i = 0
    character(7,kind=4) :: chr = 4_"goodbye"
    type(tContainer) :: cont

    cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804'

    cont = tContainer(i+42) ! Failed here
    select type (z => cont%x)
      type is (integer)
        if (z .ne. 42) stop 8
      class default
        stop 9
    end select

!    cont = tContainer('hello!')       ! ### ICE! ###
    cont = tContainer(4_'hello!')
    select type (z => cont%x)
      type is (character(*,kind=4))
        if (z .ne. 4_'hello!') stop 10
      class default
        stop 11
    end select

    cont = tContainer(chr)
    select type (z => cont%x)
      type is (character(*,kind=4))
        if (z .ne. 4_'goodbye') stop 12
      class default
        stop 13
    end select

  end subroutine bar
end program

WARNING: multiple messages have this Message-ID
From: Harald Anlauf <anlauf@gmx.de>
To: gcc-patches@gcc.gnu.org
Cc: fortran@gcc.gnu.org
Subject: Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression
Date: Sat, 24 Jun 2023 21:50:53 +0200	[thread overview]
Message-ID: <d343bfea-b284-664f-6cbf-e6a4cb870802@gmx.de> (raw)
Message-ID: <20230624195053.LnZOjCleRUDMCKpP9gsBwhdnosfJfsevcAOd7GYLvFo@z> (raw)
In-Reply-To: <CAGkQGiKPvpOMQSbx5tm9UGVvyGuDoEcQAR7WJMo7iQiYh9pL+A@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 3075 bytes --]

Hi Paul!

On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> extra blank line, introduced by my last patch. I played safe and went
> exclusively for class functions with attr.class_pointer set on the
> grounds that these have had all the accoutrements checked and built
> (ie. class_ok). I am still not sure if this is necessary or not.

maybe it is my fault, but I find the version in the patch confusing:

@@ -816,7 +816,7 @@ bool
  gfc_is_ptr_fcn (gfc_expr *e)
  {
    return e != NULL && e->expr_type == EXPR_FUNCTION
-             && (gfc_expr_attr (e).pointer
+             && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
                   || (e->ts.type == BT_CLASS
                       && CLASS_DATA (e)->attr.class_pointer));
  }

The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
gfc_expr_attr (e) boils down to:

       if (e->value.function.esym && e->value.function.esym->result)
	{
	  gfc_symbol *sym = e->value.function.esym->result;
	  attr = sym->attr;
	  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
	    {
	      attr.dimension = CLASS_DATA (sym)->attr.dimension;
	      attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
	    }
	}
...
       else if (e->symtree)
	attr = gfc_variable_attr (e, NULL);

So I thought this should already do what you want if you do

gfc_is_ptr_fcn (gfc_expr *e)
{
   return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr 
(e).pointer;
}

or what am I missing?  The additional checks in gfc_expr_attr are
there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
know Gerhard who showed that he is an expert in exploiting this.

To sum up, I'd prefer to use the safer form if it works.  If it
doesn't, I would expect a latent issue.

The rest of the code looked good to me, but I was suspicious about
the handling of CHARACTER.

Nasty as I am, I modified the testcase to use character(kind=4)
instead of kind=1 (see attached).  This either fails here (stop 10),
or if I activate the marked line

!    cont = tContainer('hello!')       ! ### ICE! ###

I get an ICE.

Can you have another look?

Thanks,
Harald

>

> OK for trunk?
> 
> Paul
> 
> Fortran: Enable class expressions in structure constructors [PR49213]
> 
> 2023-06-24  Paul Thomas  <pault@gcc.gnu.org>
> 
> gcc/fortran
> PR fortran/49213
> * expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
> class expressions.
> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> associate names with pointer function targets to be used in
> variable definition context.
> * trans-decl.cc (get_symbol_decl): Remove extraneous line.
> * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> size of intrinsic and character expressions.
> (gfc_trans_subcomponent_assign): Expand assignment to class
> components to include intrinsic and character expressions.
> 
> gcc/testsuite/
> PR fortran/49213
> * gfortran.dg/pr49213.f90 : New test

[-- Attachment #2: pr49213-kind4.f90 --]
[-- Type: text/x-fortran, Size: 2013 bytes --]

! { dg-do run }
!
! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
!
program main
! character(2) :: c
  character(2,kind=4) :: c

  type :: S
    integer :: n
  end type
  type(S) :: Sobj

  type, extends(S) :: S2
    integer :: m
  end type
  type(S2) :: S2obj

  type :: T
    class(S), allocatable :: x
  end type
  type(T) :: Tobj

  Sobj = S(1)
  Tobj = T(Sobj)

  S2obj = S2(1,2)
  Tobj = T(S2obj)            ! Failed here
  select type (x => Tobj%x)
    type is (S2)
      if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 1
    class default
      stop 2
  end select

  c = 4_"  "
  call pass_it (T(Sobj))
  if (c .ne. 4_"S ") stop 3
  call pass_it (T(S2obj))    ! and here
  if (c .ne. 4_"S2") stop 4

  call bar

contains

  subroutine pass_it (foo)
    type(T), intent(in) :: foo
    select type (x => foo%x)
      type is (S)
        c = 4_"S "
        if (x%n .ne. 1) stop 5
      type is (S2)
        c = 4_"S2"
        if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6
      class default
        stop 7
    end select
  end subroutine

  subroutine bar
   ! Test from comment #29 of the PR - due to Janus Weil
    type tContainer
      class(*), allocatable :: x
    end type
    integer, parameter :: i = 0
    character(7,kind=4) :: chr = 4_"goodbye"
    type(tContainer) :: cont

    cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804'

    cont = tContainer(i+42) ! Failed here
    select type (z => cont%x)
      type is (integer)
        if (z .ne. 42) stop 8
      class default
        stop 9
    end select

!    cont = tContainer('hello!')       ! ### ICE! ###
    cont = tContainer(4_'hello!')
    select type (z => cont%x)
      type is (character(*,kind=4))
        if (z .ne. 4_'hello!') stop 10
      class default
        stop 11
    end select

    cont = tContainer(chr)
    select type (z => cont%x)
      type is (character(*,kind=4))
        if (z .ne. 4_'goodbye') stop 12
      class default
        stop 13
    end select

  end subroutine bar
end program

  reply	other threads:[~2023-06-24 19:50 UTC|newest]

Thread overview: 7+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-06-24 13:18 Paul Richard Thomas
2023-06-24 19:50 ` Harald Anlauf [this message]
2023-06-24 19:50   ` Harald Anlauf
2023-06-27 10:30   ` Paul Richard Thomas
2023-06-27 19:27     ` Harald Anlauf
2023-06-27 19:27       ` Harald Anlauf
2023-06-28  9:47       ` Paul Richard Thomas

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=d343bfea-b284-664f-6cbf-e6a4cb870802@gmx.de \
    --to=anlauf@gmx.de \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=paul.richard.thomas@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).