Re: [Patch, Fortran] PR57217 - re-add type checks for TBP overriding

[Tobias Burnus <burnus at net-b dot de>]

Janus Weil wrote:
> > > Ok, so: How about the attached patch as a simple & backportable fix for
> > > the regression? (Ok for trunk/4.8/4.7?)
> > I think that part is okay - but as you mentioned TYPE(*) in your last email:
> > That doesn't work; I think compare_type_rank should be made asymmetrical in
> > this regard (ditto for "!gcc$ attributes no_arg_check"). Thus, could you fix
> > that part as well?
> What do you mean?

Try the four attached test cases - they should all be rejected, but they 
are accepted.

> Anyway, anything in this direction is probably a non-regression and
> should rather be handled as a follow-up. Is the current patch
> (http://gcc.gnu.org/ml/fortran/2013-05/msg00045.html) ok for
> trunk/4.8/4.7?

OK. Still, I would like if the attached test cases would be rejected. 
(The first one only affects GCC 4.9, the others also GCC4.8).

Tobias

PS: If you have time, could you please review 
http://gcc.gnu.org/ml/fortran/2013-05/msg00081.html (dealloc intent(in) 
poly array)?

(For the finalization wrapper patch, I will later send a follow-up patch 
which addresses some additional issues, I found while testing.)
module base_mod
  type base_type
    integer :: kind
  contains
    procedure, pass(map)  :: clone    => base_clone
  end type base_type
contains
  subroutine  base_clone(map,mapout,info)
    implicit none
    class(base_type), intent(inout) :: map
    class(base_type), intent(inout) :: mapout
    integer     :: info
  end subroutine base_clone
end module base_mod

module r_mod
  use base_mod
  type, extends(base_type) :: r_type
    real  :: dat
  contains
    procedure, pass(map)  :: clone    => r_clone
  end type r_type
contains
  subroutine  r_clone(map,mapout,info)
    implicit none
    class(r_type), intent(inout) :: map
!gcc$ attributes no_arg_check :: mapout
    integer, intent(inout) :: mapout
    integer     :: info
  end subroutine r_clone
end module r_mod

module base_mod
  type base_type
    integer :: kind
  contains
    procedure, pass(map)  :: clone    => base_clone
  end type base_type
contains
  subroutine  base_clone(map,mapout,info)
    implicit none
    class(base_type), intent(inout) :: map
    class(base_type), intent(inout) :: mapout
    integer     :: info
  end subroutine base_clone
end module base_mod

module r_mod
  use base_mod
  type, extends(base_type) :: r_type
    real  :: dat
  contains
    procedure, pass(map)  :: clone    => r_clone
  end type r_type
contains
  subroutine  r_clone(map,mapout,info)
    implicit none
    class(r_type), intent(inout) :: map
    class(base_type), intent(inout) :: mapout(..)
    integer     :: info
  end subroutine r_clone
end module r_mod

module base_mod
  type base_type
    integer :: kind
  contains
    procedure, pass(map)  :: clone    => base_clone
  end type base_type
contains
  subroutine  base_clone(map,mapout,info)
    implicit none
    class(base_type), intent(inout) :: map
    class(base_type), intent(inout) :: mapout
    integer     :: info
  end subroutine base_clone
end module base_mod

module r_mod
  use base_mod
  type, extends(base_type) :: r_type
    real  :: dat
  contains
    procedure, pass(map)  :: clone    => r_clone
  end type r_type
contains
  subroutine  r_clone(map,mapout,info)
    implicit none
    class(r_type), intent(inout) :: map
    type(*), intent(inout) :: mapout
    integer     :: info
  end subroutine r_clone
end module r_mod