1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- I N T E R F A C E S . C --
9 -- Copyright (C) 1992-2009, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 package body Interfaces.C is
34 -----------------------
35 -- Is_Nul_Terminated --
36 -----------------------
40 function Is_Nul_Terminated (Item : char_array) return Boolean is
42 for J in Item'Range loop
43 if Item (J) = nul then
49 end Is_Nul_Terminated;
51 -- Case of wchar_array
53 function Is_Nul_Terminated (Item : wchar_array) return Boolean is
55 for J in Item'Range loop
56 if Item (J) = wide_nul then
62 end Is_Nul_Terminated;
64 -- Case of char16_array
66 function Is_Nul_Terminated (Item : char16_array) return Boolean is
68 for J in Item'Range loop
69 if Item (J) = char16_nul then
75 end Is_Nul_Terminated;
77 -- Case of char32_array
79 function Is_Nul_Terminated (Item : char32_array) return Boolean is
81 for J in Item'Range loop
82 if Item (J) = char32_nul then
88 end Is_Nul_Terminated;
94 -- Convert char to Character
96 function To_Ada (Item : char) return Character is
98 return Character'Val (char'Pos (Item));
101 -- Convert char_array to String (function form)
105 Trim_Nul : Boolean := True) return String
115 if From > Item'Last then
116 raise Terminator_Error;
117 elsif Item (From) = nul then
124 Count := Natural (From - Item'First);
127 Count := Item'Length;
131 R : String (1 .. Count);
134 for J in R'Range loop
135 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
142 -- Convert char_array to String (procedure form)
148 Trim_Nul : Boolean := True)
157 if From > Item'Last then
158 raise Terminator_Error;
159 elsif Item (From) = nul then
166 Count := Natural (From - Item'First);
169 Count := Item'Length;
172 if Count > Target'Length then
173 raise Constraint_Error;
179 for J in 1 .. Count loop
180 Target (To) := Character (Item (From));
188 -- Convert wchar_t to Wide_Character
190 function To_Ada (Item : wchar_t) return Wide_Character is
192 return Wide_Character (Item);
195 -- Convert wchar_array to Wide_String (function form)
199 Trim_Nul : Boolean := True) return Wide_String
209 if From > Item'Last then
210 raise Terminator_Error;
211 elsif Item (From) = wide_nul then
218 Count := Natural (From - Item'First);
221 Count := Item'Length;
225 R : Wide_String (1 .. Count);
228 for J in R'Range loop
229 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
236 -- Convert wchar_array to Wide_String (procedure form)
240 Target : out Wide_String;
242 Trim_Nul : Boolean := True)
251 if From > Item'Last then
252 raise Terminator_Error;
253 elsif Item (From) = wide_nul then
260 Count := Natural (From - Item'First);
263 Count := Item'Length;
266 if Count > Target'Length then
267 raise Constraint_Error;
273 for J in 1 .. Count loop
274 Target (To) := To_Ada (Item (From));
281 -- Convert char16_t to Wide_Character
283 function To_Ada (Item : char16_t) return Wide_Character is
285 return Wide_Character'Val (char16_t'Pos (Item));
288 -- Convert char16_array to Wide_String (function form)
291 (Item : char16_array;
292 Trim_Nul : Boolean := True) return Wide_String
302 if From > Item'Last then
303 raise Terminator_Error;
304 elsif Item (From) = char16_t'Val (0) then
311 Count := Natural (From - Item'First);
314 Count := Item'Length;
318 R : Wide_String (1 .. Count);
321 for J in R'Range loop
322 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
329 -- Convert char16_array to Wide_String (procedure form)
332 (Item : char16_array;
333 Target : out Wide_String;
335 Trim_Nul : Boolean := True)
344 if From > Item'Last then
345 raise Terminator_Error;
346 elsif Item (From) = char16_t'Val (0) then
353 Count := Natural (From - Item'First);
356 Count := Item'Length;
359 if Count > Target'Length then
360 raise Constraint_Error;
366 for J in 1 .. Count loop
367 Target (To) := To_Ada (Item (From));
374 -- Convert char32_t to Wide_Wide_Character
376 function To_Ada (Item : char32_t) return Wide_Wide_Character is
378 return Wide_Wide_Character'Val (char32_t'Pos (Item));
381 -- Convert char32_array to Wide_Wide_String (function form)
384 (Item : char32_array;
385 Trim_Nul : Boolean := True) return Wide_Wide_String
395 if From > Item'Last then
396 raise Terminator_Error;
397 elsif Item (From) = char32_t'Val (0) then
404 Count := Natural (From - Item'First);
407 Count := Item'Length;
411 R : Wide_Wide_String (1 .. Count);
414 for J in R'Range loop
415 R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
422 -- Convert char32_array to Wide_Wide_String (procedure form)
425 (Item : char32_array;
426 Target : out Wide_Wide_String;
428 Trim_Nul : Boolean := True)
437 if From > Item'Last then
438 raise Terminator_Error;
439 elsif Item (From) = char32_t'Val (0) then
446 Count := Natural (From - Item'First);
449 Count := Item'Length;
452 if Count > Target'Length then
453 raise Constraint_Error;
459 for J in 1 .. Count loop
460 Target (To) := To_Ada (Item (From));
471 -- Convert Character to char
473 function To_C (Item : Character) return char is
475 return char'Val (Character'Pos (Item));
478 -- Convert String to char_array (function form)
482 Append_Nul : Boolean := True) return char_array
487 R : char_array (0 .. Item'Length);
490 for J in Item'Range loop
491 R (size_t (J - Item'First)) := To_C (Item (J));
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.
508 if Item'Length = 0 then
509 raise Constraint_Error;
515 R : char_array (0 .. Item'Length - 1);
518 for J in Item'Range loop
519 R (size_t (J - Item'First)) := To_C (Item (J));
528 -- Convert String to char_array (procedure form)
532 Target : out char_array;
534 Append_Nul : Boolean := True)
539 if Target'Length < Item'Length then
540 raise Constraint_Error;
544 for From in Item'Range loop
545 Target (To) := char (Item (From));
550 if To > Target'Last then
551 raise Constraint_Error;
554 Count := Item'Length + 1;
558 Count := Item'Length;
563 -- Convert Wide_Character to wchar_t
565 function To_C (Item : Wide_Character) return wchar_t is
567 return wchar_t (Item);
570 -- Convert Wide_String to wchar_array (function form)
574 Append_Nul : Boolean := True) return wchar_array
579 R : wchar_array (0 .. Item'Length);
582 for J in Item'Range loop
583 R (size_t (J - Item'First)) := To_C (Item (J));
586 R (R'Last) := wide_nul;
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.
598 if Item'Length = 0 then
599 raise Constraint_Error;
603 R : wchar_array (0 .. Item'Length - 1);
606 for J in size_t range 0 .. Item'Length - 1 loop
607 R (J) := To_C (Item (Integer (J) + Item'First));
616 -- Convert Wide_String to wchar_array (procedure form)
620 Target : out wchar_array;
622 Append_Nul : Boolean := True)
627 if Target'Length < Item'Length then
628 raise Constraint_Error;
632 for From in Item'Range loop
633 Target (To) := To_C (Item (From));
638 if To > Target'Last then
639 raise Constraint_Error;
641 Target (To) := wide_nul;
642 Count := Item'Length + 1;
646 Count := Item'Length;
651 -- Convert Wide_Character to char16_t
653 function To_C (Item : Wide_Character) return char16_t is
655 return char16_t'Val (Wide_Character'Pos (Item));
658 -- Convert Wide_String to char16_array (function form)
662 Append_Nul : Boolean := True) return char16_array
667 R : char16_array (0 .. Item'Length);
670 for J in Item'Range loop
671 R (size_t (J - Item'First)) := To_C (Item (J));
674 R (R'Last) := char16_t'Val (0);
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.
686 if Item'Length = 0 then
687 raise Constraint_Error;
691 R : char16_array (0 .. Item'Length - 1);
694 for J in size_t range 0 .. Item'Length - 1 loop
695 R (J) := To_C (Item (Integer (J) + Item'First));
704 -- Convert Wide_String to char16_array (procedure form)
708 Target : out char16_array;
710 Append_Nul : Boolean := True)
715 if Target'Length < Item'Length then
716 raise Constraint_Error;
720 for From in Item'Range loop
721 Target (To) := To_C (Item (From));
726 if To > Target'Last then
727 raise Constraint_Error;
729 Target (To) := char16_t'Val (0);
730 Count := Item'Length + 1;
734 Count := Item'Length;
739 -- Convert Wide_Character to char32_t
741 function To_C (Item : Wide_Wide_Character) return char32_t is
743 return char32_t'Val (Wide_Wide_Character'Pos (Item));
746 -- Convert Wide_Wide_String to char32_array (function form)
749 (Item : Wide_Wide_String;
750 Append_Nul : Boolean := True) return char32_array
755 R : char32_array (0 .. Item'Length);
758 for J in Item'Range loop
759 R (size_t (J - Item'First)) := To_C (Item (J));
762 R (R'Last) := char32_t'Val (0);
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
773 if Item'Length = 0 then
774 raise Constraint_Error;
778 R : char32_array (0 .. Item'Length - 1);
781 for J in size_t range 0 .. Item'Length - 1 loop
782 R (J) := To_C (Item (Integer (J) + Item'First));
791 -- Convert Wide_Wide_String to char32_array (procedure form)
794 (Item : Wide_Wide_String;
795 Target : out char32_array;
797 Append_Nul : Boolean := True)
802 if Target'Length < Item'Length then
803 raise Constraint_Error;
807 for From in Item'Range loop
808 Target (To) := To_C (Item (From));
813 if To > Target'Last then
814 raise Constraint_Error;
816 Target (To) := char32_t'Val (0);
817 Count := Item'Length + 1;
821 Count := Item'Length;