libsim  Versione 7.2.1
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
20 PROGRAM char_test
21 USE kinds
23 IMPLICIT NONE
24 
25 CHARACTER(len=64) :: charbuf
26 INTEGER :: icheck
27 INTEGER(kind=int_b) :: bcheck
28 REAL :: rcheck
29 DOUBLE PRECISION :: dcheck
30 INTEGER, POINTER :: ws(:), we(:)
31 TYPE(line_split) :: longline
32 
33 print*,'=== Testing char_utilities module ==='
34 
35 print*,'Checking int_to_char'
36 charbuf = to_char(huge(1))
37 READ(charbuf, '(I10)') icheck
38 IF (icheck /= huge(1)) CALL exit(1)
39 charbuf = to_char(-1000000)
40 READ(charbuf, '(I10)') icheck
41 IF (icheck /= -1000000) CALL exit(1)
42 
43 print*,'Checking byte_to_char'
44 charbuf = to_char(127_int_b)
45 READ(charbuf, '(I4)') bcheck
46 IF (bcheck /= 127_int_b) CALL exit(1)
47 charbuf = to_char(-127_int_b)
48 READ(charbuf, '(I4)') bcheck
49 IF (bcheck /= -127_int_b) CALL exit(1)
50 
51 print*,'Checking real_to_char'
52 charbuf = to_char(1.0e+20)
53 READ(charbuf, '(F15.0)') rcheck
54 IF (abs((rcheck-1.0e+20)/1.0e+20) > 1.0e-30 ) CALL exit(1)
55 charbuf = to_char(-1.0e-20)
56 READ(charbuf, '(F15.0)') rcheck
57 IF (abs((rcheck+1.0e-20)/1.0e+20) > 1.0e-30 ) CALL exit(1)
58 
59 print*,'Checking double_to_char'
60 charbuf = to_char(1.0d+120)
61 READ(charbuf, '(D24.0)') dcheck
62 IF (abs((dcheck-1.0d+120)/1.0d+120) > 1.0d-200 ) CALL exit(1)
63 charbuf = to_char(-1.0d-120)
64 READ(charbuf, '(D24.0)') dcheck
65 IF (abs((dcheck+1.0d-120)/1.0d+120) > 1.0d-200 ) CALL exit(1)
66 
67 print*,'Checking l_nblnk'
68 IF (l_nblnk('1234') /= 4 .OR. l_nblnk('12345 ') /= 5) CALL exit(1)
69 print*,'Checking l_nblnk partly degenerated'
70 IF (l_nblnk(' ') /= 0) CALL exit(1)
71 print*,'Checking l_nblnk fully degenerated'
72 IF (l_nblnk('') /= 0) CALL exit(1)
73 print*,'Checking f_nblnk'
74 IF (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)
79 print*,'Checking f_nblnk partly degenerated'
80 IF (f_nblnk(' ') /= 5) CALL exit(1)
81 print*,'Checking f_nblnk fully degenerated'
82 IF (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)
92 print*,'Checking align_center even'
93 IF (align_center(' ciao') /= ' ciao ' .OR. align_center('ciao ') /= ' ciao ') CALL exit(1)
94 print*,'Checking align_center odd'
95 IF (align_center(' ciao ') /= ' ciao ' .AND. align_center(' ciao ') /= ' ciao ') CALL exit(1)
96 print*,'Checking align_center degenerated'
97 IF (align_center('') /= '' .OR. align_center(' ') /= ' ') CALL exit(1)
98 
99 print*,'Checking word_split - 3 words'
100 IF (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)
104 print*,'Checking word_split degenerated - 1 word'
105 IF (word_split('prima') /= 1 .OR. word_split(' prima') /= 1 &
106  .OR. word_split('prima ') /= 1) CALL exit(1)
107 print*,'Checking word_split degenerated - 0 words'
108 IF (word_split('') /= 0 .OR. word_split(' ') /= 0) CALL exit(1)
109 
110 print*,'Checking word_split with indices - 3 words'
111 IF (word_split(' prima secunda tertia ', ws, we) /= 3) CALL exit(1)
112 print*,'Checking word_split with indices - 3 words - checking indices'
113 IF (any(ws(:) /= (/3,9,18/)) .OR. any(we(:) /= (/7,15,23/))) CALL exit(1)
114 DEALLOCATE(ws, we)
115 
116 print*,'Checking line_split'
117 longline=line_split_new('che bella cosa ''na jurna` de sole, l''aria serena dopo la tempesta', 20)
118 IF (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)
123 CALL delete(longline)
124 
125 print*,'checking wash_char'
126 IF (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 
130 END 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:255

Generated with Doxygen.