https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89374
Bug ID: 89374
Summary: gfortran does not respect privacy of types
Product: gcc
Version: 9.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: juergen.reuter at desy dot de
Target Milestone: ---
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
