From: Arnaud Charlet Date: Fri, 31 Oct 2014 11:22:19 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=527f5eb67affc709c78a4f65ba7a1f731d63315e;p=gcc.git [multiple changes] 2014-10-31 Vincent Celier * prj-conf.adb (Look_For_Project_Paths): New procedure (Parse_Project_And_Apply_Config): Initially, parse the project files ignoring missing withs. If there are missing withs, extend the project path with directories rooted at the compiler roots, including directories rooted at the runtime roots, if there are non default runtimes, in the PATH orser. * prj-env.adb (Initialize_Default_Project_Path): Do not add any directory from the prefix if the target is "-". * prj-part.adb (Parse): Initialize the tables, as Parse may be call several times by gprbuild. * prj.adb (Update_Ignore_Missing_With): New procedure. 2014-10-31 Ed Schonberg * sem_aux.adb (First_Stored_Discriminant, Has_Completely_Hidden_Discriminant): When scanning the list of discriminants to locate possibly hidden (inherited) discriminants, ignore itypes that may appear in the entity list, when an access discriminants is constrained by an access attribute reference. 2014-10-31 Javier Miranda * freeze.adb (Freeze_Record_Type): Add missing check to verify that all the primitives of an interface type are abstract or null procedures. 2014-10-31 Vincent Celier * s-os_lib.adb, s-os_lib.ads: New function Non_Blocking_Spawn that redirects standard output and standard error to two different files. 2014-10-31 Bob Duff * makeutl.ads: Minor comment fix. 2014-10-31 Arnaud Charlet * system-linux-x86_64.ads, system-mingw-x86_64.ads (Word_Size, Memory_Size): Use Standard'Word_Size so that the value can be changed via a target configuration file. From-SVN: r216965 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a31639b95a7..9e76cbb5f68 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,46 @@ +2014-10-31 Vincent Celier + + * prj-conf.adb (Look_For_Project_Paths): New procedure + (Parse_Project_And_Apply_Config): Initially, parse the project + files ignoring missing withs. If there are missing withs, extend + the project path with directories rooted at the compiler roots, + including directories rooted at the runtime roots, if there are + non default runtimes, in the PATH orser. + * prj-env.adb (Initialize_Default_Project_Path): Do not add + any directory from the prefix if the target is "-". + * prj-part.adb (Parse): Initialize the tables, as Parse may be + call several times by gprbuild. + * prj.adb (Update_Ignore_Missing_With): New procedure. + +2014-10-31 Ed Schonberg + + * sem_aux.adb (First_Stored_Discriminant, + Has_Completely_Hidden_Discriminant): When scanning the list of + discriminants to locate possibly hidden (inherited) discriminants, + ignore itypes that may appear in the entity list, when an access + discriminants is constrained by an access attribute reference. + +2014-10-31 Javier Miranda + + * freeze.adb (Freeze_Record_Type): Add missing + check to verify that all the primitives of an interface type + are abstract or null procedures. + +2014-10-31 Vincent Celier + + * s-os_lib.adb, s-os_lib.ads: New function Non_Blocking_Spawn that + redirects standard output and standard error to two different files. + +2014-10-31 Bob Duff + + * makeutl.ads: Minor comment fix. + +2014-10-31 Arnaud Charlet + + * system-linux-x86_64.ads, system-mingw-x86_64.ads (Word_Size, + Memory_Size): Use Standard'Word_Size so that the value can be changed + via a target configuration file. + 2014-10-31 Eric Botcazou * exp_ch4.adb: Minor tweak. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index caef71f9197..e20aebb1df2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4004,6 +4004,47 @@ package body Freeze is -- call to the Analyze_Freeze_Entity for the record type. end Check_Variant_Part; + + -- Check that all the primitives of an interface type are abstract + -- or null procedures. + + if Is_Interface (Rec) + and then not Error_Posted (Parent (Rec)) + then + declare + Elmt : Elmt_Id; + Subp : Entity_Id; + + begin + Elmt := First_Elmt (Primitive_Operations (Rec)); + while Present (Elmt) loop + Subp := Node (Elmt); + + if not Is_Abstract_Subprogram (Subp) + + -- Avoid reporting the error on inherited primitives + + and then Comes_From_Source (Subp) + then + Error_Msg_Name_1 := Chars (Subp); + + if Ekind (Subp) = E_Procedure then + if not Null_Present (Parent (Subp)) then + Error_Msg_N + ("interface procedure % must be abstract or null", + Parent (Subp)); + end if; + else + Error_Msg_N + ("interface function % must be abstract", + Parent (Subp)); + end if; + end if; + + Next_Elmt (Elmt); + end loop; + end; + end if; end Freeze_Record_Type; ------------------------------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 04537090318..cf28b1ec1da 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -254,8 +254,8 @@ package Makeutl is -- file. This checks various attributes to see if there are file specific -- switches, or else defaults on the switches for the corresponding -- language. Is_Default is set to False if there were file-specific - -- switches Source_File can be set to No_File to force retrieval of the - -- default switches. If Test_Without_Suffix is True, and there is no " for + -- switches. Source_File can be set to No_File to force retrieval of the + -- default switches. If Test_Without_Suffix is True, and there is no "for -- Switches(Source_File) use", then this procedure also tests without the -- extension of the filename. If Test_Without_Suffix is True and -- Check_ALI_Suffix is True, then we also replace the file extension with diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 1afdb2ce55a..fe6cb60b381 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -53,6 +53,32 @@ package body Prj.Conf is Gprconfig_Name : constant String := "gprconfig"; + Warn_For_RTS : Boolean := True; + -- Set to False when gprbuild parse again the project files, to avoid + -- an incorrect warning. + + type Runtime_Root_Data; + type Runtime_Root_Ptr is access Runtime_Root_Data; + type Runtime_Root_Data is record + Root : String_Access; + Next : Runtime_Root_Ptr; + end record; + -- Data for a runtime root to be used when adding directories to the + -- project path. + + type Compiler_Root_Data; + type Compiler_Root_Ptr is access Compiler_Root_Data; + type Compiler_Root_Data is record + Root : String_Access; + Runtimes : Runtime_Root_Ptr; + Next : Compiler_Root_Ptr; + end record; + -- Data for a compiler root to be used when adding directories to the + -- project path. + + First_Compiler_Root : Compiler_Root_Ptr := null; + -- Head of the list of compiler roots + package RTS_Languages is new GNAT.HTable.Simple_HTable (Header_Num => Prj.Header_Num, Element => Name_Id, @@ -98,6 +124,21 @@ package body Prj.Conf is -- projects, so that when the second phase of the processing is performed -- these attributes are automatically taken into account. + type State is (No_State); + + procedure Look_For_Project_Paths + (Project : Project_Id; + Tree : Project_Tree_Ref; + With_State : in out State); + -- Check the compilers in the Project and add record them in the list + -- rooted at First_Compiler_Root, with their runtimes, if they are not + -- already in the list. + + procedure Update_Project_Path is new + For_Every_Project_Imported + (State => State, + Action => Look_For_Project_Paths); + ------------------------------------ -- Add_Default_GNAT_Naming_Scheme -- ------------------------------------ @@ -1448,7 +1489,8 @@ package body Prj.Conf is -- If the config file is not auto-generated, warn if there is any --RTS -- switch, but not when the config file is generated in memory. - elsif RTS_Languages.Get_First /= No_Name + elsif Warn_For_RTS + and then RTS_Languages.Get_First /= No_Name and then Opt.Warning_Mode /= Opt.Suppress and then On_Load_Config = null then @@ -1558,11 +1600,36 @@ package body Prj.Conf is On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null) is Success : Boolean := False; - Try_Again : Boolean := True; + Target_Try_Again : Boolean := True; + Config_Try_Again : Boolean; + + S : State := No_State; + + Conf_File_Name : String_Access := new String'(Config_File_Name); + + procedure Add_Directory (Dir : String); + -- Add a directory at the end of the Project Path + + ------------------- + -- Add_Directory -- + ------------------- + + procedure Add_Directory (Dir : String) is + begin + if Opt.Verbose_Mode then + Write_Line (" Adding directory """ & Dir & """"); + end if; + + Prj.Env.Add_Directories (Env.Project_Path, Dir); + end Add_Directory; begin pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path)); + -- Start with ignoring missing withed projects + + Update_Ignore_Missing_With (Env.Flags, True); + -- Record Target_Value and Target_Origin. if Target_Name = "" then @@ -1630,10 +1697,10 @@ package body Prj.Conf is and then Get_Name_String (Variable.Value) /= Opt.Target_Value.all then - if Try_Again then + if Target_Try_Again then Opt.Target_Value := new String'(Get_Name_String (Variable.Value)); - Try_Again := False; + Target_Try_Again := False; goto Parse_Again; else @@ -1643,13 +1710,18 @@ package body Prj.Conf is end if; end if; end; - end if; + -- If there are missing withed projects, the projects will be parsed + -- again after the project path is extended with directories rooted + -- at the compiler roots. + + Config_Try_Again := Project_Node_Tree.Incomplete_With; + Process_Project_And_Apply_Config (Main_Project => Main_Project, User_Project_Node => User_Project_Node, - Config_File_Name => Config_File_Name, + Config_File_Name => Conf_File_Name.all, Autoconf_Specified => Autoconf_Specified, Project_Tree => Project_Tree, Project_Node_Tree => Project_Node_Tree, @@ -1663,6 +1735,194 @@ package body Prj.Conf is On_Load_Config => On_Load_Config, On_New_Tree_Loaded => On_New_Tree_Loaded, Do_Phase_1 => Opt.Target_Origin = Specified); + + -- Exit if there was an error. Otherwise, if Config_Try_Again is True, + -- update the project path and try again. + + if Main_Project /= No_Project and then Config_Try_Again then + Update_Ignore_Missing_With (Env.Flags, False); + + if Config_File_Path /= null then + Conf_File_Name := new String'(Simple_Name (Config_File_Path.all)); + end if; + + -- For the second time the project files are parsed, the warning for + -- --RTS= being only taken into account in auto-configuration are + -- suppressed, as we are no longer in auto-configuration. + + Warn_For_RTS := False; + + -- Add the default directories corresponding to the compilers + + Update_Project_Path + (By => Main_Project, + Tree => Project_Tree, + With_State => S, + Include_Aggregated => True, + Imported_First => False); + + declare + Compiler_Root : Compiler_Root_Ptr; + Prefix : String_Access; + Runtime_Root : Runtime_Root_Ptr; + Path_Value : constant String_Access := Getenv ("PATH"); + + begin + if Opt.Verbose_Mode then + Write_Line ("Setting the default project search directories"); + + if Prj.Current_Verbosity = High then + if Path_Value = null or else Path_Value'Length = 0 then + Write_Line ("No environment variable PATH"); + + else + Write_Line ("PATH ="); + Write_Line (" " & Path_Value.all); + end if; + end if; + end if; + + -- Reorder the compiler roots in the PATH order + + if First_Compiler_Root /= null + and then First_Compiler_Root.Next /= null + then + declare + Pred : Compiler_Root_Ptr; + First_New_Comp : Compiler_Root_Ptr := null; + New_Comp : Compiler_Root_Ptr := null; + First : Positive := Path_Value'First; + Last : Positive; + Path_Last : Positive; + begin + while First <= Path_Value'Last loop + Last := First; + + if Path_Value (First) /= Path_Separator then + while Last < Path_Value'Last + and then Path_Value (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + Path_Last := Last; + while Path_Last > First + and then + Path_Value (Path_Last) = Directory_Separator + loop + Path_Last := Path_Last - 1; + end loop; + + if Path_Last > First + 4 + and then + Path_Value (Path_Last - 2 .. Path_Last) = "bin" + and then + Path_Value (Path_Last - 3) = Directory_Separator + then + Path_Last := Path_Last - 4; + Pred := null; + Compiler_Root := First_Compiler_Root; + while Compiler_Root /= null + and then Compiler_Root.Root.all /= + Path_Value (First .. Path_Last) + loop + Pred := Compiler_Root; + Compiler_Root := Compiler_Root.Next; + end loop; + + if Compiler_Root /= null then + if Pred = null then + First_Compiler_Root := + First_Compiler_Root.Next; + else + Pred.Next := Compiler_Root.Next; + end if; + + if First_New_Comp = null then + First_New_Comp := Compiler_Root; + else + New_Comp.Next := Compiler_Root; + end if; + + New_Comp := Compiler_Root; + New_Comp.Next := null; + end if; + end if; + end if; + + First := Last + 1; + end loop; + + if First_New_Comp /= null then + New_Comp.Next := First_Compiler_Root; + First_Compiler_Root := First_New_Comp; + end if; + end; + end if; + + -- Now that the compiler roots are in a correct order, add the + -- directories corresponding to these compiler roots in the + -- project path. + + Compiler_Root := First_Compiler_Root; + while Compiler_Root /= null loop + Prefix := Compiler_Root.Root; + + Runtime_Root := Compiler_Root.Runtimes; + while Runtime_Root /= null loop + Add_Directory + (Runtime_Root.Root.all & + Directory_Separator & + "lib" & + Directory_Separator & + "gnat"); + Add_Directory + (Runtime_Root.Root.all & + Directory_Separator & + "share" & + Directory_Separator & + "gpr"); + Runtime_Root := Runtime_Root.Next; + end loop; + + Add_Directory + (Prefix.all & + Directory_Separator & + Opt.Target_Value.all & + Directory_Separator & + "lib" & + Directory_Separator & + "gnat"); + Add_Directory + (Prefix.all & + Directory_Separator & + Opt.Target_Value.all & + Directory_Separator & + "share" & + Directory_Separator & + "gpr"); + Add_Directory + (Prefix.all & + Directory_Separator & + "share" & + Directory_Separator & + "gpr"); + Add_Directory + (Prefix.all & + Directory_Separator & + "lib" & + Directory_Separator & + "gnat"); + Compiler_Root := Compiler_Root.Next; + end loop; + end; + + -- And parse again the project files. There will be no missing + -- withed projects, as Ignore_Missing_With is set to False in + -- the environment flags, so there is no risk of endless loop here. + + goto Parse_Again; + end if; end Parse_Project_And_Apply_Config; -------------------------------------- @@ -1886,4 +2146,112 @@ package body Prj.Conf is RTS_Languages.Set (Language, Name_Find); end Set_Runtime_For; + ---------------------------- + -- Look_For_Project_Paths -- + ---------------------------- + + procedure Look_For_Project_Paths + (Project : Project_Id; + Tree : Project_Tree_Ref; + With_State : in out State) + is + Lang_Id : Language_Ptr; + Compiler_Root : Compiler_Root_Ptr; + Runtime_Root : Runtime_Root_Ptr; + Comp_Driver : String_Access; + Comp_Dir : String_Access; + Prefix : String_Access; + + pragma Unreferenced (Tree); + + begin + With_State := No_State; + + Lang_Id := Project.Languages; + while Lang_Id /= No_Language_Index loop + if Lang_Id.Config.Compiler_Driver /= No_File then + Comp_Driver := + new String' + (Get_Name_String (Lang_Id.Config.Compiler_Driver)); + + -- Get the absolute path of the compiler driver + + if not Is_Absolute_Path (Comp_Driver.all) then + Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all); + end if; + + if Comp_Driver /= null and then Comp_Driver'Length > 0 then + Comp_Dir := + new String' + (Containing_Directory (Comp_Driver.all)); + + -- Consider only the compiler drivers that are in "bin" + -- subdirectories. + + if Simple_Name (Comp_Dir.all) = "bin" then + Prefix := + new String'(Containing_Directory (Comp_Dir.all)); + + -- Check if the compiler root is already in the list. If it + -- is not, add it to the list. + + Compiler_Root := First_Compiler_Root; + while Compiler_Root /= null loop + exit when Prefix.all = Compiler_Root.Root.all; + Compiler_Root := Compiler_Root.Next; + end loop; + + if Compiler_Root = null then + First_Compiler_Root := + new Compiler_Root_Data' + (Root => Prefix, + Runtimes => null, + Next => First_Compiler_Root); + Compiler_Root := First_Compiler_Root; + end if; + + -- If there is a runtime for this compiler, check if it is + -- recorded with the compiler root. If it is not, record + -- the runtime. + + declare + Runtime : constant String := + Runtime_Name_For (Lang_Id.Name); + Root : String_Access; + begin + if Runtime'Length > 0 then + if Is_Absolute_Path (Runtime) then + Root := new String'(Runtime); + + else + Root := + new String' + (Prefix.all & + Directory_Separator & + Opt.Target_Value.all & + Directory_Separator & + Runtime); + end if; + + Runtime_Root := Compiler_Root.Runtimes; + while Runtime_Root /= null loop + exit when Root.all = Runtime_Root.Root.all; + Runtime_Root := Runtime_Root.Next; + end loop; + + if Runtime_Root = null then + Compiler_Root.Runtimes := + new Runtime_Root_Data' + (Root => Root, + Next => Compiler_Root.Runtimes); + end if; + end if; + end; + end if; + end if; + end if; + + Lang_Id := Lang_Id.Next; + end loop; + end Look_For_Project_Paths; end Prj.Conf; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index b6bb25fcbf8..7dbb4ce7c8c 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1876,7 +1876,7 @@ package body Prj.Env is (Self : in out Project_Search_Path; Target_Name : String) is - Add_Default_Dir : Boolean := True; + Add_Default_Dir : Boolean := Target_Name /= "-"; First : Positive; Last : Positive; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 08f2b400f6b..f070a75fce3 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -175,8 +175,10 @@ package Prj.Env is Target_Name : String); -- Initialize Self. It will then contain the default project path on the -- given target (including directories specified by the environment - -- variables ADA_PROJECT_PATH and GPR_PROJECT_PATH). This does nothing if - -- Self has already been initialized. + -- variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH). + -- If one of the directory or Target_Name is "-", then the path contains + -- only those directories specified by the environment variables (except + -- "-"). This does nothing if Self has already been initialized. procedure Copy (From : Project_Search_Path; To : out Project_Search_Path); -- Copy From into To diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 5f04158bebf..34b13bc1e80 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -553,6 +553,8 @@ package body Prj.Part is begin In_Tree.Incomplete_With := False; + Project_Stack.Init; + Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT); if not Is_Initialized (Env.Project_Path) then Prj.Env.Initialize_Default_Project_Path diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 88196e10f41..8a267cf476f 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -2147,6 +2147,17 @@ package body Prj is (Root_Project, Root_Tree, Project_Context'(False, False)); end For_Project_And_Aggregated_Context; + -------------------------------- + -- Update_Ignore_Missing_With -- + -------------------------------- + + procedure Update_Ignore_Missing_With + (Flags : in out Processing_Flags; Value : Boolean) + is + begin + Flags.Ignore_Missing_With := Value; + end Update_Ignore_Missing_With; + -- Package initialization for Prj begin diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 804d88aa210..4ba3fac3bca 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1893,6 +1893,10 @@ package Prj is -- * user project also includes a "with" that can only be resolved -- once we have found the gnatls + procedure Update_Ignore_Missing_With + (Flags : in out Processing_Flags; Value : Boolean); + -- Update the value of component Ignore_Missing_With in Flags with Value + Gprbuild_Flags : constant Processing_Flags; Gprinstall_Flags : constant Processing_Flags; Gprclean_Flags : constant Processing_Flags; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 5f70faba0ab..46fdd006784 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1698,6 +1698,54 @@ package body System.OS_Lib is end if; end Non_Blocking_Spawn; + function Non_Blocking_Spawn + (Program_Name : String; + Args : Argument_List; + Stdout_File : String; + Stderr_File : String) return Process_Id + is + Stdout_FD : constant File_Descriptor := + Create_Output_Text_File (Stdout_File); + Stderr_FD : constant File_Descriptor := + Create_Output_Text_File (Stderr_File); + + Saved_Output : File_Descriptor; + Saved_Error : File_Descriptor; + + Result : Process_Id; + + begin + -- Do not attempt to spawn if the output files could not be created + + if Stdout_FD = Invalid_FD or else Stderr_FD = Invalid_FD then + return Invalid_Pid; + end if; + + -- Set standard output and error to the specified files + + Saved_Output := Dup (Standout); + Dup2 (Stdout_FD, Standout); + + Saved_Error := Dup (Standerr); + Dup2 (Stderr_FD, Standerr); + + -- Spawn the program + + Result := Non_Blocking_Spawn (Program_Name, Args); + + -- Restore the standard output and error + + Dup2 (Saved_Output, Standout); + Dup2 (Saved_Error, Standerr); + + -- And close the saved standard output and error file descriptors + + Close (Saved_Output); + Close (Saved_Error); + + return Result; + end Non_Blocking_Spawn; + ------------------------- -- Normalize_Arguments -- ------------------------- diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 2a24ca29d62..d285fd4cb07 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -856,6 +856,15 @@ package System.OS_Lib is -- This function will always return Invalid_Pid under VxWorks, since there -- is no notion of executables under this OS. + function Non_Blocking_Spawn + (Program_Name : String; + Args : Argument_List; + Stdout_File : String; + Stderr_File : String) return Process_Id; + -- Similar to the procedure above, but saves the standard output of the + -- command to a file with the name Stdout_File and the standard output + -- of the command to a file with the name Stderr_File. + procedure Wait_Process (Pid : out Process_Id; Success : out Boolean); -- Wait for the completion of any of the processes created by previous -- calls to Non_Blocking_Spawn. The caller will be suspended until one of diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 4b251e31c51..68104b906ff 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -282,6 +282,8 @@ package body Sem_Aux is (Typ : Entity_Id) return Boolean; -- Scans the Discriminants to see whether any are Completely_Hidden -- (the mechanism for describing non-specified stored discriminants) + -- Note that the entity list for the type may contain anonymous access + -- types created by expressions that constrain access discriminants. ---------------------------------------- -- Has_Completely_Hidden_Discriminant -- @@ -296,8 +298,17 @@ package body Sem_Aux is pragma Assert (Ekind (Typ) = E_Discriminant); Ent := Typ; - while Present (Ent) and then Ekind (Ent) = E_Discriminant loop - if Is_Completely_Hidden (Ent) then + while Present (Ent) loop + + -- Skip anonymous types that may be created by expressions + -- used as discriminant constraints on inherited discriminants. + + if Is_Itype (Ent) then + null; + + elsif Ekind (Ent) = E_Discriminant + and then Is_Completely_Hidden (Ent) + then return True; end if; @@ -322,7 +333,8 @@ package body Sem_Aux is if Has_Completely_Hidden_Discriminant (Ent) then while Present (Ent) loop - exit when Is_Completely_Hidden (Ent); + exit when Ekind (Ent) = E_Discriminant + and then Is_Completely_Hidden (Ent); Ent := Next_Entity (Ent); end loop; end if; diff --git a/gcc/ada/system-linux-x86_64.ads b/gcc/ada/system-linux-x86_64.ads index 2874376f002..3103cf781d9 100644 --- a/gcc/ada/system-linux-x86_64.ads +++ b/gcc/ada/system-linux-x86_64.ads @@ -69,8 +69,8 @@ package System is Null_Address : constant Address; Storage_Unit : constant := 8; - Word_Size : constant := 64; - Memory_Size : constant := 2 ** 64; + Word_Size : constant := Standard'Word_Size; + Memory_Size : constant := 2 ** Word_Size; -- Address comparison diff --git a/gcc/ada/system-mingw-x86_64.ads b/gcc/ada/system-mingw-x86_64.ads index 7b73968d10c..865bcd6b161 100644 --- a/gcc/ada/system-mingw-x86_64.ads +++ b/gcc/ada/system-mingw-x86_64.ads @@ -69,8 +69,8 @@ package System is Null_Address : constant Address; Storage_Unit : constant := 8; - Word_Size : constant := 64; - Memory_Size : constant := 2 ** 64; + Word_Size : constant := Standard'Word_Size; + Memory_Size : constant := 2 ** Word_Size; -- Address comparison