First : constant Positive := Switch_Chars'First + 1;
Last : constant Natural := Switch_Last (Switch_Chars);
begin
-
-- Recognize -gxxx switches
if Switch_Chars (First) = 'g' then
-- Start of processing for Output_JSON_Message
begin
-
-- Print message kind
Write_Str ("{""kind"":");
procedure Set_Msg_Char (C : Character) is
begin
-
-- The check for message buffer overflow is needed to deal with cases
-- where insertions get too long (in particular a child unit name can
-- be very long).
-- One-dimensional subaggregate
begin
-
-- For now, only deal with cases where an integral number of elements
-- fit in a single byte. This includes the most common boolean case.
Offset : Node_Id;
begin
-
if CodePeer_Mode then
return;
end if;
Offset : Node_Id;
begin
-
if CodePeer_Mode then
return;
end if;
PAT : Entity_Id;
begin
-
if CodePeer_Mode then
return;
end if;
Arg : Node_Id;
begin
-
if CodePeer_Mode then
return;
end if;
PAT : Entity_Id;
begin
-
if CodePeer_Mode then
return;
end if;
Size : Unat;
begin
-
if CodePeer_Mode then
return;
end if;
Third_Component : Entity_Id := Next_Entity (Second_Component);
begin
-
-- Sem_prag.adb ensured that Init_Val is either a Dim3, an aggregate
-- of three Any_Integers or Any_Integer.
Lib_RE : RE_Id;
begin
-
-- Check first for Boolean and Character. These are enumeration types,
-- but we treat them specially, since they may require special handling
-- in the transfer protocol. However, this special handling only applies
Find_Aspect (Typ, Aspect_No_Parts);
Curr_Aspect_Spec : Entity_Id;
begin
-
-- Examine Typ's associated node, when present, since aspect
-- specifications do not get transferred when nodes get rewritten.
Aspect_Spec : constant Entity_Id :=
Find_Aspect_No_Parts (Typ);
begin
-
-- Return the value of the aspect when present
if Present (Aspect_Spec) then
-- Start of processing for Compute_Field_Offsets
begin
-
-- Compute the number of types that have each field, weighted by the
-- frequency of such nodes.
-- Start of processing for Adjust_Global_Switches
begin
-
-- -gnatd_U disables prepending error messages with "error:"
if Debug_Flag_Underscore_UU then
procedure Expand_CUDA_Package (N : Node_Id) is
begin
-
-- If not compiling for the host, do not do anything.
if not Debug_Flag_Underscore_C then
Read_Ptr : File_Offset := 1;
begin
-
loop
This_Read := Read (FD,
A => Buffer (Read_Ptr)'Address,
Last : Natural;
begin
-
if Is_Absolute_Path (Path) then
if Is_Directory (Path) then
return new String'(Path);
-- when gnatbind is invoked with -shared.
begin
-
-- Check now for switch -shared
for J in Binder_Switches.First .. Last_Arg loop
function P_Exception_Choice return Node_Id is
begin
-
if Token = Tok_Others then
Scan; -- past OTHERS
return New_Node (N_Others_Choice, Prev_Token_Ptr);
Scan_State : Saved_Scan_State;
begin
-
Save_Scan_State (Scan_State);
ID_Node := P_Defining_Identifier (C_In);
Is_Extended : Boolean := False;
begin
-
if Token = Tok_Identifier then
Save_Scan_State (Scan_State); -- at identifier
Scan; -- past identifier
procedure Check_Dereference is
begin
-
-- Case of a subtype mark
if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
New_F : Entity_Id;
begin
-
Subp := Make_Defining_Identifier (Loc, Chars (Formal_Subp));
Mutate_Ekind (Subp, Ekind (Formal_Subp));
Set_Is_Generic_Actual_Subprogram (Subp);
is
IR : constant Node_Id := Make_Itype_Reference (Sloc (Nod));
begin
-
-- Itype references are only created for use by the back-end
if Inside_A_Generic then
-- Start of processing for Validate_Compile_Time_Warning_Errors
begin
-
-- These error/warning messages were deferred because they could not be
-- evaluated in the front-end and they needed additional information
-- from the back-end. There is no reason to run these checks again if
-- Start of processing for Resolve_Declare_Expression
begin
-
Decl := First (Actions (N));
while Present (Decl) loop
function Build_Default_Subtype_OK (T : Entity_Id) return Boolean is
begin
-
if Is_Constrained (T) then
-- We won't build a new subtype if T is constrained
Node_Exists : Boolean := False;
begin
-
if Is_Non_Empty_List (List) then
if Dump_Original_Only then