~ubuntu-branches/ubuntu/hardy/pxp/hardy

« back to all changes in this revision

Viewing changes to rtests/lex/test_lex_utf8.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2005-03-29 11:06:39 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050329110639-5p39hz1d4aq3r2ec
Tags: 1.1.95-6
* Rebuilt against ocaml 3.08.3
* No longer built with wlex support (since wlex is no longer supported
  upstream and corresponding package has been removed from the debian
  archive)

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* $Id: test_lex_utf8.ml 673 2004-06-02 22:07:53Z gerd $
 
2
 * ----------------------------------------------------------------------
 
3
 *
 
4
 *)
 
5
 
 
6
open Pxp_lexer_types
 
7
 
 
8
let mk_utf8_string l =
 
9
  let n = List.length l in
 
10
  let s = String.create (2*n) in
 
11
  for k = 0 to n-1 do
 
12
    let v = List.nth l k in
 
13
    s.[2*k]   <- Char.chr(v land 0xff);
 
14
    s.[2*k+1] <- Char.chr(v lsr 8);
 
15
  done;
 
16
  Netconversion.recode_string `Enc_utf16_le `Enc_utf8 s
 
17
;;
 
18
 
 
19
let scan s =
 
20
  let lfactory = Pxp_lexers.get_lexer_factory `Enc_utf8 in
 
21
  let lobj = lfactory # open_string s in
 
22
  let scanner = lobj # scan_name_string in
 
23
  let rec scan_rest () =
 
24
    match scanner () with
 
25
        Eof -> []
 
26
      | tok -> tok :: scan_rest()
 
27
  in
 
28
  scan_rest()
 
29
;;
 
30
 
 
31
let dotest name f =
 
32
  print_string ("Test " ^ name ^ ": ");
 
33
  flush stdout;
 
34
  try
 
35
    if f () then
 
36
      print_endline "OK"
 
37
    else
 
38
      print_endline "FAILED (returns false)"
 
39
  with
 
40
      ex ->
 
41
        print_endline ("FAILED (exception " ^ Printexc.to_string ex ^ ")")
 
42
;;
 
43
 
 
44
(**********************************************************************)
 
45
 
 
46
let name1 = [ 0x03d0; 0x03d1; 0x0958; 0x0041; 0x0A05 ];;
 
47
let name2 = [ 0x10d0; 0x11ba; 0x2126; 0xAc00; 0xac01 ];;
 
48
let name3 = [ 0xd700; 0xd701; 0x3105; 0x1f5d; 0x114c ];;
 
49
 
 
50
let s_name1 = mk_utf8_string name1 ;;
 
51
let s_name2 = mk_utf8_string name2 ;;
 
52
let s_name3 = mk_utf8_string name3 ;;
 
53
 
 
54
let ideo1 = [ 0x4e00; 0x3007; 0x9fa4 ];;
 
55
let ideo2 = [ 0x3021; 0x3026; 0x3027 ];;
 
56
 
 
57
let s_ideo1 = mk_utf8_string ideo1 ;;
 
58
let s_ideo2 = mk_utf8_string ideo2 ;;
 
59
 
 
60
let digit1 = [ 0x0030; 0x0031 ];;
 
61
let digit2 = [ 0x09e6; 0x09ef ];;
 
62
let digit3 = [ 0x30fc; 0x30fe ];;
 
63
 
 
64
let s_digit1 = mk_utf8_string digit1 ;;
 
65
let s_digit2 = mk_utf8_string digit2 ;;
 
66
let s_digit3 = mk_utf8_string digit3 ;;
 
67
 
 
68
let other1_1 = [ 0x00f7 ];;
 
69
let other1_2 = [ 0x0a00 ];;
 
70
let other1 = other1_1 @ other1_2 ;;
 
71
let other2_1 = [ 0x1000 ];;
 
72
let other2_2 = [ 0x2000 ];;
 
73
let other2 = other2_1 @ other2_2 ;;
 
74
 
 
75
let s_other1_1 = mk_utf8_string other1_1 ;;
 
76
let s_other1_2 = mk_utf8_string other1_2 ;;
 
77
let s_other1 = mk_utf8_string other1 ;;
 
78
let s_other2_1 = mk_utf8_string other2_1 ;;
 
79
let s_other2_2 = mk_utf8_string other2_2 ;;
 
80
let s_other2 = mk_utf8_string other2 ;;
 
81
 
 
82
let t_name1 () =
 
83
  scan s_name1 = [ Name s_name1 ]
 
84
;;
 
85
 
 
86
let t_name2 () =
 
87
  scan s_name2 = [ Name s_name2 ]
 
88
;;
 
89
 
 
90
let t_name3 () =
 
91
  scan s_name3 = [ Name s_name3 ]
 
92
;;
 
93
 
 
94
let t_digit1 () =
 
95
  scan s_digit1 = [ Nametoken s_digit1 ]
 
96
;;
 
97
 
 
98
let t_digit2 () =
 
99
  scan s_digit2 = [ Nametoken s_digit2 ]
 
100
;;
 
101
 
 
102
let t_digit3 () =
 
103
  scan s_digit3 = [ Nametoken s_digit3 ]
 
104
;;
 
105
 
 
106
let t_name1digit1 () =
 
107
  scan (s_name1 ^ s_digit1) = [ Name (s_name1 ^ s_digit1) ]
 
108
;;
 
109
 
 
110
let t_name2digit2 () =
 
111
  scan (s_name2 ^ s_digit2) = [ Name (s_name2 ^ s_digit2) ]
 
112
;;
 
113
 
 
114
let t_name3digit3 () =
 
115
  scan (s_name3 ^ s_digit3) = [ Name (s_name3 ^ s_digit3) ]
 
116
;;
 
117
 
 
118
let t_name1ideo1 () =
 
119
  scan (s_name1 ^ s_ideo1) = [ Name (s_name1 ^ s_ideo1) ]
 
120
;;
 
121
 
 
122
let t_name2ideo2 () =
 
123
  scan (s_name2 ^ s_ideo2) = [ Name (s_name2 ^ s_ideo2) ]
 
124
;;
 
125
 
 
126
let t_digit1name1 () =
 
127
  scan (s_digit1 ^ s_name1) = [ Nametoken (s_digit1 ^ s_name1) ]
 
128
;;
 
129
 
 
130
let t_digit2name2 () =
 
131
  scan (s_digit2 ^ s_name2) = [ Nametoken (s_digit2 ^ s_name2) ]
 
132
;;
 
133
 
 
134
let t_digit3name3 () =
 
135
  scan (s_digit3 ^ s_name3) = [ Nametoken (s_digit3 ^ s_name3) ]
 
136
;;
 
137
 
 
138
let t_other1 () =
 
139
  scan s_other1 = [ CharData s_other1_1; CharData s_other1_2 ]
 
140
;;
 
141
 
 
142
let t_other2 () =
 
143
  scan s_other2 = [ CharData s_other2_1; CharData s_other2_2 ]
 
144
;;
 
145
 
 
146
let t_name1other1name2 () =
 
147
  scan (s_name1 ^ s_other1 ^ s_name2 ) =
 
148
  [ Name s_name1; CharData s_other1_1; CharData s_other1_2; Name s_name2 ]
 
149
;;
 
150
 
 
151
let t_name2other2name3 () =
 
152
  scan (s_name2 ^ s_other2 ^ s_name3 ) =
 
153
  [ Name s_name2; CharData s_other2_1; CharData s_other2_2; Name s_name3 ]
 
154
;;
 
155
 
 
156
let t_digit1other1digit2 () =
 
157
  scan (s_digit1 ^ s_other1 ^ s_digit2 ) =
 
158
  [ Nametoken s_digit1; 
 
159
    CharData s_other1_1; CharData s_other1_2; 
 
160
    Nametoken s_digit2 ]
 
161
;;
 
162
 
 
163
let t_digit2other2digit3 () =
 
164
  scan (s_digit2 ^ s_other2 ^ s_digit3 ) =
 
165
  [ Nametoken s_digit2; 
 
166
    CharData s_other2_1; CharData s_other2_2; 
 
167
    Nametoken s_digit3 ]
 
168
;;
 
169
 
 
170
let t_illegal1 () =
 
171
  let chr x = String.make 1 (Char.chr x) in
 
172
  try
 
173
    (* The wrong way to encode 0x00: *)
 
174
    let _ = scan (chr 0b11000000 ^ chr 0b10000000) in
 
175
    false
 
176
  with
 
177
      Netconversion.Malformed_code ->
 
178
        true
 
179
;;
 
180
 
 
181
let t_illegal2 () =
 
182
  let chr x = String.make 1 (Char.chr x) in
 
183
  try
 
184
    (* The wrong way to encode 0x40: *)
 
185
    let _ = scan (chr 0b11000001 ^ chr 0b10000000) in
 
186
    false
 
187
  with
 
188
      Netconversion.Malformed_code ->
 
189
        true
 
190
;;
 
191
 
 
192
let t_illegal3 () =
 
193
  let chr x = String.make 1 (Char.chr x) in
 
194
  try
 
195
    (* The wrong way to encode 0x00: *)
 
196
    let _ = scan (chr 0b11100000 ^ chr 0b10000000 ^ chr 0b10000000) in
 
197
    false
 
198
  with
 
199
      Netconversion.Malformed_code ->
 
200
        true
 
201
;;
 
202
 
 
203
let t_illegal4 () =
 
204
  let chr x = String.make 1 (Char.chr x) in
 
205
  try
 
206
    (* The wrong way to encode 0x0700: *)
 
207
    let _ = scan (chr 0b11100000 ^ chr 0b10011100 ^ chr 0b10000000) in
 
208
    false
 
209
  with
 
210
      Netconversion.Malformed_code ->
 
211
        true
 
212
;;
 
213
 
 
214
let t_illegal5 () =
 
215
  let chr x = String.make 1 (Char.chr x) in
 
216
  try
 
217
    (* The wrong way to encode 0x00: *)
 
218
    let _ = scan (chr 0b11110000 ^ chr 0b10000000 ^ chr 0b10000000 ^ chr 0b10000000) in
 
219
    false
 
220
  with
 
221
      Netconversion.Malformed_code ->
 
222
        true
 
223
;;
 
224
 
 
225
let t_illegal6 () =
 
226
  let chr x = String.make 1 (Char.chr x) in
 
227
  try
 
228
    (* The wrong way to encode 0x0700: *)
 
229
    let _ = scan (chr 0b11110000 ^ chr 0b10000000 ^ chr 0b10011100 ^ chr 0b10000000) in
 
230
    false
 
231
  with
 
232
      Netconversion.Malformed_code ->
 
233
        true
 
234
;;
 
235
 
 
236
 
 
237
let t_illegal7 () =
 
238
  let chr x = String.make 1 (Char.chr x) in
 
239
  try
 
240
    (* The wrong way to encode 0x7000: *)
 
241
    let _ = scan (chr 0b11110000 ^ chr 0b10000111 ^ chr 0b10000000 ^ chr 0b10000000) in
 
242
    false
 
243
  with
 
244
      Netconversion.Malformed_code ->
 
245
        true
 
246
;;
 
247
 
 
248
(**********************************************************************)
 
249
 
 
250
dotest "t_name1" t_name1;;
 
251
dotest "t_name2" t_name2;;
 
252
dotest "t_name3" t_name3;;
 
253
 
 
254
dotest "t_digit1" t_digit1;;
 
255
dotest "t_digit2" t_digit2;;
 
256
dotest "t_digit3" t_digit3;;
 
257
 
 
258
dotest "t_name1digit1" t_name1digit1;;
 
259
dotest "t_name2digit2" t_name2digit2;;
 
260
dotest "t_name3digit3" t_name3digit3;;
 
261
 
 
262
dotest "t_name1ideo1" t_name1ideo1;;
 
263
dotest "t_name2ideo2" t_name2ideo2;;
 
264
 
 
265
dotest "t_digit1name1" t_digit1name1;;
 
266
dotest "t_digit2name2" t_digit2name2;;
 
267
dotest "t_digit3name3" t_digit3name3;;
 
268
 
 
269
dotest "t_other1" t_other1;;
 
270
dotest "t_other2" t_other2;;
 
271
 
 
272
dotest "t_name1other1name2" t_name1other1name2;;
 
273
dotest "t_name2other2name3" t_name2other2name3;;
 
274
 
 
275
dotest "t_digit1other1digit2" t_digit1other1digit2;;
 
276
dotest "t_digit2other2digit3" t_digit2other2digit3;;
 
277
 
 
278
dotest "t_illegal1" t_illegal1;;
 
279
dotest "t_illegal2" t_illegal2;;
 
280
dotest "t_illegal3" t_illegal3;;
 
281
dotest "t_illegal4" t_illegal4;;
 
282
dotest "t_illegal5" t_illegal5;;
 
283
dotest "t_illegal6" t_illegal6;;
 
284
dotest "t_illegal7" t_illegal7;;
 
285