|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- I N T E R F A C E S . C --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 package body Interfaces.C is
|
|
|
33
|
|
|
34 -----------------------
|
|
|
35 -- Is_Nul_Terminated --
|
|
|
36 -----------------------
|
|
|
37
|
|
|
38 -- Case of char_array
|
|
|
39
|
|
|
40 function Is_Nul_Terminated (Item : char_array) return Boolean is
|
|
|
41 begin
|
|
|
42 for J in Item'Range loop
|
|
|
43 if Item (J) = nul then
|
|
|
44 return True;
|
|
|
45 end if;
|
|
|
46 end loop;
|
|
|
47
|
|
|
48 return False;
|
|
|
49 end Is_Nul_Terminated;
|
|
|
50
|
|
|
51 -- Case of wchar_array
|
|
|
52
|
|
|
53 function Is_Nul_Terminated (Item : wchar_array) return Boolean is
|
|
|
54 begin
|
|
|
55 for J in Item'Range loop
|
|
|
56 if Item (J) = wide_nul then
|
|
|
57 return True;
|
|
|
58 end if;
|
|
|
59 end loop;
|
|
|
60
|
|
|
61 return False;
|
|
|
62 end Is_Nul_Terminated;
|
|
|
63
|
|
|
64 -- Case of char16_array
|
|
|
65
|
|
|
66 function Is_Nul_Terminated (Item : char16_array) return Boolean is
|
|
|
67 begin
|
|
|
68 for J in Item'Range loop
|
|
|
69 if Item (J) = char16_nul then
|
|
|
70 return True;
|
|
|
71 end if;
|
|
|
72 end loop;
|
|
|
73
|
|
|
74 return False;
|
|
|
75 end Is_Nul_Terminated;
|
|
|
76
|
|
|
77 -- Case of char32_array
|
|
|
78
|
|
|
79 function Is_Nul_Terminated (Item : char32_array) return Boolean is
|
|
|
80 begin
|
|
|
81 for J in Item'Range loop
|
|
|
82 if Item (J) = char32_nul then
|
|
|
83 return True;
|
|
|
84 end if;
|
|
|
85 end loop;
|
|
|
86
|
|
|
87 return False;
|
|
|
88 end Is_Nul_Terminated;
|
|
|
89
|
|
|
90 ------------
|
|
|
91 -- To_Ada --
|
|
|
92 ------------
|
|
|
93
|
|
|
94 -- Convert char to Character
|
|
|
95
|
|
|
96 function To_Ada (Item : char) return Character is
|
|
|
97 begin
|
|
|
98 return Character'Val (char'Pos (Item));
|
|
|
99 end To_Ada;
|
|
|
100
|
|
|
101 -- Convert char_array to String (function form)
|
|
|
102
|
|
|
103 function To_Ada
|
|
|
104 (Item : char_array;
|
|
|
105 Trim_Nul : Boolean := True) return String
|
|
|
106 is
|
|
|
107 Count : Natural;
|
|
|
108 From : size_t;
|
|
|
109
|
|
|
110 begin
|
|
|
111 if Trim_Nul then
|
|
|
112 From := Item'First;
|
|
|
113
|
|
|
114 loop
|
|
|
115 if From > Item'Last then
|
|
|
116 raise Terminator_Error;
|
|
|
117 elsif Item (From) = nul then
|
|
|
118 exit;
|
|
|
119 else
|
|
|
120 From := From + 1;
|
|
|
121 end if;
|
|
|
122 end loop;
|
|
|
123
|
|
|
124 Count := Natural (From - Item'First);
|
|
|
125
|
|
|
126 else
|
|
|
127 Count := Item'Length;
|
|
|
128 end if;
|
|
|
129
|
|
|
130 declare
|
|
|
131 R : String (1 .. Count);
|
|
|
132
|
|
|
133 begin
|
|
|
134 for J in R'Range loop
|
|
|
135 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
|
|
|
136 end loop;
|
|
|
137
|
|
|
138 return R;
|
|
|
139 end;
|
|
|
140 end To_Ada;
|
|
|
141
|
|
|
142 -- Convert char_array to String (procedure form)
|
|
|
143
|
|
|
144 procedure To_Ada
|
|
|
145 (Item : char_array;
|
|
|
146 Target : out String;
|
|
|
147 Count : out Natural;
|
|
|
148 Trim_Nul : Boolean := True)
|
|
|
149 is
|
|
|
150 From : size_t;
|
|
|
151 To : Positive;
|
|
|
152
|
|
|
153 begin
|
|
|
154 if Trim_Nul then
|
|
|
155 From := Item'First;
|
|
|
156 loop
|
|
|
157 if From > Item'Last then
|
|
|
158 raise Terminator_Error;
|
|
|
159 elsif Item (From) = nul then
|
|
|
160 exit;
|
|
|
161 else
|
|
|
162 From := From + 1;
|
|
|
163 end if;
|
|
|
164 end loop;
|
|
|
165
|
|
|
166 Count := Natural (From - Item'First);
|
|
|
167
|
|
|
168 else
|
|
|
169 Count := Item'Length;
|
|
|
170 end if;
|
|
|
171
|
|
|
172 if Count > Target'Length then
|
|
|
173 raise Constraint_Error;
|
|
|
174
|
|
|
175 else
|
|
|
176 From := Item'First;
|
|
|
177 To := Target'First;
|
|
|
178
|
|
|
179 for J in 1 .. Count loop
|
|
|
180 Target (To) := Character (Item (From));
|
|
|
181 From := From + 1;
|
|
|
182 To := To + 1;
|
|
|
183 end loop;
|
|
|
184 end if;
|
|
|
185
|
|
|
186 end To_Ada;
|
|
|
187
|
|
|
188 -- Convert wchar_t to Wide_Character
|
|
|
189
|
|
|
190 function To_Ada (Item : wchar_t) return Wide_Character is
|
|
|
191 begin
|
|
|
192 return Wide_Character (Item);
|
|
|
193 end To_Ada;
|
|
|
194
|
|
|
195 -- Convert wchar_array to Wide_String (function form)
|
|
|
196
|
|
|
197 function To_Ada
|
|
|
198 (Item : wchar_array;
|
|
|
199 Trim_Nul : Boolean := True) return Wide_String
|
|
|
200 is
|
|
|
201 Count : Natural;
|
|
|
202 From : size_t;
|
|
|
203
|
|
|
204 begin
|
|
|
205 if Trim_Nul then
|
|
|
206 From := Item'First;
|
|
|
207
|
|
|
208 loop
|
|
|
209 if From > Item'Last then
|
|
|
210 raise Terminator_Error;
|
|
|
211 elsif Item (From) = wide_nul then
|
|
|
212 exit;
|
|
|
213 else
|
|
|
214 From := From + 1;
|
|
|
215 end if;
|
|
|
216 end loop;
|
|
|
217
|
|
|
218 Count := Natural (From - Item'First);
|
|
|
219
|
|
|
220 else
|
|
|
221 Count := Item'Length;
|
|
|
222 end if;
|
|
|
223
|
|
|
224 declare
|
|
|
225 R : Wide_String (1 .. Count);
|
|
|
226
|
|
|
227 begin
|
|
|
228 for J in R'Range loop
|
|
|
229 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
|
|
|
230 end loop;
|
|
|
231
|
|
|
232 return R;
|
|
|
233 end;
|
|
|
234 end To_Ada;
|
|
|
235
|
|
|
236 -- Convert wchar_array to Wide_String (procedure form)
|
|
|
237
|
|
|
238 procedure To_Ada
|
|
|
239 (Item : wchar_array;
|
|
|
240 Target : out Wide_String;
|
|
|
241 Count : out Natural;
|
|
|
242 Trim_Nul : Boolean := True)
|
|
|
243 is
|
|
|
244 From : size_t;
|
|
|
245 To : Positive;
|
|
|
246
|
|
|
247 begin
|
|
|
248 if Trim_Nul then
|
|
|
249 From := Item'First;
|
|
|
250 loop
|
|
|
251 if From > Item'Last then
|
|
|
252 raise Terminator_Error;
|
|
|
253 elsif Item (From) = wide_nul then
|
|
|
254 exit;
|
|
|
255 else
|
|
|
256 From := From + 1;
|
|
|
257 end if;
|
|
|
258 end loop;
|
|
|
259
|
|
|
260 Count := Natural (From - Item'First);
|
|
|
261
|
|
|
262 else
|
|
|
263 Count := Item'Length;
|
|
|
264 end if;
|
|
|
265
|
|
|
266 if Count > Target'Length then
|
|
|
267 raise Constraint_Error;
|
|
|
268
|
|
|
269 else
|
|
|
270 From := Item'First;
|
|
|
271 To := Target'First;
|
|
|
272
|
|
|
273 for J in 1 .. Count loop
|
|
|
274 Target (To) := To_Ada (Item (From));
|
|
|
275 From := From + 1;
|
|
|
276 To := To + 1;
|
|
|
277 end loop;
|
|
|
278 end if;
|
|
|
279 end To_Ada;
|
|
|
280
|
|
|
281 -- Convert char16_t to Wide_Character
|
|
|
282
|
|
|
283 function To_Ada (Item : char16_t) return Wide_Character is
|
|
|
284 begin
|
|
|
285 return Wide_Character'Val (char16_t'Pos (Item));
|
|
|
286 end To_Ada;
|
|
|
287
|
|
|
288 -- Convert char16_array to Wide_String (function form)
|
|
|
289
|
|
|
290 function To_Ada
|
|
|
291 (Item : char16_array;
|
|
|
292 Trim_Nul : Boolean := True) return Wide_String
|
|
|
293 is
|
|
|
294 Count : Natural;
|
|
|
295 From : size_t;
|
|
|
296
|
|
|
297 begin
|
|
|
298 if Trim_Nul then
|
|
|
299 From := Item'First;
|
|
|
300
|
|
|
301 loop
|
|
|
302 if From > Item'Last then
|
|
|
303 raise Terminator_Error;
|
|
|
304 elsif Item (From) = char16_t'Val (0) then
|
|
|
305 exit;
|
|
|
306 else
|
|
|
307 From := From + 1;
|
|
|
308 end if;
|
|
|
309 end loop;
|
|
|
310
|
|
|
311 Count := Natural (From - Item'First);
|
|
|
312
|
|
|
313 else
|
|
|
314 Count := Item'Length;
|
|
|
315 end if;
|
|
|
316
|
|
|
317 declare
|
|
|
318 R : Wide_String (1 .. Count);
|
|
|
319
|
|
|
320 begin
|
|
|
321 for J in R'Range loop
|
|
|
322 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
|
|
|
323 end loop;
|
|
|
324
|
|
|
325 return R;
|
|
|
326 end;
|
|
|
327 end To_Ada;
|
|
|
328
|
|
|
329 -- Convert char16_array to Wide_String (procedure form)
|
|
|
330
|
|
|
331 procedure To_Ada
|
|
|
332 (Item : char16_array;
|
|
|
333 Target : out Wide_String;
|
|
|
334 Count : out Natural;
|
|
|
335 Trim_Nul : Boolean := True)
|
|
|
336 is
|
|
|
337 From : size_t;
|
|
|
338 To : Positive;
|
|
|
339
|
|
|
340 begin
|
|
|
341 if Trim_Nul then
|
|
|
342 From := Item'First;
|
|
|
343 loop
|
|
|
344 if From > Item'Last then
|
|
|
345 raise Terminator_Error;
|
|
|
346 elsif Item (From) = char16_t'Val (0) then
|
|
|
347 exit;
|
|
|
348 else
|
|
|
349 From := From + 1;
|
|
|
350 end if;
|
|
|
351 end loop;
|
|
|
352
|
|
|
353 Count := Natural (From - Item'First);
|
|
|
354
|
|
|
355 else
|
|
|
356 Count := Item'Length;
|
|
|
357 end if;
|
|
|
358
|
|
|
359 if Count > Target'Length then
|
|
|
360 raise Constraint_Error;
|
|
|
361
|
|
|
362 else
|
|
|
363 From := Item'First;
|
|
|
364 To := Target'First;
|
|
|
365
|
|
|
366 for J in 1 .. Count loop
|
|
|
367 Target (To) := To_Ada (Item (From));
|
|
|
368 From := From + 1;
|
|
|
369 To := To + 1;
|
|
|
370 end loop;
|
|
|
371 end if;
|
|
|
372 end To_Ada;
|
|
|
373
|
|
|
374 -- Convert char32_t to Wide_Wide_Character
|
|
|
375
|
|
|
376 function To_Ada (Item : char32_t) return Wide_Wide_Character is
|
|
|
377 begin
|
|
|
378 return Wide_Wide_Character'Val (char32_t'Pos (Item));
|
|
|
379 end To_Ada;
|
|
|
380
|
|
|
381 -- Convert char32_array to Wide_Wide_String (function form)
|
|
|
382
|
|
|
383 function To_Ada
|
|
|
384 (Item : char32_array;
|
|
|
385 Trim_Nul : Boolean := True) return Wide_Wide_String
|
|
|
386 is
|
|
|
387 Count : Natural;
|
|
|
388 From : size_t;
|
|
|
389
|
|
|
390 begin
|
|
|
391 if Trim_Nul then
|
|
|
392 From := Item'First;
|
|
|
393
|
|
|
394 loop
|
|
|
395 if From > Item'Last then
|
|
|
396 raise Terminator_Error;
|
|
|
397 elsif Item (From) = char32_t'Val (0) then
|
|
|
398 exit;
|
|
|
399 else
|
|
|
400 From := From + 1;
|
|
|
401 end if;
|
|
|
402 end loop;
|
|
|
403
|
|
|
404 Count := Natural (From - Item'First);
|
|
|
405
|
|
|
406 else
|
|
|
407 Count := Item'Length;
|
|
|
408 end if;
|
|
|
409
|
|
|
410 declare
|
|
|
411 R : Wide_Wide_String (1 .. Count);
|
|
|
412
|
|
|
413 begin
|
|
|
414 for J in R'Range loop
|
|
|
415 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
|
|
|
416 end loop;
|
|
|
417
|
|
|
418 return R;
|
|
|
419 end;
|
|
|
420 end To_Ada;
|
|
|
421
|
|
|
422 -- Convert char32_array to Wide_Wide_String (procedure form)
|
|
|
423
|
|
|
424 procedure To_Ada
|
|
|
425 (Item : char32_array;
|
|
|
426 Target : out Wide_Wide_String;
|
|
|
427 Count : out Natural;
|
|
|
428 Trim_Nul : Boolean := True)
|
|
|
429 is
|
|
|
430 From : size_t;
|
|
|
431 To : Positive;
|
|
|
432
|
|
|
433 begin
|
|
|
434 if Trim_Nul then
|
|
|
435 From := Item'First;
|
|
|
436 loop
|
|
|
437 if From > Item'Last then
|
|
|
438 raise Terminator_Error;
|
|
|
439 elsif Item (From) = char32_t'Val (0) then
|
|
|
440 exit;
|
|
|
441 else
|
|
|
442 From := From + 1;
|
|
|
443 end if;
|
|
|
444 end loop;
|
|
|
445
|
|
|
446 Count := Natural (From - Item'First);
|
|
|
447
|
|
|
448 else
|
|
|
449 Count := Item'Length;
|
|
|
450 end if;
|
|
|
451
|
|
|
452 if Count > Target'Length then
|
|
|
453 raise Constraint_Error;
|
|
|
454
|
|
|
455 else
|
|
|
456 From := Item'First;
|
|
|
457 To := Target'First;
|
|
|
458
|
|
|
459 for J in 1 .. Count loop
|
|
|
460 Target (To) := To_Ada (Item (From));
|
|
|
461 From := From + 1;
|
|
|
462 To := To + 1;
|
|
|
463 end loop;
|
|
|
464 end if;
|
|
|
465 end To_Ada;
|
|
|
466
|
|
|
467 ----------
|
|
|
468 -- To_C --
|
|
|
469 ----------
|
|
|
470
|
|
|
471 -- Convert Character to char
|
|
|
472
|
|
|
473 function To_C (Item : Character) return char is
|
|
|
474 begin
|
|
|
475 return char'Val (Character'Pos (Item));
|
|
|
476 end To_C;
|
|
|
477
|
|
|
478 -- Convert String to char_array (function form)
|
|
|
479
|
|
|
480 function To_C
|
|
|
481 (Item : String;
|
|
|
482 Append_Nul : Boolean := True) return char_array
|
|
|
483 is
|
|
|
484 begin
|
|
|
485 if Append_Nul then
|
|
|
486 declare
|
|
|
487 R : char_array (0 .. Item'Length);
|
|
|
488
|
|
|
489 begin
|
|
|
490 for J in Item'Range loop
|
|
|
491 R (size_t (J - Item'First)) := To_C (Item (J));
|
|
|
492 end loop;
|
|
|
493
|
|
|
494 R (R'Last) := nul;
|
|
|
495 return R;
|
|
|
496 end;
|
|
|
497
|
|
|
498 -- Append_Nul False
|
|
|
499
|
|
|
500 else
|
|
|
501 -- A nasty case, if the string is null, we must return a null
|
|
|
502 -- char_array. The lower bound of this array is required to be zero
|
|
|
503 -- (RM B.3(50)) but that is of course impossible given that size_t
|
|
|
504 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
|
|
|
505 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
|
|
|
506 -- since nothing else makes sense.
|
|
|
507
|
|
|
508 if Item'Length = 0 then
|
|
|
509 raise Constraint_Error;
|
|
|
510
|
|
|
511 -- Normal case
|
|
|
512
|
|
|
513 else
|
|
|
514 declare
|
|
|
515 R : char_array (0 .. Item'Length - 1);
|
|
|
516
|
|
|
517 begin
|
|
|
518 for J in Item'Range loop
|
|
|
519 R (size_t (J - Item'First)) := To_C (Item (J));
|
|
|
520 end loop;
|
|
|
521
|
|
|
522 return R;
|
|
|
523 end;
|
|
|
524 end if;
|
|
|
525 end if;
|
|
|
526 end To_C;
|
|
|
527
|
|
|
528 -- Convert String to char_array (procedure form)
|
|
|
529
|
|
|
530 procedure To_C
|
|
|
531 (Item : String;
|
|
|
532 Target : out char_array;
|
|
|
533 Count : out size_t;
|
|
|
534 Append_Nul : Boolean := True)
|
|
|
535 is
|
|
|
536 To : size_t;
|
|
|
537
|
|
|
538 begin
|
|
|
539 if Target'Length < Item'Length then
|
|
|
540 raise Constraint_Error;
|
|
|
541
|
|
|
542 else
|
|
|
543 To := Target'First;
|
|
|
544 for From in Item'Range loop
|
|
|
545 Target (To) := char (Item (From));
|
|
|
546 To := To + 1;
|
|
|
547 end loop;
|
|
|
548
|
|
|
549 if Append_Nul then
|
|
|
550 if To > Target'Last then
|
|
|
551 raise Constraint_Error;
|
|
|
552 else
|
|
|
553 Target (To) := nul;
|
|
|
554 Count := Item'Length + 1;
|
|
|
555 end if;
|
|
|
556
|
|
|
557 else
|
|
|
558 Count := Item'Length;
|
|
|
559 end if;
|
|
|
560 end if;
|
|
|
561 end To_C;
|
|
|
562
|
|
|
563 -- Convert Wide_Character to wchar_t
|
|
|
564
|
|
|
565 function To_C (Item : Wide_Character) return wchar_t is
|
|
|
566 begin
|
|
|
567 return wchar_t (Item);
|
|
|
568 end To_C;
|
|
|
569
|
|
|
570 -- Convert Wide_String to wchar_array (function form)
|
|
|
571
|
|
|
572 function To_C
|
|
|
573 (Item : Wide_String;
|
|
|
574 Append_Nul : Boolean := True) return wchar_array
|
|
|
575 is
|
|
|
576 begin
|
|
|
577 if Append_Nul then
|
|
|
578 declare
|
|
|
579 R : wchar_array (0 .. Item'Length);
|
|
|
580
|
|
|
581 begin
|
|
|
582 for J in Item'Range loop
|
|
|
583 R (size_t (J - Item'First)) := To_C (Item (J));
|
|
|
584 end loop;
|
|
|
585
|
|
|
586 R (R'Last) := wide_nul;
|
|
|
587 return R;
|
|
|
588 end;
|
|
|
589
|
|
|
590 else
|
|
|
591 -- A nasty case, if the string is null, we must return a null
|
|
|
592 -- wchar_array. The lower bound of this array is required to be zero
|
|
|
593 -- (RM B.3(50)) but that is of course impossible given that size_t
|
|
|
594 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
|
|
|
595 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
|
|
|
596 -- since nothing else makes sense.
|
|
|
597
|
|
|
598 if Item'Length = 0 then
|
|
|
599 raise Constraint_Error;
|
|
|
600
|
|
|
601 else
|
|
|
602 declare
|
|
|
603 R : wchar_array (0 .. Item'Length - 1);
|
|
|
604
|
|
|
605 begin
|
|
|
606 for J in size_t range 0 .. Item'Length - 1 loop
|
|
|
607 R (J) := To_C (Item (Integer (J) + Item'First));
|
|
|
608 end loop;
|
|
|
609
|
|
|
610 return R;
|
|
|
611 end;
|
|
|
612 end if;
|
|
|
613 end if;
|
|
|
614 end To_C;
|
|
|
615
|
|
|
616 -- Convert Wide_String to wchar_array (procedure form)
|
|
|
617
|
|
|
618 procedure To_C
|
|
|
619 (Item : Wide_String;
|
|
|
620 Target : out wchar_array;
|
|
|
621 Count : out size_t;
|
|
|
622 Append_Nul : Boolean := True)
|
|
|
623 is
|
|
|
624 To : size_t;
|
|
|
625
|
|
|
626 begin
|
|
|
627 if Target'Length < Item'Length then
|
|
|
628 raise Constraint_Error;
|
|
|
629
|
|
|
630 else
|
|
|
631 To := Target'First;
|
|
|
632 for From in Item'Range loop
|
|
|
633 Target (To) := To_C (Item (From));
|
|
|
634 To := To + 1;
|
|
|
635 end loop;
|
|
|
636
|
|
|
637 if Append_Nul then
|
|
|
638 if To > Target'Last then
|
|
|
639 raise Constraint_Error;
|
|
|
640 else
|
|
|
641 Target (To) := wide_nul;
|
|
|
642 Count := Item'Length + 1;
|
|
|
643 end if;
|
|
|
644
|
|
|
645 else
|
|
|
646 Count := Item'Length;
|
|
|
647 end if;
|
|
|
648 end if;
|
|
|
649 end To_C;
|
|
|
650
|
|
|
651 -- Convert Wide_Character to char16_t
|
|
|
652
|
|
|
653 function To_C (Item : Wide_Character) return char16_t is
|
|
|
654 begin
|
|
|
655 return char16_t'Val (Wide_Character'Pos (Item));
|
|
|
656 end To_C;
|
|
|
657
|
|
|
658 -- Convert Wide_String to char16_array (function form)
|
|
|
659
|
|
|
660 function To_C
|
|
|
661 (Item : Wide_String;
|
|
|
662 Append_Nul : Boolean := True) return char16_array
|
|
|
663 is
|
|
|
664 begin
|
|
|
665 if Append_Nul then
|
|
|
666 declare
|
|
|
667 R : char16_array (0 .. Item'Length);
|
|
|
668
|
|
|
669 begin
|
|
|
670 for J in Item'Range loop
|
|
|
671 R (size_t (J - Item'First)) := To_C (Item (J));
|
|
|
672 end loop;
|
|
|
673
|
|
|
674 R (R'Last) := char16_t'Val (0);
|
|
|
675 return R;
|
|
|
676 end;
|
|
|
677
|
|
|
678 else
|
|
|
679 -- A nasty case, if the string is null, we must return a null
|
|
|
680 -- char16_array. The lower bound of this array is required to be zero
|
|
|
681 -- (RM B.3(50)) but that is of course impossible given that size_t
|
|
|
682 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
|
|
|
683 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
|
|
|
684 -- since nothing else makes sense.
|
|
|
685
|
|
|
686 if Item'Length = 0 then
|
|
|
687 raise Constraint_Error;
|
|
|
688
|
|
|
689 else
|
|
|
690 declare
|
|
|
691 R : char16_array (0 .. Item'Length - 1);
|
|
|
692
|
|
|
693 begin
|
|
|
694 for J in size_t range 0 .. Item'Length - 1 loop
|
|
|
695 R (J) := To_C (Item (Integer (J) + Item'First));
|
|
|
696 end loop;
|
|
|
697
|
|
|
698 return R;
|
|
|
699 end;
|
|
|
700 end if;
|
|
|
701 end if;
|
|
|
702 end To_C;
|
|
|
703
|
|
|
704 -- Convert Wide_String to char16_array (procedure form)
|
|
|
705
|
|
|
706 procedure To_C
|
|
|
707 (Item : Wide_String;
|
|
|
708 Target : out char16_array;
|
|
|
709 Count : out size_t;
|
|
|
710 Append_Nul : Boolean := True)
|
|
|
711 is
|
|
|
712 To : size_t;
|
|
|
713
|
|
|
714 begin
|
|
|
715 if Target'Length < Item'Length then
|
|
|
716 raise Constraint_Error;
|
|
|
717
|
|
|
718 else
|
|
|
719 To := Target'First;
|
|
|
720 for From in Item'Range loop
|
|
|
721 Target (To) := To_C (Item (From));
|
|
|
722 To := To + 1;
|
|
|
723 end loop;
|
|
|
724
|
|
|
725 if Append_Nul then
|
|
|
726 if To > Target'Last then
|
|
|
727 raise Constraint_Error;
|
|
|
728 else
|
|
|
729 Target (To) := char16_t'Val (0);
|
|
|
730 Count := Item'Length + 1;
|
|
|
731 end if;
|
|
|
732
|
|
|
733 else
|
|
|
734 Count := Item'Length;
|
|
|
735 end if;
|
|
|
736 end if;
|
|
|
737 end To_C;
|
|
|
738
|
|
|
739 -- Convert Wide_Character to char32_t
|
|
|
740
|
|
|
741 function To_C (Item : Wide_Wide_Character) return char32_t is
|
|
|
742 begin
|
|
|
743 return char32_t'Val (Wide_Wide_Character'Pos (Item));
|
|
|
744 end To_C;
|
|
|
745
|
|
|
746 -- Convert Wide_Wide_String to char32_array (function form)
|
|
|
747
|
|
|
748 function To_C
|
|
|
749 (Item : Wide_Wide_String;
|
|
|
750 Append_Nul : Boolean := True) return char32_array
|
|
|
751 is
|
|
|
752 begin
|
|
|
753 if Append_Nul then
|
|
|
754 declare
|
|
|
755 R : char32_array (0 .. Item'Length);
|
|
|
756
|
|
|
757 begin
|
|
|
758 for J in Item'Range loop
|
|
|
759 R (size_t (J - Item'First)) := To_C (Item (J));
|
|
|
760 end loop;
|
|
|
761
|
|
|
762 R (R'Last) := char32_t'Val (0);
|
|
|
763 return R;
|
|
|
764 end;
|
|
|
765
|
|
|
766 else
|
|
|
767 -- A nasty case, if the string is null, we must return a null
|
|
|
768 -- char32_array. The lower bound of this array is required to be zero
|
|
|
769 -- (RM B.3(50)) but that is of course impossible given that size_t
|
|
|
770 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
|
|
|
771 -- Constraint_Error.
|
|
|
772
|
|
|
773 if Item'Length = 0 then
|
|
|
774 raise Constraint_Error;
|
|
|
775
|
|
|
776 else
|
|
|
777 declare
|
|
|
778 R : char32_array (0 .. Item'Length - 1);
|
|
|
779
|
|
|
780 begin
|
|
|
781 for J in size_t range 0 .. Item'Length - 1 loop
|
|
|
782 R (J) := To_C (Item (Integer (J) + Item'First));
|
|
|
783 end loop;
|
|
|
784
|
|
|
785 return R;
|
|
|
786 end;
|
|
|
787 end if;
|
|
|
788 end if;
|
|
|
789 end To_C;
|
|
|
790
|
|
|
791 -- Convert Wide_Wide_String to char32_array (procedure form)
|
|
|
792
|
|
|
793 procedure To_C
|
|
|
794 (Item : Wide_Wide_String;
|
|
|
795 Target : out char32_array;
|
|
|
796 Count : out size_t;
|
|
|
797 Append_Nul : Boolean := True)
|
|
|
798 is
|
|
|
799 To : size_t;
|
|
|
800
|
|
|
801 begin
|
|
|
802 if Target'Length < Item'Length then
|
|
|
803 raise Constraint_Error;
|
|
|
804
|
|
|
805 else
|
|
|
806 To := Target'First;
|
|
|
807 for From in Item'Range loop
|
|
|
808 Target (To) := To_C (Item (From));
|
|
|
809 To := To + 1;
|
|
|
810 end loop;
|
|
|
811
|
|
|
812 if Append_Nul then
|
|
|
813 if To > Target'Last then
|
|
|
814 raise Constraint_Error;
|
|
|
815 else
|
|
|
816 Target (To) := char32_t'Val (0);
|
|
|
817 Count := Item'Length + 1;
|
|
|
818 end if;
|
|
|
819
|
|
|
820 else
|
|
|
821 Count := Item'Length;
|
|
|
822 end if;
|
|
|
823 end if;
|
|
|
824 end To_C;
|
|
|
825
|
|
|
826 end Interfaces.C;
|
