[Bug fortran/54322] New: [OOP] Wrong TARGET-attribute handling with CLASS IS/TYPE IS

[Bug fortran/54322] New: [OOP] Wrong TARGET-attribute handling with CLASS IS/TYPE IS

[burnus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54322

             Bug #: 54322
           Summary: [OOP] Wrong TARGET-attribute handling with CLASS
                    IS/TYPE IS
    Classification: Unclassified
           Product: gcc
           Version: 4.8.0
            Status: UNCONFIRMED
          Keywords: accepts-invalid, diagnostic
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: burnus@gcc.gnu.org
                CC: janus@gcc.gnu.org


Reported at comp.lang.fortran,
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.fortran/11t7gAgUGD4 


The following piece of the program is invalid if PC_ALLOC is not a TARGET,
however, gfortran accepts it:

   select type ( AN => pc_alloc )
      type is ( POINT_3D )
         p3d_poi=>AN


Note that this possibly not only affects pointer assignment but also passing as
actual argument to an INTENT(IN) pointer dummy, and possibly other cases.


!------------- LONG TEST CASE ---------------

module mymod

type POINT
   real :: X, Y

   contains
      procedure :: s1 => sub1

end type POINT

type, extends(POINT) :: POINT_3D
   real :: Z
end type POINT_3D

type, extends(POINT) :: COLOR_POINT
   integer :: COLOR
end type COLOR_POINT


contains

subroutine sub1(this)
   class(POINT) :: this
end subroutine sub1

end module mymod


!================================================
program hello

   use mymod
   implicit none

   type(POINT), target :: P
   type(POINT_3D), target :: P3D
   type(COLOR_POINT), target :: CP
   class(POINT), pointer :: P_OR_CP

   class(POINT),allocatable::pc_alloc  !NO "TARGET"
   class(POINT_3D),pointer ::p3d_poi


   P_OR_CP=> CP
   allocate (POINT_3D :: pc_alloc)

   pc_alloc%X=1.
   pc_alloc%Y=2.

   select type ( AN => pc_alloc )
      class is ( POINT )
!      print *, AN%X, AN%Y

      type is ( POINT_3D )
         AN%Z=3.
         p3d_poi=>AN  ! INVALID if PC_ALLOC is not a TARGET
   end select

   print *, p3d_poi%X, p3d_poi%Y, p3d_poi%Z
end program

[Bug fortran/54322] [OOP] Wrong TARGET-attribute handling with CLASS IS/TYPE IS

[dominiq at lps dot ens.fr]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=54322

Dominique d'Humieres <dominiq at lps dot ens.fr> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2015-10-13
     Ever confirmed|0                           |1

--- Comment #1 from Dominique d'Humieres <dominiq at lps dot ens.fr> ---
Still present at r228753.

[Bug fortran/54322] [OOP] Wrong TARGET-attribute handling with CLASS IS/TYPE IS

[burnus at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=54322

Tobias Burnus <burnus at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Keywords|                            |rejects-valid

--- Comment #2 from Tobias Burnus <burnus at gcc dot gnu.org> ---
The problem is:
   copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)

which has:

  if (selector->ts.type == BT_CLASS)
    { 
      /* The correct class container has to be available.  */
      assoc_sym->ts.type = BT_CLASS;
      assoc_sym->ts.u.derived = CLASS_DATA (selector)
        ? CLASS_DATA (selector)->ts.u.derived : selector->ts.u.derived;
      assoc_sym->attr.pointer = 1;
      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr,
&assoc_sym->as);
    }

The latter sets pointer = 1 – such that 'AN' wrongly has the pointer attribute
but it does not have the allocate attribute.

Thus, also:

   select type ( AN => pc_alloc )
      class is ( POINT )
        if (.not. allocated (an)) error stop

fails.