mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2025-01-02 08:53:44 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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:
Arnaud Charlet 2014-11-20 12:45:28 +01:00
parent 8b64ed4caa
commit 35e7063a98
5 changed files with 60 additions and 639 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -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.

4
gcc/ada/freeze.adb
View File

@ -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,

662
gcc/ada/gnatcmd.adb
View File

@ -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;

6
gcc/ada/sem_ch13.adb
View File

@ -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.

11
gcc/ada/sem_ch6.adb
View File

@ -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));