Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/widechar_2.f90 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 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 s1 = "this is me!" | |
| 8 s4 = s1 | |
| 9 call check(s1, 4_"this is me! ") | |
| 10 call check2(s1, 4_"this is me! ") | |
| 11 s4 = "this is me!" | |
| 12 call check(s1, 4_"this is me! ") | |
| 13 call check2(s1, 4_"this is me! ") | |
| 14 | |
| 15 s1 = "" | |
| 16 s4 = s1 | |
| 17 call check(s1, 4_" ") | |
| 18 call check2(s1, 4_" ") | |
| 19 s4 = "" | |
| 20 call check(s1, 4_" ") | |
| 21 call check2(s1, 4_" ") | |
| 22 | |
| 23 s1 = " \xFF" | |
| 24 s4 = s1 | |
| 25 call check(s1, 4_" \xFF ") | |
| 26 call check2(s1, 4_" \xFF ") | |
| 27 s4 = " \xFF" | |
| 28 call check(s1, 4_" \xFF ") | |
| 29 call check2(s1, 4_" \xFF ") | |
| 30 | |
| 31 s1 = " \xFF" | |
| 32 s4 = s1 | |
| 33 call check(s1, 4_" \xFF ") | |
| 34 call check2(s1, 4_" \xFF ") | |
| 35 s4 = " \xFF" | |
| 36 call check(s1, 4_" \xFF ") | |
| 37 call check2(s1, 4_" \xFF ") | |
| 38 | |
| 39 contains | |
| 40 subroutine check(s1,s4) | |
| 41 character(kind=1,len=20) :: s1, t1 | |
| 42 character(kind=4,len=20) :: s4 | |
| 43 t1 = s4 | |
| 44 if (t1 /= s1) call abort | |
| 45 if (len(s1) /= len(t1)) call abort | |
| 46 if (len(s1) /= len(s4)) call abort | |
| 47 if (len_trim(s1) /= len_trim(t1)) call abort | |
| 48 if (len_trim(s1) /= len_trim(s4)) call abort | |
| 49 end subroutine check | |
| 50 | |
| 51 subroutine check2(s1,s4) | |
| 52 character(kind=1,len=*) :: s1 | |
| 53 character(kind=4,len=*) :: s4 | |
| 54 character(kind=1,len=len(s1)) :: t1 | |
| 55 character(kind=4,len=len(s4)) :: t4 | |
| 56 | |
| 57 t1 = s4 | |
| 58 t4 = s1 | |
| 59 if (t1 /= s1) call abort | |
| 60 if (t4 /= s4) call abort | |
| 61 if (len(s1) /= len(t1)) call abort | |
| 62 if (len(s1) /= len(s4)) call abort | |
| 63 if (len(s1) /= len(t4)) call abort | |
| 64 if (len_trim(s1) /= len_trim(t1)) call abort | |
| 65 if (len_trim(s1) /= len_trim(s4)) call abort | |
| 66 if (len_trim(s1) /= len_trim(t4)) call abort | |
| 67 end subroutine check2 | |
| 68 | |
| 69 end |