libsim Versione 7.1.11
char_utilities_test.f90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18! Programma di test per il module char_utilities
19! migliorare a piacimento
20PROGRAM char_test
21USE kinds
23IMPLICIT NONE
24
25CHARACTER(len=64) :: charbuf
26INTEGER :: icheck
27INTEGER(kind=int_b) :: bcheck
28REAL :: rcheck
29DOUBLE PRECISION :: dcheck
30INTEGER, POINTER :: ws(:), we(:)
31TYPE(line_split) :: longline
32
33print*,'=== Testing char_utilities module ==='
34
35print*,'Checking int_to_char'
36charbuf = to_char(huge(1))
37READ(charbuf, '(I10)') icheck
38IF (icheck /= huge(1)) CALL exit(1)
39charbuf = to_char(-1000000)
40READ(charbuf, '(I10)') icheck
41IF (icheck /= -1000000) CALL exit(1)
42
43print*,'Checking byte_to_char'
44charbuf = to_char(127_int_b)
45READ(charbuf, '(I4)') bcheck
46IF (bcheck /= 127_int_b) CALL exit(1)
47charbuf = to_char(-127_int_b)
48READ(charbuf, '(I4)') bcheck
49IF (bcheck /= -127_int_b) CALL exit(1)
50
51print*,'Checking real_to_char'
52charbuf = to_char(1.0e+20)
53READ(charbuf, '(F15.0)') rcheck
54IF (abs((rcheck-1.0e+20)/1.0e+20) > 1.0e-30 ) CALL exit(1)
55charbuf = to_char(-1.0e-20)
56READ(charbuf, '(F15.0)') rcheck
57IF (abs((rcheck+1.0e-20)/1.0e+20) > 1.0e-30 ) CALL exit(1)
58
59print*,'Checking double_to_char'
60charbuf = to_char(1.0d+120)
61READ(charbuf, '(D24.0)') dcheck
62IF (abs((dcheck-1.0d+120)/1.0d+120) > 1.0d-200 ) CALL exit(1)
63charbuf = to_char(-1.0d-120)
64READ(charbuf, '(D24.0)') dcheck
65IF (abs((dcheck+1.0d-120)/1.0d+120) > 1.0d-200 ) CALL exit(1)
66
67print*,'Checking l_nblnk'
68IF (l_nblnk('1234') /= 4 .OR. l_nblnk('12345 ') /= 5) CALL exit(1)
69print*,'Checking l_nblnk partly degenerated'
70IF (l_nblnk(' ') /= 0) CALL exit(1)
71print*,'Checking l_nblnk fully degenerated'
72IF (l_nblnk('') /= 0) CALL exit(1)
73print*,'Checking f_nblnk'
74IF (f_nblnk('1234', ' ') /= 1 .OR. f_nblnk(' 12345',' ') /= 2) CALL exit(1)
75! the following test fails with gfortran-4.8.3 -O2 because f_nblnk is
76! called only once and the result recycled, so the test has been split
77!PRINT*,'Checking f_nblnk degenerated'
78!IF (f_nblnk(' ') /= 5 .OR. f_nblnk('') /= 1) CALL EXIT(1)
79print*,'Checking f_nblnk partly degenerated'
80IF (f_nblnk(' ') /= 5) CALL exit(1)
81print*,'Checking f_nblnk fully degenerated'
82IF (f_nblnk('') /= 1) CALL exit(1)
83
84!PRINT*,'Checking align_left'
85!IF (align_left(' ciao') /= 'ciao ' .OR. align_left('ciao ') /= 'ciao ') CALL EXIT(1)
86!PRINT*,'Checking align_left degenerated'
87!IF (align_left('') /= '' .OR. align_left(' ') /= ' ') CALL EXIT(1)
88!PRINT*,'Checking align_right'
89!IF (align_right(' ciao') /= ' ciao' .OR. align_right('ciao ') /= ' ciao') CALL EXIT(1)
90!PRINT*,'Checking align_right degenerated'
91!IF (align_right('') /= '' .OR. align_right(' ') /= ' ') CALL EXIT(1)
92print*,'Checking align_center even'
93IF (align_center(' ciao') /= ' ciao ' .OR. align_center('ciao ') /= ' ciao ') CALL exit(1)
94print*,'Checking align_center odd'
95IF (align_center(' ciao ') /= ' ciao ' .AND. align_center(' ciao ') /= ' ciao ') CALL exit(1)
96print*,'Checking align_center degenerated'
97IF (align_center('') /= '' .OR. align_center(' ') /= ' ') CALL exit(1)
98
99print*,'Checking word_split - 3 words'
100IF (word_split(' prima secunda tertia ') /= 3 .OR. &
101 word_split('prima secunda tertia ') /= 3 .OR. &
102 word_split(' prima secunda tertia') /= 3 .OR. &
103 word_split('prima secunda tertia') /= 3) CALL exit(1)
104print*,'Checking word_split degenerated - 1 word'
105IF (word_split('prima') /= 1 .OR. word_split(' prima') /= 1 &
106 .OR. word_split('prima ') /= 1) CALL exit(1)
107print*,'Checking word_split degenerated - 0 words'
108IF (word_split('') /= 0 .OR. word_split(' ') /= 0) CALL exit(1)
109
110print*,'Checking word_split with indices - 3 words'
111IF (word_split(' prima secunda tertia ', ws, we) /= 3) CALL exit(1)
112print*,'Checking word_split with indices - 3 words - checking indices'
113IF (any(ws(:) /= (/3,9,18/)) .OR. any(we(:) /= (/7,15,23/))) CALL exit(1)
114DEALLOCATE(ws, we)
115
116print*,'Checking line_split'
117longline=line_split_new('che bella cosa ''na jurna` de sole, l''aria serena dopo la tempesta', 20)
118IF (line_split_get_nlines(longline) /= 4 .OR. &
119 line_split_get_line(longline, 1) /= 'che bella cosa ''na' .OR. &
120 line_split_get_line(longline, 2) /= 'jurna` de sole,' .OR. &
121 line_split_get_line(longline, 3) /= 'l''aria serena dopo' .OR. &
122 line_split_get_line(longline, 4) /= 'la tempesta') CALL exit(1)
123CALL delete(longline)
124
125print*,'checking wash_char'
126IF (trim(wash_char('abcde12345')) /= 'abcde' .OR. &
127 trim(wash_char('abcde 12345',badchar='a')) /= 'bcde 12345' .OR. &
128 trim(wash_char('abcde12345',goodchar='a')) /= 'a') CALL exit(1)
129
130END PROGRAM char_test
Destructor for the line_split class.
Set of functions that return a CHARACTER representation of the input variable.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251

Generated with Doxygen.