Bug 89374 - gfortran does not respect privacy of types
Summary: gfortran does not respect privacy of types
Status: WAITING
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 9.0
: P3 normal
Target Milestone: ---
Assignee: Not yet assigned to anyone
URL:
Keywords: accepts-invalid
Depends on:
Blocks:
 
Reported: 2019-02-16 08:30 UTC by Jürgen Reuter
Modified: 2019-02-16 08:44 UTC (History)
0 users

See Also:
Host:
Target:
Build:
Known to work:
Known to fail: 5.4.0, 9.0
Last reconfirmed: 2019-02-16 00:00:00


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Jürgen Reuter 2019-02-16 08:30:47 UTC
The following example is from the Intel Forum, cf. 
https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/583935
The NAG compiler and now also the Intel compiler report:
Error: abstract.f90, line 69: Cannot extend abstract type ABSTRACT_BUGGY because it has a private deferred type-bound procedure BUGGY_MULTIPLY_SCALAR
       detected at ::@BUGGY
Error: abstract.f90, line 69: Cannot extend abstract type ABSTRACT_BUGGY because it has a private deferred type-bound procedure SCALAR_MULTIPLY_BUGGY
       detected at ::@BUGGY
Error: abstract.f90, line 69: Cannot extend abstract type ABSTRACT_BUGGY because it has a private deferred type-bound procedure BUGGY_ASSIGN_BUGGY
       detected at ::@BUGGY
[NAG Fortran Compiler pass 1 error termination, 3 errors]
If I  undestand this correctly, the abstract types cannot be extended because they are private, and not public. gfortran doesn't seem to recognize this. 


The code is below 

module type_abstract_buggy
implicit none
private
public :: abstract_buggy

type, abstract :: abstract_buggy
  contains
    ! public methods
    procedure(abstract_printf), public, deferred :: printf
    generic,                    public           :: operator(*) => buggy_multiply_scalar, scalar_multiply_buggy
    generic,                    public           :: assignment(=) => buggy_assign_buggy
    ! private methods
    procedure(abstract_buggy_multiply_scalar),       pass(lhs), private, deferred :: buggy_multiply_scalar
    procedure(scalar_multiply_abstract_buggy),       pass(rhs), private, deferred :: scalar_multiply_buggy
    procedure(abstract_buggy_assign_abstract_buggy), pass(lhs), private, deferred :: buggy_assign_buggy
endtype abstract_buggy
abstract interface
  subroutine abstract_printf(self)
  import :: abstract_buggy
  class(abstract_buggy), intent(IN) :: self
  endsubroutine abstract_printf

  function abstract_buggy_multiply_scalar(lhs, rhs) result(multy)
  import :: abstract_buggy
  class(abstract_buggy), intent(IN)  :: lhs
  integer,               intent(IN)  :: rhs
  class(abstract_buggy), allocatable :: multy
  endfunction abstract_buggy_multiply_scalar

  function scalar_multiply_abstract_buggy(lhs, rhs) result(multy)
  import :: abstract_buggy
  integer,               intent(IN)  :: lhs
  class(abstract_buggy), intent(IN)  :: rhs
  class(abstract_buggy), allocatable :: multy
  endfunction scalar_multiply_abstract_buggy

  pure subroutine abstract_buggy_assign_abstract_buggy(lhs, rhs)
  import :: abstract_buggy
  class(abstract_buggy), intent(INOUT) :: lhs
  class(abstract_buggy), intent(IN)    :: rhs
  endsubroutine abstract_buggy_assign_abstract_buggy
endinterface
endmodule type_abstract_buggy

module lib_abstract_buggy
use type_abstract_buggy, only : abstract_buggy
implicit none
private
public :: raise_bug
contains
  subroutine raise_bug(bug, scalar)
  class(abstract_buggy), intent(INOUT) :: bug
  integer,               intent(IN)    :: scalar

  call bug%printf()
  bug = bug * scalar
  call bug%printf()
  bug = scalar * bug
  call bug%printf()
  endsubroutine raise_bug
endmodule lib_abstract_buggy

module type_buggy
use type_abstract_buggy, only : abstract_buggy
implicit none
private
public :: buggy

type, extends(abstract_buggy) :: buggy
  private
  real, dimension(:), allocatable :: array
  integer                         :: scalar=0
  contains
    ! public methods
    procedure, pass(self), public :: printf
    ! private methods
    procedure, pass(lhs), private :: buggy_multiply_scalar
    procedure, pass(rhs), private :: scalar_multiply_buggy
    procedure, pass(lhs), private :: buggy_assign_buggy
endtype buggy
interface buggy
  procedure create_buggy
endinterface
contains
  pure function create_buggy(array, scalar) result(bug)
  real, dimension(:), intent(IN) :: array
  integer,            intent(IN) :: scalar
  type(buggy)                    :: bug

  bug%array = array
  bug%scalar = scalar
  return
  endfunction create_buggy

  subroutine printf(self)
  class(buggy), intent(IN) :: self
  integer      :: i

  print "(A)", "Array:"
  do i=1, size(self%array)
    print*, self%array(i)
  enddo
  print "(A,I5)", "Scalar: ", self%scalar
  endsubroutine printf

  function buggy_multiply_scalar(lhs, rhs) result(multy)
  class(buggy), intent(IN)           :: lhs
  integer,      intent(IN)           :: rhs
  class(abstract_buggy), allocatable :: multy
  type(buggy),           allocatable :: multy_tmp

  allocate(buggy :: multy_tmp)
  multy_tmp%array = lhs%array * rhs
  multy_tmp%scalar = lhs%scalar
  call move_alloc(multy_tmp, multy)
  return
  endfunction buggy_multiply_scalar

  pure function scalar_multiply_buggy(lhs, rhs) result(multy)
  integer,      intent(IN)           :: lhs
  class(buggy), intent(IN)           :: rhs
  class(abstract_buggy), allocatable :: multy
  type(buggy),           allocatable :: multy_tmp

  allocate(buggy :: multy_tmp)
  multy_tmp%array = rhs%array * lhs
  multy_tmp%scalar = rhs%scalar
  call move_alloc(multy_tmp, multy)
  return
  endfunction scalar_multiply_buggy

  pure subroutine buggy_assign_buggy(lhs, rhs)
  class(buggy),          intent(INOUT) :: lhs
  class(abstract_buggy), intent(IN)    :: rhs

  select type(rhs)
  class is(buggy)
    if (allocated(rhs%array)) lhs%array = rhs%array
    lhs%scalar = rhs%scalar
  endselect
  return
  endsubroutine buggy_assign_buggy
endmodule type_buggy

program ifort_bug
use lib_abstract_buggy, only : raise_bug
use type_buggy, only : buggy
implicit none
type(buggy) :: bug

bug = buggy(array=[1., 2., 3.], scalar=3)
call raise_bug(bug=bug, scalar=2)
stop
endprogram ifort_bug
Comment 1 Dominique d'Humieres 2019-02-16 08:40:12 UTC
Related to/duplicate of pr36383?
Comment 2 Jürgen Reuter 2019-02-16 08:44:10 UTC
(In reply to Dominique d'Humieres from comment #1)
> Related to/duplicate of pr36383?

Related to most likely yes, could have the same origin. Probably the fortran DT is cast into an internal C representation. I don't know whether this is the same (or a related) object in the gfortran C code.