From 423b89fd97ff0fb92acf81f600c439492c98848f Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 20 Nov 2014 11:45:28 +0000 Subject: [PATCH] 2014-11-20 Thomas Quinot * freeze.adb, sem_ch13.adb: Minor editing. 2014-11-20 Vincent Celier * 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 * sem_ch6.adb (Analyze_Expression_Function): Reject declaration of expression function with identical profile as previous expression function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@217846 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 16 ++ gcc/ada/freeze.adb | 4 +- gcc/ada/gnatcmd.adb | 662 +++------------------------------------------------ gcc/ada/sem_ch13.adb | 6 +- gcc/ada/sem_ch6.adb | 11 + 5 files changed, 60 insertions(+), 639 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d469009944..c01298c750e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2014-11-20 Thomas Quinot + * freeze.adb, sem_ch13.adb: Minor editing. + +2014-11-20 Vincent Celier + + * 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 + + * sem_ch6.adb (Analyze_Expression_Function): Reject declaration + of expression function with identical profile as previous + expression function. + +2014-11-20 Thomas Quinot + * 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 332c1ddc86f..8c8f019acfb 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 c7a1330a151..3306aa64464 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
-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 2f22e0a4b80..d8f71c53d59 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 23f4bc5e47b..5a5265c2778 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)); -- 2.11.4.GIT