[multiple changes]
2011-08-03 Emmanuel Briot <briot@adacore.com> * make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new package. 2011-08-03 Yannick Moy <moy@adacore.com> * cstand.adb (Create_Standard): select Universal_Integer as an ALFA type * sem_ch3.adb (Array_Type_Declaration): detect array types in ALFA * sem_util.adb, sem_util.ads (Has_Static_Array_Bounds): new function to detect that an array has static bounds. From-SVN: r177264
This commit is contained in:
parent
98c99a5a37
commit
e280f98126
|
@ -1,3 +1,15 @@
|
||||||
|
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
||||||
|
|
||||||
|
* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new
|
||||||
|
package.
|
||||||
|
|
||||||
|
2011-08-03 Yannick Moy <moy@adacore.com>
|
||||||
|
|
||||||
|
* cstand.adb (Create_Standard): select Universal_Integer as an ALFA type
|
||||||
|
* sem_ch3.adb (Array_Type_Declaration): detect array types in ALFA
|
||||||
|
* sem_util.adb, sem_util.ads (Has_Static_Array_Bounds): new function to
|
||||||
|
detect that an array has static bounds.
|
||||||
|
|
||||||
2011-08-03 Thomas Quinot <quinot@adacore.com>
|
2011-08-03 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
* exp_dist.adb: Minor reformatting.
|
* exp_dist.adb: Minor reformatting.
|
||||||
|
|
|
@ -141,34 +141,6 @@ package body Clean is
|
||||||
-- Table to store all the source files of a library unit: spec, body and
|
-- Table to store all the source files of a library unit: spec, body and
|
||||||
-- subunits, to detect .dg files and delete them.
|
-- subunits, to detect .dg files and delete them.
|
||||||
|
|
||||||
----------------------------
|
|
||||||
-- Queue (Q) manipulation --
|
|
||||||
----------------------------
|
|
||||||
|
|
||||||
procedure Init_Q;
|
|
||||||
-- Must be called to initialize the Q
|
|
||||||
|
|
||||||
procedure Insert_Q (Lib_File : File_Name_Type);
|
|
||||||
-- If Lib_File is not marked, inserts it at the end of Q and mark it
|
|
||||||
|
|
||||||
function Empty_Q return Boolean;
|
|
||||||
-- Returns True if Q is empty
|
|
||||||
|
|
||||||
procedure Extract_From_Q (Lib_File : out File_Name_Type);
|
|
||||||
-- Extracts the first element from the Q
|
|
||||||
|
|
||||||
Q_Front : Natural;
|
|
||||||
-- Points to the first valid element in the Q
|
|
||||||
|
|
||||||
package Q is new Table.Table (
|
|
||||||
Table_Component_Type => File_Name_Type,
|
|
||||||
Table_Index_Type => Natural,
|
|
||||||
Table_Low_Bound => 0,
|
|
||||||
Table_Initial => 4000,
|
|
||||||
Table_Increment => 100,
|
|
||||||
Table_Name => "Clean.Q");
|
|
||||||
-- This is the actual queue
|
|
||||||
|
|
||||||
-----------------------------
|
-----------------------------
|
||||||
-- Other local subprograms --
|
-- Other local subprograms --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
@ -399,8 +371,11 @@ package body Clean is
|
||||||
Text : Text_Buffer_Ptr;
|
Text : Text_Buffer_Ptr;
|
||||||
The_ALI : ALI_Id;
|
The_ALI : ALI_Id;
|
||||||
|
|
||||||
|
Found : Boolean;
|
||||||
|
Source : Queue.Source_Info;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Init_Q;
|
Queue.Initialize (Queue_Per_Obj_Dir => False);
|
||||||
|
|
||||||
-- It does not really matter if there is or not an object file
|
-- It does not really matter if there is or not an object file
|
||||||
-- corresponding to an ALI file: if there is one, it will be deleted.
|
-- corresponding to an ALI file: if there is one, it will be deleted.
|
||||||
|
@ -414,12 +389,23 @@ package body Clean is
|
||||||
for N_File in 1 .. Osint.Number_Of_Files loop
|
for N_File in 1 .. Osint.Number_Of_Files loop
|
||||||
Main_Source_File := Next_Main_Source;
|
Main_Source_File := Next_Main_Source;
|
||||||
Main_Lib_File := Osint.Lib_File_Name
|
Main_Lib_File := Osint.Lib_File_Name
|
||||||
(Main_Source_File, Current_File_Index);
|
(Main_Source_File, Current_File_Index);
|
||||||
Insert_Q (Main_Lib_File);
|
|
||||||
|
|
||||||
while not Empty_Q loop
|
if Main_Lib_File /= No_File then
|
||||||
|
Queue.Insert
|
||||||
|
((Format => Format_Gnatmake,
|
||||||
|
File => Main_Lib_File,
|
||||||
|
Unit => No_Unit_Name,
|
||||||
|
Index => 0,
|
||||||
|
Project => No_Project));
|
||||||
|
end if;
|
||||||
|
|
||||||
|
while not Queue.Is_Empty loop
|
||||||
Sources.Set_Last (0);
|
Sources.Set_Last (0);
|
||||||
Extract_From_Q (Lib_File);
|
Queue.Extract (Found, Source);
|
||||||
|
pragma Assert (Found);
|
||||||
|
pragma Assert (Source.File /= No_File);
|
||||||
|
Lib_File := Source.File;
|
||||||
Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
|
Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
|
||||||
|
|
||||||
-- If we have existing ALI file that is not read-only, process it
|
-- If we have existing ALI file that is not read-only, process it
|
||||||
|
@ -448,7 +434,14 @@ package body Clean is
|
||||||
for K in ALI.Units.Table (J).First_With ..
|
for K in ALI.Units.Table (J).First_With ..
|
||||||
ALI.Units.Table (J).Last_With
|
ALI.Units.Table (J).Last_With
|
||||||
loop
|
loop
|
||||||
Insert_Q (Withs.Table (K).Afile);
|
if Withs.Table (K).Afile /= No_File then
|
||||||
|
Queue.Insert
|
||||||
|
((Format => Format_Gnatmake,
|
||||||
|
File => Withs.Table (K).Afile,
|
||||||
|
Unit => No_Unit_Name,
|
||||||
|
Index => 0,
|
||||||
|
Project => No_Project));
|
||||||
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
|
@ -1348,26 +1341,6 @@ package body Clean is
|
||||||
end if;
|
end if;
|
||||||
end Display_Copyright;
|
end Display_Copyright;
|
||||||
|
|
||||||
-------------
|
|
||||||
-- Empty_Q --
|
|
||||||
-------------
|
|
||||||
|
|
||||||
function Empty_Q return Boolean is
|
|
||||||
begin
|
|
||||||
return Q_Front >= Q.Last;
|
|
||||||
end Empty_Q;
|
|
||||||
|
|
||||||
--------------------
|
|
||||||
-- Extract_From_Q --
|
|
||||||
--------------------
|
|
||||||
|
|
||||||
procedure Extract_From_Q (Lib_File : out File_Name_Type) is
|
|
||||||
Lib : constant File_Name_Type := Q.Table (Q_Front);
|
|
||||||
begin
|
|
||||||
Q_Front := Q_Front + 1;
|
|
||||||
Lib_File := Lib;
|
|
||||||
end Extract_From_Q;
|
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
-- Gnatclean --
|
-- Gnatclean --
|
||||||
---------------
|
---------------
|
||||||
|
@ -1535,16 +1508,6 @@ package body Clean is
|
||||||
return False;
|
return False;
|
||||||
end In_Extension_Chain;
|
end In_Extension_Chain;
|
||||||
|
|
||||||
------------
|
|
||||||
-- Init_Q --
|
|
||||||
------------
|
|
||||||
|
|
||||||
procedure Init_Q is
|
|
||||||
begin
|
|
||||||
Q_Front := Q.First;
|
|
||||||
Q.Set_Last (Q.First);
|
|
||||||
end Init_Q;
|
|
||||||
|
|
||||||
----------------
|
----------------
|
||||||
-- Initialize --
|
-- Initialize --
|
||||||
----------------
|
----------------
|
||||||
|
@ -1596,24 +1559,6 @@ package body Clean is
|
||||||
All_Projects := False;
|
All_Projects := False;
|
||||||
end Initialize;
|
end Initialize;
|
||||||
|
|
||||||
--------------
|
|
||||||
-- Insert_Q --
|
|
||||||
--------------
|
|
||||||
|
|
||||||
procedure Insert_Q (Lib_File : File_Name_Type) is
|
|
||||||
begin
|
|
||||||
-- Do not insert an empty name or an already marked source
|
|
||||||
|
|
||||||
if Lib_File /= No_File and then not Makeutl.Is_Marked (Lib_File) then
|
|
||||||
Q.Table (Q.Last) := Lib_File;
|
|
||||||
Q.Increment_Last;
|
|
||||||
|
|
||||||
-- Mark the source that has been just added to the Q
|
|
||||||
|
|
||||||
Makeutl.Mark (Lib_File);
|
|
||||||
end if;
|
|
||||||
end Insert_Q;
|
|
||||||
|
|
||||||
----------------------
|
----------------------
|
||||||
-- Object_File_Name --
|
-- Object_File_Name --
|
||||||
----------------------
|
----------------------
|
||||||
|
|
|
@ -1334,6 +1334,7 @@ package body CStand is
|
||||||
Set_Scope (Universal_Integer, Standard_Standard);
|
Set_Scope (Universal_Integer, Standard_Standard);
|
||||||
Build_Signed_Integer_Type
|
Build_Signed_Integer_Type
|
||||||
(Universal_Integer, Standard_Long_Long_Integer_Size);
|
(Universal_Integer, Standard_Long_Long_Integer_Size);
|
||||||
|
Set_Is_In_ALFA (Universal_Integer);
|
||||||
|
|
||||||
Universal_Real := New_Standard_Entity;
|
Universal_Real := New_Standard_Entity;
|
||||||
Decl := New_Node (N_Full_Type_Declaration, Stloc);
|
Decl := New_Node (N_Full_Type_Declaration, Stloc);
|
||||||
|
|
440
gcc/ada/make.adb
440
gcc/ada/make.adb
|
@ -71,7 +71,6 @@ with Ada.Command_Line; use Ada.Command_Line;
|
||||||
|
|
||||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||||
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
||||||
with GNAT.HTable;
|
|
||||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||||
|
|
||||||
|
@ -172,56 +171,6 @@ package body Make is
|
||||||
N_M_Switch : Natural := 0;
|
N_M_Switch : Natural := 0;
|
||||||
-- Used to count -mxxx switches that can affect multilib
|
-- Used to count -mxxx switches that can affect multilib
|
||||||
|
|
||||||
package Queue is
|
|
||||||
---------------------------------
|
|
||||||
-- Queue Manipulation Routines --
|
|
||||||
---------------------------------
|
|
||||||
|
|
||||||
procedure Initialize (Queue_Per_Obj_Dir : Boolean);
|
|
||||||
-- Initialize the queue
|
|
||||||
|
|
||||||
function Is_Empty return Boolean;
|
|
||||||
-- Returns True if the queue is empty
|
|
||||||
|
|
||||||
function Is_Virtually_Empty return Boolean;
|
|
||||||
-- Returns True if the queue is empty or if all object directories are
|
|
||||||
-- busy.
|
|
||||||
|
|
||||||
procedure Insert
|
|
||||||
(Source_File_Name : File_Name_Type;
|
|
||||||
Project : Project_Id;
|
|
||||||
Source_Unit : Unit_Name_Type := No_Unit_Name;
|
|
||||||
Index : Int := 0);
|
|
||||||
-- Insert source in the queue
|
|
||||||
|
|
||||||
procedure Extract
|
|
||||||
(Source_File_Name : out File_Name_Type;
|
|
||||||
Source_Unit : out Unit_Name_Type;
|
|
||||||
Source_Index : out Int);
|
|
||||||
-- Get the first source that can be compiled from the queue. If no
|
|
||||||
-- source may be compiled, return No_File/No_Source.
|
|
||||||
|
|
||||||
function Size return Natural;
|
|
||||||
-- Return the total size of the queue, including the sources already
|
|
||||||
-- extracted.
|
|
||||||
|
|
||||||
function Processed return Natural;
|
|
||||||
-- Return the number of source in the queue that have already been
|
|
||||||
-- processed.
|
|
||||||
|
|
||||||
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
|
|
||||||
-- Indicate that this object directory is busy, so that when
|
|
||||||
-- One_Compilation_Per_Obj_Dir is True no other compilation occurs in
|
|
||||||
-- this object directory.
|
|
||||||
|
|
||||||
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
|
|
||||||
-- Indicate that there is no compilation for this object directory
|
|
||||||
|
|
||||||
function Element (Rank : Positive) return File_Name_Type;
|
|
||||||
-- Get the file name for element of index Rank in the queue
|
|
||||||
|
|
||||||
end Queue;
|
|
||||||
|
|
||||||
-- The 3 following packages are used to store gcc, gnatbind and gnatlink
|
-- The 3 following packages are used to store gcc, gnatbind and gnatlink
|
||||||
-- switches found in the project files.
|
-- switches found in the project files.
|
||||||
|
|
||||||
|
@ -2736,14 +2685,16 @@ package body Make is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Add_It then
|
if Add_It then
|
||||||
if Is_Marked (Sfile) then
|
if not Queue.Insert
|
||||||
|
((Format => Format_Gnatmake,
|
||||||
|
File => Sfile,
|
||||||
|
Unit => No_Unit_Name,
|
||||||
|
Project => No_Project,
|
||||||
|
Index => 0))
|
||||||
|
then
|
||||||
if Is_In_Obsoleted (Sfile) then
|
if Is_In_Obsoleted (Sfile) then
|
||||||
Executable_Obsolete := True;
|
Executable_Obsolete := True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
else
|
|
||||||
Queue.Insert (Sfile, Project => No_Project, Index => 0);
|
|
||||||
Mark (Sfile, Index => 0);
|
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
@ -3168,21 +3119,18 @@ package body Make is
|
||||||
else
|
else
|
||||||
Source_Index := Unit_Index_Of (Withs.Table (K).Afile);
|
Source_Index := Unit_Index_Of (Withs.Table (K).Afile);
|
||||||
|
|
||||||
if Is_Marked (Sfile, Source_Index) then
|
if not (Check_Readonly_Files or Must_Compile)
|
||||||
Debug_Msg ("Skipping marked file:", Sfile);
|
|
||||||
|
|
||||||
elsif not (Check_Readonly_Files or Must_Compile)
|
|
||||||
and then Is_Internal_File_Name (Sfile, False)
|
and then Is_Internal_File_Name (Sfile, False)
|
||||||
then
|
then
|
||||||
Debug_Msg ("Skipping internal file:", Sfile);
|
Debug_Msg ("Skipping internal file:", Sfile);
|
||||||
|
|
||||||
else
|
else
|
||||||
Queue.Insert
|
Queue.Insert
|
||||||
(Sfile,
|
((Format => Format_Gnatmake,
|
||||||
ALI_P.Project,
|
File => Sfile,
|
||||||
Withs.Table (K).Uname,
|
Project => ALI_P.Project,
|
||||||
Source_Index);
|
Unit => Withs.Table (K).Uname,
|
||||||
Mark (Sfile, Source_Index);
|
Index => Source_Index));
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
@ -3306,15 +3254,11 @@ package body Make is
|
||||||
Pid : Process_Id;
|
Pid : Process_Id;
|
||||||
Process_Created : Boolean;
|
Process_Created : Boolean;
|
||||||
|
|
||||||
Source_File : File_Name_Type;
|
Source : Queue.Source_Info;
|
||||||
Full_Source_File : File_Name_Type;
|
Full_Source_File : File_Name_Type;
|
||||||
Source_File_Attr : aliased File_Attributes;
|
Source_File_Attr : aliased File_Attributes;
|
||||||
-- The full name of the source file and its attributes (size, ...)
|
-- The full name of the source file and its attributes (size, ...)
|
||||||
|
|
||||||
Source_Unit : Unit_Name_Type;
|
|
||||||
Source_Index : Int;
|
|
||||||
-- Index of the current unit in the current source file
|
|
||||||
|
|
||||||
Lib_File : File_Name_Type;
|
Lib_File : File_Name_Type;
|
||||||
Full_Lib_File : File_Name_Type;
|
Full_Lib_File : File_Name_Type;
|
||||||
Lib_File_Attr : aliased File_Attributes;
|
Lib_File_Attr : aliased File_Attributes;
|
||||||
|
@ -3326,18 +3270,20 @@ package body Make is
|
||||||
Obj_Stamp : Time_Stamp_Type;
|
Obj_Stamp : Time_Stamp_Type;
|
||||||
-- The object file
|
-- The object file
|
||||||
|
|
||||||
|
Found : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not Queue.Is_Virtually_Empty and then
|
if not Queue.Is_Virtually_Empty and then
|
||||||
Outstanding_Compiles < Max_Process
|
Outstanding_Compiles < Max_Process
|
||||||
then
|
then
|
||||||
Queue.Extract (Source_File, Source_Unit, Source_Index);
|
Queue.Extract (Found, Source);
|
||||||
|
|
||||||
Osint.Full_Source_Name
|
Osint.Full_Source_Name
|
||||||
(Source_File,
|
(Source.File,
|
||||||
Full_File => Full_Source_File,
|
Full_File => Full_Source_File,
|
||||||
Attr => Source_File_Attr'Access);
|
Attr => Source_File_Attr'Access);
|
||||||
|
|
||||||
Lib_File := Osint.Lib_File_Name (Source_File, Source_Index);
|
Lib_File := Osint.Lib_File_Name (Source.File, Source.Index);
|
||||||
|
|
||||||
-- ??? This call could be avoided when using projects, since we
|
-- ??? This call could be avoided when using projects, since we
|
||||||
-- know where the ALI file is supposed to be. That would avoid
|
-- know where the ALI file is supposed to be. That would avoid
|
||||||
|
@ -3352,7 +3298,7 @@ package body Make is
|
||||||
|
|
||||||
-- If source has already been compiled, executable is obsolete
|
-- If source has already been compiled, executable is obsolete
|
||||||
|
|
||||||
if Is_In_Obsoleted (Source_File) then
|
if Is_In_Obsoleted (Source.File) then
|
||||||
Executable_Obsolete := True;
|
Executable_Obsolete := True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -3390,7 +3336,7 @@ package body Make is
|
||||||
-- directory of a project being extended must not be skipped).
|
-- directory of a project being extended must not be skipped).
|
||||||
|
|
||||||
elsif Read_Only
|
elsif Read_Only
|
||||||
and then Is_In_Object_Directory (Source_File, Full_Lib_File)
|
and then Is_In_Object_Directory (Source.File, Full_Lib_File)
|
||||||
then
|
then
|
||||||
Verbose_Msg
|
Verbose_Msg
|
||||||
(Lib_File,
|
(Lib_File,
|
||||||
|
@ -3401,19 +3347,19 @@ package body Make is
|
||||||
-- The source file that we are checking cannot be located
|
-- The source file that we are checking cannot be located
|
||||||
|
|
||||||
elsif Full_Source_File = No_File then
|
elsif Full_Source_File = No_File then
|
||||||
Record_Failure (Source_File, Source_Unit, False);
|
Record_Failure (Source.File, Source.Unit, False);
|
||||||
|
|
||||||
-- Source and library files can be located but are internal
|
-- Source and library files can be located but are internal
|
||||||
-- files.
|
-- files.
|
||||||
|
|
||||||
elsif not (Check_Readonly_Files or else Must_Compile)
|
elsif not (Check_Readonly_Files or else Must_Compile)
|
||||||
and then Full_Lib_File /= No_File
|
and then Full_Lib_File /= No_File
|
||||||
and then Is_Internal_File_Name (Source_File, False)
|
and then Is_Internal_File_Name (Source.File, False)
|
||||||
then
|
then
|
||||||
if Force_Compilations then
|
if Force_Compilations then
|
||||||
Fail
|
Fail
|
||||||
("not allowed to compile """ &
|
("not allowed to compile """ &
|
||||||
Get_Name_String (Source_File) &
|
Get_Name_String (Source.File) &
|
||||||
"""; use -a switch, or compile file with " &
|
"""; use -a switch, or compile file with " &
|
||||||
"""-gnatg"" switch");
|
"""-gnatg"" switch");
|
||||||
end if;
|
end if;
|
||||||
|
@ -3428,7 +3374,7 @@ package body Make is
|
||||||
|
|
||||||
else
|
else
|
||||||
Collect_Arguments
|
Collect_Arguments
|
||||||
(Source_File, Source_File = Main_Source, Args);
|
(Source.File, Source.File = Main_Source, Args);
|
||||||
|
|
||||||
-- Do nothing if project of source is externally built
|
-- Do nothing if project of source is externally built
|
||||||
|
|
||||||
|
@ -3442,9 +3388,9 @@ package body Make is
|
||||||
Need_To_Compile := Force_Compilations;
|
Need_To_Compile := Force_Compilations;
|
||||||
|
|
||||||
if not Force_Compilations then
|
if not Force_Compilations then
|
||||||
Check (Source_File => Source_File,
|
Check (Source_File => Source.File,
|
||||||
Source_Index => Source_Index,
|
Source_Index => Source.Index,
|
||||||
Is_Main_Source => Source_File = Main_Source,
|
Is_Main_Source => Source.File = Main_Source,
|
||||||
The_Args => Args,
|
The_Args => Args,
|
||||||
Lib_File => Lib_File,
|
Lib_File => Lib_File,
|
||||||
Full_Lib_File => Full_Lib_File,
|
Full_Lib_File => Full_Lib_File,
|
||||||
|
@ -3482,7 +3428,7 @@ package body Make is
|
||||||
and then not External_Unit_Compilation_Allowed
|
and then not External_Unit_Compilation_Allowed
|
||||||
then
|
then
|
||||||
Make_Failed ("external source ("
|
Make_Failed ("external source ("
|
||||||
& Get_Name_String (Source_File)
|
& Get_Name_String (Source.File)
|
||||||
& ") is not part of any project;"
|
& ") is not part of any project;"
|
||||||
& " cannot be compiled without"
|
& " cannot be compiled without"
|
||||||
& " gnatmake switch -x");
|
& " gnatmake switch -x");
|
||||||
|
@ -3514,7 +3460,7 @@ package body Make is
|
||||||
|
|
||||||
Lib_File :=
|
Lib_File :=
|
||||||
Osint.Lib_File_Name
|
Osint.Lib_File_Name
|
||||||
(Full_Source_File, Source_Index);
|
(Full_Source_File, Source.Index);
|
||||||
Full_Lib_File := Lib_File;
|
Full_Lib_File := Lib_File;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -3532,7 +3478,7 @@ package body Make is
|
||||||
Collect_Arguments_And_Compile
|
Collect_Arguments_And_Compile
|
||||||
(Full_Source_File => Full_Source_File,
|
(Full_Source_File => Full_Source_File,
|
||||||
Lib_File => Lib_File,
|
Lib_File => Lib_File,
|
||||||
Source_Index => Source_Index,
|
Source_Index => Source.Index,
|
||||||
Pid => Pid,
|
Pid => Pid,
|
||||||
Process_Created => Process_Created);
|
Process_Created => Process_Created);
|
||||||
|
|
||||||
|
@ -3584,13 +3530,13 @@ package body Make is
|
||||||
|
|
||||||
if Process_Created then
|
if Process_Created then
|
||||||
if Pid = Invalid_Pid then
|
if Pid = Invalid_Pid then
|
||||||
Record_Failure (Full_Source_File, Source_Unit);
|
Record_Failure (Full_Source_File, Source.Unit);
|
||||||
else
|
else
|
||||||
Add_Process
|
Add_Process
|
||||||
(Pid => Pid,
|
(Pid => Pid,
|
||||||
Sfile => Full_Source_File,
|
Sfile => Full_Source_File,
|
||||||
Afile => Lib_File,
|
Afile => Lib_File,
|
||||||
Uname => Source_Unit,
|
Uname => Source.Unit,
|
||||||
Mfile => Mfile,
|
Mfile => Mfile,
|
||||||
Full_Lib_File => Full_Lib_File,
|
Full_Lib_File => Full_Lib_File,
|
||||||
Lib_File_Attr => Lib_File_Attr);
|
Lib_File_Attr => Lib_File_Attr);
|
||||||
|
@ -3727,13 +3673,12 @@ package body Make is
|
||||||
Check_Source_Files := True;
|
Check_Source_Files := True;
|
||||||
All_Sources := False;
|
All_Sources := False;
|
||||||
|
|
||||||
-- Only insert in the Q if it is not already done, to avoid simultaneous
|
Queue.Insert
|
||||||
-- compilations if -jnnn is used.
|
((Format => Format_Gnatmake,
|
||||||
|
File => Main_Source,
|
||||||
if not Is_Marked (Main_Source, Main_Index) then
|
Project => Main_Project,
|
||||||
Queue.Insert (Main_Source, Main_Project, Index => Main_Index);
|
Unit => No_Unit_Name,
|
||||||
Mark (Main_Source, Main_Index);
|
Index => Main_Index));
|
||||||
end if;
|
|
||||||
|
|
||||||
First_Compiled_File := No_File;
|
First_Compiled_File := No_File;
|
||||||
Most_Recent_Obj_File := No_File;
|
Most_Recent_Obj_File := No_File;
|
||||||
|
@ -6497,10 +6442,7 @@ package body Make is
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Remove all marks to be sure to check sources for all executables,
|
Queue.Remove_Marks;
|
||||||
-- as the switches may be different and -s may be in use.
|
|
||||||
|
|
||||||
Delete_All_Marks;
|
|
||||||
end loop Multiple_Main_Loop;
|
end loop Multiple_Main_Loop;
|
||||||
|
|
||||||
if Do_Codepeer_Globalize_Step then
|
if Do_Codepeer_Globalize_Step then
|
||||||
|
@ -7033,17 +6975,13 @@ package body Make is
|
||||||
(Main_Project /= No_Project and then
|
(Main_Project /= No_Project and then
|
||||||
One_Compilation_Per_Obj_Dir);
|
One_Compilation_Per_Obj_Dir);
|
||||||
|
|
||||||
-- And of course, only insert in the Q if the source is not marked
|
if Sfile /= No_File then
|
||||||
|
Queue.Insert
|
||||||
if Sfile /= No_File and then not Is_Marked (Sfile, Index) then
|
((Format => Format_Gnatmake,
|
||||||
if Verbose_Mode then
|
File => Sfile,
|
||||||
Write_Str ("Adding """);
|
Project => Project,
|
||||||
Write_Str (Get_Name_String (Sfile));
|
Unit => No_Unit_Name,
|
||||||
Write_Line (""" to the queue");
|
Index => Index));
|
||||||
end if;
|
|
||||||
|
|
||||||
Queue.Insert (Sfile, Project, Index => Index);
|
|
||||||
Mark (Sfile, Index);
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if not Put_In_Q and then Sfile /= No_File then
|
if not Put_In_Q and then Sfile /= No_File then
|
||||||
|
@ -7477,290 +7415,6 @@ package body Make is
|
||||||
Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
|
Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
|
||||||
end Process_Multilib;
|
end Process_Multilib;
|
||||||
|
|
||||||
-----------
|
|
||||||
-- Queue --
|
|
||||||
-----------
|
|
||||||
|
|
||||||
package body Queue is
|
|
||||||
|
|
||||||
type Q_Record is record
|
|
||||||
File : File_Name_Type;
|
|
||||||
Unit : Unit_Name_Type;
|
|
||||||
Index : Int;
|
|
||||||
Project : Project_Id;
|
|
||||||
Processed : Boolean;
|
|
||||||
end record;
|
|
||||||
-- File is the name of the file to compile. Unit is for gnatdist use in
|
|
||||||
-- order to easily get the unit name of a file to compile when its name
|
|
||||||
-- is krunched or declared in gnat.adc. Index, when not 0, is the index
|
|
||||||
-- of the unit in a multi-unit source.
|
|
||||||
|
|
||||||
package Q is new Table.Table
|
|
||||||
(Table_Component_Type => Q_Record,
|
|
||||||
Table_Index_Type => Positive,
|
|
||||||
Table_Low_Bound => 1,
|
|
||||||
Table_Initial => 4000,
|
|
||||||
Table_Increment => 100,
|
|
||||||
Table_Name => "Make.Queue.Q");
|
|
||||||
-- This is the actual Q
|
|
||||||
|
|
||||||
package Busy_Obj_Dirs is new GNAT.HTable.Simple_HTable
|
|
||||||
(Header_Num => Prj.Header_Num,
|
|
||||||
Element => Boolean,
|
|
||||||
No_Element => False,
|
|
||||||
Key => Path_Name_Type,
|
|
||||||
Hash => Hash,
|
|
||||||
Equal => "=");
|
|
||||||
|
|
||||||
Q_First : Natural := 1;
|
|
||||||
-- Points to the first valid element in the queue
|
|
||||||
|
|
||||||
Q_Processed : Natural := 0;
|
|
||||||
One_Queue_Per_Obj_Dir : Boolean := False;
|
|
||||||
Q_Initialized : Boolean := False;
|
|
||||||
|
|
||||||
-------------
|
|
||||||
-- Element --
|
|
||||||
-------------
|
|
||||||
|
|
||||||
function Element (Rank : Positive) return File_Name_Type is
|
|
||||||
begin
|
|
||||||
if Rank <= Q.Last then
|
|
||||||
return Q.Table (Rank).File;
|
|
||||||
else
|
|
||||||
return No_File;
|
|
||||||
end if;
|
|
||||||
end Element;
|
|
||||||
|
|
||||||
-------------
|
|
||||||
-- Extract --
|
|
||||||
-------------
|
|
||||||
|
|
||||||
-- This body needs commenting ???
|
|
||||||
|
|
||||||
procedure Extract
|
|
||||||
(Source_File_Name : out File_Name_Type;
|
|
||||||
Source_Unit : out Unit_Name_Type;
|
|
||||||
Source_Index : out Int)
|
|
||||||
is
|
|
||||||
Found : Boolean := False;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if One_Queue_Per_Obj_Dir then
|
|
||||||
for J in Q_First .. Q.Last loop
|
|
||||||
if not Q.Table (J).Processed
|
|
||||||
and then (Q.Table (J).Project = No_Project
|
|
||||||
or else not
|
|
||||||
Busy_Obj_Dirs.Get
|
|
||||||
(Q.Table (J).Project.Object_Directory.Name))
|
|
||||||
then
|
|
||||||
Found := True;
|
|
||||||
Source_File_Name := Q.Table (J).File;
|
|
||||||
Source_Unit := Q.Table (J).Unit;
|
|
||||||
Source_Index := Q.Table (J).Index;
|
|
||||||
Q.Table (J).Processed := True;
|
|
||||||
|
|
||||||
if J = Q_First then
|
|
||||||
while Q_First <= Q.Last
|
|
||||||
and then Q.Table (Q_First).Processed
|
|
||||||
loop
|
|
||||||
Q_First := Q_First + 1;
|
|
||||||
end loop;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
exit;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
elsif Q_First <= Q.Last then
|
|
||||||
Source_File_Name := Q.Table (Q_First).File;
|
|
||||||
Source_Unit := Q.Table (Q_First).Unit;
|
|
||||||
Source_Index := Q.Table (Q_First).Index;
|
|
||||||
Q.Table (Q_First).Processed := True;
|
|
||||||
Q_First := Q_First + 1;
|
|
||||||
Found := True;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Found then
|
|
||||||
Q_Processed := Q_Processed + 1;
|
|
||||||
else
|
|
||||||
Source_File_Name := No_File;
|
|
||||||
Source_Unit := No_Unit_Name;
|
|
||||||
Source_Index := 0;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Found and then Debug.Debug_Flag_Q then
|
|
||||||
Write_Str (" Q := Q - [ ");
|
|
||||||
Write_Name (Source_File_Name);
|
|
||||||
|
|
||||||
if Source_Index /= 0 then
|
|
||||||
Write_Str (", ");
|
|
||||||
Write_Int (Source_Index);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Write_Str (" ]");
|
|
||||||
Write_Eol;
|
|
||||||
|
|
||||||
Write_Str (" Q_First =");
|
|
||||||
Write_Int (Int (Q_First));
|
|
||||||
Write_Eol;
|
|
||||||
|
|
||||||
Write_Str (" Q.Last =");
|
|
||||||
Write_Int (Int (Q.Last));
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
|
||||||
end Extract;
|
|
||||||
|
|
||||||
----------------
|
|
||||||
-- Initialize --
|
|
||||||
----------------
|
|
||||||
|
|
||||||
procedure Initialize (Queue_Per_Obj_Dir : Boolean) is
|
|
||||||
begin
|
|
||||||
if not Q_Initialized then
|
|
||||||
One_Queue_Per_Obj_Dir := Queue_Per_Obj_Dir;
|
|
||||||
Q.Init;
|
|
||||||
Q_Initialized := True;
|
|
||||||
Q_Processed := 0;
|
|
||||||
Q_First := 1;
|
|
||||||
end if;
|
|
||||||
end Initialize;
|
|
||||||
|
|
||||||
------------
|
|
||||||
-- Insert --
|
|
||||||
------------
|
|
||||||
|
|
||||||
-- This body needs commenting ???
|
|
||||||
|
|
||||||
procedure Insert
|
|
||||||
(Source_File_Name : File_Name_Type;
|
|
||||||
Project : Project_Id;
|
|
||||||
Source_Unit : Unit_Name_Type := No_Unit_Name;
|
|
||||||
Index : Int := 0)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Q.Append
|
|
||||||
((File => Source_File_Name,
|
|
||||||
Project => Project,
|
|
||||||
Unit => Source_Unit,
|
|
||||||
Index => Index,
|
|
||||||
Processed => False));
|
|
||||||
|
|
||||||
if Debug.Debug_Flag_Q then
|
|
||||||
Write_Str (" Q := Q + [ ");
|
|
||||||
Write_Name (Source_File_Name);
|
|
||||||
|
|
||||||
if Index /= 0 then
|
|
||||||
Write_Str (", ");
|
|
||||||
Write_Int (Index);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Write_Str (" ] ");
|
|
||||||
Write_Eol;
|
|
||||||
|
|
||||||
Write_Str (" Q_First =");
|
|
||||||
Write_Int (Int (Q_First));
|
|
||||||
Write_Eol;
|
|
||||||
|
|
||||||
Write_Str (" Q.Last =");
|
|
||||||
Write_Int (Int (Q.Last));
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
|
||||||
end Insert;
|
|
||||||
|
|
||||||
--------------
|
|
||||||
-- Is_Empty --
|
|
||||||
--------------
|
|
||||||
|
|
||||||
function Is_Empty return Boolean is
|
|
||||||
begin
|
|
||||||
if Debug.Debug_Flag_P then
|
|
||||||
Write_Str (" Q := [");
|
|
||||||
|
|
||||||
for J in Q_First .. Q.Last loop
|
|
||||||
if not Q.Table (J).Processed then
|
|
||||||
Write_Str (" ");
|
|
||||||
Write_Name (Q.Table (J).File);
|
|
||||||
Write_Eol;
|
|
||||||
Write_Str (" ");
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
Write_Str ("]");
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return Q_First > Q.Last;
|
|
||||||
end Is_Empty;
|
|
||||||
|
|
||||||
------------------------
|
|
||||||
-- Is_Virtually_Empty --
|
|
||||||
------------------------
|
|
||||||
|
|
||||||
function Is_Virtually_Empty return Boolean is
|
|
||||||
begin
|
|
||||||
if One_Queue_Per_Obj_Dir then
|
|
||||||
for J in Q_First .. Q.Last loop
|
|
||||||
if not Q.Table (J).Processed
|
|
||||||
and then
|
|
||||||
(Q.Table (J).Project = No_Project
|
|
||||||
or else not
|
|
||||||
Busy_Obj_Dirs.Get
|
|
||||||
(Q.Table (J).Project.Object_Directory.Name))
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
return True;
|
|
||||||
|
|
||||||
else
|
|
||||||
return Is_Empty;
|
|
||||||
end if;
|
|
||||||
end Is_Virtually_Empty;
|
|
||||||
|
|
||||||
---------------
|
|
||||||
-- Processed --
|
|
||||||
---------------
|
|
||||||
|
|
||||||
function Processed return Natural is
|
|
||||||
begin
|
|
||||||
return Q_Processed;
|
|
||||||
end Processed;
|
|
||||||
|
|
||||||
----------------------
|
|
||||||
-- Set_Obj_Dir_Busy --
|
|
||||||
----------------------
|
|
||||||
|
|
||||||
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type) is
|
|
||||||
begin
|
|
||||||
if One_Queue_Per_Obj_Dir then
|
|
||||||
Busy_Obj_Dirs.Set (Obj_Dir, True);
|
|
||||||
end if;
|
|
||||||
end Set_Obj_Dir_Busy;
|
|
||||||
|
|
||||||
----------------------
|
|
||||||
-- Set_Obj_Dir_Free --
|
|
||||||
----------------------
|
|
||||||
|
|
||||||
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type) is
|
|
||||||
begin
|
|
||||||
if One_Queue_Per_Obj_Dir then
|
|
||||||
Busy_Obj_Dirs.Set (Obj_Dir, False);
|
|
||||||
end if;
|
|
||||||
end Set_Obj_Dir_Free;
|
|
||||||
|
|
||||||
----------
|
|
||||||
-- Size --
|
|
||||||
----------
|
|
||||||
|
|
||||||
function Size return Natural is
|
|
||||||
begin
|
|
||||||
return Q.Last;
|
|
||||||
end Size;
|
|
||||||
|
|
||||||
end Queue;
|
|
||||||
|
|
||||||
-----------------------------
|
-----------------------------
|
||||||
-- Recursive_Compute_Depth --
|
-- Recursive_Compute_Depth --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
|
@ -44,30 +44,6 @@ with GNAT.HTable;
|
||||||
|
|
||||||
package body Makeutl is
|
package body Makeutl is
|
||||||
|
|
||||||
type Mark_Key is record
|
|
||||||
File : File_Name_Type;
|
|
||||||
Index : Int;
|
|
||||||
end record;
|
|
||||||
-- Identify either a mono-unit source (when Index = 0) or a specific unit
|
|
||||||
-- (index = 1's origin index of unit) in a multi-unit source.
|
|
||||||
|
|
||||||
-- There follow many global undocumented declarations, comments needed ???
|
|
||||||
|
|
||||||
Max_Mask_Num : constant := 2048;
|
|
||||||
|
|
||||||
subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1;
|
|
||||||
|
|
||||||
function Hash (Key : Mark_Key) return Mark_Num;
|
|
||||||
|
|
||||||
package Marks is new GNAT.HTable.Simple_HTable
|
|
||||||
(Header_Num => Mark_Num,
|
|
||||||
Element => Boolean,
|
|
||||||
No_Element => False,
|
|
||||||
Key => Mark_Key,
|
|
||||||
Hash => Hash,
|
|
||||||
Equal => "=");
|
|
||||||
-- A hash table to keep tracks of the marked units
|
|
||||||
|
|
||||||
type Linker_Options_Data is record
|
type Linker_Options_Data is record
|
||||||
Project : Project_Id;
|
Project : Project_Id;
|
||||||
Options : String_List_Id;
|
Options : String_List_Id;
|
||||||
|
@ -520,15 +496,6 @@ package body Makeutl is
|
||||||
return Name_Find;
|
return Name_Find;
|
||||||
end Create_Name;
|
end Create_Name;
|
||||||
|
|
||||||
----------------------
|
|
||||||
-- Delete_All_Marks --
|
|
||||||
----------------------
|
|
||||||
|
|
||||||
procedure Delete_All_Marks is
|
|
||||||
begin
|
|
||||||
Marks.Reset;
|
|
||||||
end Delete_All_Marks;
|
|
||||||
|
|
||||||
----------------------------
|
----------------------------
|
||||||
-- Executable_Prefix_Path --
|
-- Executable_Prefix_Path --
|
||||||
----------------------------
|
----------------------------
|
||||||
|
@ -817,15 +784,6 @@ package body Makeutl is
|
||||||
end if;
|
end if;
|
||||||
end Get_Switches;
|
end Get_Switches;
|
||||||
|
|
||||||
----------
|
|
||||||
-- Hash --
|
|
||||||
----------
|
|
||||||
|
|
||||||
function Hash (Key : Mark_Key) return Mark_Num is
|
|
||||||
begin
|
|
||||||
return Union_Id (Key.File) mod Max_Mask_Num;
|
|
||||||
end Hash;
|
|
||||||
|
|
||||||
------------
|
------------
|
||||||
-- Inform --
|
-- Inform --
|
||||||
------------
|
------------
|
||||||
|
@ -893,18 +851,6 @@ package body Makeutl is
|
||||||
Declaration => Argv (Start .. Finish));
|
Declaration => Argv (Start .. Finish));
|
||||||
end Is_External_Assignment;
|
end Is_External_Assignment;
|
||||||
|
|
||||||
---------------
|
|
||||||
-- Is_Marked --
|
|
||||||
---------------
|
|
||||||
|
|
||||||
function Is_Marked
|
|
||||||
(Source_File : File_Name_Type;
|
|
||||||
Index : Int := 0) return Boolean
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Marks.Get (K => (File => Source_File, Index => Index));
|
|
||||||
end Is_Marked;
|
|
||||||
|
|
||||||
-----------------------------
|
-----------------------------
|
||||||
-- Linker_Options_Switches --
|
-- Linker_Options_Switches --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
@ -1151,15 +1097,6 @@ package body Makeutl is
|
||||||
end Update_Main;
|
end Update_Main;
|
||||||
end Mains;
|
end Mains;
|
||||||
|
|
||||||
----------
|
|
||||||
-- Mark --
|
|
||||||
----------
|
|
||||||
|
|
||||||
procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is
|
|
||||||
begin
|
|
||||||
Marks.Set (K => (File => Source_File, Index => Index), E => True);
|
|
||||||
end Mark;
|
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
-- Path_Or_File_Name --
|
-- Path_Or_File_Name --
|
||||||
-----------------------
|
-----------------------
|
||||||
|
@ -1363,6 +1300,10 @@ package body Makeutl is
|
||||||
Write_Eol;
|
Write_Eol;
|
||||||
end Verbose_Msg;
|
end Verbose_Msg;
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
-- Verbose_Msg --
|
||||||
|
-----------------
|
||||||
|
|
||||||
procedure Verbose_Msg
|
procedure Verbose_Msg
|
||||||
(N1 : File_Name_Type;
|
(N1 : File_Name_Type;
|
||||||
S1 : String;
|
S1 : String;
|
||||||
|
@ -1376,4 +1317,414 @@ package body Makeutl is
|
||||||
(Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
|
(Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
|
||||||
end Verbose_Msg;
|
end Verbose_Msg;
|
||||||
|
|
||||||
|
-----------
|
||||||
|
-- Queue --
|
||||||
|
-----------
|
||||||
|
|
||||||
|
package body Queue is
|
||||||
|
type Q_Record is record
|
||||||
|
Info : Source_Info;
|
||||||
|
Processed : Boolean;
|
||||||
|
end record;
|
||||||
|
|
||||||
|
package Q is new Table.Table
|
||||||
|
(Table_Component_Type => Q_Record,
|
||||||
|
Table_Index_Type => Natural,
|
||||||
|
Table_Low_Bound => 1,
|
||||||
|
Table_Initial => 1000,
|
||||||
|
Table_Increment => 100,
|
||||||
|
Table_Name => "Makeutl.Queue.Q");
|
||||||
|
-- This is the actual Queue
|
||||||
|
|
||||||
|
package Busy_Obj_Dirs is new GNAT.HTable.Simple_HTable
|
||||||
|
(Header_Num => Prj.Header_Num,
|
||||||
|
Element => Boolean,
|
||||||
|
No_Element => False,
|
||||||
|
Key => Path_Name_Type,
|
||||||
|
Hash => Hash,
|
||||||
|
Equal => "=");
|
||||||
|
|
||||||
|
type Mark_Key is record
|
||||||
|
File : File_Name_Type;
|
||||||
|
Index : Int;
|
||||||
|
end record;
|
||||||
|
-- Identify either a mono-unit source (when Index = 0) or a specific
|
||||||
|
-- unit (index = 1's origin index of unit) in a multi-unit source.
|
||||||
|
|
||||||
|
Max_Mask_Num : constant := 2048;
|
||||||
|
subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1;
|
||||||
|
|
||||||
|
function Hash (Key : Mark_Key) return Mark_Num;
|
||||||
|
|
||||||
|
package Marks is new GNAT.HTable.Simple_HTable
|
||||||
|
(Header_Num => Mark_Num,
|
||||||
|
Element => Boolean,
|
||||||
|
No_Element => False,
|
||||||
|
Key => Mark_Key,
|
||||||
|
Hash => Hash,
|
||||||
|
Equal => "=");
|
||||||
|
-- A hash table to keep tracks of the marked units.
|
||||||
|
-- These are the units that have already been processed, when using the
|
||||||
|
-- gnatmake format. When using the gprbuild format, we can directly
|
||||||
|
-- store in the source_id whether the file has already been processed.
|
||||||
|
|
||||||
|
procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
|
||||||
|
-- Mark a unit, identified by its source file and, when Index is not 0,
|
||||||
|
-- the index of the unit in the source file. Marking is used to signal
|
||||||
|
-- that the unit has already been inserted in the Q.
|
||||||
|
|
||||||
|
function Is_Marked
|
||||||
|
(Source_File : File_Name_Type;
|
||||||
|
Index : Int := 0) return Boolean;
|
||||||
|
-- Returns True if the unit was previously marked
|
||||||
|
|
||||||
|
Q_Processed : Natural := 0;
|
||||||
|
Q_Initialized : Boolean := False;
|
||||||
|
|
||||||
|
Q_First : Natural := 1;
|
||||||
|
-- Points to the first valid element in the queue
|
||||||
|
|
||||||
|
One_Queue_Per_Obj_Dir : Boolean := False;
|
||||||
|
-- See parameter to Initialize
|
||||||
|
|
||||||
|
function Available_Obj_Dir (S : Source_Info) return Boolean;
|
||||||
|
-- Whether the object directory for S is available for a build
|
||||||
|
|
||||||
|
procedure Debug_Display (S : Source_Info);
|
||||||
|
-- A debug display for S
|
||||||
|
|
||||||
|
function Was_Processed (S : Source_Info) return Boolean;
|
||||||
|
-- Whether S has already been processed. This marks the source as
|
||||||
|
-- processed, if it hasn't already been processed.
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
-- Was_Processed --
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
function Was_Processed (S : Source_Info) return Boolean is
|
||||||
|
begin
|
||||||
|
case S.Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
if S.Id.In_The_Queue then
|
||||||
|
return True;
|
||||||
|
end if;
|
||||||
|
S.Id.In_The_Queue := True;
|
||||||
|
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
if Is_Marked (S.File, S.Index) then
|
||||||
|
return True;
|
||||||
|
end if;
|
||||||
|
Mark (S.File, Index => S.Index);
|
||||||
|
end case;
|
||||||
|
|
||||||
|
return False;
|
||||||
|
end Was_Processed;
|
||||||
|
|
||||||
|
-----------------------
|
||||||
|
-- Available_Obj_Dir --
|
||||||
|
-----------------------
|
||||||
|
|
||||||
|
function Available_Obj_Dir (S : Source_Info) return Boolean is
|
||||||
|
begin
|
||||||
|
case S.Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
return not Busy_Obj_Dirs.Get
|
||||||
|
(S.Id.Project.Object_Directory.Name);
|
||||||
|
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
return S.Project = No_Project
|
||||||
|
or else
|
||||||
|
not Busy_Obj_Dirs.Get (S.Project.Object_Directory.Name);
|
||||||
|
end case;
|
||||||
|
end Available_Obj_Dir;
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
-- Debug_Display --
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
procedure Debug_Display (S : Source_Info) is
|
||||||
|
begin
|
||||||
|
case S.Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
Write_Name (S.Id.File);
|
||||||
|
|
||||||
|
if S.Id.Index /= 0 then
|
||||||
|
Write_Str (", ");
|
||||||
|
Write_Int (S.Id.Index);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
Write_Name (S.File);
|
||||||
|
|
||||||
|
if S.Index /= 0 then
|
||||||
|
Write_Str (", ");
|
||||||
|
Write_Int (S.Index);
|
||||||
|
end if;
|
||||||
|
end case;
|
||||||
|
end Debug_Display;
|
||||||
|
|
||||||
|
----------
|
||||||
|
-- Hash --
|
||||||
|
----------
|
||||||
|
|
||||||
|
function Hash (Key : Mark_Key) return Mark_Num is
|
||||||
|
begin
|
||||||
|
return Union_Id (Key.File) mod Max_Mask_Num;
|
||||||
|
end Hash;
|
||||||
|
|
||||||
|
---------------
|
||||||
|
-- Is_Marked --
|
||||||
|
---------------
|
||||||
|
|
||||||
|
function Is_Marked
|
||||||
|
(Source_File : File_Name_Type;
|
||||||
|
Index : Int := 0) return Boolean is
|
||||||
|
begin
|
||||||
|
return Marks.Get (K => (File => Source_File, Index => Index));
|
||||||
|
end Is_Marked;
|
||||||
|
|
||||||
|
----------
|
||||||
|
-- Mark --
|
||||||
|
----------
|
||||||
|
|
||||||
|
procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is
|
||||||
|
begin
|
||||||
|
Marks.Set (K => (File => Source_File, Index => Index), E => True);
|
||||||
|
end Mark;
|
||||||
|
|
||||||
|
-------------
|
||||||
|
-- Extract --
|
||||||
|
-------------
|
||||||
|
|
||||||
|
procedure Extract
|
||||||
|
(Found : out Boolean;
|
||||||
|
Source : out Source_Info) is
|
||||||
|
begin
|
||||||
|
Found := False;
|
||||||
|
|
||||||
|
if One_Queue_Per_Obj_Dir then
|
||||||
|
for J in Q_First .. Q.Last loop
|
||||||
|
if not Q.Table (J).Processed
|
||||||
|
and then Available_Obj_Dir (Q.Table (J).Info)
|
||||||
|
then
|
||||||
|
Found := True;
|
||||||
|
Source := Q.Table (J).Info;
|
||||||
|
Q.Table (J).Processed := True;
|
||||||
|
|
||||||
|
if J = Q_First then
|
||||||
|
while Q_First <= Q.Last
|
||||||
|
and then Q.Table (Q_First).Processed
|
||||||
|
loop
|
||||||
|
Q_First := Q_First + 1;
|
||||||
|
end loop;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
exit;
|
||||||
|
end if;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
elsif Q_First <= Q.Last then
|
||||||
|
Source := Q.Table (Q_First).Info;
|
||||||
|
Q.Table (Q_First).Processed := True;
|
||||||
|
Q_First := Q_First + 1;
|
||||||
|
Found := True;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Found then
|
||||||
|
Q_Processed := Q_Processed + 1;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Found and then Debug.Debug_Flag_Q then
|
||||||
|
Write_Str (" Q := Q - [ ");
|
||||||
|
Debug_Display (Source);
|
||||||
|
Write_Str (" ]");
|
||||||
|
Write_Eol;
|
||||||
|
|
||||||
|
Write_Str (" Q_First =");
|
||||||
|
Write_Int (Int (Q_First));
|
||||||
|
Write_Eol;
|
||||||
|
|
||||||
|
Write_Str (" Q.Last =");
|
||||||
|
Write_Int (Int (Q.Last));
|
||||||
|
Write_Eol;
|
||||||
|
end if;
|
||||||
|
end Extract;
|
||||||
|
|
||||||
|
---------------
|
||||||
|
-- Processed --
|
||||||
|
---------------
|
||||||
|
|
||||||
|
function Processed return Natural is
|
||||||
|
begin
|
||||||
|
return Q_Processed;
|
||||||
|
end Processed;
|
||||||
|
|
||||||
|
----------------
|
||||||
|
-- Initialize --
|
||||||
|
----------------
|
||||||
|
|
||||||
|
procedure Initialize
|
||||||
|
(Queue_Per_Obj_Dir : Boolean;
|
||||||
|
Force : Boolean := False) is
|
||||||
|
begin
|
||||||
|
if Force or else not Q_Initialized then
|
||||||
|
Q_Initialized := True;
|
||||||
|
|
||||||
|
for J in 1 .. Q.Last loop
|
||||||
|
case Q.Table (J).Info.Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
Q.Table (J).Info.Id.In_The_Queue := False;
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
null;
|
||||||
|
end case;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
Q.Init;
|
||||||
|
Q_Processed := 0;
|
||||||
|
Q_First := 1;
|
||||||
|
One_Queue_Per_Obj_Dir := Queue_Per_Obj_Dir;
|
||||||
|
end if;
|
||||||
|
end Initialize;
|
||||||
|
|
||||||
|
------------
|
||||||
|
-- Insert --
|
||||||
|
------------
|
||||||
|
|
||||||
|
function Insert (Source : Source_Info) return Boolean is
|
||||||
|
begin
|
||||||
|
-- Only insert in the Q if it is not already done, to avoid
|
||||||
|
-- simultaneous compilations if -jnnn is used.
|
||||||
|
|
||||||
|
if Was_Processed (Source) then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Current_Verbosity = High then
|
||||||
|
Write_Str ("Adding """);
|
||||||
|
Debug_Display (Source);
|
||||||
|
Write_Line (" to the queue");
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Q.Append (New_Val => (Info => Source, Processed => False));
|
||||||
|
|
||||||
|
if Debug.Debug_Flag_Q then
|
||||||
|
Write_Str (" Q := Q + [ ");
|
||||||
|
Debug_Display (Source);
|
||||||
|
Write_Str (" ] ");
|
||||||
|
Write_Eol;
|
||||||
|
|
||||||
|
Write_Str (" Q_First =");
|
||||||
|
Write_Int (Int (Q_First));
|
||||||
|
Write_Eol;
|
||||||
|
|
||||||
|
Write_Str (" Q.Last =");
|
||||||
|
Write_Int (Int (Q.Last));
|
||||||
|
Write_Eol;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
return True;
|
||||||
|
end Insert;
|
||||||
|
|
||||||
|
------------
|
||||||
|
-- Insert --
|
||||||
|
------------
|
||||||
|
|
||||||
|
procedure Insert (Source : Source_Info) is
|
||||||
|
Tmp : Boolean;
|
||||||
|
pragma Unreferenced (Tmp);
|
||||||
|
begin
|
||||||
|
Tmp := Insert (Source);
|
||||||
|
end Insert;
|
||||||
|
|
||||||
|
--------------
|
||||||
|
-- Is_Empty --
|
||||||
|
--------------
|
||||||
|
|
||||||
|
function Is_Empty return Boolean is
|
||||||
|
begin
|
||||||
|
return Q_Processed >= Q.Last;
|
||||||
|
end Is_Empty;
|
||||||
|
|
||||||
|
------------------------
|
||||||
|
-- Is_Virtually_Empty --
|
||||||
|
------------------------
|
||||||
|
|
||||||
|
function Is_Virtually_Empty return Boolean is
|
||||||
|
begin
|
||||||
|
if One_Queue_Per_Obj_Dir then
|
||||||
|
for J in Q_First .. Q.Last loop
|
||||||
|
if not Q.Table (J).Processed
|
||||||
|
and then Available_Obj_Dir (Q.Table (J).Info)
|
||||||
|
then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
return True;
|
||||||
|
|
||||||
|
else
|
||||||
|
return Is_Empty;
|
||||||
|
end if;
|
||||||
|
end Is_Virtually_Empty;
|
||||||
|
|
||||||
|
----------------------
|
||||||
|
-- Set_Obj_Dir_Busy --
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type) is
|
||||||
|
begin
|
||||||
|
if One_Queue_Per_Obj_Dir then
|
||||||
|
Busy_Obj_Dirs.Set (Obj_Dir, True);
|
||||||
|
end if;
|
||||||
|
end Set_Obj_Dir_Busy;
|
||||||
|
|
||||||
|
----------------------
|
||||||
|
-- Set_Obj_Dir_Free --
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type) is
|
||||||
|
begin
|
||||||
|
if One_Queue_Per_Obj_Dir then
|
||||||
|
Busy_Obj_Dirs.Set (Obj_Dir, False);
|
||||||
|
end if;
|
||||||
|
end Set_Obj_Dir_Free;
|
||||||
|
|
||||||
|
----------
|
||||||
|
-- Size --
|
||||||
|
----------
|
||||||
|
|
||||||
|
function Size return Natural is
|
||||||
|
begin
|
||||||
|
return Q.Last;
|
||||||
|
end Size;
|
||||||
|
|
||||||
|
-------------
|
||||||
|
-- Element --
|
||||||
|
-------------
|
||||||
|
|
||||||
|
function Element (Rank : Positive) return File_Name_Type is
|
||||||
|
begin
|
||||||
|
if Rank <= Q.Last then
|
||||||
|
case Q.Table (Rank).Info.Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
return Q.Table (Rank).Info.Id.File;
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
return Q.Table (Rank).Info.File;
|
||||||
|
end case;
|
||||||
|
else
|
||||||
|
return No_File;
|
||||||
|
end if;
|
||||||
|
end Element;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- Remove_Marks --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
procedure Remove_Marks is
|
||||||
|
begin
|
||||||
|
Marks.Reset;
|
||||||
|
end Remove_Marks;
|
||||||
|
|
||||||
|
end Queue;
|
||||||
|
|
||||||
end Makeutl;
|
end Makeutl;
|
||||||
|
|
|
@ -250,21 +250,86 @@ package Makeutl is
|
||||||
|
|
||||||
end Mains;
|
end Mains;
|
||||||
|
|
||||||
----------------------
|
-----------
|
||||||
-- Marking Routines --
|
-- Queue --
|
||||||
----------------------
|
-----------
|
||||||
|
|
||||||
procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
|
type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
|
||||||
-- Mark a unit, identified by its source file and, when Index is not 0, the
|
|
||||||
-- index of the unit in the source file. Marking is used to signal that the
|
|
||||||
-- unit has already been inserted in the Q.
|
|
||||||
|
|
||||||
function Is_Marked
|
package Queue is
|
||||||
(Source_File : File_Name_Type;
|
-- The queue of sources to be checked for compilation.
|
||||||
Index : Int := 0) return Boolean;
|
-- There can be a single such queue per application.
|
||||||
-- Returns True if the unit was previously marked
|
|
||||||
|
|
||||||
procedure Delete_All_Marks;
|
type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
|
||||||
-- Remove all file/index couples marked
|
record
|
||||||
|
case Format is
|
||||||
|
when Format_Gprbuild =>
|
||||||
|
Id : Source_Id := null;
|
||||||
|
|
||||||
|
when Format_Gnatmake =>
|
||||||
|
File : File_Name_Type := No_File;
|
||||||
|
Unit : Unit_Name_Type := No_Unit_Name;
|
||||||
|
Index : Int := 0;
|
||||||
|
Project : Project_Id := No_Project;
|
||||||
|
end case;
|
||||||
|
end record;
|
||||||
|
-- Information about files stored in the queue. The exact information
|
||||||
|
-- depends on the builder, and in particular whether it only supports
|
||||||
|
-- project-based files (in which case we have a full Source_Id record).
|
||||||
|
|
||||||
|
procedure Initialize
|
||||||
|
(Queue_Per_Obj_Dir : Boolean;
|
||||||
|
Force : Boolean := False);
|
||||||
|
-- Initialize the queue.
|
||||||
|
-- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
|
||||||
|
-- when True, there cannot be simultaneous compilations with the object
|
||||||
|
-- files in the same object directory when project files are used.
|
||||||
|
--
|
||||||
|
-- Nothing is done if Force is False and the queue was already
|
||||||
|
-- initialized.
|
||||||
|
|
||||||
|
procedure Remove_Marks;
|
||||||
|
-- Remove all marks set for the files.
|
||||||
|
-- This means that the files will be handed to the compiler if they are
|
||||||
|
-- added to the queue, and is mostly useful when recompiling several
|
||||||
|
-- executables in non-project mode, as the switches may be different
|
||||||
|
-- and -s may be in use.
|
||||||
|
|
||||||
|
function Is_Empty return Boolean;
|
||||||
|
-- Returns True if the queue is empty
|
||||||
|
|
||||||
|
function Is_Virtually_Empty return Boolean;
|
||||||
|
-- Returns True if the queue is empty or if all object directories are
|
||||||
|
-- busy.
|
||||||
|
|
||||||
|
procedure Insert (Source : Source_Info);
|
||||||
|
function Insert (Source : Source_Info) return Boolean;
|
||||||
|
-- Insert source in the queue.
|
||||||
|
-- The second version returns False if the Source was already marked in
|
||||||
|
-- the queue.
|
||||||
|
|
||||||
|
procedure Extract
|
||||||
|
(Found : out Boolean;
|
||||||
|
Source : out Source_Info);
|
||||||
|
-- Get the first source that can be compiled from the queue. If no
|
||||||
|
-- source may be compiled, sets Found to False. In this case, the value
|
||||||
|
-- for Source is undefined.
|
||||||
|
|
||||||
|
function Size return Natural;
|
||||||
|
-- Return the total size of the queue, including the sources already
|
||||||
|
-- extracted.
|
||||||
|
|
||||||
|
function Processed return Natural;
|
||||||
|
-- Return the number of source in the queue that have aready been
|
||||||
|
-- processed.
|
||||||
|
|
||||||
|
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
|
||||||
|
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
|
||||||
|
-- Mark Obj_Dir as busy or free (see the parameter to Initialize)
|
||||||
|
|
||||||
|
function Element (Rank : Positive) return File_Name_Type;
|
||||||
|
-- Get the file name for element of index Rank in the queue
|
||||||
|
|
||||||
|
end Queue;
|
||||||
|
|
||||||
end Makeutl;
|
end Makeutl;
|
||||||
|
|
|
@ -4639,6 +4639,7 @@ package body Sem_Ch3 is
|
||||||
Nb_Index : Nat;
|
Nb_Index : Nat;
|
||||||
P : constant Node_Id := Parent (Def);
|
P : constant Node_Id := Parent (Def);
|
||||||
Priv : Entity_Id;
|
Priv : Entity_Id;
|
||||||
|
T_In_ALFA : Boolean := True;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (Def) = N_Constrained_Array_Definition then
|
if Nkind (Def) = N_Constrained_Array_Definition then
|
||||||
|
@ -4665,6 +4666,12 @@ package body Sem_Ch3 is
|
||||||
Check_SPARK_Restriction ("subtype mark required", Index);
|
Check_SPARK_Restriction ("subtype mark required", Index);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
if Present (Etype (Index))
|
||||||
|
and then not Is_In_ALFA (Etype (Index))
|
||||||
|
then
|
||||||
|
T_In_ALFA := False;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Add a subtype declaration for each index of private array type
|
-- Add a subtype declaration for each index of private array type
|
||||||
-- declaration whose etype is also private. For example:
|
-- declaration whose etype is also private. For example:
|
||||||
|
|
||||||
|
@ -4740,10 +4747,18 @@ package body Sem_Ch3 is
|
||||||
Check_SPARK_Restriction ("subtype mark required", Component_Typ);
|
Check_SPARK_Restriction ("subtype mark required", Component_Typ);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
if Present (Element_Type)
|
||||||
|
and then not Is_In_ALFA (Element_Type)
|
||||||
|
then
|
||||||
|
T_In_ALFA := False;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Ada 2005 (AI-230): Access Definition case
|
-- Ada 2005 (AI-230): Access Definition case
|
||||||
|
|
||||||
else pragma Assert (Present (Access_Definition (Component_Def)));
|
else pragma Assert (Present (Access_Definition (Component_Def)));
|
||||||
|
|
||||||
|
T_In_ALFA := False;
|
||||||
|
|
||||||
-- Indicate that the anonymous access type is created by the
|
-- Indicate that the anonymous access type is created by the
|
||||||
-- array type declaration.
|
-- array type declaration.
|
||||||
|
|
||||||
|
@ -4820,6 +4835,12 @@ package body Sem_Ch3 is
|
||||||
(Implicit_Base, Finalize_Storage_Only
|
(Implicit_Base, Finalize_Storage_Only
|
||||||
(Element_Type));
|
(Element_Type));
|
||||||
|
|
||||||
|
-- Final check for static bounds on array
|
||||||
|
|
||||||
|
if not Has_Static_Array_Bounds (T) then
|
||||||
|
T_In_ALFA := False;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Unconstrained array case
|
-- Unconstrained array case
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -4844,6 +4865,7 @@ package body Sem_Ch3 is
|
||||||
|
|
||||||
Set_Component_Type (Base_Type (T), Element_Type);
|
Set_Component_Type (Base_Type (T), Element_Type);
|
||||||
Set_Packed_Array_Type (T, Empty);
|
Set_Packed_Array_Type (T, Empty);
|
||||||
|
Set_Is_In_ALFA (T, T_In_ALFA);
|
||||||
|
|
||||||
if Aliased_Present (Component_Definition (Def)) then
|
if Aliased_Present (Component_Definition (Def)) then
|
||||||
Check_SPARK_Restriction
|
Check_SPARK_Restriction
|
||||||
|
|
|
@ -5550,6 +5550,69 @@ package body Sem_Util is
|
||||||
end if;
|
end if;
|
||||||
end Has_Private_Component;
|
end Has_Private_Component;
|
||||||
|
|
||||||
|
-----------------------------
|
||||||
|
-- Has_Static_Array_Bounds --
|
||||||
|
-----------------------------
|
||||||
|
|
||||||
|
function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean is
|
||||||
|
Ndims : constant Nat := Number_Dimensions (Typ);
|
||||||
|
|
||||||
|
Index : Node_Id;
|
||||||
|
Low : Node_Id;
|
||||||
|
High : Node_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Unconstrained types do not have static bounds
|
||||||
|
|
||||||
|
if not Is_Constrained (Typ) then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- First treat specially string literals, as the lower bound and length
|
||||||
|
-- of string literals are not stored like those of arrays.
|
||||||
|
|
||||||
|
-- A string literal always has static bounds
|
||||||
|
|
||||||
|
if Ekind (Typ) = E_String_Literal_Subtype then
|
||||||
|
return True;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Treat all dimensions in turn
|
||||||
|
|
||||||
|
Index := First_Index (Typ);
|
||||||
|
for Indx in 1 .. Ndims loop
|
||||||
|
|
||||||
|
-- In case of an erroneous index which is not a discrete type, return
|
||||||
|
-- that the type is not static.
|
||||||
|
|
||||||
|
if not Is_Discrete_Type (Etype (Index))
|
||||||
|
or else Etype (Index) = Any_Type
|
||||||
|
then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Get_Index_Bounds (Index, Low, High);
|
||||||
|
|
||||||
|
if Error_Posted (Low) or else Error_Posted (High) then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Is_OK_Static_Expression (Low)
|
||||||
|
and then Is_OK_Static_Expression (High)
|
||||||
|
then
|
||||||
|
null;
|
||||||
|
else
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Next (Index);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
-- If we fall through the loop, all indexes matched
|
||||||
|
|
||||||
|
return True;
|
||||||
|
end Has_Static_Array_Bounds;
|
||||||
|
|
||||||
----------------
|
----------------
|
||||||
-- Has_Stream --
|
-- Has_Stream --
|
||||||
----------------
|
----------------
|
||||||
|
|
|
@ -624,6 +624,9 @@ package Sem_Util is
|
||||||
-- Check if a type has a (sub)component of a private type that has not
|
-- Check if a type has a (sub)component of a private type that has not
|
||||||
-- yet received a full declaration.
|
-- yet received a full declaration.
|
||||||
|
|
||||||
|
function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
|
||||||
|
-- Return whether an array type has static bounds
|
||||||
|
|
||||||
function Has_Stream (T : Entity_Id) return Boolean;
|
function Has_Stream (T : Entity_Id) return Boolean;
|
||||||
-- Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
|
-- Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
|
||||||
-- case of a composite type, has a component for which this predicate is
|
-- case of a composite type, has a component for which this predicate is
|
||||||
|
|
Loading…
Reference in New Issue