annotate gcc/testsuite/gfortran.dg/trim_1.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2
kono
parents:
diff changeset
3 ! Torture-test TRIM and LEN_TRIM for correctness.
kono
parents:
diff changeset
4
kono
parents:
diff changeset
5
kono
parents:
diff changeset
6 ! Given a total string length and a trimmed length, construct an
kono
parents:
diff changeset
7 ! appropriate string and check gfortran gets it right.
kono
parents:
diff changeset
8
kono
parents:
diff changeset
9 SUBROUTINE check_trim (full_len, trimmed_len)
kono
parents:
diff changeset
10 IMPLICIT NONE
kono
parents:
diff changeset
11 INTEGER, INTENT(IN) :: full_len, trimmed_len
kono
parents:
diff changeset
12 CHARACTER(LEN=full_len) :: string
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 string = ""
kono
parents:
diff changeset
15 IF (trimmed_len > 0) THEN
kono
parents:
diff changeset
16 string(trimmed_len:trimmed_len) = "x"
kono
parents:
diff changeset
17 END IF
kono
parents:
diff changeset
18
kono
parents:
diff changeset
19 IF (LEN (string) /= full_len &
kono
parents:
diff changeset
20 .OR. LEN_TRIM (string) /= trimmed_len &
kono
parents:
diff changeset
21 .OR. LEN (TRIM (string)) /= trimmed_len &
kono
parents:
diff changeset
22 .OR. TRIM (string) /= string (1:trimmed_len)) THEN
kono
parents:
diff changeset
23 PRINT *, full_len, trimmed_len
kono
parents:
diff changeset
24 PRINT *, LEN (string), LEN_TRIM (string)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
25 STOP 1
111
kono
parents:
diff changeset
26 END IF
kono
parents:
diff changeset
27 END SUBROUTINE check_trim
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29
kono
parents:
diff changeset
30 ! The main program, check with various combinations.
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 PROGRAM main
kono
parents:
diff changeset
33 IMPLICIT NONE
kono
parents:
diff changeset
34 INTEGER :: i, j
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 DO i = 0, 20
kono
parents:
diff changeset
37 DO j = 0, i
kono
parents:
diff changeset
38 CALL check_trim (i, j)
kono
parents:
diff changeset
39 END DO
kono
parents:
diff changeset
40 END DO
kono
parents:
diff changeset
41 END PROGRAM main