gcc/testsuite/gfortran.dg/pr95398.f90

   1 ! { dg-do compile }
   2
   3 ! { dg-options "-std=f2008" }
   4
   5 program test
   6    implicit none
   7
   8    type :: t1
   9      integer :: i
  10    end type
  11
  12    type, extends(t1) :: t2
  13    end type
  14
  15    class(t1), allocatable :: array1(:,:)
  16    class(t2), allocatable :: array2(:,:)
  17
  18    allocate(array1(3,3))
  19    allocate(array2(3,3))
  20
  21    select type(b => foo(1))
  22       type is (t1)
  23          b%i = 1
  24       type is (t2)
  25          call sub_with_in_and_inout_param(b,b)
  26    end select
  27
  28    contains
  29
  30      function foo(i)
  31        integer :: U(2)
  32        integer :: i
  33        class(t1), POINTER :: foo(:)
  34        ALLOCATE(foo(2))
  35        U = [ 1,2 ]
  36        if (i>0) then
  37          foo => array1(2,U)
  38        else
  39          foo => array2(2,U)
  40        end if
  41      end function
  42
  43      subroutine sub_with_in_and_inout_param(y, z)
  44         type(t2), INTENT(IN) :: y(:)
  45         class(t2), INTENT(INOUT) :: z(:)
  46         z%i = 10
  47      end subroutine
  48
  49 end
  50
  51 ! { dg-error "being used in a variable definition context .assignment."  " " { target *-*-* } 23 }
  52 ! { dg-error "being used in a variable definition context .actual argument to INTENT = OUT.INOUT."  " " { target *-*-* } 25 }
  53 ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 37 }
  54 ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 39 }
  55