package body Interfaces.C is
function Is_Nul_Terminated (Item : char_array) return Boolean is
begin
for J in Item'Range loop
if Item (J) = nul then
return True;
end if;
end loop;
return False;
end Is_Nul_Terminated;
function Is_Nul_Terminated (Item : wchar_array) return Boolean is
begin
for J in Item'Range loop
if Item (J) = wide_nul then
return True;
end if;
end loop;
return False;
end Is_Nul_Terminated;
function Is_Nul_Terminated (Item : char16_array) return Boolean is
begin
for J in Item'Range loop
if Item (J) = char16_nul then
return True;
end if;
end loop;
return False;
end Is_Nul_Terminated;
function Is_Nul_Terminated (Item : char32_array) return Boolean is
begin
for J in Item'Range loop
if Item (J) = char32_nul then
return True;
end if;
end loop;
return False;
end Is_Nul_Terminated;
function To_Ada (Item : char) return Character is
begin
return Character'Val (char'Pos (Item));
end To_Ada;
function To_Ada
(Item : char_array;
Trim_Nul : Boolean := True) return String
is
Count : Natural;
From : size_t;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = nul then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
declare
R : String (1 .. Count);
begin
for J in R'Range loop
R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
end loop;
return R;
end;
end To_Ada;
procedure To_Ada
(Item : char_array;
Target : out String;
Count : out Natural;
Trim_Nul : Boolean := True)
is
From : size_t;
To : Positive;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = nul then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
if Count > Target'Length then
raise Constraint_Error;
else
From := Item'First;
To := Target'First;
for J in 1 .. Count loop
Target (To) := Character (Item (From));
From := From + 1;
To := To + 1;
end loop;
end if;
end To_Ada;
function To_Ada (Item : wchar_t) return Wide_Character is
begin
return Wide_Character (Item);
end To_Ada;
function To_Ada
(Item : wchar_array;
Trim_Nul : Boolean := True) return Wide_String
is
Count : Natural;
From : size_t;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = wide_nul then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
declare
R : Wide_String (1 .. Count);
begin
for J in R'Range loop
R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
end loop;
return R;
end;
end To_Ada;
procedure To_Ada
(Item : wchar_array;
Target : out Wide_String;
Count : out Natural;
Trim_Nul : Boolean := True)
is
From : size_t;
To : Positive;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = wide_nul then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
if Count > Target'Length then
raise Constraint_Error;
else
From := Item'First;
To := Target'First;
for J in 1 .. Count loop
Target (To) := To_Ada (Item (From));
From := From + 1;
To := To + 1;
end loop;
end if;
end To_Ada;
function To_Ada (Item : char16_t) return Wide_Character is
begin
return Wide_Character'Val (char16_t'Pos (Item));
end To_Ada;
function To_Ada
(Item : char16_array;
Trim_Nul : Boolean := True) return Wide_String
is
Count : Natural;
From : size_t;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = char16_t'Val (0) then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
declare
R : Wide_String (1 .. Count);
begin
for J in R'Range loop
R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
end loop;
return R;
end;
end To_Ada;
procedure To_Ada
(Item : char16_array;
Target : out Wide_String;
Count : out Natural;
Trim_Nul : Boolean := True)
is
From : size_t;
To : Positive;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = char16_t'Val (0) then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
if Count > Target'Length then
raise Constraint_Error;
else
From := Item'First;
To := Target'First;
for J in 1 .. Count loop
Target (To) := To_Ada (Item (From));
From := From + 1;
To := To + 1;
end loop;
end if;
end To_Ada;
function To_Ada (Item : char32_t) return Wide_Wide_Character is
begin
return Wide_Wide_Character'Val (char32_t'Pos (Item));
end To_Ada;
function To_Ada
(Item : char32_array;
Trim_Nul : Boolean := True) return Wide_Wide_String
is
Count : Natural;
From : size_t;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = char32_t'Val (0) then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
declare
R : Wide_Wide_String (1 .. Count);
begin
for J in R'Range loop
R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
end loop;
return R;
end;
end To_Ada;
procedure To_Ada
(Item : char32_array;
Target : out Wide_Wide_String;
Count : out Natural;
Trim_Nul : Boolean := True)
is
From : size_t;
To : Positive;
begin
if Trim_Nul then
From := Item'First;
loop
if From > Item'Last then
raise Terminator_Error;
elsif Item (From) = char32_t'Val (0) then
exit;
else
From := From + 1;
end if;
end loop;
Count := Natural (From - Item'First);
else
Count := Item'Length;
end if;
if Count > Target'Length then
raise Constraint_Error;
else
From := Item'First;
To := Target'First;
for J in 1 .. Count loop
Target (To) := To_Ada (Item (From));
From := From + 1;
To := To + 1;
end loop;
end if;
end To_Ada;
function To_C (Item : Character) return char is
begin
return char'Val (Character'Pos (Item));
end To_C;
function To_C
(Item : String;
Append_Nul : Boolean := True) return char_array
is
begin
if Append_Nul then
declare
R : char_array (0 .. Item'Length);
begin
for J in Item'Range loop
R (size_t (J - Item'First)) := To_C (Item (J));
end loop;
R (R'Last) := nul;
return R;
end;
else
if Item'Length = 0 then
raise Constraint_Error;
else
declare
R : char_array (0 .. Item'Length - 1);
begin
for J in Item'Range loop
R (size_t (J - Item'First)) := To_C (Item (J));
end loop;
return R;
end;
end if;
end if;
end To_C;
procedure To_C
(Item : String;
Target : out char_array;
Count : out size_t;
Append_Nul : Boolean := True)
is
To : size_t;
begin
if Target'Length < Item'Length then
raise Constraint_Error;
else
To := Target'First;
for From in Item'Range loop
Target (To) := char (Item (From));
To := To + 1;
end loop;
if Append_Nul then
if To > Target'Last then
raise Constraint_Error;
else
Target (To) := nul;
Count := Item'Length + 1;
end if;
else
Count := Item'Length;
end if;
end if;
end To_C;
function To_C (Item : Wide_Character) return wchar_t is
begin
return wchar_t (Item);
end To_C;
function To_C
(Item : Wide_String;
Append_Nul : Boolean := True) return wchar_array
is
begin
if Append_Nul then
declare
R : wchar_array (0 .. Item'Length);
begin
for J in Item'Range loop
R (size_t (J - Item'First)) := To_C (Item (J));
end loop;
R (R'Last) := wide_nul;
return R;
end;
else
if Item'Length = 0 then
raise Constraint_Error;
else
declare
R : wchar_array (0 .. Item'Length - 1);
begin
for J in size_t range 0 .. Item'Length - 1 loop
R (J) := To_C (Item (Integer (J) + Item'First));
end loop;
return R;
end;
end if;
end if;
end To_C;
procedure To_C
(Item : Wide_String;
Target : out wchar_array;
Count : out size_t;
Append_Nul : Boolean := True)
is
To : size_t;
begin
if Target'Length < Item'Length then
raise Constraint_Error;
else
To := Target'First;
for From in Item'Range loop
Target (To) := To_C (Item (From));
To := To + 1;
end loop;
if Append_Nul then
if To > Target'Last then
raise Constraint_Error;
else
Target (To) := wide_nul;
Count := Item'Length + 1;
end if;
else
Count := Item'Length;
end if;
end if;
end To_C;
function To_C (Item : Wide_Character) return char16_t is
begin
return char16_t'Val (Wide_Character'Pos (Item));
end To_C;
function To_C
(Item : Wide_String;
Append_Nul : Boolean := True) return char16_array
is
begin
if Append_Nul then
declare
R : char16_array (0 .. Item'Length);
begin
for J in Item'Range loop
R (size_t (J - Item'First)) := To_C (Item (J));
end loop;
R (R'Last) := char16_t'Val (0);
return R;
end;
else
if Item'Length = 0 then
raise Constraint_Error;
else
declare
R : char16_array (0 .. Item'Length - 1);
begin
for J in size_t range 0 .. Item'Length - 1 loop
R (J) := To_C (Item (Integer (J) + Item'First));
end loop;
return R;
end;
end if;
end if;
end To_C;
procedure To_C
(Item : Wide_String;
Target : out char16_array;
Count : out size_t;
Append_Nul : Boolean := True)
is
To : size_t;
begin
if Target'Length < Item'Length then
raise Constraint_Error;
else
To := Target'First;
for From in Item'Range loop
Target (To) := To_C (Item (From));
To := To + 1;
end loop;
if Append_Nul then
if To > Target'Last then
raise Constraint_Error;
else
Target (To) := char16_t'Val (0);
Count := Item'Length + 1;
end if;
else
Count := Item'Length;
end if;
end if;
end To_C;
function To_C (Item : Wide_Wide_Character) return char32_t is
begin
return char32_t'Val (Wide_Wide_Character'Pos (Item));
end To_C;
function To_C
(Item : Wide_Wide_String;
Append_Nul : Boolean := True) return char32_array
is
begin
if Append_Nul then
declare
R : char32_array (0 .. Item'Length);
begin
for J in Item'Range loop
R (size_t (J - Item'First)) := To_C (Item (J));
end loop;
R (R'Last) := char32_t'Val (0);
return R;
end;
else
if Item'Length = 0 then
raise Constraint_Error;
else
declare
R : char32_array (0 .. Item'Length - 1);
begin
for J in size_t range 0 .. Item'Length - 1 loop
R (J) := To_C (Item (Integer (J) + Item'First));
end loop;
return R;
end;
end if;
end if;
end To_C;
procedure To_C
(Item : Wide_Wide_String;
Target : out char32_array;
Count : out size_t;
Append_Nul : Boolean := True)
is
To : size_t;
begin
if Target'Length < Item'Length then
raise Constraint_Error;
else
To := Target'First;
for From in Item'Range loop
Target (To) := To_C (Item (From));
To := To + 1;
end loop;
if Append_Nul then
if To > Target'Last then
raise Constraint_Error;
else
Target (To) := char32_t'Val (0);
Count := Item'Length + 1;
end if;
else
Count := Item'Length;
end if;
end if;
end To_C;
end Interfaces.C;