[multiple changes]
2014-11-20 Thomas Quinot <quinot@adacore.com> * freeze.adb, sem_ch13.adb: Minor editing. 2014-11-20 Vincent Celier <celier@adacore.com> * gnatcmd.adb: Remove any special processing for the ASIS tools (gnatpp, gnatmetric, gnatcheck, gnatelim and gnatstup) and simply invoke the tool with the provided switches and arguments. 2014-11-20 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Analyze_Expression_Function): Reject declaration of expression function with identical profile as previous expression function. From-SVN: r217846
This commit is contained in:
parent
8b64ed4caa
commit
35e7063a98
|
@ -1,3 +1,19 @@
|
|||
2014-11-20 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* freeze.adb, sem_ch13.adb: Minor editing.
|
||||
|
||||
2014-11-20 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb: Remove any special processing for the ASIS tools
|
||||
(gnatpp, gnatmetric, gnatcheck, gnatelim and gnatstup) and simply
|
||||
invoke the tool with the provided switches and arguments.
|
||||
|
||||
2014-11-20 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Analyze_Expression_Function): Reject declaration
|
||||
of expression function with identical profile as previous
|
||||
expression function.
|
||||
|
||||
2014-11-20 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* sem_ch13.adb: Complete previous change.
|
||||
|
|
|
@ -7705,8 +7705,8 @@ package body Freeze is
|
|||
and then not (Is_Tagged_Type (T)
|
||||
and then Is_Derived_Type (T))))
|
||||
then
|
||||
if ((Bytes_Big_Endian and then SSO_Set_Low_By_Default (T))
|
||||
or else
|
||||
if ((Bytes_Big_Endian and then SSO_Set_Low_By_Default (T))
|
||||
or else
|
||||
((not Bytes_Big_Endian) and then SSO_Set_High_By_Default (T)))
|
||||
|
||||
-- For a record type, if native bit order is specified explicitly,
|
||||
|
|
|
@ -123,9 +123,6 @@ procedure GNATCmd is
|
|||
-- The name of the temporary text file to put a list of source/object
|
||||
-- files to pass to a tool.
|
||||
|
||||
ASIS_Main : String_Access := null;
|
||||
-- Main for commands Check, Metric and Pretty, when -U is used
|
||||
|
||||
package First_Switches is new Table.Table
|
||||
(Table_Component_Type => String_Access,
|
||||
Table_Index_Type => Integer,
|
||||
|
@ -177,33 +174,20 @@ procedure GNATCmd is
|
|||
|
||||
Naming_String : constant SA := new String'("naming");
|
||||
Binder_String : constant SA := new String'("binder");
|
||||
Builder_String : constant SA := new String'("builder");
|
||||
Compiler_String : constant SA := new String'("compiler");
|
||||
Check_String : constant SA := new String'("check");
|
||||
Synchronize_String : constant SA := new String'("synchronize");
|
||||
Eliminate_String : constant SA := new String'("eliminate");
|
||||
Finder_String : constant SA := new String'("finder");
|
||||
Linker_String : constant SA := new String'("linker");
|
||||
Gnatls_String : constant SA := new String'("gnatls");
|
||||
Pretty_String : constant SA := new String'("pretty_printer");
|
||||
Stack_String : constant SA := new String'("stack");
|
||||
Gnatstub_String : constant SA := new String'("gnatstub");
|
||||
Metric_String : constant SA := new String'("metrics");
|
||||
Xref_String : constant SA := new String'("cross_reference");
|
||||
|
||||
Packages_To_Check_By_Binder : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Binder_String));
|
||||
|
||||
Packages_To_Check_By_Check : constant String_List_Access :=
|
||||
new String_List'
|
||||
((Naming_String, Builder_String, Check_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Sync : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Synchronize_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Eliminate : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Eliminate_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Finder : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Finder_String));
|
||||
|
||||
|
@ -213,18 +197,9 @@ procedure GNATCmd is
|
|||
Packages_To_Check_By_Gnatls : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Gnatls_String));
|
||||
|
||||
Packages_To_Check_By_Pretty : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Pretty_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Stack : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Stack_String));
|
||||
|
||||
Packages_To_Check_By_Gnatstub : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Gnatstub_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Metric : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Metric_String, Compiler_String));
|
||||
|
||||
Packages_To_Check_By_Xref : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Xref_String));
|
||||
|
||||
|
@ -374,10 +349,6 @@ procedure GNATCmd is
|
|||
-- Add a switch to the Carg_Switches table. If it is the first one, put the
|
||||
-- switch "-cargs" at the beginning of the table.
|
||||
|
||||
procedure Add_To_Rules_Switches (Switch : String_Access);
|
||||
-- Add a switch to the Rules_Switches table. If it is the first one, put
|
||||
-- the switch "-crules" at the beginning of the table.
|
||||
|
||||
procedure Check_Files;
|
||||
-- For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
|
||||
-- project file is specified, without any file arguments and without a
|
||||
|
@ -414,10 +385,6 @@ procedure GNATCmd is
|
|||
-- includes directory information, prepend the path with Parent. This
|
||||
-- subprogram is only called when using project files.
|
||||
|
||||
procedure Get_Closure;
|
||||
-- Get the sources in the closure of the ASIS_Main and add them to the
|
||||
-- list of arguments.
|
||||
|
||||
function Mapping_File return Path_Name_Type;
|
||||
-- Create and return the path name of a mapping file. Used for gnatstub
|
||||
-- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
|
||||
|
@ -460,23 +427,6 @@ procedure GNATCmd is
|
|||
Carg_Switches.Table (Carg_Switches.Last) := Switch;
|
||||
end Add_To_Carg_Switches;
|
||||
|
||||
---------------------------
|
||||
-- Add_To_Rules_Switches --
|
||||
---------------------------
|
||||
|
||||
procedure Add_To_Rules_Switches (Switch : String_Access) is
|
||||
begin
|
||||
-- If the Rules_Switches table is empty, put "-rules" at the beginning
|
||||
|
||||
if Rules_Switches.Last = 0 then
|
||||
Rules_Switches.Increment_Last;
|
||||
Rules_Switches.Table (Rules_Switches.Last) := new String'("-rules");
|
||||
end if;
|
||||
|
||||
Rules_Switches.Increment_Last;
|
||||
Rules_Switches.Table (Rules_Switches.Last) := Switch;
|
||||
end Add_To_Rules_Switches;
|
||||
|
||||
-----------------
|
||||
-- Check_Files --
|
||||
-----------------
|
||||
|
@ -538,36 +488,13 @@ procedure GNATCmd is
|
|||
-- there is a -files= switch.
|
||||
|
||||
for Index in 1 .. Last_Switches.Last loop
|
||||
if Last_Switches.Table (Index).all'Length > 7
|
||||
and then Last_Switches.Table (Index) (1 .. 7) = "-files="
|
||||
if Last_Switches.Table (Index) (1) /= '-'
|
||||
or else
|
||||
(Last_Switches.Table (Index).all'Length > 7
|
||||
and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
|
||||
then
|
||||
Add_Sources := False;
|
||||
exit;
|
||||
|
||||
elsif Last_Switches.Table (Index) (1) /= '-' then
|
||||
if Index = 1
|
||||
or else
|
||||
(The_Command = Check
|
||||
and then Last_Switches.Table (Index - 1).all /= "-o")
|
||||
or else
|
||||
(The_Command = Pretty
|
||||
and then Last_Switches.Table (Index - 1).all /= "-o"
|
||||
and then Last_Switches.Table (Index - 1).all /= "-of")
|
||||
or else
|
||||
(The_Command = Metric
|
||||
and then
|
||||
Last_Switches.Table (Index - 1).all /= "-o" and then
|
||||
Last_Switches.Table (Index - 1).all /= "-og" and then
|
||||
Last_Switches.Table (Index - 1).all /= "-ox" and then
|
||||
Last_Switches.Table (Index - 1).all /= "-d")
|
||||
or else
|
||||
(The_Command /= Check and then
|
||||
The_Command /= Pretty and then
|
||||
The_Command /= Metric)
|
||||
then
|
||||
Add_Sources := False;
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
|
@ -580,10 +507,7 @@ procedure GNATCmd is
|
|||
-- put the list of sources in it. For gnatstack create a temporary
|
||||
-- file with the list of .ci files.
|
||||
|
||||
if The_Command = Check or else
|
||||
The_Command = Pretty or else
|
||||
The_Command = Metric or else
|
||||
The_Command = List or else
|
||||
if The_Command = List or else
|
||||
The_Command = Stack
|
||||
then
|
||||
Tempdir.Create_Temp_File (FD, Temp_File_Name);
|
||||
|
@ -805,26 +729,6 @@ procedure GNATCmd is
|
|||
"ci"));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- For gnatcheck, gnatsync, gnatpp and gnatmetric, put all
|
||||
-- sources of the project, or of all projects if -U was
|
||||
-- specified.
|
||||
|
||||
for Kind in Spec_Or_Body loop
|
||||
if Unit.File_Names (Kind) /= null
|
||||
and then Check_Project
|
||||
(Unit.File_Names (Kind).Project, Project)
|
||||
and then not Unit.File_Names (Kind).Locally_Removed
|
||||
then
|
||||
Add_To_Response_File
|
||||
("""" &
|
||||
Get_Name_String
|
||||
(Unit.File_Names (Kind).Path.Display_Name) &
|
||||
"""",
|
||||
Check_File => False);
|
||||
end if;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
|
||||
|
@ -849,24 +753,12 @@ procedure GNATCmd is
|
|||
(Project : Project_Id;
|
||||
Root_Project : Project_Id) return Boolean
|
||||
is
|
||||
Proj : Project_Id;
|
||||
|
||||
begin
|
||||
if Project = No_Project then
|
||||
return False;
|
||||
|
||||
elsif All_Projects or else Project = Root_Project then
|
||||
return True;
|
||||
|
||||
elsif The_Command = Metric then
|
||||
Proj := Root_Project;
|
||||
while Proj.Extends /= No_Project loop
|
||||
if Project = Proj.Extends then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
Proj := Proj.Extends;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return False;
|
||||
|
@ -964,175 +856,6 @@ procedure GNATCmd is
|
|||
Including_RTS => True);
|
||||
end Ensure_Absolute_Path;
|
||||
|
||||
-----------------
|
||||
-- Get_Closure --
|
||||
-----------------
|
||||
|
||||
procedure Get_Closure is
|
||||
Args : constant Argument_List :=
|
||||
(1 => new String'("-q"),
|
||||
2 => new String'("-b"),
|
||||
3 => new String'("-P"),
|
||||
4 => Project_File,
|
||||
5 => ASIS_Main,
|
||||
6 => new String'("-bargs"),
|
||||
7 => new String'("-R"),
|
||||
8 => new String'("-Z"));
|
||||
-- Arguments for the invocation of gnatmake which are added to the
|
||||
-- Last_Arguments list by this procedure.
|
||||
|
||||
FD : File_Descriptor;
|
||||
-- File descriptor for the temp file that will get the output of the
|
||||
-- invocation of gnatmake.
|
||||
|
||||
Name : Path_Name_Type;
|
||||
-- Path of the file FD
|
||||
|
||||
GN_Name : constant String := Program_Name ("gnatmake", "gnat").all;
|
||||
-- Name for gnatmake
|
||||
|
||||
GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name);
|
||||
-- Path of gnatmake
|
||||
|
||||
Return_Code : Integer;
|
||||
|
||||
Unused : Boolean;
|
||||
pragma Warnings (Off, Unused);
|
||||
|
||||
File : Ada.Text_IO.File_Type;
|
||||
Line : String (1 .. 250);
|
||||
Last : Natural;
|
||||
-- Used to read file if there is an error, it is good enough to display
|
||||
-- just 250 characters if the first line of the file is very long.
|
||||
|
||||
Unit : Unit_Index;
|
||||
Path : Path_Name_Type;
|
||||
|
||||
Files_File : Ada.Text_IO.File_Type;
|
||||
Temp_File_Name : Path_Name_Type;
|
||||
|
||||
begin
|
||||
if GN_Path = null then
|
||||
Put_Line (Standard_Error, "could not locate " & GN_Name);
|
||||
raise Error_Exit;
|
||||
end if;
|
||||
|
||||
-- Create the temp file
|
||||
|
||||
Prj.Env.Create_Temp_File (Project_Tree.Shared, FD, Name, "files");
|
||||
|
||||
-- And close it
|
||||
|
||||
Close (FD);
|
||||
|
||||
-- Spawn "gnatmake -q -b -P <project> <main> -bargs -R -Z"
|
||||
|
||||
Spawn
|
||||
(Program_Name => GN_Path.all,
|
||||
Args => Args,
|
||||
Output_File => Get_Name_String (Name),
|
||||
Success => Unused,
|
||||
Return_Code => Return_Code,
|
||||
Err_To_Out => True);
|
||||
|
||||
-- Read the output of the invocation of gnatmake
|
||||
|
||||
Open (File, In_File, Get_Name_String (Name));
|
||||
|
||||
-- If it was unsuccessful, display the first line in the file and exit
|
||||
-- with error.
|
||||
|
||||
if Return_Code /= 0 then
|
||||
Get_Line (File, Line, Last);
|
||||
|
||||
begin
|
||||
if not Keep_Temporary_Files then
|
||||
Delete (File);
|
||||
else
|
||||
Close (File);
|
||||
end if;
|
||||
|
||||
-- Don't crash if it is not possible to delete or close the file,
|
||||
-- just ignore the situation.
|
||||
|
||||
exception
|
||||
when others =>
|
||||
null;
|
||||
end;
|
||||
|
||||
Put_Line (Standard_Error, Line (1 .. Last));
|
||||
Put_Line
|
||||
(Standard_Error, "could not get closure of " & ASIS_Main.all);
|
||||
raise Error_Exit;
|
||||
|
||||
else
|
||||
-- Create a temporary file to put the list of files in the closure
|
||||
|
||||
Tempdir.Create_Temp_File (FD, Temp_File_Name);
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'("-files=" & Get_Name_String (Temp_File_Name));
|
||||
|
||||
Close (FD);
|
||||
|
||||
Open (Files_File, Out_File, Get_Name_String (Temp_File_Name));
|
||||
|
||||
-- Get each file name in the file, find its path and add it the list
|
||||
-- of arguments.
|
||||
|
||||
while not End_Of_File (File) loop
|
||||
Get_Line (File, Line, Last);
|
||||
Path := No_Path;
|
||||
|
||||
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
|
||||
while Unit /= No_Unit_Index loop
|
||||
if Unit.File_Names (Spec) /= null
|
||||
and then
|
||||
Get_Name_String (Unit.File_Names (Spec).File) =
|
||||
Line (1 .. Last)
|
||||
then
|
||||
Path := Unit.File_Names (Spec).Path.Name;
|
||||
exit;
|
||||
|
||||
elsif Unit.File_Names (Impl) /= null
|
||||
and then
|
||||
Get_Name_String (Unit.File_Names (Impl).File) =
|
||||
Line (1 .. Last)
|
||||
then
|
||||
Path := Unit.File_Names (Impl).Path.Name;
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
|
||||
end loop;
|
||||
|
||||
if Path /= No_Path then
|
||||
Put_Line (Files_File, Get_Name_String (Path));
|
||||
|
||||
else
|
||||
Put_Line (Files_File, Line (1 .. Last));
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
Close (Files_File);
|
||||
|
||||
begin
|
||||
if not Keep_Temporary_Files then
|
||||
Delete (File);
|
||||
else
|
||||
Close (File);
|
||||
end if;
|
||||
|
||||
-- Don't crash if it is not possible to delete or close the file,
|
||||
-- just ignore the situation.
|
||||
|
||||
exception
|
||||
when others =>
|
||||
null;
|
||||
end;
|
||||
end if;
|
||||
end Get_Closure;
|
||||
|
||||
------------------
|
||||
-- Mapping_File --
|
||||
------------------
|
||||
|
@ -1216,7 +939,8 @@ procedure GNATCmd is
|
|||
|
||||
New_Line;
|
||||
Put_Line ("All commands except chop, krunch and preprocess " &
|
||||
"accept project file switches -vPx, -Pprj and -Xnam=val");
|
||||
"accept project file switches -vPx, -Pprj, -Xnam=val," &
|
||||
"--subdirs= and -eL");
|
||||
New_Line;
|
||||
end Usage;
|
||||
|
||||
|
@ -1792,12 +1516,6 @@ begin
|
|||
when Bind =>
|
||||
Tool_Package_Name := Name_Binder;
|
||||
Packages_To_Check := Packages_To_Check_By_Binder;
|
||||
when Check =>
|
||||
Tool_Package_Name := Name_Check;
|
||||
Packages_To_Check := Packages_To_Check_By_Check;
|
||||
when Elim =>
|
||||
Tool_Package_Name := Name_Eliminate;
|
||||
Packages_To_Check := Packages_To_Check_By_Eliminate;
|
||||
when Find =>
|
||||
Tool_Package_Name := Name_Finder;
|
||||
Packages_To_Check := Packages_To_Check_By_Finder;
|
||||
|
@ -1807,18 +1525,9 @@ begin
|
|||
when List =>
|
||||
Tool_Package_Name := Name_Gnatls;
|
||||
Packages_To_Check := Packages_To_Check_By_Gnatls;
|
||||
when Metric =>
|
||||
Tool_Package_Name := Name_Metrics;
|
||||
Packages_To_Check := Packages_To_Check_By_Metric;
|
||||
when Pretty =>
|
||||
Tool_Package_Name := Name_Pretty_Printer;
|
||||
Packages_To_Check := Packages_To_Check_By_Pretty;
|
||||
when Stack =>
|
||||
Tool_Package_Name := Name_Stack;
|
||||
Packages_To_Check := Packages_To_Check_By_Stack;
|
||||
when Stub =>
|
||||
Tool_Package_Name := Name_Gnatstub;
|
||||
Packages_To_Check := Packages_To_Check_By_Gnatstub;
|
||||
when Sync =>
|
||||
Tool_Package_Name := Name_Synchronize;
|
||||
Packages_To_Check := Packages_To_Check_By_Sync;
|
||||
|
@ -2013,10 +1722,7 @@ begin
|
|||
Remove_Switch (Arg_Num);
|
||||
|
||||
elsif
|
||||
(The_Command = Check or else
|
||||
The_Command = Sync or else
|
||||
The_Command = Pretty or else
|
||||
The_Command = Metric or else
|
||||
(The_Command = Sync or else
|
||||
The_Command = Stack or else
|
||||
The_Command = List)
|
||||
and then Argv'Length = 2
|
||||
|
@ -2029,20 +1735,6 @@ begin
|
|||
Arg_Num := Arg_Num + 1;
|
||||
end if;
|
||||
|
||||
elsif ((The_Command = Check and then Argv (Argv'First) /= '+')
|
||||
or else The_Command = Sync
|
||||
or else The_Command = Metric
|
||||
or else The_Command = Pretty)
|
||||
and then Project_File /= null
|
||||
and then All_Projects
|
||||
then
|
||||
if ASIS_Main /= null then
|
||||
Fail ("cannot specify more than one main after -U");
|
||||
else
|
||||
ASIS_Main := Argv;
|
||||
Remove_Switch (Arg_Num);
|
||||
end if;
|
||||
|
||||
else
|
||||
Arg_Num := Arg_Num + 1;
|
||||
end if;
|
||||
|
@ -2121,10 +1813,8 @@ begin
|
|||
|
||||
-- Packages Binder (for gnatbind), Cross_Reference (for
|
||||
-- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
|
||||
-- Pretty_Printer (for gnatpp), Eliminate (for gnatelim), Check
|
||||
-- (for gnatcheck), and Metric (for gnatmetric) have an
|
||||
-- attributed Switches, an associative array, indexed by the
|
||||
-- name of the file.
|
||||
-- have an attributed Switches, an associative array, indexed
|
||||
-- by the name of the file.
|
||||
|
||||
-- They also have an attribute Default_Switches, indexed by the
|
||||
-- name of the programming language.
|
||||
|
@ -2229,10 +1919,7 @@ begin
|
|||
end if;
|
||||
end;
|
||||
|
||||
if The_Command = Bind or else
|
||||
The_Command = Link or else
|
||||
The_Command = Elim
|
||||
then
|
||||
if The_Command = Bind or else The_Command = Link then
|
||||
if Project.Object_Directory.Name = No_Path then
|
||||
Fail ("project " & Get_Name_String (Project.Display_Name)
|
||||
& " has no object directory");
|
||||
|
@ -2249,13 +1936,7 @@ begin
|
|||
-- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
|
||||
-- a configuration pragmas file, if necessary.
|
||||
|
||||
if The_Command = Pretty
|
||||
or else The_Command = Metric
|
||||
or else The_Command = Stub
|
||||
or else The_Command = Elim
|
||||
or else The_Command = Check
|
||||
or else The_Command = Sync
|
||||
then
|
||||
if The_Command = Sync then
|
||||
-- If there are switches in package Compiler, put them in the
|
||||
-- Carg_Switches table.
|
||||
|
||||
|
@ -2384,11 +2065,7 @@ begin
|
|||
-- command is CHECK.
|
||||
|
||||
K := J + 1;
|
||||
while K <= First_Switches.Last
|
||||
and then
|
||||
(The_Command /= Check
|
||||
or else First_Switches.Table (K).all /= "-rules")
|
||||
loop
|
||||
while K <= First_Switches.Last loop
|
||||
Add_To_Carg_Switches (First_Switches.Table (K));
|
||||
K := K + 1;
|
||||
end loop;
|
||||
|
@ -2415,40 +2092,11 @@ begin
|
|||
|
||||
for J in 1 .. Last_Switches.Last loop
|
||||
if Last_Switches.Table (J).all = "-cargs" then
|
||||
declare
|
||||
K : Positive;
|
||||
Last : Natural;
|
||||
|
||||
begin
|
||||
-- Move the switches that are before -rules when the
|
||||
-- command is CHECK.
|
||||
|
||||
K := J + 1;
|
||||
while K <= Last_Switches.Last
|
||||
and then
|
||||
(The_Command /= Check
|
||||
or else Last_Switches.Table (K).all /= "-rules")
|
||||
loop
|
||||
Add_To_Carg_Switches (Last_Switches.Table (K));
|
||||
K := K + 1;
|
||||
end loop;
|
||||
|
||||
if K > Last_Switches.Last then
|
||||
Last_Switches.Set_Last (J - 1);
|
||||
|
||||
else
|
||||
Last := J - 1;
|
||||
while K <= Last_Switches.Last loop
|
||||
Last := Last + 1;
|
||||
Last_Switches.Table (Last) :=
|
||||
Last_Switches.Table (K);
|
||||
K := K + 1;
|
||||
end loop;
|
||||
|
||||
Last_Switches.Set_Last (Last);
|
||||
end if;
|
||||
end;
|
||||
for K in J + 1 .. Last_Switches.Last loop
|
||||
Add_To_Carg_Switches (Last_Switches.Table (K));
|
||||
end loop;
|
||||
|
||||
Last_Switches.Set_Last (J - 1);
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
@ -2459,122 +2107,14 @@ begin
|
|||
|
||||
begin
|
||||
if CP_File /= No_Path then
|
||||
if The_Command = Elim then
|
||||
First_Switches.Increment_Last;
|
||||
First_Switches.Table (First_Switches.Last) :=
|
||||
new String'("-C" & Get_Name_String (CP_File));
|
||||
|
||||
else
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatec=" & Get_Name_String (CP_File)));
|
||||
end if;
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatec=" & Get_Name_String (CP_File)));
|
||||
end if;
|
||||
|
||||
if M_File /= No_Path then
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatem=" & Get_Name_String (M_File)));
|
||||
end if;
|
||||
|
||||
-- For gnatcheck, gnatpp, gnatstub and gnatmetric, also
|
||||
-- indicate a global configuration pragmas file and, if -U
|
||||
-- is not used, a local one.
|
||||
|
||||
if The_Command = Check or else
|
||||
The_Command = Pretty or else
|
||||
The_Command = Stub or else
|
||||
The_Command = Metric
|
||||
then
|
||||
declare
|
||||
Pkg : constant Prj.Package_Id :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Builder,
|
||||
In_Packages => Project.Decl.Packages,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
Variable : Variable_Value :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => No_Name,
|
||||
Attribute_Or_Array_Name =>
|
||||
Name_Global_Configuration_Pragmas,
|
||||
In_Package => Pkg,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
begin
|
||||
if (Variable = Nil_Variable_Value
|
||||
or else Length_Of_Name (Variable.Value) = 0)
|
||||
and then Pkg /= No_Package
|
||||
then
|
||||
Variable :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Ada,
|
||||
Attribute_Or_Array_Name =>
|
||||
Name_Global_Config_File,
|
||||
In_Package => Pkg,
|
||||
Shared => Project_Tree.Shared);
|
||||
end if;
|
||||
|
||||
if Variable /= Nil_Variable_Value
|
||||
and then Length_Of_Name (Variable.Value) /= 0
|
||||
then
|
||||
declare
|
||||
Path : constant String :=
|
||||
Absolute_Path
|
||||
(Path_Name_Type (Variable.Value),
|
||||
Variable.Project);
|
||||
begin
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatec=" & Path));
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
|
||||
if not All_Projects then
|
||||
declare
|
||||
Pkg : constant Prj.Package_Id :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Compiler,
|
||||
In_Packages => Project.Decl.Packages,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
Variable : Variable_Value :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => No_Name,
|
||||
Attribute_Or_Array_Name =>
|
||||
Name_Local_Configuration_Pragmas,
|
||||
In_Package => Pkg,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
begin
|
||||
if (Variable = Nil_Variable_Value
|
||||
or else Length_Of_Name (Variable.Value) = 0)
|
||||
and then Pkg /= No_Package
|
||||
then
|
||||
Variable :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Ada,
|
||||
Attribute_Or_Array_Name =>
|
||||
Name_Local_Config_File,
|
||||
In_Package => Pkg,
|
||||
Shared =>
|
||||
Project_Tree.Shared);
|
||||
end if;
|
||||
|
||||
if Variable /= Nil_Variable_Value
|
||||
and then Length_Of_Name (Variable.Value) /= 0
|
||||
then
|
||||
declare
|
||||
Path : constant String :=
|
||||
Absolute_Path
|
||||
(Path_Name_Type (Variable.Value),
|
||||
Variable.Project);
|
||||
begin
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatec=" & Path));
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
@ -2606,166 +2146,18 @@ begin
|
|||
(First_Switches.Table (J), Project_Dir);
|
||||
end loop;
|
||||
end;
|
||||
|
||||
elsif The_Command = Stub then
|
||||
declare
|
||||
File_Index : Integer := 0;
|
||||
Dir_Index : Integer := 0;
|
||||
Last : constant Integer := Last_Switches.Last;
|
||||
Lang : constant Language_Ptr :=
|
||||
Get_Language_From_Name (Project, "ada");
|
||||
|
||||
begin
|
||||
for Index in 1 .. Last loop
|
||||
if Last_Switches.Table (Index)
|
||||
(Last_Switches.Table (Index)'First) /= '-'
|
||||
then
|
||||
File_Index := Index;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- If the project file naming scheme is not standard, and if
|
||||
-- the file name ends with the spec suffix, then indicate to
|
||||
-- gnatstub the name of the body file with a -o switch.
|
||||
|
||||
if Lang /= No_Language_Index
|
||||
and then not Is_Standard_GNAT_Naming (Lang.Config.Naming_Data)
|
||||
then
|
||||
if File_Index /= 0 then
|
||||
declare
|
||||
Spec : constant String :=
|
||||
Base_Name
|
||||
(Last_Switches.Table (File_Index).all);
|
||||
Last : Natural := Spec'Last;
|
||||
|
||||
begin
|
||||
Get_Name_String (Lang.Config.Naming_Data.Spec_Suffix);
|
||||
|
||||
if Spec'Length > Name_Len
|
||||
and then Spec (Last - Name_Len + 1 .. Last) =
|
||||
Name_Buffer (1 .. Name_Len)
|
||||
then
|
||||
Last := Last - Name_Len;
|
||||
Get_Name_String
|
||||
(Lang.Config.Naming_Data.Body_Suffix);
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'("-o");
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'(Spec (Spec'First .. Last) &
|
||||
Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Add the directory of the spec as the destination directory
|
||||
-- of the body, if there is no destination directory already
|
||||
-- specified.
|
||||
|
||||
if File_Index /= 0 then
|
||||
for Index in File_Index + 1 .. Last loop
|
||||
if Last_Switches.Table (Index)
|
||||
(Last_Switches.Table (Index)'First) /= '-'
|
||||
then
|
||||
Dir_Index := Index;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if Dir_Index = 0 then
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'
|
||||
(Dir_Name (Last_Switches.Table (File_Index).all));
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- For gnatmetric, the generated files should be put in the object
|
||||
-- directory. This must be the first switch, because it may be
|
||||
-- overridden by a switch in package Metrics in the project file or
|
||||
-- by a command line option. Note that we don't add the -d= switch
|
||||
-- if there is no object directory available.
|
||||
-- For gnat sync with -U + a main, get the list of sources from the
|
||||
-- closure and add them to the arguments.
|
||||
|
||||
if The_Command = Metric
|
||||
and then Project.Object_Directory /= No_Path_Information
|
||||
then
|
||||
First_Switches.Increment_Last;
|
||||
First_Switches.Table (2 .. First_Switches.Last) :=
|
||||
First_Switches.Table (1 .. First_Switches.Last - 1);
|
||||
First_Switches.Table (1) :=
|
||||
new String'("-d=" &
|
||||
Get_Name_String (Project.Object_Directory.Name));
|
||||
end if;
|
||||
-- For gnat sync, gnat list, and gnat stack, if no file has been put
|
||||
-- on the command line, call tool with all the sources of the main
|
||||
-- project.
|
||||
|
||||
-- For gnat check, -rules and the following switches need to be the
|
||||
-- last options, so move all these switches to table Rules_Switches.
|
||||
|
||||
if The_Command = Check then
|
||||
declare
|
||||
New_Last : Natural;
|
||||
-- Set to rank of options preceding "-rules"
|
||||
|
||||
In_Rules_Switches : Boolean;
|
||||
-- Set to True when options "-rules" is found
|
||||
|
||||
begin
|
||||
New_Last := First_Switches.Last;
|
||||
In_Rules_Switches := False;
|
||||
|
||||
for J in 1 .. First_Switches.Last loop
|
||||
if In_Rules_Switches then
|
||||
Add_To_Rules_Switches (First_Switches.Table (J));
|
||||
|
||||
elsif First_Switches.Table (J).all = "-rules" then
|
||||
New_Last := J - 1;
|
||||
In_Rules_Switches := True;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if In_Rules_Switches then
|
||||
First_Switches.Set_Last (New_Last);
|
||||
end if;
|
||||
|
||||
New_Last := Last_Switches.Last;
|
||||
In_Rules_Switches := False;
|
||||
|
||||
for J in 1 .. Last_Switches.Last loop
|
||||
if In_Rules_Switches then
|
||||
Add_To_Rules_Switches (Last_Switches.Table (J));
|
||||
|
||||
elsif Last_Switches.Table (J).all = "-rules" then
|
||||
New_Last := J - 1;
|
||||
In_Rules_Switches := True;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if In_Rules_Switches then
|
||||
Last_Switches.Set_Last (New_Last);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- For gnat check, sync, metric or pretty with -U + a main, get the
|
||||
-- list of sources from the closure and add them to the arguments.
|
||||
|
||||
if ASIS_Main /= null then
|
||||
Get_Closure;
|
||||
|
||||
-- For gnat check, gnat sync, gnat pretty, gnat metric, gnat list,
|
||||
-- and gnat stack, if no file has been put on the command line, call
|
||||
-- tool with all the sources of the main project.
|
||||
|
||||
elsif The_Command = Check or else
|
||||
The_Command = Sync or else
|
||||
The_Command = Pretty or else
|
||||
The_Command = Metric or else
|
||||
The_Command = List or else
|
||||
The_Command = Stack
|
||||
if The_Command = Sync or else
|
||||
The_Command = List or else
|
||||
The_Command = Stack
|
||||
then
|
||||
Check_Files;
|
||||
end if;
|
||||
|
|
|
@ -3798,7 +3798,8 @@ package body Sem_Ch13 is
|
|||
("variable indexing must return a reference type");
|
||||
return;
|
||||
|
||||
elsif Is_Access_Constant (Etype (First_Discriminant (Ret_Type)))
|
||||
elsif Is_Access_Constant
|
||||
(Etype (First_Discriminant (Ret_Type)))
|
||||
then
|
||||
Illegal_Indexing
|
||||
("variable indexing must return an access to variable");
|
||||
|
@ -10936,7 +10937,8 @@ package body Sem_Ch13 is
|
|||
SSO_Set_High_By_Default (Bas_Typ)))
|
||||
then
|
||||
Set_Reverse_Storage_Order (Bas_Typ,
|
||||
Reverse_Storage_Order (Base_Type (Etype (Bas_Typ))));
|
||||
Reverse_Storage_Order
|
||||
(Implementation_Base_Type (Etype (Bas_Typ))));
|
||||
|
||||
-- Clear default SSO indications, since the inherited aspect
|
||||
-- which was set explicitly overrides the default.
|
||||
|
|
|
@ -326,6 +326,17 @@ package body Sem_Ch6 is
|
|||
then
|
||||
Def_Id := Analyze_Subprogram_Specification (Spec);
|
||||
Prev := Find_Corresponding_Spec (N);
|
||||
|
||||
-- The previous entity may be an expression function as well, in
|
||||
-- which case the redeclaration is illegal.
|
||||
|
||||
if Present (Prev)
|
||||
and then Nkind (Original_Node (Unit_Declaration_Node (Prev)))
|
||||
= N_Expression_Function
|
||||
then
|
||||
Error_Msg_N ("Duplicate expression function", N);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Ret := Make_Simple_Return_Statement (LocX, Expression (N));
|
||||
|
|
Loading…
Reference in New Issue