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        ")) call abort
  21   if (adjustr (s4) /= adjustr (4_"\0  foo bar \xFF        ")) call abort
  22
  23   s4 = "   \0  foo bar \xFF"
  24   if (adjustl (s4) /= adjustl (4_"   \0  foo bar \xFF     ")) call abort
  25   if (adjustr (s4) /= adjustr (4_"   \0  foo bar \xFF     ")) call abort
  26
  27   s4 = 4_" \U12345678\xeD bar \ufd30"
  28   if (adjustl (s4) /= &
  29       adjustl (4_" \U12345678\xeD bar \ufd30           ")) call abort
  30   if (adjustr (s4) /= &
  31       adjustr (4_" \U12345678\xeD bar \ufd30           ")) call abort
  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)) call abort
  44     if (len(t1) /= len(t4)) call abort
  45
  46     if (len_trim(s1) /= len_trim (s4)) call abort
  47
  48     t1 = adjustl (s4)
  49     t4 = adjustl (s1)
  50     if (t1 /= adjustl (s1)) call abort
  51     if (t4 /= adjustl (s4)) call abort
  52     if (len_trim (t1) /= len_trim (t4)) call abort
  53     if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
  54     if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
  55
  56     if (len_trim (t1) /= len (trim (t1))) call abort
  57     if (len_trim (s1) /= len (trim (s1))) call abort
  58     if (len_trim (t4) /= len (trim (t4))) call abort
  59     if (len_trim (s4) /= len (trim (s4))) call abort
  60
  61     t1 = adjustr (s4)
  62     t4 = adjustr (s1)
  63     if (t1 /= adjustr (s1)) call abort
  64     if (t4 /= adjustr (s4)) call abort
  65     if (len_trim (t1) /= len_trim (t4)) call abort
  66     if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
  67     if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
  68     if (len (t1) /= len_trim (t1)) call abort
  69     if (len (t4) /= len_trim (t4)) call abort
  70
  71     if (len_trim (t1) /= len (trim (t1))) call abort
  72     if (len_trim (s1) /= len (trim (s1))) call abort
  73     if (len_trim (t4) /= len (trim (t4))) call abort
  74     if (len_trim (s4) /= len (trim (s4))) call abort
  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)) call abort
  87     if (len(t1) /= len(t4)) call abort
  88
  89     if (len_trim(s1) /= len_trim (s4)) call abort
  90
  91     t1 = adjustl (s4)
  92     t4 = adjustl (s1)
  93     if (t1 /= adjustl (s1)) call abort
  94     if (t4 /= adjustl (s4)) call abort
  95     if (len_trim (t1) /= len_trim (t4)) call abort
  96     if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
  97     if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
  98
  99     if (len_trim (t1) /= len (trim (t1))) call abort
 100     if (len_trim (s1) /= len (trim (s1))) call abort
 101     if (len_trim (t4) /= len (trim (t4))) call abort
 102     if (len_trim (s4) /= len (trim (s4))) call abort
 103
 104     t1 = adjustr (s4)
 105     t4 = adjustr (s1)
 106     if (t1 /= adjustr (s1)) call abort
 107     if (t4 /= adjustr (s4)) call abort
 108     if (len_trim (t1) /= len_trim (t4)) call abort
 109     if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
 110     if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
 111     if (len (t1) /= len_trim (t1)) call abort
 112     if (len (t4) /= len_trim (t4)) call abort
 113
 114     if (len_trim (t1) /= len (trim (t1))) call abort
 115     if (len_trim (s1) /= len (trim (s1))) call abort
 116     if (len_trim (t4) /= len (trim (t4))) call abort
 117     if (len_trim (s4) /= len (trim (s4))) call abort
 118
 119   end subroutine test_adjust2
 120
 121 end