gcc/testsuite/gfortran.dg/assumed_type_3.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 ! PR fortran/48820
   5 !
   6 ! Test TYPE(*)
   7
   8 subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
   9   type(*), value :: a
  10 end subroutine one
  11
  12 subroutine two(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
  13   type(*), pointer :: a
  14 end subroutine two
  15
  16 subroutine three(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
  17   type(*), allocatable :: a
  18 end subroutine three
  19
  20 subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
  21   type(*)  :: a[*]
  22 end subroutine four
  23
  24 subroutine five(a) ! { dg-error "shall not be an explicit-shape array" }
  25   type(*) :: a(3)
  26 end subroutine five
  27
  28 subroutine six()
  29   type(*) :: nodum ! { dg-error "is only permitted for dummy variables" }
  30 end subroutine six
  31
  32 subroutine seven(y)
  33  type(*) :: y(:)
  34  call a7(y(3:5)) ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
  35 contains
  36  subroutine a7(x)
  37    type(*) :: x(*)
  38  end subroutine a7
  39 end subroutine seven
  40
  41 subroutine eight()
  42   type t
  43     type(*) :: x ! { dg-error "is not allowed for components" }
  44   end type t
  45 end subroutine eight
  46
  47 subroutine nine()
  48   interface one
  49     subroutine okay(x)
  50       type(*) :: x
  51     end subroutine okay
  52     subroutine okay2(x)
  53       type(*) :: x(*)
  54     end subroutine okay2
  55     subroutine okay3(x,y)
  56       integer :: x
  57       type(*) :: y
  58     end subroutine okay3
  59   end interface
  60   interface two
  61     subroutine okok1(x)
  62       type(*) :: x
  63     end subroutine okok1
  64     subroutine okok2(x)
  65       integer :: x(*)
  66     end subroutine okok2
  67   end interface
  68   interface three
  69     subroutine ambig1(x) ! { dg-error "Ambiguous interfaces" }
  70       type(*) :: x
  71     end subroutine ambig1
  72     subroutine ambig2(x) ! { dg-error "Ambiguous interfaces" }
  73       integer :: x
  74     end subroutine ambig2
  75   end interface
  76 end subroutine nine
  77
  78 subroutine ten()
  79  interface
  80    subroutine bar()
  81    end subroutine
  82  end interface
  83  type t
  84  contains
  85    procedure, nopass :: proc => bar
  86  end type
  87  type(t) :: xx
  88  call sub(xx) ! { dg-error "is of derived type with type-bound or FINAL procedures" }
  89 contains
  90   subroutine sub(a)
  91     type(*) :: a
  92   end subroutine sub
  93 end subroutine ten
  94
  95 subroutine eleven(x)
  96   external bar
  97   type(*) :: x
  98   call bar(x) ! { dg-error "Assumed-type argument x at .1. requires an explicit interface" }
  99 end subroutine eleven
 100
 101 subroutine twelf(x)
 102   type(*) :: x
 103   call bar(x) ! { dg-error "Type mismatch in argument" }
 104 contains
 105   subroutine bar(x)
 106     integer :: x
 107   end subroutine bar
 108 end subroutine twelf
 109
 110 subroutine thirteen(x, y)
 111   type(*) :: x
 112   integer :: y(:)
 113   print *, ubound(y, dim=x) ! { dg-error "Assumed-type argument at .1. is only permitted as first actual argument to the intrinsic ubound" }
 114 end subroutine thirteen
 115
 116 subroutine fourteen(x)
 117   type(*) :: x
 118   x = x ! { dg-error "Assumed-type variable x at .1. may only be used as actual argument" }
 119 end subroutine fourteen