gcc/testsuite/gfortran.dg/dec_type_print.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdec" }
   3 !
   4 ! Test the usage of TYPE as an alias for PRINT.
   5 !
   6 ! Note the heavy use of other TYPE statements to test for
   7 ! regressions involving ambiguity.
   8 !
   9 program main
  10
  11 logical bool
  12 integer i /0/, j /1/, k /2/
  13 character(*), parameter :: fmtstr = "(A11)"
  14 namelist /nmlist/ i, j, k
  15 integer, parameter :: n = 5
  16 real a(n)
  17
  18 ! derived type declarations
  19 type is
  20   integer i
  21 end type
  22
  23 type point
  24    real x, y
  25 end type point
  26
  27 type, extends(point) :: point_3d
  28    real :: z
  29 end type point_3d
  30
  31 type, extends(point) :: color_point
  32    integer :: color
  33 end type color_point
  34
  35 ! declaration type specification
  36 type(is) x
  37 type(point), target :: p
  38 type(point_3d), target :: p3
  39 type(color_point), target :: c
  40 class(point), pointer :: p_or_c
  41
  42 ! select type
  43 p_or_c => c
  44 select type ( a => p_or_c )
  45   class is ( point )
  46     print *, "point"     ! <===
  47   type is ( point_3d )
  48     print *, "point 3D"
  49 end select
  50
  51 ! Type as alias for print
  52 type*
  53 type *
  54 type*,'St','ar'
  55 type *, 'St', 'ar'
  56 type 10, 'Integer literal'
  57 type 10, 'Integer variable'
  58 type '(A11)', 'Character literal'
  59 type fmtstr, 'Character variable'
  60 type nmlist ! namelist
  61
  62 a(1) = 0
  63 call f(.true., a, n)
  64
  65 10    format (A11)
  66
  67 end program
  68
  69
  70 subroutine f(b,a,n)
  71   implicit none
  72   logical b
  73   real a(*)
  74   integer n
  75
  76   integer i
  77
  78   do i = 2,n
  79     a(i) = 2 * (a(i-1) + 1)
  80     if (b) type*,a(i) ! test TYPE as PRINT inside one-line IF
  81   enddo
  82
  83   return
  84 end subroutine