gcc/testsuite/gfortran.dg/repeat_8.f90

   1 ! { dg-do compile }
   2 ! { dg-additional-options "-Wconversion-extra" }
   3 !
   4 ! Test fix for PR fortran/96724
   5 !
   6 ! Contributed by José Rui Faustino de Sousa
   7
   8 program repeat_p
   9   use, intrinsic :: iso_fortran_env, only: int8, int16, int32, int64
  10   implicit none
  11
  12   integer, parameter :: n = 20
  13   integer, parameter :: ucs4 = selected_char_kind ('ISO_10646')
  14
  15   integer(kind=int8),  parameter :: p08 = int(n, kind=int8)
  16   integer(kind=int16), parameter :: p16 = int(n, kind=int16)
  17   integer(kind=int16), parameter :: p32 = int(n, kind=int32)
  18   integer(kind=int16), parameter :: p64 = int(n, kind=int64)
  19
  20   integer(kind=int8)  :: i08
  21   integer(kind=int16) :: i16
  22   integer(kind=int32) :: i32
  23   integer(kind=int64) :: i64
  24
  25   character(len=n,kind=1)    :: c
  26   character(len=n,kind=ucs4) :: d
  27
  28   i08 = p08
  29   c = repeat('X', 20_int8)
  30   c = repeat('X', i08)
  31   c = repeat('X', p08)
  32   c = repeat('X', len08(c))
  33   d = repeat(ucs4_'X', 20_int8)
  34   d = repeat(ucs4_'X', i08)
  35   d = repeat(ucs4_'X', p08)
  36   d = repeat(ucs4_'X', len08(c))
  37   i16 = p16
  38   c = repeat('X', 20_int16)
  39   c = repeat('X', i16)
  40   c = repeat('X', p16)
  41   c = repeat('X', len16(c))
  42   d = repeat(ucs4_'X', 20_int16)
  43   d = repeat(ucs4_'X', i16)
  44   d = repeat(ucs4_'X', p16)
  45   d = repeat(ucs4_'X', len16(c))
  46   i32 = p32
  47   c = repeat('X', 20_int32)
  48   c = repeat('X', i32)
  49   c = repeat('X', p32)
  50   c = repeat('X', len32(c))
  51   d = repeat(ucs4_'X', 20_int32)
  52   d = repeat(ucs4_'X', i32)
  53   d = repeat(ucs4_'X', p32)
  54   d = repeat(ucs4_'X', len32(c))
  55   i64 = p64
  56   c = repeat('X', 20_int64)
  57   c = repeat('X', i64)
  58   c = repeat('X', p64)
  59   c = repeat('X', len64(c))
  60   d = repeat(ucs4_'X', 20_int64)
  61   d = repeat(ucs4_'X', i64)
  62   d = repeat(ucs4_'X', p64)
  63   d = repeat(ucs4_'X', len64(c))
  64
  65 contains
  66
  67   function len08(x) result(l)
  68     character(len=*), intent(in) :: x
  69     integer(kind=int8) :: l
  70
  71     l = int(len(x), kind=int8)
  72   end function len08
  73
  74   function len16(x) result(l)
  75     character(len=*), intent(in) :: x
  76     integer(kind=int16) :: l
  77
  78     l = int(len(x), kind=int16)
  79   end function len16
  80
  81   function len32(x) result(l)
  82     character(len=*), intent(in) :: x
  83     integer(kind=int32) :: l
  84
  85     l = int(len(x), kind=int32)
  86   end function len32
  87
  88   function len64(x) result(l)
  89     character(len=*), intent(in) :: x
  90     integer(kind=int64) :: l
  91
  92     l = int(len(x), kind=int64)
  93   end function len64
  94
  95   function ulen08(x) result(l)
  96     character(len=*,kind=ucs4), intent(in) :: x
  97     integer(kind=int8) :: l
  98
  99     l = int(len(x), kind=int8)
 100   end function ulen08
 101
 102   function ulen16(x) result(l)
 103     character(len=*,kind=ucs4), intent(in) :: x
 104     integer(kind=int16) :: l
 105
 106     l = int(len(x), kind=int16)
 107   end function ulen16
 108
 109   function ulen32(x) result(l)
 110     character(len=*,kind=ucs4), intent(in) :: x
 111     integer(kind=int32) :: l
 112
 113     l = int(len(x), kind=int32)
 114   end function ulen32
 115
 116   function ulen64(x) result(l)
 117     character(len=*,kind=ucs4), intent(in) :: x
 118     integer(kind=int64) :: l
 119
 120     l = int(len(x), kind=int64)
 121   end function ulen64
 122
 123 end program repeat_p