From: Arnaud Charlet Date: Thu, 4 Aug 2011 13:31:14 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6a2e5d0f3d52360a6a0f036a19cedffbd4b8bd42;p=gcc.git [multiple changes] 2011-08-04 Vincent Celier * gnat_ugn.texi: Improve documentation of gnatmake switch --source-info-file=. 2011-08-04 Hristian Kirtchev * exp_ch7.adb (Make_Final_Call): Add local variable Atyp (assertion type). Initialize Atyp to the appropriate type which is later checked for completion. Rewrite the assertion associated with private type completion. 2011-08-04 Ed Falis * adaint.c: Add call to vxCpuConfiguredGet for VxWorks SMP to initialize the number of CPUs. 2011-08-04 Ed Schonberg * sem_type.adb (Disambiguate): New subsidiary routine In_Same_Declaration_List, to implement AI05-0020: a user-defined equality on an anonymous access type whose designated type is private does not lead to an ambiguity with the universal access equality operator in the body or child units of the defining package. The same is true for a multiplication operator on a private type completed with a fixed-point-type. 2011-08-04 Javier Miranda * opt.ads (Init_Or_Norm_Scalars_Config): Removed. (Normalize_Scalars_Config): Removed. * opt.adb (Register_Opt_Config_Switches): Remove registering config values of Init_Or_Norm_Scalars_Config and Normalize_Scalars_Config. (Restore_Opt_Config_Switches): Remove code which restores the values of Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of Init_Or_Norm_Scalars. (Save_Opt_Config_Switches): Remove code which saves values of Init_Or_Norm_Scalars and Normalize_Scalars. (Set_Opt_Config_Switches): Remove code which restores config values of Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of Init_Or_Norm_Scalars. 2011-08-04 Yannick Moy * frontend.adb (Frontend): remove previous patch to avoid full qualification in ALFA mode. * lib-xref-alfa.adb (Add_ALFA_Xrefs): use unique name for variables. * sem_util.adb, sem_util.ads (Unique_Name): new function to define a unique name for an entity, which could be used to identify the entity across compilation units. 2011-08-04 Thomas Quinot * prj-env.adb (Initialize_Default_Project_Path): Add target specific directory ($prefix/$target/lib/gnat) in front of project path in all cases (making gnatmake's behaviour consistent with gprbuild). * gnatcmd.adb, make.adb, prj-makr.adb, clean.adb: Pass target name from Sdefault to project subsystem. * gnatls.adb: Show new target specific default project directory. 2011-08-04 Johannes Kanig * cstand.adb: Add Information to Identifier in Standard (Identifer_For): Set Entity to the corresponding entity From-SVN: r177383 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 48e9e5352ac..2db1c79bf23 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,70 @@ +2011-08-04 Vincent Celier + + * gnat_ugn.texi: Improve documentation of gnatmake switch + --source-info-file=. + +2011-08-04 Hristian Kirtchev + + * exp_ch7.adb (Make_Final_Call): Add local variable Atyp (assertion + type). Initialize Atyp to the appropriate type which is later checked + for completion. Rewrite the assertion associated with private type + completion. + +2011-08-04 Ed Falis + + * adaint.c: Add call to vxCpuConfiguredGet for VxWorks SMP to + initialize the number of CPUs. + +2011-08-04 Ed Schonberg + + * sem_type.adb (Disambiguate): New subsidiary routine + In_Same_Declaration_List, to implement AI05-0020: a user-defined + equality on an anonymous access type whose designated type is private + does not lead to an ambiguity with the universal access equality + operator in the body or child units of the defining package. The same + is true for a multiplication operator on a private type completed with + a fixed-point-type. + +2011-08-04 Javier Miranda + + * opt.ads (Init_Or_Norm_Scalars_Config): Removed. + (Normalize_Scalars_Config): Removed. + * opt.adb + (Register_Opt_Config_Switches): Remove registering config values of + Init_Or_Norm_Scalars_Config and Normalize_Scalars_Config. + (Restore_Opt_Config_Switches): Remove code which restores the values of + Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of + Init_Or_Norm_Scalars. + (Save_Opt_Config_Switches): Remove code which saves values of + Init_Or_Norm_Scalars and Normalize_Scalars. + (Set_Opt_Config_Switches): Remove code which restores config values of + Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of + Init_Or_Norm_Scalars. + +2011-08-04 Yannick Moy + + * frontend.adb (Frontend): remove previous patch to avoid full + qualification in ALFA mode. + * lib-xref-alfa.adb (Add_ALFA_Xrefs): use unique name for variables. + * sem_util.adb, sem_util.ads (Unique_Name): new function to define a + unique name for an entity, which could be used to identify the entity + across compilation units. + +2011-08-04 Thomas Quinot + + * prj-env.adb + (Initialize_Default_Project_Path): Add target specific directory + ($prefix/$target/lib/gnat) in front of project path in all cases + (making gnatmake's behaviour consistent with gprbuild). + * gnatcmd.adb, make.adb, prj-makr.adb, clean.adb: + Pass target name from Sdefault to project subsystem. + * gnatls.adb: Show new target specific default project directory. + +2011-08-04 Johannes Kanig + + * cstand.adb: Add Information to Identifier in Standard + (Identifer_For): Set Entity to the corresponding entity + 2011-08-04 Sergey Rybin * gnat_ugn.texi: Update doc on gnatcheck. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 471dc2c2313..a5cc29c4732 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -51,6 +51,11 @@ extern "C" { #include "cacheLib.h" #endif /* __mips_vxworks */ +/* If SMP, access vxCpuConfiguredGet */ +#ifdef _WRS_CONFIG_SMP +#include +#endif /* _WRS_CONFIG_SMP */ + #endif /* VxWorks */ #if (defined (__mips) && defined (__sgi)) || defined (__APPLE__) @@ -2442,6 +2447,12 @@ __gnat_number_of_cpus (void) status = LIB$GETSYI (&code, &res); if ((status & 1) != 0) cores = res; + +#elif defined (__WRS_CONFIG_SMP) + unsigned int vxCpuConfiguredGet (void); + + cores = vxCpuConfiguredGet (); + #endif return cores; diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index adf8b0171e0..d6dc8ba140e 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -37,6 +37,7 @@ with Prj.Ext; with Prj.Pars; with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; +with Sdefault; with Snames; with Switch; use Switch; with Table; @@ -1528,7 +1529,8 @@ package body Clean is Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags); Prj.Env.Initialize_Default_Project_Path - (Root_Environment.Project_Path, Target_Name => ""); + (Root_Environment.Project_Path, + Target_Name => Sdefault.Target_Name.all); Project_Node_Tree := new Project_Node_Tree_Data; Prj.Tree.Initialize (Project_Node_Tree); diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index b3cc75f8e2c..650b86e5dee 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -1651,6 +1651,7 @@ package body CStand is begin Ident_Node := New_Node (N_Identifier, Stloc); Set_Chars (Ident_Node, Chars (Standard_Entity (S))); + Set_Entity (Ident_Node, Standard_Entity (S)); return Ident_Node; end Identifier_For; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index a679c294c89..bb5a9efdce3 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -6734,6 +6734,7 @@ package body Exp_Ch7 is For_Parent : Boolean := False) return Node_Id is Loc : constant Source_Ptr := Sloc (Obj_Ref); + Atyp : Entity_Id; Fin_Id : Entity_Id := Empty; Ref : Node_Id; Utyp : Entity_Id; @@ -6743,10 +6744,12 @@ package body Exp_Ch7 is if Is_Class_Wide_Type (Typ) then Utyp := Root_Type (Typ); + Atyp := Utyp; Ref := Obj_Ref; elsif Is_Concurrent_Type (Typ) then Utyp := Corresponding_Record_Type (Typ); + Atyp := Empty; Ref := Convert_Concurrent (Obj_Ref, Typ); elsif Is_Private_Type (Typ) @@ -6754,10 +6757,12 @@ package body Exp_Ch7 is and then Is_Concurrent_Type (Full_View (Typ)) then Utyp := Corresponding_Record_Type (Full_View (Typ)); + Atyp := Typ; Ref := Convert_Concurrent (Obj_Ref, Full_View (Typ)); else Utyp := Typ; + Atyp := Typ; Ref := Obj_Ref; end if; @@ -6802,7 +6807,7 @@ package body Exp_Ch7 is -- instead. if Utyp /= Base_Type (Utyp) then - pragma Assert (Is_Private_Type (Typ)); + pragma Assert (Present (Atyp) and then Is_Private_Type (Atyp)); Utyp := Base_Type (Utyp); Ref := Unchecked_Convert_To (Utyp, Ref); diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 02a272f9d88..c6dd8cb5991 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -372,11 +372,9 @@ begin -- Qualify all entity names in inner packages, package bodies, etc., -- except when compiling for the VM back-ends, which depend on having -- unqualified names in certain cases and handles the generation of - -- qualified names when needed, and when compiling for formal verification, - -- in which the back-end calls directly Qualify_All_Entity_Names after some - -- preprocessing which uses the non-qualified names. + -- qualified names when needed. - if VM_Target = No_VM and then not ALFA_Mode then + if VM_Target = No_VM then Exp_Dbug.Qualify_All_Entity_Names; end if; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d47d6eabd93..6f7843a0761 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -9389,7 +9389,9 @@ to process the project files, especially when looking for sources that take a long time. If the source info file exists but cannot be parsed successfully, the Project Manager will attempt to recreate it. If the Project Manager fails to create the source info file, a message is issued, but gnatmake does not -fail. +fail. @command{gnatmake} "trusts" the source info file. This means that +if the source files have changed (addition, deletion, moving to a different +source directory), then the source info file need to be deleted and recreated. @ifclear vms @item --create-map-file diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index d00f03b1238..1a25dc8347f 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -41,6 +41,7 @@ with Prj.Ext; use Prj.Ext; with Prj.Pars; with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; +with Sdefault; with Sinput.P; with Snames; use Snames; with Table; @@ -1360,7 +1361,8 @@ begin Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags); Prj.Env.Initialize_Default_Project_Path - (Root_Environment.Project_Path, Target_Name => ""); + (Root_Environment.Project_Path, + Target_Name => Sdefault.Target_Name.all); Project_Node_Tree := new Project_Node_Tree_Data; Prj.Tree.Initialize (Project_Node_Tree); diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index b684ebbc8ed..25b2da1f094 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1614,6 +1614,9 @@ begin Write_Str (" "); Write_Eol; + -- The code below reproduces Prj.Env.Initialize_Default_Project_Path, + -- shouldn't we reuse that instead??? + declare Project_Path : String_Access := Getenv (Gpr_Project_Path); @@ -1624,6 +1627,7 @@ begin Last : Natural; Add_Default_Dir : Boolean := True; + Prefix_Name_Len : Integer; begin -- If there is a project path, display each directory in the path @@ -1699,12 +1703,26 @@ begin end loop; -- If the sequence "/lib"/ was found, display the default - -- directory /lib/gnat/. + -- directories //lib/gnat and /lib/gnat/. if Name_Len >= 5 then - Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat"; - Name_Buffer (Name_Len + 5) := Directory_Separator; - Name_Len := Name_Len + 5; + Prefix_Name_Len := Name_Len - 4; + + Name_Len := Prefix_Name_Len; + + Name_Len := Prefix_Name_Len; + Add_Str_To_Name_Buffer (Sdefault.Target_Name.all); + Name_Len := Name_Len - 1; + Add_Str_To_Name_Buffer (Directory_Separator + & "lib" & Directory_Separator + & "gnat" & Directory_Separator); + Write_Str (" "); + Write_Line + (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all); + + Name_Len := Prefix_Name_Len; + Add_Str_To_Name_Buffer ("lib" & Directory_Separator + & "gnat" & Directory_Separator); Write_Str (" "); Write_Line (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all); diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 26bd28e0f03..77da460df3f 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -738,7 +738,7 @@ package body ALFA is if XE.Ent /= Cur_Entity then Cur_Entity_Name := - new String'(Exact_Source_Name (Sloc (XE.Ent))); + new String'(Unique_Name (XE.Ent)); end if; ALFA_Xref_Table.Append ( diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index dd9e9b9c2ee..cc62e7f897b 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -51,6 +51,7 @@ with Prj.Env; with Prj.Pars; with Prj.Tree; use Prj.Tree; with Prj.Util; +with Sdefault; with SFN_Scan; with Sinput.P; with Snames; use Snames; @@ -6370,7 +6371,7 @@ package body Make is Prj.Tree.Initialize (Env, Gnatmake_Flags); Prj.Env.Initialize_Default_Project_Path - (Env.Project_Path, Target_Name => ""); + (Env.Project_Path, Target_Name => Sdefault.Target_Name.all); Project_Node_Tree := new Project_Node_Tree_Data; Prj.Tree.Initialize (Project_Node_Tree); diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 4b66c34b5bf..d850e69fe24 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -57,9 +57,7 @@ package body Opt is External_Name_Exp_Casing_Config := External_Name_Exp_Casing; External_Name_Imp_Casing_Config := External_Name_Imp_Casing; Fast_Math_Config := Fast_Math; - Init_Or_Norm_Scalars_Config := Init_Or_Norm_Scalars; Initialize_Scalars_Config := Initialize_Scalars; - Normalize_Scalars_Config := Normalize_Scalars; Optimize_Alignment_Config := Optimize_Alignment; Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Polling_Required_Config := Polling_Required; @@ -92,15 +90,20 @@ package body Opt is External_Name_Exp_Casing := Save.External_Name_Exp_Casing; External_Name_Imp_Casing := Save.External_Name_Imp_Casing; Fast_Math := Save.Fast_Math; - Init_Or_Norm_Scalars := Save.Init_Or_Norm_Scalars; Initialize_Scalars := Save.Initialize_Scalars; - Normalize_Scalars := Save.Normalize_Scalars; Optimize_Alignment := Save.Optimize_Alignment; Optimize_Alignment_Local := Save.Optimize_Alignment_Local; Persistent_BSS_Mode := Save.Persistent_BSS_Mode; Polling_Required := Save.Polling_Required; Short_Descriptors := Save.Short_Descriptors; Use_VADS_Size := Save.Use_VADS_Size; + + -- Update consistently the value of Init_Or_Norm_Scalars. The value of + -- Normalize_Scalars is not saved/restored because after set to True its + -- value is never changed. That is, if a compilation unit has pragma + -- Normalize_Scalars then it forces that value for all with'ed units. + + Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; end Restore_Opt_Config_Switches; ------------------------------ @@ -122,9 +125,7 @@ package body Opt is Save.External_Name_Exp_Casing := External_Name_Exp_Casing; Save.External_Name_Imp_Casing := External_Name_Imp_Casing; Save.Fast_Math := Fast_Math; - Save.Init_Or_Norm_Scalars := Init_Or_Norm_Scalars; Save.Initialize_Scalars := Initialize_Scalars; - Save.Normalize_Scalars := Normalize_Scalars; Save.Optimize_Alignment := Optimize_Alignment; Save.Optimize_Alignment_Local := Optimize_Alignment_Local; Save.Persistent_BSS_Mode := Persistent_BSS_Mode; @@ -190,13 +191,19 @@ package body Opt is External_Name_Exp_Casing := External_Name_Exp_Casing_Config; External_Name_Imp_Casing := External_Name_Imp_Casing_Config; Fast_Math := Fast_Math_Config; - Init_Or_Norm_Scalars := Init_Or_Norm_Scalars_Config; Initialize_Scalars := Initialize_Scalars_Config; - Normalize_Scalars := Normalize_Scalars_Config; Optimize_Alignment := Optimize_Alignment_Config; Optimize_Alignment_Local := False; Persistent_BSS_Mode := Persistent_BSS_Mode_Config; Use_VADS_Size := Use_VADS_Size_Config; + + -- Update consistently the value of Init_Or_Norm_Scalars. The value + -- of Normalize_Scalars is not saved/restored because once set to + -- True its value is never changed. That is, if a compilation unit + -- has pragma Normalize_Scalars then it forces that value for all + -- with'ed units. + + Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; end if; Default_Pool := Default_Pool_Config; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 563e57804c1..3eaa855358d 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1718,11 +1718,6 @@ package Opt is -- used to set the initial value of Fast_Math at the start of each new -- compilation unit. - Init_Or_Norm_Scalars_Config : Boolean; - -- GNAT - -- This is the value of the configuration switch that is set by one - -- of the pragmas Initialize_Scalars or Normalize_Scalars. - Initialize_Scalars_Config : Boolean; -- GNAT -- This is the value of the configuration switch that is set by the @@ -1730,13 +1725,6 @@ package Opt is -- This switch is not set when the pragma appears ahead of a given -- unit, so it does not affect the compilation of other units. - Normalize_Scalars_Config : Boolean; - -- GNAT - -- This is the value of the configuration switch that is set by the - -- pragma Normalize_Scalars when it appears in the gnat.adc file. - -- This switch is not set when the pragma appears ahead of a given - -- unit, so it does not affect the compilation of other units. - Optimize_Alignment_Config : Character; -- GNAT -- This is the value of the configuration switch that controls the @@ -1916,7 +1904,6 @@ private External_Name_Exp_Casing : External_Casing_Type; External_Name_Imp_Casing : External_Casing_Type; Fast_Math : Boolean; - Init_Or_Norm_Scalars : Boolean; Initialize_Scalars : Boolean; Normalize_Scalars : Boolean; Optimize_Alignment : Character; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index f2c8500f9ee..5f5b831368b 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1981,44 +1981,67 @@ package body Prj.Env is if Add_Default_Dir then declare - Prefix : String_Ptr := Sdefault.Search_Dir_Prefix; + Prefix : String_Ptr; + Add_Prefix_Share_Gpr : Boolean; begin - if Prefix = null then + if Sdefault.Search_Dir_Prefix = null then + + -- gprbuild case + Prefix := new String'(Executable_Prefix_Path); + Add_Prefix_Share_Gpr := True; - if Prefix.all /= "" then - if Target_Name /= "" then - Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - Target_Name & Directory_Separator & - "lib" & Directory_Separator & "gnat"); - end if; + else + Prefix := new String'(Sdefault.Search_Dir_Prefix.all + & ".." & Dir_Separator + & ".." & Dir_Separator + & ".." & Dir_Separator + & ".." & Dir_Separator); + Add_Prefix_Share_Gpr := False; + end if; + + if Prefix.all /= "" then + if Target_Name /= "" then + + -- $prefix/$target/lib/gnat Add_Str_To_Name_Buffer (Path_Separator & Prefix.all & - "share" & Directory_Separator & "gpr"); + Target_Name); + + -- Note: Target_Name has a trailing / when it comes from + -- Sdefault. + + if Name_Buffer (Name_Len) /= '/' then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer + ("lib" & Directory_Separator & "gnat"); + end if; + + if Add_Prefix_Share_Gpr then + + -- $prefix/share/gpr + Add_Str_To_Name_Buffer (Path_Separator & Prefix.all & - "lib" & Directory_Separator & "gnat"); + "share" & Directory_Separator & "gpr"); end if; - else - Self.Path := - new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & - Prefix.all & - ".." & Directory_Separator & - ".." & Directory_Separator & - ".." & Directory_Separator & "gnat"); + -- $prefix/lib/gnat + + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + "lib" & Directory_Separator & "gnat"); end if; Free (Prefix); end; end if; - if Self.Path = null then - Self.Path := new String'(Name_Buffer (1 .. Name_Len)); - end if; + Self.Path := new String'(Name_Buffer (1 .. Name_Len)); end Initialize_Default_Project_Path; -------------- diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 678492106c1..29fe7b48cb0 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -34,6 +34,7 @@ with Prj.Part; with Prj.PP; with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; +with Sdefault; with Snames; use Snames; with Table; use Table; @@ -802,7 +803,8 @@ package body Prj.Makr is Prj.Tree.Initialize (Root_Environment, Flags); Prj.Env.Initialize_Default_Project_Path - (Root_Environment.Project_Path, Target_Name => ""); + (Root_Environment.Project_Path, + Target_Name => Sdefault.Target_Name.all); Prj.Tree.Initialize (Tree); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 91d7a9dd0df..cf48392c817 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1196,6 +1196,17 @@ package body Sem_Type is -- Determine whether one of the candidates is an operation inherited by -- a type that is derived from an actual in an instantiation. + function In_Same_Declaration_List + (Typ : Entity_Id; + Op_Decl : Entity_Id) return Boolean; + -- AI05-0020: a spurious ambiguity may arise when equality on anonymous + -- access types is declared on the partial view of a designated type, so + -- that the type declaration and equality are not in the same list of + -- declarations. This AI gives a preference rule for the user-defined + -- operation. Same rule applies for arithmetic operations on private + -- types completed with fixed-point types: the predefined operation is + -- hidden; this is already handled properly in GNAT. + function Is_Actual_Subprogram (S : Entity_Id) return Boolean; -- Determine whether a subprogram is an actual in an enclosing instance. -- An overloading between such a subprogram and one declared outside the @@ -1255,6 +1266,26 @@ package body Sem_Type is end if; end Inherited_From_Actual; + ------------------------------ + -- In_Same_Declaration_List -- + ------------------------------ + + function In_Same_Declaration_List + (Typ : Entity_Id; + Op_Decl : Entity_Id) return Boolean + is + Scop : constant Entity_Id := Scope (Typ); + + begin + return In_Same_List (Parent (Typ), Op_Decl) + or else + (Ekind_In (Scop, E_Package, E_Generic_Package) + and then List_Containing (Op_Decl) = + Visible_Declarations (Parent (Scop)) + and then List_Containing (Parent (Typ)) = + Private_Declarations (Parent (Scop))); + end In_Same_Declaration_List; + -------------------------- -- Is_Actual_Subprogram -- -------------------------- @@ -1934,8 +1965,9 @@ package body Sem_Type is and then Etype (User_Subp) = Standard_Boolean and then Ekind (Operand_Type) = E_Anonymous_Access_Type and then - In_Same_List (Parent (Designated_Type (Operand_Type)), - Unit_Declaration_Node (User_Subp)) + In_Same_Declaration_List + (Designated_Type (Operand_Type), + Unit_Declaration_Node (User_Subp)) then if It2.Nam = Predef_Subp then return It1; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4bfb83a3b05..8db690506ae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12201,6 +12201,22 @@ package body Sem_Util is end case; end Unique_Defining_Entity; + ----------------- + -- Unique_Name -- + ----------------- + + function Unique_Name (E : Entity_Id) return String is + Name : constant String := Get_Name_String (Chars (E)); + begin + if Has_Fully_Qualified_Name (E) + or else E = Standard_Standard + then + return Name; + else + return Unique_Name (Scope (E)) & "__" & Name; + end if; + end Unique_Name; + -------------------------- -- Unit_Declaration_Node -- -------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a16544d9274..7c7ddd65227 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1372,6 +1372,10 @@ package Sem_Util is -- Return the entity which represents declaration N, so that matching -- declaration and body have the same entity. + function Unique_Name (E : Entity_Id) return String; + -- Return a unique name for entity E, which could be used to identify E + -- across compilation units. + function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id; -- Unit_Id is the simple name of a program unit, this function returns the -- corresponding xxx_Declaration node for the entity. Also applies to the