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") call abort
  15   if (repeat (1_"fo ", 2) /= 1_"fo fo ") call abort
  16   if (repeat (1_"fo ", 2) /= 1_"fo fo") call abort
  17   if (repeat (1_"fo ", 0) /= 1_"") call abort
  18   if (repeat (s1, 2) /= 1_"fo fo ") call abort
  19   if (repeat (s1, 2) /= 1_"fo fo") call abort
  20   if (repeat (s1, 2) /= s1 // s1) call abort
  21   if (repeat (s1, 3) /= s1 // s1 // s1) call abort
  22   if (repeat (s1, 1) /= s1) call abort
  23   if (repeat (s1, 0) /= "") call abort
  24
  25   if (repeat (4_"foo", 2) /= 4_"foofoo") call abort
  26   if (repeat (4_"fo ", 2) /= 4_"fo fo ") call abort
  27   if (repeat (4_"fo ", 2) /= 4_"fo fo") call abort
  28   if (repeat (4_"fo ", 0) /= 4_"") call abort
  29   if (repeat (s4, 2) /= 4_"fo fo ") call abort
  30   if (repeat (s4, 2) /= 4_"fo fo") call abort
  31   if (repeat (s4, 3) /= s4 // s4 // s4) call abort
  32   if (repeat (s4, 1) /= s4) call abort
  33   if (repeat (s4, 0) /= 4_"") call abort
  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) call abort
  43   if (len(new_line ("")) /= 1) call abort
  44   if (ichar(new_line (s1)) /= 10) call abort
  45   if (len(new_line (s1)) /= 1) call abort
  46   if (ichar(new_line (["",""])) /= 10) call abort
  47   if (len(new_line (["",""])) /= 1) call abort
  48   if (ichar(new_line ([s1,s1])) /= 10) call abort
  49   if (len(new_line ([s1,s1])) /= 1) call abort
  50
  51   if (ichar(new_line (4_"")) /= 10) call abort
  52   if (len(new_line (4_"")) /= 1) call abort
  53   if (ichar(new_line (s4)) /= 10) call abort
  54   if (len(new_line (s4)) /= 1) call abort
  55   if (ichar(new_line ([4_"",4_""])) /= 10) call abort
  56   if (len(new_line ([4_"",4_""])) /= 1) call abort
  57   if (ichar(new_line ([s4,s4])) /= 10) call abort
  58   if (len(new_line ([s4,s4])) /= 1) call abort
  59
  60   ! Check SIZEOF
  61
  62   if (sizeof ("") /= 0) call abort
  63   if (sizeof (4_"") /= 0) call abort
  64   if (sizeof ("x") /= 1) call abort
  65   if (sizeof ("\xFF") /= 1) call abort
  66   if (sizeof (4_"x") /= 4) call abort
  67   if (sizeof (4_"\UFFFFFFFF") /= 4) call abort
  68   if (sizeof (s1) /= 3) call abort
  69   if (sizeof (s4) /= 12) call abort
  70
  71   if (sizeof (["a", "x", "z"]) / sizeof ("a") /= 3) call abort
  72   if (sizeof ([4_"a", 4_"x", 4_"z"]) / sizeof (4_"a") /= 3) call abort
  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)) call abort
  89       if (len (repeat(s4, i)) /= i * len(s4)) call abort
  90
  91       if (len_trim (repeat(s1, i)) &
  92           /= max(0, (i - 1) * len(s1) + len_trim (s1))) call abort
  93       if (len_trim (repeat(s4, i)) &
  94           /= max(0, (i - 1) * len(s4) + len_trim (s4))) call abort
  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) call abort
 105     if (sizeof (s4) / sizeof (4_" ") /= i) call abort
 106     if (sizeof (t4) / sizeof (4_" ") /= i) call abort
 107   end subroutine check_sizeof
 108
 109 end