aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-11-20 12:45:28 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2014-11-20 12:45:28 +0100
commit35e7063a98e07a17c273f820250ef024b2deae9a (patch)
treed9922669737d1d3b3d47b510d9cb9120e211056b /gcc/ada
parent8b64ed4caa9831dd98e2f8de09624a0cf1f878f7 (diff)
downloadgcc-35e7063a98e07a17c273f820250ef024b2deae9a.zip
gcc-35e7063a98e07a17c273f820250ef024b2deae9a.tar.gz
gcc-35e7063a98e07a17c273f820250ef024b2deae9a.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/freeze.adb4
-rw-r--r--gcc/ada/gnatcmd.adb662
-rw-r--r--gcc/ada/sem_ch13.adb6
-rw-r--r--gcc/ada/sem_ch6.adb11
5 files changed, 60 insertions, 639 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8d46900..c01298c7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
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.
* exp_dist.adb, exp_dist.ads: Rework PolyORB/DSA arguments processing
circuitry to correctly handle the case of non-private limited
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 332c1dd..8c8f019 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -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,
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index c7a1330..3306aa6 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -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 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;
+ -- 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.
- 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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 2f22e0a..d8f71c5 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 23f4bc5..5a5265c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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));