gcc/testsuite/gfortran.dg/pdt_4.f03

   1 ! { dg-do compile }
   2 !
   3 ! Test bad PDT coding: Based on pdt_3.f03
   4 !
   5 module m
   6   integer :: d_dim = 4
   7   integer :: mat_dim = 256
   8   integer, parameter :: ftype = kind(0.0d0)
   9   type :: modtype (a,b)
  10     integer, kind :: a = kind(0.0e0)
  11     integer, LEN :: b = 4
  12     integer :: i
  13     real(kind = a) :: d(b, b)
  14   end type
  15 end module
  16
  17 module bad_vars
  18   use m
  19   type(modtype(8,mat_dim)) :: mod_q ! { dg-error "must not have the SAVE attribute" }
  20   type(modtype(8,*)) :: mod_r       ! { dg-error "ASSUMED type parameters" }
  21 end module
  22
  23   use m
  24   implicit none
  25   integer :: i
  26   integer, kind :: bad_kind    ! { dg-error "not allowed outside a TYPE definition" }
  27   integer, len :: bad_len      ! { dg-error "not allowed outside a TYPE definition" }
  28
  29   type :: bad_pdt (a,b, c, d)  ! { dg-error "does not have a component" }
  30     real, kind :: a            ! { dg-error "must be INTEGER" }
  31     INTEGER(8), kind :: b      ! { dg-error "be default integer kind" }
  32     real, LEN :: c             ! { dg-error "must be INTEGER" }
  33     INTEGER(8), LEN :: d       ! { dg-error "be default integer kind" }
  34   end type
  35
  36   type :: mytype (a,b)
  37     integer, kind :: a = kind(0.0e0)
  38     integer, LEN :: b = 4
  39     integer :: i
  40     real(kind = a) :: d(b, b)
  41   end type
  42
  43   type, extends(mytype) :: thytype(h)
  44     integer, kind :: h
  45     integer(kind = h) :: j
  46   end type
  47
  48   type x (q, r, s)
  49     integer, kind :: q
  50     integer, kind :: r
  51     integer, LEN :: s
  52     integer(kind = q) :: idx_mat(2,2)
  53     type (mytype (b=s)) :: mat1
  54     type (mytype (b=s*2)) :: mat2
  55   end type x
  56
  57   real, allocatable :: matrix (:,:)
  58
  59 ! Bad KIND parameters
  60   type(thytype(d_dim, 4, 4)) :: wbad ! { dg-error "does not reduce to a constant" }
  61   type(thytype(*, 4, 4)) :: worse    ! { dg-error "cannot either be ASSUMED or DEFERRED" }
  62   type(thytype(:, 4, 4)) :: w_ugh    ! { dg-error "cannot either be ASSUMED or DEFERRED" }
  63
  64   type(thytype(ftype, b=4, h=4)) :: w
  65   type(x(8,4,mat_dim)) :: q          ! { dg-error "must not have the SAVE attribute" }
  66   class(mytype(ftype, :)), allocatable :: cz
  67
  68   w%a = 1                           ! { dg-error "assignment to a KIND or LEN component" }
  69   w%b = 2                           ! { dg-error "assignment to a KIND or LEN component" }
  70   w%h = 3                           ! { dg-error "assignment to a KIND or LEN component" }
  71
  72   w%d = reshape ([(real(i), i = 1, d_dim*d_dim)],[d_dim,d_dim])
  73
  74   matrix = w%d
  75
  76   allocate (cz, source = mytype(*, d_dim, 0, matrix)) ! { dg-error "Syntax error" }
  77   allocate (cz, source = mytype(ftype, :, 0, matrix)) ! { dg-error "Syntax error" }
  78   select type (cz)
  79     type is (mytype(ftype, d_dim))  ! { dg-error "must be ASSUMED" }
  80       if (int (sum (cz%d)) .ne. 136) STOP 1! { dg-error "Expected TYPE IS" }
  81     type is (thytype(ftype, *, 8))
  82       STOP 2
  83   end select
  84   deallocate (cz)
  85
  86   allocate (thytype(ftype, d_dim*2, 8) :: cz)
  87   cz%d = reshape ([(i*10, i = 1, cz%b**2)], [cz%b,cz%b])
  88   select type (cz)
  89     type is (mytype(4, *))        !  { dg-error "must be an extension" }
  90       STOP 3
  91     type is (thytype(ftype, *, 8))
  92       if (int (sum (cz%d)) .ne. 20800) STOP 4
  93   end select
  94   deallocate (cz)
  95 contains
  96   subroutine foo(arg)
  97     type (mytype(4, *)) :: arg      ! OK
  98   end subroutine
  99   subroutine bar(arg)               ! { dg-error "is neither allocatable nor a pointer" }
 100     type (thytype(8, :, 4) :: arg
 101   end subroutine
 102   subroutine foobar(arg)            ! OK
 103     type (thytype(8, *, 4) :: arg
 104   end subroutine
 105 end