1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- I N T E R F A C E S . C --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 package body Interfaces.C is
36 -----------------------
37 -- Is_Nul_Terminated --
38 -----------------------
42 function Is_Nul_Terminated (Item : char_array) return Boolean is
44 for J in Item'Range loop
45 if Item (J) = nul then
51 end Is_Nul_Terminated;
53 -- Case of wchar_array
55 function Is_Nul_Terminated (Item : wchar_array) return Boolean is
57 for J in Item'Range loop
58 if Item (J) = wide_nul then
64 end Is_Nul_Terminated;
66 -- Case of char16_array
68 function Is_Nul_Terminated (Item : char16_array) return Boolean is
70 for J in Item'Range loop
71 if Item (J) = char16_nul then
77 end Is_Nul_Terminated;
79 -- Case of char32_array
81 function Is_Nul_Terminated (Item : char32_array) return Boolean is
83 for J in Item'Range loop
84 if Item (J) = char32_nul then
90 end Is_Nul_Terminated;
96 -- Convert char to Character
98 function To_Ada (Item : char) return Character is
100 return Character'Val (char'Pos (Item));
103 -- Convert char_array to String (function form)
107 Trim_Nul : Boolean := True) return String
117 if From > Item'Last then
118 raise Terminator_Error;
119 elsif Item (From) = nul then
126 Count := Natural (From - Item'First);
129 Count := Item'Length;
133 R : String (1 .. Count);
136 for J in R'Range loop
137 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
144 -- Convert char_array to String (procedure form)
150 Trim_Nul : Boolean := True)
159 if From > Item'Last then
160 raise Terminator_Error;
161 elsif Item (From) = nul then
168 Count := Natural (From - Item'First);
171 Count := Item'Length;
174 if Count > Target'Length then
175 raise Constraint_Error;
181 for J in 1 .. Count loop
182 Target (To) := Character (Item (From));
190 -- Convert wchar_t to Wide_Character
192 function To_Ada (Item : wchar_t) return Wide_Character is
194 return Wide_Character (Item);
197 -- Convert wchar_array to Wide_String (function form)
201 Trim_Nul : Boolean := True) return Wide_String
211 if From > Item'Last then
212 raise Terminator_Error;
213 elsif Item (From) = wide_nul then
220 Count := Natural (From - Item'First);
223 Count := Item'Length;
227 R : Wide_String (1 .. Count);
230 for J in R'Range loop
231 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
238 -- Convert wchar_array to Wide_String (procedure form)
242 Target : out Wide_String;
244 Trim_Nul : Boolean := True)
253 if From > Item'Last then
254 raise Terminator_Error;
255 elsif Item (From) = wide_nul then
262 Count := Natural (From - Item'First);
265 Count := Item'Length;
268 if Count > Target'Length then
269 raise Constraint_Error;
275 for J in 1 .. Count loop
276 Target (To) := To_Ada (Item (From));
283 -- Convert char16_t to Wide_Character
285 function To_Ada (Item : char16_t) return Wide_Character is
287 return Wide_Character'Val (char16_t'Pos (Item));
290 -- Convert char16_array to Wide_String (function form)
293 (Item : char16_array;
294 Trim_Nul : Boolean := True) return Wide_String
304 if From > Item'Last then
305 raise Terminator_Error;
306 elsif Item (From) = char16_t'Val (0) then
313 Count := Natural (From - Item'First);
316 Count := Item'Length;
320 R : Wide_String (1 .. Count);
323 for J in R'Range loop
324 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
331 -- Convert char16_array to Wide_String (procedure form)
334 (Item : char16_array;
335 Target : out Wide_String;
337 Trim_Nul : Boolean := True)
346 if From > Item'Last then
347 raise Terminator_Error;
348 elsif Item (From) = char16_t'Val (0) then
355 Count := Natural (From - Item'First);
358 Count := Item'Length;
361 if Count > Target'Length then
362 raise Constraint_Error;
368 for J in 1 .. Count loop
369 Target (To) := To_Ada (Item (From));
376 -- Convert char32_t to Wide_Wide_Character
378 function To_Ada (Item : char32_t) return Wide_Wide_Character is
380 return Wide_Wide_Character'Val (char32_t'Pos (Item));
383 -- Convert char32_array to Wide_Wide_String (function form)
386 (Item : char32_array;
387 Trim_Nul : Boolean := True) return Wide_Wide_String
397 if From > Item'Last then
398 raise Terminator_Error;
399 elsif Item (From) = char32_t'Val (0) then
406 Count := Natural (From - Item'First);
409 Count := Item'Length;
413 R : Wide_Wide_String (1 .. Count);
416 for J in R'Range loop
417 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
424 -- Convert char32_array to Wide_Wide_String (procedure form)
427 (Item : char32_array;
428 Target : out Wide_Wide_String;
430 Trim_Nul : Boolean := True)
439 if From > Item'Last then
440 raise Terminator_Error;
441 elsif Item (From) = char32_t'Val (0) then
448 Count := Natural (From - Item'First);
451 Count := Item'Length;
454 if Count > Target'Length then
455 raise Constraint_Error;
461 for J in 1 .. Count loop
462 Target (To) := To_Ada (Item (From));
473 -- Convert Character to char
475 function To_C (Item : Character) return char is
477 return char'Val (Character'Pos (Item));
480 -- Convert String to char_array (function form)
484 Append_Nul : Boolean := True) return char_array
489 R : char_array (0 .. Item'Length);
492 for J in Item'Range loop
493 R (size_t (J - Item'First)) := To_C (Item (J));
503 -- A nasty case, if the string is null, we must return a null
504 -- char_array. The lower bound of this array is required to be zero
505 -- (RM B.3(50)) but that is of course impossible given that size_t
506 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
507 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
508 -- since nothing else makes sense.
510 if Item'Length = 0 then
511 raise Constraint_Error;
517 R : char_array (0 .. Item'Length - 1);
520 for J in Item'Range loop
521 R (size_t (J - Item'First)) := To_C (Item (J));
530 -- Convert String to char_array (procedure form)
534 Target : out char_array;
536 Append_Nul : Boolean := True)
541 if Target'Length < Item'Length then
542 raise Constraint_Error;
546 for From in Item'Range loop
547 Target (To) := char (Item (From));
552 if To > Target'Last then
553 raise Constraint_Error;
556 Count := Item'Length + 1;
560 Count := Item'Length;
565 -- Convert Wide_Character to wchar_t
567 function To_C (Item : Wide_Character) return wchar_t is
569 return wchar_t (Item);
572 -- Convert Wide_String to wchar_array (function form)
576 Append_Nul : Boolean := True) return wchar_array
581 R : wchar_array (0 .. Item'Length);
584 for J in Item'Range loop
585 R (size_t (J - Item'First)) := To_C (Item (J));
588 R (R'Last) := wide_nul;
593 -- A nasty case, if the string is null, we must return a null
594 -- wchar_array. The lower bound of this array is required to be zero
595 -- (RM B.3(50)) but that is of course impossible given that size_t
596 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
597 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
598 -- since nothing else makes sense.
600 if Item'Length = 0 then
601 raise Constraint_Error;
605 R : wchar_array (0 .. Item'Length - 1);
608 for J in size_t range 0 .. Item'Length - 1 loop
609 R (J) := To_C (Item (Integer (J) + Item'First));
618 -- Convert Wide_String to wchar_array (procedure form)
622 Target : out wchar_array;
624 Append_Nul : Boolean := True)
629 if Target'Length < Item'Length then
630 raise Constraint_Error;
634 for From in Item'Range loop
635 Target (To) := To_C (Item (From));
640 if To > Target'Last then
641 raise Constraint_Error;
643 Target (To) := wide_nul;
644 Count := Item'Length + 1;
648 Count := Item'Length;
653 -- Convert Wide_Character to char16_t
655 function To_C (Item : Wide_Character) return char16_t is
657 return char16_t'Val (Wide_Character'Pos (Item));
660 -- Convert Wide_String to char16_array (function form)
664 Append_Nul : Boolean := True) return char16_array
669 R : char16_array (0 .. Item'Length);
672 for J in Item'Range loop
673 R (size_t (J - Item'First)) := To_C (Item (J));
676 R (R'Last) := char16_t'Val (0);
681 -- A nasty case, if the string is null, we must return a null
682 -- char16_array. The lower bound of this array is required to be zero
683 -- (RM B.3(50)) but that is of course impossible given that size_t
684 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
685 -- Constraint_Error. This is also the appropriate behavior in Ada 95,
686 -- since nothing else makes sense.
688 if Item'Length = 0 then
689 raise Constraint_Error;
693 R : char16_array (0 .. Item'Length - 1);
696 for J in size_t range 0 .. Item'Length - 1 loop
697 R (J) := To_C (Item (Integer (J) + Item'First));
706 -- Convert Wide_String to char16_array (procedure form)
710 Target : out char16_array;
712 Append_Nul : Boolean := True)
717 if Target'Length < Item'Length then
718 raise Constraint_Error;
722 for From in Item'Range loop
723 Target (To) := To_C (Item (From));
728 if To > Target'Last then
729 raise Constraint_Error;
731 Target (To) := char16_t'Val (0);
732 Count := Item'Length + 1;
736 Count := Item'Length;
741 -- Convert Wide_Character to char32_t
743 function To_C (Item : Wide_Wide_Character) return char32_t is
745 return char32_t'Val (Wide_Wide_Character'Pos (Item));
748 -- Convert Wide_Wide_String to char32_array (function form)
751 (Item : Wide_Wide_String;
752 Append_Nul : Boolean := True) return char32_array
757 R : char32_array (0 .. Item'Length);
760 for J in Item'Range loop
761 R (size_t (J - Item'First)) := To_C (Item (J));
764 R (R'Last) := char32_t'Val (0);
769 -- A nasty case, if the string is null, we must return a null
770 -- char32_array. The lower bound of this array is required to be zero
771 -- (RM B.3(50)) but that is of course impossible given that size_t
772 -- is unsigned. According to Ada 2005 AI-258, the result is to raise
775 if Item'Length = 0 then
776 raise Constraint_Error;
780 R : char32_array (0 .. Item'Length - 1);
783 for J in size_t range 0 .. Item'Length - 1 loop
784 R (J) := To_C (Item (Integer (J) + Item'First));
793 -- Convert Wide_Wide_String to char32_array (procedure form)
796 (Item : Wide_Wide_String;
797 Target : out char32_array;
799 Append_Nul : Boolean := True)
804 if Target'Length < Item'Length then
805 raise Constraint_Error;
809 for From in Item'Range loop
810 Target (To) := To_C (Item (From));
815 if To > Target'Last then
816 raise Constraint_Error;
818 Target (To) := char32_t'Val (0);
819 Count := Item'Length + 1;
823 Count := Item'Length;