[multiple changes]
2009-10-28 Thomas Quinot <quinot@adacore.com> * exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for the operand of the unary minus and ABS operators. * sem_type.adb (Covers): A concurrent type and its corresponding record type are compatible. * exp_attr.adb (Expand_N_Attribute_Reference): Do not rewrite a 'Access attribute reference for the current instance of a protected type while analyzing an access discriminant constraint in a component definition. Such a reference is handled in the corresponding record's init proc, while initializing the constrained component. * exp_ch9.adb (Expand_N_Protected_Type_Declaration): When creating the corresponding record type, propagate components' Has_Per_Object_Constraint flag. * exp_ch3.adb (Build_Init_Procedure.Build_Init_Statements): For a concurrent type, set up concurrent aspects before initializing components with a per object constrain, because they may be controlled, and their initialization may call entries or protected subprograms of the enclosing concurrent object. 2009-10-28 Emmanuel Briot <briot@adacore.com> * prj-nmsc.adb (Add_If_Not_In_List): New subprogram, for better sharing of code. (Find_Source_Dirs): resolve links if Opt.Follow_Links_For_Dirs when processing the directories specified explicitly in the project file. From-SVN: r153657
This commit is contained in:
Arnaud Charlet
parent
b87971f33e
commit
5f3f175d79
@ -1,3 +1,31 @@
|
||||
2009-10-28 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for
|
||||
the operand of the unary minus and ABS operators.
|
||||
|
||||
* sem_type.adb (Covers): A concurrent type and its corresponding record
|
||||
type are compatible.
|
||||
* exp_attr.adb (Expand_N_Attribute_Reference): Do not rewrite a 'Access
|
||||
attribute reference for the current instance of a protected type while
|
||||
analyzing an access discriminant constraint in a component definition.
|
||||
Such a reference is handled in the corresponding record's init proc,
|
||||
while initializing the constrained component.
|
||||
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): When creating the
|
||||
corresponding record type, propagate components'
|
||||
Has_Per_Object_Constraint flag.
|
||||
* exp_ch3.adb (Build_Init_Procedure.Build_Init_Statements):
|
||||
For a concurrent type, set up concurrent aspects before initializing
|
||||
components with a per object constrain, because they may be controlled,
|
||||
and their initialization may call entries or protected subprograms of
|
||||
the enclosing concurrent object.
|
||||
|
||||
2009-10-28 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* prj-nmsc.adb (Add_If_Not_In_List): New subprogram, for better sharing
|
||||
of code.
|
||||
(Find_Source_Dirs): resolve links if Opt.Follow_Links_For_Dirs when
|
||||
processing the directories specified explicitly in the project file.
|
||||
|
||||
2009-10-28 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* a-ztexio.adb, a-ztexio.ads, a-witeio.ads, a-witeio.adb,
|
||||
|
||||
@ -654,10 +654,20 @@ package body Exp_Attr is
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
|
||||
end if;
|
||||
|
||||
-- If prefix is a protected type name, this is a reference to
|
||||
-- the current instance of the type.
|
||||
-- If prefix is a protected type name, this is a reference to the
|
||||
-- current instance of the type. For a component definition, nothing
|
||||
-- to do (expansion will occur in the init proc). In other contexts,
|
||||
-- rewrite into reference to current instance.
|
||||
|
||||
if Is_Protected_Self_Reference (Pref) then
|
||||
if Is_Protected_Self_Reference (Pref)
|
||||
and then not
|
||||
(Nkind_In (Parent (N),
|
||||
N_Index_Or_Discriminant_Constraint,
|
||||
N_Discriminant_Association)
|
||||
and then
|
||||
Nkind (Parent (Parent (Parent (Parent (N)))))
|
||||
= N_Component_Definition)
|
||||
then
|
||||
Rewrite (Pref, Concurrent_Ref (Pref));
|
||||
Analyze (Pref);
|
||||
end if;
|
||||
|
||||
@ -2733,70 +2733,11 @@ package body Exp_Ch3 is
|
||||
Next_Non_Pragma (Decl);
|
||||
end loop;
|
||||
|
||||
if Per_Object_Constraint_Components then
|
||||
|
||||
-- Second pass: components with per-object constraints
|
||||
|
||||
Decl := First_Non_Pragma (Component_Items (Comp_List));
|
||||
while Present (Decl) loop
|
||||
Loc := Sloc (Decl);
|
||||
Id := Defining_Identifier (Decl);
|
||||
Typ := Etype (Id);
|
||||
|
||||
if Has_Access_Constraint (Id)
|
||||
and then No (Expression (Decl))
|
||||
then
|
||||
if Has_Non_Null_Base_Init_Proc (Typ) then
|
||||
Append_List_To (Statement_List,
|
||||
Build_Initialization_Call (Loc,
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Name_uInit),
|
||||
Selector_Name => New_Occurrence_Of (Id, Loc)),
|
||||
Typ,
|
||||
In_Init_Proc => True,
|
||||
Enclos_Type => Rec_Type,
|
||||
Discr_Map => Discr_Map));
|
||||
|
||||
Clean_Task_Names (Typ, Proc_Id);
|
||||
|
||||
elsif Component_Needs_Simple_Initialization (Typ) then
|
||||
Append_List_To (Statement_List,
|
||||
Build_Assignment
|
||||
(Id, Get_Simple_Init_Val (Typ, N, Esize (Id))));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next_Non_Pragma (Decl);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Process the variant part
|
||||
|
||||
if Present (Variant_Part (Comp_List)) then
|
||||
Alt_List := New_List;
|
||||
Variant := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
|
||||
while Present (Variant) loop
|
||||
Loc := Sloc (Variant);
|
||||
Append_To (Alt_List,
|
||||
Make_Case_Statement_Alternative (Loc,
|
||||
Discrete_Choices =>
|
||||
New_Copy_List (Discrete_Choices (Variant)),
|
||||
Statements =>
|
||||
Build_Init_Statements (Component_List (Variant))));
|
||||
Next_Non_Pragma (Variant);
|
||||
end loop;
|
||||
|
||||
-- The expression of the case statement which is a reference
|
||||
-- to one of the discriminants is replaced by the appropriate
|
||||
-- formal parameter of the initialization procedure.
|
||||
|
||||
Append_To (Statement_List,
|
||||
Make_Case_Statement (Loc,
|
||||
Expression =>
|
||||
New_Reference_To (Discriminal (
|
||||
Entity (Name (Variant_Part (Comp_List)))), Loc),
|
||||
Alternatives => Alt_List));
|
||||
end if;
|
||||
-- Set up tasks and protected object support. This needs to be done
|
||||
-- before any component with a per-object access discriminant
|
||||
-- constraint, or any variant part (which may contain such
|
||||
-- components) is initialized, because the initialization of these
|
||||
-- components may reference the enclosing concurrent object.
|
||||
|
||||
-- For a task record type, add the task create call and calls
|
||||
-- to bind any interrupt (signal) entries.
|
||||
@ -2898,6 +2839,71 @@ package body Exp_Ch3 is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Per_Object_Constraint_Components then
|
||||
|
||||
-- Second pass: components with per-object constraints
|
||||
|
||||
Decl := First_Non_Pragma (Component_Items (Comp_List));
|
||||
while Present (Decl) loop
|
||||
Loc := Sloc (Decl);
|
||||
Id := Defining_Identifier (Decl);
|
||||
Typ := Etype (Id);
|
||||
|
||||
if Has_Access_Constraint (Id)
|
||||
and then No (Expression (Decl))
|
||||
then
|
||||
if Has_Non_Null_Base_Init_Proc (Typ) then
|
||||
Append_List_To (Statement_List,
|
||||
Build_Initialization_Call (Loc,
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Name_uInit),
|
||||
Selector_Name => New_Occurrence_Of (Id, Loc)),
|
||||
Typ,
|
||||
In_Init_Proc => True,
|
||||
Enclos_Type => Rec_Type,
|
||||
Discr_Map => Discr_Map));
|
||||
|
||||
Clean_Task_Names (Typ, Proc_Id);
|
||||
|
||||
elsif Component_Needs_Simple_Initialization (Typ) then
|
||||
Append_List_To (Statement_List,
|
||||
Build_Assignment
|
||||
(Id, Get_Simple_Init_Val (Typ, N, Esize (Id))));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next_Non_Pragma (Decl);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Process the variant part
|
||||
|
||||
if Present (Variant_Part (Comp_List)) then
|
||||
Alt_List := New_List;
|
||||
Variant := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
|
||||
while Present (Variant) loop
|
||||
Loc := Sloc (Variant);
|
||||
Append_To (Alt_List,
|
||||
Make_Case_Statement_Alternative (Loc,
|
||||
Discrete_Choices =>
|
||||
New_Copy_List (Discrete_Choices (Variant)),
|
||||
Statements =>
|
||||
Build_Init_Statements (Component_List (Variant))));
|
||||
Next_Non_Pragma (Variant);
|
||||
end loop;
|
||||
|
||||
-- The expression of the case statement which is a reference
|
||||
-- to one of the discriminants is replaced by the appropriate
|
||||
-- formal parameter of the initialization procedure.
|
||||
|
||||
Append_To (Statement_List,
|
||||
Make_Case_Statement (Loc,
|
||||
Expression =>
|
||||
New_Reference_To (Discriminal (
|
||||
Entity (Name (Variant_Part (Comp_List)))), Loc),
|
||||
Alternatives => Alt_List));
|
||||
end if;
|
||||
|
||||
-- If no initializations when generated for component declarations
|
||||
-- corresponding to this Statement_List, append a null statement
|
||||
-- to the Statement_List to make it a valid Ada tree.
|
||||
|
||||
@ -8056,27 +8056,25 @@ package body Exp_Ch4 is
|
||||
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
|
||||
Expression => Relocate_Node (Right_Opnd (Operand)));
|
||||
|
||||
if Nkind (Operand) = N_Op_Minus then
|
||||
Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
|
||||
Opnd := New_Op_Node (Nkind (Operand), Loc);
|
||||
Set_Right_Opnd (Opnd, R);
|
||||
|
||||
else
|
||||
if Nkind (Operand) in N_Binary_Op then
|
||||
L :=
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
|
||||
Expression => Relocate_Node (Left_Opnd (Operand)));
|
||||
|
||||
Opnd := New_Op_Node (Nkind (Operand), Loc);
|
||||
Set_Left_Opnd (Opnd, L);
|
||||
Set_Right_Opnd (Opnd, R);
|
||||
|
||||
Rewrite (N,
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
|
||||
Expression => Opnd));
|
||||
|
||||
Analyze_And_Resolve (N, Target_Type);
|
||||
return;
|
||||
Set_Left_Opnd (Opnd, L);
|
||||
end if;
|
||||
|
||||
Rewrite (N,
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
|
||||
Expression => Opnd));
|
||||
|
||||
Analyze_And_Resolve (N, Target_Type);
|
||||
return;
|
||||
end;
|
||||
end if;
|
||||
|
||||
@ -9174,10 +9172,12 @@ package body Exp_Ch4 is
|
||||
Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
|
||||
|
||||
-- Test for interesting operation, which includes addition,
|
||||
-- division, exponentiation, multiplication, subtraction, and
|
||||
-- unary negation.
|
||||
-- division, exponentiation, multiplication, subtraction, absolute
|
||||
-- value and unary negation. Unary "+" is omitted since it is a
|
||||
-- no-op and thus can't overflow.
|
||||
|
||||
and then Nkind_In (Operand, N_Op_Add,
|
||||
and then Nkind_In (Operand, N_Op_Abs,
|
||||
N_Op_Add,
|
||||
N_Op_Divide,
|
||||
N_Op_Expon,
|
||||
N_Op_Minus,
|
||||
|
||||
@ -7821,20 +7821,23 @@ package body Exp_Ch9 is
|
||||
|
||||
declare
|
||||
Old_Comp : constant Node_Id := Component_Definition (Priv);
|
||||
Pent : constant Entity_Id := Defining_Identifier (Priv);
|
||||
Oent : constant Entity_Id := Defining_Identifier (Priv);
|
||||
New_Comp : Node_Id;
|
||||
Nent : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Sloc (Oent), Chars (Oent));
|
||||
|
||||
begin
|
||||
if Present (Subtype_Indication (Old_Comp)) then
|
||||
New_Comp :=
|
||||
Make_Component_Definition (Sloc (Pent),
|
||||
Make_Component_Definition (Sloc (Oent),
|
||||
Aliased_Present => False,
|
||||
Subtype_Indication =>
|
||||
New_Copy_Tree (Subtype_Indication (Old_Comp),
|
||||
Discr_Map));
|
||||
else
|
||||
New_Comp :=
|
||||
Make_Component_Definition (Sloc (Pent),
|
||||
Make_Component_Definition (Sloc (Oent),
|
||||
Aliased_Present => False,
|
||||
Access_Definition =>
|
||||
New_Copy_Tree (Access_Definition (Old_Comp),
|
||||
@ -7843,11 +7846,13 @@ package body Exp_Ch9 is
|
||||
|
||||
New_Priv :=
|
||||
Make_Component_Declaration (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Sloc (Pent), Chars (Pent)),
|
||||
Defining_Identifier => Nent,
|
||||
Component_Definition => New_Comp,
|
||||
Expression => Expression (Priv));
|
||||
|
||||
Set_Has_Per_Object_Constraint (Nent,
|
||||
Has_Per_Object_Constraint (Oent));
|
||||
|
||||
Append_To (Cdecls, New_Priv);
|
||||
end;
|
||||
|
||||
|
||||
@ -4707,12 +4707,112 @@ package body Prj.Nmsc is
|
||||
Removed : Boolean := False)
|
||||
is
|
||||
Directory : constant String := Get_Name_String (From);
|
||||
Element : String_Element;
|
||||
|
||||
procedure Add_If_Not_In_List
|
||||
(Path_Id : Name_Id;
|
||||
Display_Path_Id : Name_Id);
|
||||
-- Add the directory Path_Id to the list of source_dirs if not
|
||||
-- already in the list
|
||||
|
||||
procedure Recursive_Find_Dirs (Path : Name_Id);
|
||||
-- Find all the subdirectories (recursively) of Path and add them
|
||||
-- to the list of source directories of the project.
|
||||
|
||||
------------------------
|
||||
-- Add_If_Not_In_List --
|
||||
------------------------
|
||||
|
||||
procedure Add_If_Not_In_List
|
||||
(Path_Id : Name_Id;
|
||||
Display_Path_Id : Name_Id)
|
||||
is
|
||||
List : String_List_Id;
|
||||
Prev : String_List_Id;
|
||||
Rank_List : Number_List_Index;
|
||||
Prev_Rank : Number_List_Index;
|
||||
Element : String_Element;
|
||||
begin
|
||||
Prev := Nil_String;
|
||||
Prev_Rank := No_Number_List;
|
||||
List := Project.Source_Dirs;
|
||||
Rank_List := Project.Source_Dir_Ranks;
|
||||
|
||||
while List /= Nil_String loop
|
||||
Element := Data.Tree.String_Elements.Table (List);
|
||||
exit when Element.Value = Path_Id;
|
||||
Prev := List;
|
||||
List := Element.Next;
|
||||
Prev_Rank := Rank_List;
|
||||
Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next;
|
||||
end loop;
|
||||
|
||||
-- The directory is in the list if List is not Nil_String
|
||||
|
||||
if not Removed and then List = Nil_String then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Adding Source Dir=");
|
||||
Write_Line (Get_Name_String (Path_Id));
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
||||
Element :=
|
||||
(Value => Path_Id,
|
||||
Index => 0,
|
||||
Display_Value => Display_Path_Id,
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
|
||||
Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
|
||||
|
||||
if Last_Source_Dir = Nil_String then
|
||||
|
||||
-- This is the first source directory
|
||||
|
||||
Project.Source_Dirs :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Project.Source_Dir_Ranks :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
|
||||
else
|
||||
-- We already have source directories, link the previous
|
||||
-- last to the new one.
|
||||
|
||||
Data.Tree.String_Elements.Table (Last_Source_Dir).Next :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
|
||||
end if;
|
||||
|
||||
-- And register this source directory as the new last
|
||||
|
||||
Last_Source_Dir :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
|
||||
Last_Src_Dir_Rank :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
|
||||
(Number => Rank, Next => No_Number_List);
|
||||
|
||||
elsif List /= Nil_String then
|
||||
-- Remove source dir, if present
|
||||
|
||||
if Prev = Nil_String then
|
||||
Project.Source_Dirs :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Project.Source_Dir_Ranks :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
|
||||
else
|
||||
Data.Tree.String_Elements.Table (Prev).Next :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
end if;
|
||||
end if;
|
||||
end Add_If_Not_In_List;
|
||||
|
||||
-------------------------
|
||||
-- Recursive_Find_Dirs --
|
||||
-------------------------
|
||||
@ -4721,13 +4821,6 @@ package body Prj.Nmsc is
|
||||
Dir : Dir_Type;
|
||||
Name : String (1 .. 250);
|
||||
Last : Natural;
|
||||
List : String_List_Id;
|
||||
Prev : String_List_Id;
|
||||
Rank_List : Number_List_Index;
|
||||
Prev_Rank : Number_List_Index;
|
||||
Element : String_Element;
|
||||
Found : Boolean := False;
|
||||
|
||||
Non_Canonical_Path : Name_Id := No_Name;
|
||||
Canonical_Path : Name_Id := No_Name;
|
||||
|
||||
@ -4763,90 +4856,9 @@ package body Prj.Nmsc is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check if directory is already in list
|
||||
|
||||
List := Project.Source_Dirs;
|
||||
Prev := Nil_String;
|
||||
Rank_List := Project.Source_Dir_Ranks;
|
||||
Prev_Rank := No_Number_List;
|
||||
while List /= Nil_String loop
|
||||
Element := Data.Tree.String_Elements.Table (List);
|
||||
|
||||
if Element.Value /= No_Name then
|
||||
Found := Element.Value = Canonical_Path;
|
||||
exit when Found;
|
||||
end if;
|
||||
|
||||
Prev := List;
|
||||
List := Element.Next;
|
||||
Prev_Rank := Rank_List;
|
||||
Rank_List := Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
end loop;
|
||||
|
||||
-- If directory is not already in list, put it there
|
||||
|
||||
if (not Removed) and (not Found) then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" ");
|
||||
Write_Line (The_Path (The_Path'First .. The_Path_Last));
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
||||
Element :=
|
||||
(Value => Canonical_Path,
|
||||
Display_Value => Non_Canonical_Path,
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String,
|
||||
Index => 0);
|
||||
|
||||
Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
|
||||
|
||||
-- Case of first source directory
|
||||
|
||||
if Last_Source_Dir = Nil_String then
|
||||
Project.Source_Dirs :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Project.Source_Dir_Ranks :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
|
||||
-- Here we already have source directories
|
||||
|
||||
else
|
||||
-- Link the previous last to the new one
|
||||
|
||||
Data.Tree.String_Elements.Table
|
||||
(Last_Source_Dir).Next :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Data.Tree.Number_Lists.Table
|
||||
(Last_Src_Dir_Rank).Next :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
|
||||
end if;
|
||||
|
||||
-- And register this source directory as the new last
|
||||
|
||||
Last_Source_Dir :=
|
||||
String_Element_Table.Last (Data.Tree.String_Elements);
|
||||
Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
|
||||
Last_Src_Dir_Rank :=
|
||||
Number_List_Table.Last (Data.Tree.Number_Lists);
|
||||
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
|
||||
(Number => Rank, Next => No_Number_List);
|
||||
|
||||
elsif Removed and Found then
|
||||
if Prev = Nil_String then
|
||||
Project.Source_Dirs :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Project.Source_Dir_Ranks :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
else
|
||||
Data.Tree.String_Elements.Table (Prev).Next :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
end if;
|
||||
end if;
|
||||
Add_If_Not_In_List
|
||||
(Path_Id => Canonical_Path,
|
||||
Display_Path_Id => Non_Canonical_Path);
|
||||
|
||||
-- Now look for subdirectories. We do that even when this
|
||||
-- directory is already in the list, because some of its
|
||||
@ -4945,7 +4957,8 @@ package body Prj.Nmsc is
|
||||
Directory =>
|
||||
Get_Name_String
|
||||
(Project.Directory.Display_Name),
|
||||
Resolve_Links => False,
|
||||
Resolve_Links =>
|
||||
Opt.Follow_Links_For_Dirs,
|
||||
Case_Sensitive => True);
|
||||
|
||||
begin
|
||||
@ -4987,10 +5000,6 @@ package body Prj.Nmsc is
|
||||
else
|
||||
declare
|
||||
Path_Name : Path_Information;
|
||||
List : String_List_Id;
|
||||
Prev : String_List_Id;
|
||||
Rank_List : Number_List_Index;
|
||||
Prev_Rank : Number_List_Index;
|
||||
Dir_Exists : Boolean;
|
||||
|
||||
begin
|
||||
@ -5020,7 +5029,13 @@ package body Prj.Nmsc is
|
||||
else
|
||||
declare
|
||||
Path : constant String :=
|
||||
Get_Name_String (Path_Name.Name);
|
||||
Normalize_Pathname
|
||||
(Name => Get_Name_String (Path_Name.Name),
|
||||
Directory =>
|
||||
Get_Name_String (Project.Directory.Name),
|
||||
Resolve_Links => Opt.Follow_Links_For_Dirs,
|
||||
Case_Sensitive => True);
|
||||
|
||||
Last_Path : constant Natural :=
|
||||
Compute_Directory_Last (Path);
|
||||
Path_Id : Name_Id;
|
||||
@ -5036,113 +5051,16 @@ package body Prj.Nmsc is
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
|
||||
Path_Id := Name_Find;
|
||||
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer
|
||||
(Display_Path
|
||||
(Display_Path'First .. Last_Display_Path));
|
||||
Display_Path_Id := Name_Find;
|
||||
|
||||
-- Check if the directory is already in the list
|
||||
|
||||
Prev := Nil_String;
|
||||
Prev_Rank := No_Number_List;
|
||||
|
||||
-- Look for source dir in current list
|
||||
|
||||
List := Project.Source_Dirs;
|
||||
Rank_List := Project.Source_Dir_Ranks;
|
||||
while List /= Nil_String loop
|
||||
Element := Data.Tree.String_Elements.Table (List);
|
||||
exit when Element.Value = Path_Id;
|
||||
Prev := List;
|
||||
List := Element.Next;
|
||||
Prev_Rank := Rank_List;
|
||||
Rank_List :=
|
||||
Data.Tree.Number_Lists.Table (Prev_Rank).Next;
|
||||
end loop;
|
||||
|
||||
-- The directory is in the list if List is not Nil_String
|
||||
|
||||
if not Removed then
|
||||
|
||||
-- As it is an existing directory, we add it to the
|
||||
-- list of directories, if not already in the list.
|
||||
|
||||
if List = Nil_String then
|
||||
String_Element_Table.Increment_Last
|
||||
(Data.Tree.String_Elements);
|
||||
Element :=
|
||||
(Value => Path_Id,
|
||||
Index => 0,
|
||||
Display_Value => Display_Path_Id,
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
Number_List_Table.Increment_Last
|
||||
(Data.Tree.Number_Lists);
|
||||
|
||||
if Last_Source_Dir = Nil_String then
|
||||
|
||||
-- This is the first source directory
|
||||
|
||||
Project.Source_Dirs :=
|
||||
String_Element_Table.Last
|
||||
(Data.Tree.String_Elements);
|
||||
Project.Source_Dir_Ranks :=
|
||||
Number_List_Table.Last
|
||||
(Data.Tree.Number_Lists);
|
||||
|
||||
else
|
||||
-- We already have source directories, link the
|
||||
-- previous last to the new one.
|
||||
|
||||
Data.Tree.String_Elements.Table
|
||||
(Last_Source_Dir).Next :=
|
||||
String_Element_Table.Last
|
||||
(Data.Tree.String_Elements);
|
||||
Data.Tree.Number_Lists.Table
|
||||
(Last_Src_Dir_Rank).Next :=
|
||||
Number_List_Table.Last
|
||||
(Data.Tree.Number_Lists);
|
||||
|
||||
end if;
|
||||
|
||||
-- And register this source directory as the new
|
||||
-- last.
|
||||
|
||||
Last_Source_Dir :=
|
||||
String_Element_Table.Last
|
||||
(Data.Tree.String_Elements);
|
||||
Data.Tree.String_Elements.Table
|
||||
(Last_Source_Dir) := Element;
|
||||
Last_Src_Dir_Rank :=
|
||||
Number_List_Table.Last
|
||||
(Data.Tree.Number_Lists);
|
||||
Data.Tree.Number_Lists.Table
|
||||
(Last_Src_Dir_Rank) :=
|
||||
(Number => Rank, Next => No_Number_List);
|
||||
end if;
|
||||
|
||||
else
|
||||
-- Remove source dir, if present
|
||||
|
||||
if List /= Nil_String then
|
||||
-- Source dir was found, remove it from the list
|
||||
|
||||
if Prev = Nil_String then
|
||||
Project.Source_Dirs :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Project.Source_Dir_Ranks :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
|
||||
else
|
||||
Data.Tree.String_Elements.Table (Prev).Next :=
|
||||
Data.Tree.String_Elements.Table (List).Next;
|
||||
Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
|
||||
Data.Tree.Number_Lists.Table (Rank_List).Next;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
Add_If_Not_In_List
|
||||
(Path_Id => Path_Id,
|
||||
Display_Path_Id => Display_Path_Id);
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
|
||||
@ -791,7 +791,7 @@ package body Sem_Type is
|
||||
or else Scope (T1) /= Scope (T2));
|
||||
end if;
|
||||
|
||||
-- Literals are compatible with types in a given "class"
|
||||
-- Literals are compatible with types in a given "class"
|
||||
|
||||
elsif (T2 = Universal_Integer and then Is_Integer_Type (T1))
|
||||
or else (T2 = Universal_Real and then Is_Real_Type (T1))
|
||||
@ -970,6 +970,12 @@ package body Sem_Type is
|
||||
then
|
||||
return Covers (Corresponding_Remote_Type (T2), T1);
|
||||
|
||||
elsif Is_Record_Type (T1) and then Is_Concurrent_Type (T2) then
|
||||
return Covers (T1, Corresponding_Record_Type (T2));
|
||||
|
||||
elsif Is_Concurrent_Type (T1) and then Is_Record_Type (T2) then
|
||||
return Covers (Corresponding_Record_Type (T1), T2);
|
||||
|
||||
elsif Ekind (T2) = E_Access_Attribute_Type
|
||||
and then (Ekind (BT1) = E_General_Access_Type
|
||||
or else Ekind (BT1) = E_Access_Type)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user