gcc/testsuite/gfortran.dg/widechar_intrinsics_4.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fbackslash" }
   3
   4   character(kind=1,len=20) :: s1
   5   character(kind=4,len=20) :: s4
   6
   7   call test_adjust1 ("  foo bar ", 4_"  foo bar ")
   8   s1 = "  foo bar " ; s4 = 4_"  foo bar "
   9   call test_adjust2 (s1, s4)
  10
  11   call test_adjust1 ("  foo bar \xFF", 4_"  foo bar \xFF")
  12   s1 = "  foo bar \xFF" ; s4 = 4_"  foo bar \xFF"
  13   call test_adjust2 (s1, s4)
  14
  15   call test_adjust1 ("\0  foo bar \xFF", 4_"\0  foo bar \xFF")
  16   s1 = "\0  foo bar \xFF" ; s4 = 4_"\0  foo bar \xFF"
  17   call test_adjust2 (s1, s4)
  18
  19   s4 = "\0  foo bar \xFF"
  20   if (adjustl (s4) /= adjustl (4_"\0  foo bar \xFF        ")) STOP 1
  21   if (adjustr (s4) /= adjustr (4_"\0  foo bar \xFF        ")) STOP 2
  22
  23   s4 = "   \0  foo bar \xFF"
  24   if (adjustl (s4) /= adjustl (4_"   \0  foo bar \xFF     ")) STOP 3
  25   if (adjustr (s4) /= adjustr (4_"   \0  foo bar \xFF     ")) STOP 4
  26
  27   s4 = 4_" \U12345678\xeD bar \ufd30"
  28   if (adjustl (s4) /= &
  29       adjustl (4_" \U12345678\xeD bar \ufd30           ")) STOP 5
  30   if (adjustr (s4) /= &
  31       adjustr (4_" \U12345678\xeD bar \ufd30           ")) STOP 6
  32
  33 contains
  34
  35   subroutine test_adjust1 (s1, s4)
  36
  37     character(kind=1,len=*) :: s1
  38     character(kind=4,len=*) :: s4
  39
  40     character(kind=1,len=len(s4)) :: t1
  41     character(kind=4,len=len(s1)) :: t4
  42
  43     if (len(s1) /= len(s4)) STOP 7
  44     if (len(t1) /= len(t4)) STOP 8
  45
  46     if (len_trim(s1) /= len_trim (s4)) STOP 9
  47
  48     t1 = adjustl (s4)
  49     t4 = adjustl (s1)
  50     if (t1 /= adjustl (s1)) STOP 10
  51     if (t4 /= adjustl (s4)) STOP 11
  52     if (len_trim (t1) /= len_trim (t4)) STOP 12
  53     if (len_trim (adjustl (s1)) /= len_trim (t4)) STOP 13
  54     if (len_trim (adjustl (s4)) /= len_trim (t1)) STOP 14
  55
  56     if (len_trim (t1) /= len (trim (t1))) STOP 15
  57     if (len_trim (s1) /= len (trim (s1))) STOP 16
  58     if (len_trim (t4) /= len (trim (t4))) STOP 17
  59     if (len_trim (s4) /= len (trim (s4))) STOP 18
  60
  61     t1 = adjustr (s4)
  62     t4 = adjustr (s1)
  63     if (t1 /= adjustr (s1)) STOP 19
  64     if (t4 /= adjustr (s4)) STOP 20
  65     if (len_trim (t1) /= len_trim (t4)) STOP 21
  66     if (len_trim (adjustr (s1)) /= len_trim (t4)) STOP 22
  67     if (len_trim (adjustr (s4)) /= len_trim (t1)) STOP 23
  68     if (len (t1) /= len_trim (t1)) STOP 24
  69     if (len (t4) /= len_trim (t4)) STOP 25
  70
  71     if (len_trim (t1) /= len (trim (t1))) STOP 26
  72     if (len_trim (s1) /= len (trim (s1))) STOP 27
  73     if (len_trim (t4) /= len (trim (t4))) STOP 28
  74     if (len_trim (s4) /= len (trim (s4))) STOP 29
  75
  76   end subroutine test_adjust1
  77
  78   subroutine test_adjust2 (s1, s4)
  79
  80     character(kind=1,len=20) :: s1
  81     character(kind=4,len=20) :: s4
  82
  83     character(kind=1,len=len(s4)) :: t1
  84     character(kind=4,len=len(s1)) :: t4
  85
  86     if (len(s1) /= len(s4)) STOP 30
  87     if (len(t1) /= len(t4)) STOP 31
  88
  89     if (len_trim(s1) /= len_trim (s4)) STOP 32
  90
  91     t1 = adjustl (s4)
  92     t4 = adjustl (s1)
  93     if (t1 /= adjustl (s1)) STOP 33
  94     if (t4 /= adjustl (s4)) STOP 34
  95     if (len_trim (t1) /= len_trim (t4)) STOP 35
  96     if (len_trim (adjustl (s1)) /= len_trim (t4)) STOP 36
  97     if (len_trim (adjustl (s4)) /= len_trim (t1)) STOP 37
  98
  99     if (len_trim (t1) /= len (trim (t1))) STOP 38
 100     if (len_trim (s1) /= len (trim (s1))) STOP 39
 101     if (len_trim (t4) /= len (trim (t4))) STOP 40
 102     if (len_trim (s4) /= len (trim (s4))) STOP 41
 103
 104     t1 = adjustr (s4)
 105     t4 = adjustr (s1)
 106     if (t1 /= adjustr (s1)) STOP 42
 107     if (t4 /= adjustr (s4)) STOP 43
 108     if (len_trim (t1) /= len_trim (t4)) STOP 44
 109     if (len_trim (adjustr (s1)) /= len_trim (t4)) STOP 45
 110     if (len_trim (adjustr (s4)) /= len_trim (t1)) STOP 46
 111     if (len (t1) /= len_trim (t1)) STOP 47
 112     if (len (t4) /= len_trim (t4)) STOP 48
 113
 114     if (len_trim (t1) /= len (trim (t1))) STOP 49
 115     if (len_trim (s1) /= len (trim (s1))) STOP 50
 116     if (len_trim (t4) /= len (trim (t4))) STOP 51
 117     if (len_trim (s4) /= len (trim (s4))) STOP 52
 118
 119   end subroutine test_adjust2
 120
 121 end