with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
-with Stringt; use Stringt;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
-- Number of concatenation operands including possibly null operands
NN : Nat := 0;
- -- Number of operands excluding any known to be null
+ -- Number of operands excluding any known to be null, except that the
+ -- last operand is always retained, in case it provides the bounds for
+ -- a null result.
+
+ Opnd : Node_Id;
+ -- Current operand being processed in the loop through operands. After
+ -- this loop is complete, always contains the last operand (which is not
+ -- the same as Operands (NN), since null operands are skipped).
-- Arrays describing the operands, only the first NN entries of each
-- array are set (NN < N when we exclude known null operands).
-- True if length of corresponding operand known at compile time
Operands : array (1 .. N) of Node_Id;
- -- Set to the corresponding entry in the Opnds list
+ -- Set to the corresponding entry in the Opnds list (but note that null
+ -- operands are excluded, so not all entries in the list are stored).
Fixed_Length : array (1 .. N) of Uint;
-- Set to length of operand. Entries in this array are set only if the
-- where the bound is known at compile time, else actual lower bound.
-- The operand low bound is of type Ityp.
- Opnd_High_Bound : array (1 .. N) of Node_Id;
- -- Set to upper bound of operand. Either an integer literal in the case
- -- where the bound is known at compile time, else actual upper bound.
- -- The operand bound is of type Ityp.
-
Var_Length : array (1 .. N) of Entity_Id;
-- Set to an entity of type Natural that contains the length of an
-- operand whose length is not known at compile time. Entries in this
-- This is either an integer literal node, or an identifier reference to
-- a constant entity initialized to the appropriate value.
+ Last_Opnd_High_Bound : Node_Id;
+ -- A tree node representing the high bound of the last operand. This
+ -- need only be set if the result could be null. It is used for the
+ -- special case of setting the right high bound for a null result.
+ -- This is of type Ityp.
+
High_Bound : Node_Id;
-- A tree node representing the high bound of the result (of type Ityp)
-- we analyzed and resolved the expression.
Set_Parent (X, Cnode);
- Analyze_And_Resolve (X, Intyp);
+ Analyze_And_Resolve (X);
if Compile_Time_Compare
(X, Type_High_Bound (Ityp),
-- Local Declarations
- Opnd : Node_Id;
Opnd_Typ : Entity_Id;
Ent : Entity_Id;
Len : Uint;
Fixed_Length (NN) := Uint_1;
Result_May_Be_Null := False;
- -- Set bounds of operand (no need to set high bound since we know
- -- for sure that result won't be null, so we won't ever use
- -- Opnd_High_Bound).
+ -- Set low bound of operand (no need to set Last_Opnd_High_Bound
+ -- since we know that the result cannot be null).
Opnd_Low_Bound (NN) :=
Make_Attribute_Reference (Loc,
elsif Nkind (Opnd) = N_String_Literal then
Len := String_Literal_Length (Opnd_Typ);
- -- Skip null string literal unless last operand
+ if Len /= 0 then
+ Result_May_Be_Null := False;
+ end if;
+
+ -- Capture last operand high bound if result could be null
+
+ if J = N and then Result_May_Be_Null then
+ Last_Opnd_High_Bound :=
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
+ Right_Opnd => Make_Integer_Literal (Loc, 1));
+ end if;
+
+ -- Skip null string literal
if J < N and then Len = 0 then
goto Continue;
Opnd_Low_Bound (NN) :=
New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ));
- Opnd_High_Bound (NN) :=
- Make_Op_Add (Loc,
- Left_Opnd =>
- New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
- Right_Opnd => Make_Integer_Literal (Loc, 1));
-
Set := True;
- Result_May_Be_Null := False;
-- All other cases
Result_May_Be_Null := False;
end if;
- -- Exclude null length case except for last operand
- -- (where we may need it to get proper bounds).
+ -- Capture last operand bound if result could be null
+
+ if J = N and then Result_May_Be_Null then
+ Last_Opnd_High_Bound :=
+ Convert_To (Ityp,
+ Make_Integer_Literal (Loc,
+ Intval => Expr_Value (Hi)));
+ end if;
+
+ -- Exclude null length case unless last operand
- if Len = 0 and then J < N then
+ if J < N and then Len = 0 then
goto Continue;
end if;
Make_Integer_Literal (Loc,
Intval => Expr_Value (Lo)));
- Opnd_High_Bound (NN) := To_Ityp (
- Make_Integer_Literal (Loc,
- Intval => Expr_Value (Hi)));
-
Set := True;
end;
end if;
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First);
- Opnd_High_Bound (NN) :=
- Make_Attribute_Reference (Loc,
- Prefix =>
- Duplicate_Subexpr (Opnd, Name_Req => True),
- Attribute_Name => Name_Last);
+ if J = N and Result_May_Be_Null then
+ Last_Opnd_High_Bound :=
+ Convert_To (Ityp,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Opnd, Name_Req => True),
+ Attribute_Name => Name_Last));
+ end if;
-- Capture length of operand in entity
J := J + 1;
end loop;
- -- If we have only skipped null operands, return a null string literal.
- -- Note that this means the lower bound is 1 and the type is string,
- -- since we retained any null operands with a type other than string,
- -- or a lower bound other than one, so this is a legitimate assumption.
+ -- If we have only skipped null operands, return the last operand
if NN = 0 then
- Start_String;
- Result := Make_String_Literal (Loc, Strval => End_String);
+ Result := Opnd;
goto Done;
end if;
end;
end if;
- -- Now find the upper bound. This is normally the Low_Bound + Length - 1
- -- but there is one exception, namely when the result is null in which
- -- case the bounds come from the last operand (so that we get the proper
- -- bounds if the last operand is super-flat).
+ -- Now find the upper bound, normally this is Low_Bound + Length - 1
High_Bound :=
To_Ityp (
Left_Opnd => New_Copy (Aggr_Length (NN)),
Right_Opnd => Make_Integer_Literal (Loc, 1))));
+ -- But there is one exception, namely when the result is null in which
+ -- case the bounds come from the last operand (so that we get the proper
+ -- bounds if the last operand is super-flat).
+
if Result_May_Be_Null then
High_Bound :=
Make_Conditional_Expression (Loc,
Make_Op_Eq (Loc,
Left_Opnd => New_Copy (Aggr_Length (NN)),
Right_Opnd => Make_Integer_Literal (Loc, 0)),
- Opnd_High_Bound (NN),
+ Last_Opnd_High_Bound,
High_Bound));
end if;
package body Prj.Nmsc is
+ type Source_Data_Access is access Source_Data;
+
No_Continuation_String : aliased String := "";
Continuation_String : aliased String := "\";
-- Used in Check_Library for continuation error messages at the same
declare
Language : Language_Index;
Source : Source_Id;
- Src_Data : Source_Data;
+ Src_Data : Source_Data_Access;
Alt_Lang : Alternate_Language_Id;
Alt_Lang_Data : Alternate_Language_Data;
Continuation : Boolean := False;
while Language /= No_Language_Index loop
Source := Data.First_Source;
Source_Loop : while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data :=
+ In_Tree.Sources.Table (Source)'Unrestricted_Access;
exit Source_Loop when Src_Data.Language = Language;
Name : File_Name_Type;
Source : Source_Id;
- Src_Data : Source_Data;
+ Src_Data : Source_Data_Access;
Project_2 : Project_Id;
Data_2 : Project_Data;
loop
Source := Data_2.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
Src_Data.In_Interfaces := False;
- In_Tree.Sources.Table (Source) := Src_Data;
Source := Src_Data.Next_In_Project;
end loop;
loop
Source := Data_2.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data :=
+ In_Tree.Sources.Table (Source)'Unrestricted_Access;
if Src_Data.File = Name then
if not Src_Data.Locally_Removed then
- In_Tree.Sources.Table (Source).In_Interfaces := True;
- In_Tree.Sources.Table
- (Source).Declared_In_Interfaces := True;
+ Src_Data.In_Interfaces := True;
+ Src_Data.Declared_In_Interfaces := True;
if Src_Data.Other_Part /= No_Source then
In_Tree.Sources.Table
if Data.Interfaces_Defined then
Source := Data.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
if not Src_Data.Declared_In_Interfaces then
Src_Data.In_Interfaces := False;
- In_Tree.Sources.Table (Source) := Src_Data;
end if;
Source := Src_Data.Next_In_Project;
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
Proj_Data : Project_Data;
Src_Id : Source_Id;
- Src : Source_Data;
+ Src : Source_Data_Access;
begin
if Proj /= No_Project then
Src_Id := Proj_Data.First_Source;
while Src_Id /= No_Source loop
- Src := In_Tree.Sources.Table (Src_Id);
+ Src := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access;
exit when Src.Lang_Kind /= File_Based
or else Src.Kind /= Spec;
is
Mains : constant Variable_Value :=
Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
- List : String_List_Id;
- Elem : String_Element;
begin
Data.Mains := Mains.Values;
(Project, In_Tree,
"a library project file cannot have Main specified",
Mains.Location);
-
- -- Normal case where Main was specified
-
- else
- List := Mains.Values;
- while List /= Nil_String loop
- Elem := In_Tree.String_Elements.Table (List);
-
- if Length_Of_Name (Elem.Value) = 0 then
- Error_Msg
- (Project, In_Tree,
- "?a main cannot have an empty name",
- Elem.Location);
- exit;
- end if;
-
- List := Elem.Next;
- end loop;
end if;
end Get_Mains;
declare
Source : Source_Id;
- Src_Data : Source_Data;
+ Src_Data : Source_Data_Access;
begin
Source := Data.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
if Src_Data.Naming_Exception
and then Src_Data.Path = No_Path_Information
Other_Part : Source_Id;
Add_Src : Boolean;
Src_Ind : Source_File_Index;
- Src_Data : Source_Data;
Unit : Name_Id;
Source_To_Replace : Source_Id := No_Source;
Language_Name : Name_Id;
Source := In_Tree.First_Source;
Add_Src := True;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ declare
+ Src_Data : constant Source_Data_Access :=
+ In_Tree.Sources.Table (Source)'Unrestricted_Access;
+ begin
- if Unit /= No_Name
- and then Src_Data.Unit = Unit
- and then
- ((Src_Data.Kind = Spec and then Kind = Impl)
- or else
- (Src_Data.Kind = Impl and then Kind = Spec))
- then
- Other_Part := Source;
+ if Unit /= No_Name
+ and then Src_Data.Unit = Unit
+ and then
+ ((Src_Data.Kind = Spec and then Kind = Impl)
+ or else
+ (Src_Data.Kind = Impl and then Kind = Spec))
+ then
+ Other_Part := Source;
- elsif (Unit /= No_Name
- and then Src_Data.Unit = Unit
- and then
- (Src_Data.Kind = Kind
+ elsif (Unit /= No_Name
+ and then Src_Data.Unit = Unit
+ and then
+ (Src_Data.Kind = Kind
or else
- (Src_Data.Kind = Sep and then Kind = Impl)
+ (Src_Data.Kind = Sep and then Kind = Impl)
or else
- (Src_Data.Kind = Impl and then Kind = Sep)))
- or else (Unit = No_Name and then Src_Data.File = File_Name)
- then
- -- Duplication of file/unit in same project is only
- -- allowed if order of source directories is known.
+ (Src_Data.Kind = Impl and then Kind = Sep)))
+ or else
+ (Unit = No_Name and then Src_Data.File = File_Name)
+ then
+ -- Duplication of file/unit in same project is only
+ -- allowed if order of source directories is known.
- if Project = Src_Data.Project then
- if Data.Known_Order_Of_Source_Dirs then
- Add_Src := False;
+ if Project = Src_Data.Project then
+ if Data.Known_Order_Of_Source_Dirs then
+ Add_Src := False;
- elsif Unit /= No_Name then
- Error_Msg_Name_1 := Unit;
- Error_Msg
- (Project, In_Tree, "duplicate unit %%", No_Location);
- Add_Src := False;
+ elsif Unit /= No_Name then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Project, In_Tree, "duplicate unit %%",
+ No_Location);
+ Add_Src := False;
- else
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree, "duplicate source file name {",
- No_Location);
- Add_Src := False;
- end if;
+ else
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree, "duplicate source file name {",
+ No_Location);
+ Add_Src := False;
+ end if;
- -- Do not allow the same unit name in different
- -- projects, except if one is extending the other.
+ -- Do not allow the same unit name in different
+ -- projects, except if one is extending the other.
- -- For a file based language, the same file name
- -- replaces a file in a project being extended, but
- -- it is allowed to have the same file name in
- -- unrelated projects.
+ -- For a file based language, the same file name
+ -- replaces a file in a project being extended, but
+ -- it is allowed to have the same file name in
+ -- unrelated projects.
- elsif Is_Extending
- (Project, Src_Data.Project, In_Tree)
- then
- Source_To_Replace := Source;
+ elsif Is_Extending
+ (Project, Src_Data.Project, In_Tree)
+ then
+ Source_To_Replace := Source;
- elsif Unit /= No_Name
- and then not Src_Data.Locally_Removed
- then
- Error_Msg_Name_1 := Unit;
- Error_Msg
- (Project, In_Tree,
- "unit %% cannot belong to several projects",
- No_Location);
+ elsif Unit /= No_Name
+ and then not Src_Data.Locally_Removed
+ then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Project, In_Tree,
+ "unit %% cannot belong to several projects",
+ No_Location);
- Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name;
- Error_Msg_Name_2 := Name_Id (Display_Path_Id);
- Error_Msg
- (Project, In_Tree, "\ project %%, %%", No_Location);
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Project).Name;
+ Error_Msg_Name_2 := Name_Id (Display_Path_Id);
+ Error_Msg
+ (Project, In_Tree, "\ project %%, %%", No_Location);
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Src_Data.Project).Name;
- Error_Msg_Name_2 := Name_Id (Src_Data.Path.Display_Name);
- Error_Msg
- (Project, In_Tree, "\ project %%, %%", No_Location);
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Src_Data.Project).Name;
+ Error_Msg_Name_2 :=
+ Name_Id (Src_Data.Path.Display_Name);
+ Error_Msg
+ (Project, In_Tree, "\ project %%, %%", No_Location);
- Add_Src := False;
+ Add_Src := False;
+ end if;
end if;
- end if;
- Source := Src_Data.Next_In_Sources;
+ Source := Src_Data.Next_In_Sources;
+ end;
end loop;
if Add_Src then
procedure Process_Sources_In_Multi_Language_Mode is
Source : Source_Id;
- Src_Data : Source_Data;
+ Src_Data : Source_Data_Access;
Name_Loc : Name_Location;
OK : Boolean;
FF : File_Found;
Source := Data.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
-- A file that is excluded cannot also be an exception file name
Source := In_Tree.First_Source;
while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
if Src_Data.File = FF.File then
then
Src_Data.Locally_Removed := True;
Src_Data.In_Interfaces := False;
- In_Tree.Sources.Table (Source) := Src_Data;
Add_Forbidden_File_Name (FF.File);
OK := True;
exit;
Check_Object_File_Names : declare
Src_Id : Source_Id;
- Src_Data : Source_Data;
+ Src_Data : Source_Data_Access;
Source_Name : File_Name_Type;
procedure Check_Object;
Object_File_Names.Reset;
Src_Id := In_Tree.First_Source;
while Src_Id /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Src_Id);
+ Src_Data := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access;
if Src_Data.Compiled and then Src_Data.Object_Exists
and then Project_Extends (Project, Src_Data.Project, In_Tree)
projects / gcc.git / commitdiff