gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fbackslash" }
   3
   4   character(kind=1, len=3) :: s1
   5   character(kind=4, len=3) :: s4
   6   integer :: i
   7
   8   s1 = "fo "
   9   s4 = 4_"fo "
  10   i = 3
  11
  12   ! Check the REPEAT intrinsic
  13
  14   if (repeat (1_"foo", 2) /= 1_"foofoo") STOP 1
  15   if (repeat (1_"fo ", 2) /= 1_"fo fo ") STOP 2
  16   if (repeat (1_"fo ", 2) /= 1_"fo fo") STOP 3
  17   if (repeat (1_"fo ", 0) /= 1_"") STOP 4
  18   if (repeat (s1, 2) /= 1_"fo fo ") STOP 5
  19   if (repeat (s1, 2) /= 1_"fo fo") STOP 6
  20   if (repeat (s1, 2) /= s1 // s1) STOP 7
  21   if (repeat (s1, 3) /= s1 // s1 // s1) STOP 8
  22   if (repeat (s1, 1) /= s1) STOP 9
  23   if (repeat (s1, 0) /= "") STOP 10
  24
  25   if (repeat (4_"foo", 2) /= 4_"foofoo") STOP 11
  26   if (repeat (4_"fo ", 2) /= 4_"fo fo ") STOP 12
  27   if (repeat (4_"fo ", 2) /= 4_"fo fo") STOP 13
  28   if (repeat (4_"fo ", 0) /= 4_"") STOP 14
  29   if (repeat (s4, 2) /= 4_"fo fo ") STOP 15
  30   if (repeat (s4, 2) /= 4_"fo fo") STOP 16
  31   if (repeat (s4, 3) /= s4 // s4 // s4) STOP 17
  32   if (repeat (s4, 1) /= s4) STOP 18
  33   if (repeat (s4, 0) /= 4_"") STOP 19
  34
  35   call check_repeat (s1, s4)
  36   call check_repeat ("", 4_"")
  37   call check_repeat ("truc", 4_"truc")
  38   call check_repeat ("truc ", 4_"truc ")
  39
  40   ! Check NEW_LINE
  41
  42   if (ichar(new_line ("")) /= 10) STOP 20
  43   if (len(new_line ("")) /= 1) STOP 21
  44   if (ichar(new_line (s1)) /= 10) STOP 22
  45   if (len(new_line (s1)) /= 1) STOP 23
  46   if (ichar(new_line (["",""])) /= 10) STOP 24
  47   if (len(new_line (["",""])) /= 1) STOP 25
  48   if (ichar(new_line ([s1,s1])) /= 10) STOP 26
  49   if (len(new_line ([s1,s1])) /= 1) STOP 27
  50
  51   if (ichar(new_line (4_"")) /= 10) STOP 28
  52   if (len(new_line (4_"")) /= 1) STOP 29
  53   if (ichar(new_line (s4)) /= 10) STOP 30
  54   if (len(new_line (s4)) /= 1) STOP 31
  55   if (ichar(new_line ([4_"",4_""])) /= 10) STOP 32
  56   if (len(new_line ([4_"",4_""])) /= 1) STOP 33
  57   if (ichar(new_line ([s4,s4])) /= 10) STOP 34
  58   if (len(new_line ([s4,s4])) /= 1) STOP 35
  59
  60   ! Check SIZEOF
  61
  62   if (sizeof ("") /= 0) STOP 36
  63   if (sizeof (4_"") /= 0) STOP 37
  64   if (sizeof ("x") /= 1) STOP 38
  65   if (sizeof ("\xFF") /= 1) STOP 39
  66   if (sizeof (4_"x") /= 4) STOP 40
  67   if (sizeof (4_"\UFFFFFFFF") /= 4) STOP 41
  68   if (sizeof (s1) /= 3) STOP 42
  69   if (sizeof (s4) /= 12) STOP 43
  70
  71   if (sizeof (["a", "x", "z"]) / sizeof ("a") /= 3) STOP 44
  72   if (sizeof ([4_"a", 4_"x", 4_"z"]) / sizeof (4_"a") /= 3) STOP 45
  73
  74   call check_sizeof ("", 4_"", 0)
  75   call check_sizeof ("x", 4_"x", 1)
  76   call check_sizeof ("\xFF", 4_"\UFEBCE19E", 1)
  77   call check_sizeof ("\xFF ", 4_"\UFEBCE19E ", 2)
  78   call check_sizeof (s1, s4, 3)
  79
  80 contains
  81
  82   subroutine check_repeat (s1, s4)
  83     character(kind=1, len=*), intent(in) :: s1
  84     character(kind=4, len=*), intent(in) :: s4
  85     integer :: i
  86
  87     do i = 0, 10
  88       if (len (repeat(s1, i)) /= i * len(s1)) STOP 46
  89       if (len (repeat(s4, i)) /= i * len(s4)) STOP 47
  90
  91       if (len_trim (repeat(s1, i)) &
  92           /= max(0, (i - 1) * len(s1) + len_trim (s1))) STOP 48
  93       if (len_trim (repeat(s4, i)) &
  94           /= max(0, (i - 1) * len(s4) + len_trim (s4))) STOP 49
  95     end do
  96   end subroutine check_repeat
  97
  98   subroutine check_sizeof (s1, s4, i)
  99     character(kind=1, len=*), intent(in) :: s1
 100     character(kind=4, len=*), intent(in) :: s4
 101     character(kind=4, len=len(s4)) :: t4
 102     integer, intent(in) :: i
 103
 104     if (sizeof (s1) /= i) STOP 50
 105     if (sizeof (s4) / sizeof (4_" ") /= i) STOP 51
 106     if (sizeof (t4) / sizeof (4_" ") /= i) STOP 52
 107   end subroutine check_sizeof
 108
 109 end