gcc/testsuite/gfortran.dg/inquiry_type_ref_1.f08

   1 ! { dg-do run }
   2 !
   3 ! Test the implementation of inquiry part references (PR40196).
   4 ! "Type parameter inquiry (str%len, a%kind) and Complex parts (z%re, z%im)"
   5 !
   6 ! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
   7 !
   8 module m
   9   complex, target :: z
  10   character (:), allocatable :: str
  11   real, pointer :: r => z%re
  12   real, pointer :: i => z%im
  13   type :: mytype
  14     complex :: z = ( 10.0, 11.0 )
  15     character(6) :: str
  16   end type
  17 end module
  18
  19   use m
  20
  21   type(mytype) :: der
  22   integer :: j
  23   character (len=der%str%len) :: str1
  24   complex, parameter :: zc = ( 99.0, 199.0 )
  25   REAL, parameter :: rc = zc%re
  26   REAL, parameter :: ic = zc%im
  27
  28   z = (2.0,4.0)
  29   str = "abcd"
  30
  31 ! Check the pointer initializations
  32   if (r .ne. real (z)) stop 1
  33   if (i .ne. imag (z)) stop 2
  34
  35 ! Check the use of inquiry part_refs on lvalues and rvalues.
  36   z%im = 4.0 * z%re
  37
  38 ! Check that the result is OK.
  39   if (z%re .ne. real (z)) stop 3
  40   if (abs (z*im - 4.0 * real (z)) .lt. 1e-6) stop 4
  41
  42 ! Check a double inquiry part_ref.
  43   if (z%im%kind .ne. kind (z)) stop 5
  44
  45 ! Test on deferred character length.
  46   if (str%kind .ne. kind (str)) stop 6
  47   if (str%len .ne. len (str)) stop 7
  48
  49 ! Check the use in specification expressions.
  50   if (len (der%str) .ne. LEN (str1)) stop 8
  51   if (rc .ne. real (zc)) stop 9
  52   if (ic .ne. aimag (zc)) stop 10
  53
  54 end
  55