gcc/testsuite/gfortran.dg/pr112316.f90

   1 ! { dg-do compile }
   2 !
   3 ! This contains both testcases in the PR
   4 !
   5 ! Contributed by Tomas Trnka  <trnka@scm.com>
   6 !
   7 ! First testcase
   8 module BogusPointerArgError
   9    implicit none
  10
  11    type :: AType
  12    end type
  13
  14 contains
  15
  16    subroutine A ()
  17
  18       class(AType), allocatable :: x
  19
  20       allocate(x)
  21       call B (x)                       ! Was an error here
  22    end subroutine
  23
  24    subroutine B (y)
  25       class(AType), intent(in)    :: y
  26    end subroutine
  27
  28    subroutine C (z)
  29       class(AType), intent(in) :: z(:)
  30
  31       associate (xxx => z(1))
  32       end associate
  33
  34    end subroutine
  35
  36 end module
  37
  38 ! Second testcase
  39 module AModule
  40    implicit none
  41    private
  42
  43    public AType
  44
  45    type, abstract :: AType
  46    contains
  47       generic, public :: assignment(=) => Assign
  48
  49       procedure, private :: Assign
  50    end type AType
  51
  52 contains
  53
  54    subroutine Assign(lhs, rhs)
  55       class(AType), intent(inout) :: lhs
  56       class(AType), intent(in)    :: rhs
  57    end subroutine
  58
  59 end module AModule
  60
  61
  62
  63 module ICEGetDescriptorField
  64    use AModule
  65    implicit none
  66
  67 contains
  68
  69    subroutine Foo (x)
  70       class(AType), intent(in)    :: x(:)
  71
  72       class(AType), allocatable :: y
  73
  74       associate (xxx => x(1))
  75          y = xxx                       ! Was an ICE here
  76       end associate
  77    end subroutine
  78
  79 end module ICEGetDescriptorField