begin
if Config_File = Empty_Node then
- -- Create a dummy config file is none was found
+ -- Create a dummy config file if none was found
Name_Len := Auto_Cgpr'Length;
Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
or else
(Tgt_Name /= No_Name
and then (Length_Of_Name (Tgt_Name) = 0
- or else Target = Get_Name_String (Tgt_Name)));
+ or else Target = Get_Name_String (Tgt_Name)));
if not OK then
if Autoconf_Specified then
end if;
-- Get the config switches. This should be done only now, as some
- -- runtimes may have been found if the Builder switches.
+ -- runtimes may have been found in the Builder switches.
Config_Switches := Get_Config_Switches;
Write_Eol;
elsif not Quiet_Output then
+
-- Display no message if we are creating auto.cgpr, unless in
- -- verbose mode
+ -- verbose mode.
- if Config_File_Name'Length > 0
- or else Verbose_Mode
- then
+ if Config_File_Name'Length > 0 or else Verbose_Mode then
Write_Str ("creating ");
Write_Str (Simple_Name (Args (3).all));
Write_Eol;
Config_Command : constant String :=
"--config=" & Get_Name_String (Name);
- Runtime_Name : constant String :=
- Runtime_Name_For (Name);
+ Runtime_Name : constant String := Runtime_Name_For (Name);
begin
- if Variable = Nil_Variable_Value
+ -- In CodePeer mode, we do not take into account any compiler
+ -- command from the package IDE.
+
+ if CodePeer_Mode
+ or else Variable = Nil_Variable_Value
or else Length_Of_Name (Variable.Value) = 0
then
Result (Count) :=
if Is_Absolute_Path (Compiler_Command) then
Result (Count) :=
new String'
- (Config_Command & ",," & Runtime_Name & "," &
- Containing_Directory (Compiler_Command) & "," &
- Simple_Name (Compiler_Command));
+ (Config_Command & ",," & Runtime_Name & ","
+ & Containing_Directory (Compiler_Command) & ","
+ & Simple_Name (Compiler_Command));
else
Result (Count) :=
new String'
- (Config_Command & ",," & Runtime_Name & ",," &
- Compiler_Command);
+ (Config_Command & ",," & Runtime_Name & ",,"
+ & Compiler_Command);
end if;
end;
end if;
begin
Variable :=
- Value_Of
- (Name_Source_Dirs,
- Project.Decl.Attributes,
- Shared);
+ Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String
then
Variable :=
- Value_Of
- (Name_Source_Files,
- Project.Decl.Attributes,
- Shared);
+ Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared);
return Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String;
end if;
end Might_Have_Sources;
+ -- Local Variables
+
Success : Boolean;
Config_Project_Node : Project_Node_Id := Empty_Node;
+ -- Start of processing for Get_Or_Create_Configuration_File
+
begin
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
On_New_Tree_Loaded => null);
end if;
- if Config_Project_Node = Empty_Node
- or else Config = No_Project
- then
+ if Config_Project_Node = Empty_Node or else Config = No_Project then
Raise_Invalid_Config
("processing of configuration project """
& Config_File_Path.all & """ failed");
Implicit_Project => Implicit_Project);
if User_Project_Node = Empty_Node then
- User_Project_Node := Empty_Node;
return;
end if;
Decl : Node_Id;
Func_Name : Node_Id;
Func : Entity_Id;
- N_Parms : Natural;
Parm_Type : Node_Id;
Profile : List_Id := New_List;
Spec : Node_Id;
- F : Entity_Id;
+ Act_F : Entity_Id;
+ Form_F : Entity_Id;
New_F : Entity_Id;
begin
Profile := New_List;
if Present (Actual) then
- F := First_Formal (Entity (Actual));
+ Act_F := First_Formal (Entity (Actual));
else
- F := First_Formal (Formal);
+ Act_F := Empty;
end if;
- N_Parms := 0;
- while Present (F) loop
+ Form_F := First_Formal (Formal);
+ while Present (Form_F) loop
-- Create new formal for profile of wrapper, and add a reference
- -- to it in the list of actuals for the enclosing call.
+ -- to it in the list of actuals for the enclosing call. The name
+ -- must be that of the formal in the formal subprogram, because
+ -- calls to it in the generic body may use named associations.
- New_F := Make_Temporary
- (Loc, Character'Val (Character'Pos ('A') + N_Parms));
+ New_F := Make_Defining_Identifier (Loc, Chars (Form_F));
if No (Actual) then
-- attribute, because the class-wide type is not retrievable by
-- visbility.
- if Is_Class_Wide_Type (Etype (F)) then
+ if Is_Class_Wide_Type (Etype (Form_F)) then
Parm_Type :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Class,
Prefix =>
- Make_Identifier (Loc, Chars (Etype (Etype (F)))));
+ Make_Identifier (Loc, Chars (Etype (Etype (Form_F)))));
else
Parm_Type :=
- Make_Identifier (Loc, Chars (Etype (Etype (F))));
+ Make_Identifier (Loc, Chars (Etype (Etype (Form_F))));
end if;
-- If actual is present, use the type of its own formal
else
- Parm_Type := New_Occurrence_Of (Etype (F), Loc);
+ Parm_Type := New_Occurrence_Of (Etype (Act_F), Loc);
end if;
Append_To (Profile,
Make_Parameter_Specification (Loc,
- Defining_Identifier => New_F,
- Parameter_Type => Parm_Type));
+ Defining_Identifier => New_F,
+ Parameter_Type => Parm_Type));
Append_To (Actuals, New_Occurrence_Of (New_F, Loc));
- Next_Formal (F);
- N_Parms := N_Parms + 1;
+ Next_Formal (Form_F);
+
+ if Present (Act_F) then
+ Next_Formal (Act_F);
+ end if;
end loop;
Spec :=
Parameter_Specifications => Profile,
Result_Definition =>
Make_Identifier (Loc, Chars (Etype (Formal))));
+
Decl :=
Make_Expression_Function (Loc,
Specification => Spec,
Set_Ekind (Id, K);
Set_Etype (Id, T);
- if (Is_Array_Type (T)
- and then not Is_Constrained (T))
- or else
- (Ekind (T) = E_Record_Type
- and then Has_Discriminants (T))
+ if (Is_Array_Type (T) and then not Is_Constrained (T))
+ or else (Ekind (T) = E_Record_Type and then Has_Discriminants (T))
then
declare
Non_Freezing_Ref : constant Node_Id :=
Needs_Body :=
(Unit_Requires_Body (Gen_Unit)
- or else Enclosing_Body_Present
- or else Present (Corresponding_Body (Gen_Decl)))
- and then (Is_In_Main_Unit (N) or else Might_Inline_Subp)
- and then not Is_Actual_Pack
- and then not Inline_Now
- and then (Operating_Mode = Generate_Code
+ or else Enclosing_Body_Present
+ or else Present (Corresponding_Body (Gen_Decl)))
+ and then (Is_In_Main_Unit (N) or else Might_Inline_Subp)
+ and then not Is_Actual_Pack
+ and then not Inline_Now
+ and then (Operating_Mode = Generate_Code
- -- Need comment for this check ???
+ -- Need comment for this check ???
- or else (Operating_Mode = Check_Semantics
- and then (ASIS_Mode or GNATprove_Mode)));
+ or else (Operating_Mode = Check_Semantics
+ and then (ASIS_Mode or GNATprove_Mode)));
-- If front_end_inlining is enabled, do not instantiate body if
-- within a generic context.
exit when Scope_Stack.Last - Num_Scopes + 1 = Scope_Stack.First
or else Scope_Stack.Table
- (Scope_Stack.Last - Num_Scopes).Entity
- = Scope (S);
+ (Scope_Stack.Last - Num_Scopes).Entity = Scope (S);
end loop;
exit when Is_Generic_Instance (S)
and then (In_Package_Body (S)
- or else Ekind (S) = E_Procedure
- or else Ekind (S) = E_Function);
+ or else Ekind (S) = E_Procedure
+ or else Ekind (S) = E_Function);
S := Scope (S);
end loop;
loop
if Is_Generic_Instance (S)
and then (In_Package_Body (S)
- or else Ekind (S) = E_Procedure
- or else Ekind (S) = E_Function)
+ or else Ekind_In (S, E_Procedure, E_Function))
then
-- We still have to remove the entities of the enclosing
-- instance from direct visibility.
S := Scope (S);
end loop;
+
pragma Assert (Num_Inner < Num_Scopes);
Push_Scope (Standard_Standard);
Set_Is_Generic_Instance (Inst, True);
if In_Package_Body (Inst)
- or else Ekind (S) = E_Procedure
- or else Ekind (S) = E_Function
+ or else Ekind_In (S, E_Procedure, E_Function)
then
E := First_Entity (Instances (J));
while Present (E) loop
-- If renaming, get original unit
if Present (Renamed_Object (Gen_Unit))
- and then (Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Procedure
- or else
- Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Function)
+ and then Ekind_In (Renamed_Object (Gen_Unit), E_Generic_Procedure,
+ E_Generic_Function)
then
Gen_Unit := Renamed_Object (Gen_Unit);
Set_Is_Instantiated (Gen_Unit);
-- If the formal package is declared with a box, or if the formal
-- parameter is defaulted, it is visible in the body.
- elsif Is_Formal_Box
- or else Is_Visible_Formal (E)
- then
+ elsif Is_Formal_Box or else Is_Visible_Formal (E) then
Set_Is_Hidden (E, False);
end if;
if Is_Child_Unit (E)
and then not Comes_From_Source (Entity (Prefix (Gen_Id)))
and then (not In_Instance
- or else Nkind (Parent (Parent (Gen_Id))) =
+ or else Nkind (Parent (Parent (Gen_Id))) =
N_Compilation_Unit)
then
Error_Msg_N
-- access type.
if Ada_Version < Ada_2005
- or else
- Ekind (Base_Type (Ftyp)) /=
- E_Anonymous_Access_Type
- or else
- Ekind (Base_Type (Etype (Actual))) /=
- E_Anonymous_Access_Type
+ or else Ekind (Base_Type (Ftyp)) /=
+ E_Anonymous_Access_Type
+ or else Ekind (Base_Type (Etype (Actual))) /=
+ E_Anonymous_Access_Type
then
- Error_Msg_NE ("type of actual does not match type of&",
- Actual, Gen_Obj);
+ Error_Msg_NE
+ ("type of actual does not match type of&", Actual, Gen_Obj);
end if;
end if;
-- Check for instantiation of atomic/volatile actual for
-- non-atomic/volatile formal (RM C.6 (12)).
- if Is_Atomic_Object (Actual)
- and then not Is_Atomic (Orig_Ftyp)
- then
+ if Is_Atomic_Object (Actual) and then not Is_Atomic (Orig_Ftyp) then
Error_Msg_N
- ("cannot instantiate non-atomic formal object " &
- "with atomic actual", Actual);
+ ("cannot instantiate non-atomic formal object "
+ & "with atomic actual", Actual);
- elsif Is_Volatile_Object (Actual)
- and then not Is_Volatile (Orig_Ftyp)
+ elsif Is_Volatile_Object (Actual) and then not Is_Volatile (Orig_Ftyp)
then
Error_Msg_N
- ("cannot instantiate non-volatile formal object " &
- "with volatile actual", Actual);
+ ("cannot instantiate non-volatile formal object "
+ & "with volatile actual", Actual);
end if;
-- Formal in-parameter
if Subtypes_Match
(Component_Type (A_Gen_T), Component_Type (Act_T))
- or else Subtypes_Match
- (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
- Component_Type (Act_T))
+ or else
+ Subtypes_Match
+ (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
+ Component_Type (Act_T))
then
null;
else
elsif Is_Constrained (Act_T) then
if Ekind (Ancestor) = E_Access_Type
- or else
- (not Is_Constrained (A_Gen_T)
- and then Is_Composite_Type (A_Gen_T))
+ or else (not Is_Constrained (A_Gen_T)
+ and then Is_Composite_Type (A_Gen_T))
then
- Error_Msg_N
- ("actual subtype must be unconstrained", Actual);
+ Error_Msg_N ("actual subtype must be unconstrained", Actual);
Abandon_Instantiation (Actual);
end if;
Actual, Gen_T);
elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
- or else
- Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
- or else
- Is_Protected_Interface (A_Gen_T) /=
- Is_Protected_Interface (Act_T)
- or else
- Is_Synchronized_Interface (A_Gen_T) /=
- Is_Synchronized_Interface (Act_T)
+ or else Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
+ or else Is_Protected_Interface (A_Gen_T) /=
+ Is_Protected_Interface (Act_T)
+ or else Is_Synchronized_Interface (A_Gen_T) /=
+ Is_Synchronized_Interface (Act_T)
then
Error_Msg_NE
("actual for interface& does not match (RM 12.5.5(4))",
if Is_Unchecked_Union (Base_Type (Act_T)) then
if not Has_Discriminants (A_Gen_T)
- or else
- (Is_Derived_Type (A_Gen_T)
- and then
- Is_Unchecked_Union (A_Gen_T))
+ or else (Is_Derived_Type (A_Gen_T)
+ and then Is_Unchecked_Union (A_Gen_T))
then
null;
else
- Error_Msg_N ("unchecked union cannot be the actual for a" &
- " discriminated formal type", Act_T);
+ Error_Msg_N ("unchecked union cannot be the actual for a "
+ & "discriminated formal type", Act_T);
end if;
end if;
if Ekind (Act_T) = E_Incomplete_Type
or else (Is_Class_Wide_Type (Act_T)
- and then
- Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
+ and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
then
-- If the formal is an incomplete type, the actual can be
-- incomplete as well.
if not In_Same_Source_Unit (N, Spec)
or else Nkind (Unit (Comp_Unit)) = N_Package_Declaration
or else (Nkind (Unit (Comp_Unit)) = N_Package_Body
- and then not Is_In_Main_Unit (Spec))
+ and then not Is_In_Main_Unit (Spec))
then
-- Find body of parent of spec, and analyze it. A special case arises
-- when the parent is an instantiation, that is to say when we are
elsif Nkind (N) = N_Op_Concat
and then Is_Generic_Type (Etype (N2))
and then (Base_Type (Etype (Right_Opnd (N2))) = Etype (N2)
- or else
+ or else
Base_Type (Etype (Left_Opnd (N2))) = Etype (N2))
and then Is_Intrinsic_Subprogram (E)
then
end if;
elsif D in List_Range then
- if D = Union_Id (No_List)
- or else Is_Empty_List (List_Id (D))
- then
+ if D = Union_Id (No_List) or else Is_Empty_List (List_Id (D)) then
null;
else
end if;
end if;
- if No (N2)
- or else No (Typ)
- or else not Is_Global (Typ)
- then
+ if No (N2) or else No (Typ) or else not Is_Global (Typ) then
Set_Associated_Node (N, Empty);
-- If the aggregate is an actual in a call, it has been
OK : Boolean;
begin
- if No (T)
- or else T = Any_Id
- then
+ if No (T) or else T = Any_Id then
return;
end if;
projects / gcc.git / commitdiff