From: Arnaud Charlet Date: Fri, 10 Oct 2014 14:49:04 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=9ceeaf9d16fa143b23e16234a22744c9191213ff;p=gcc.git [multiple changes] 2014-10-10 Robert Dewar * freeze.adb, sem_attr.adb: Minor reformatting. 2014-10-10 Johannes Kanig * a-cfdlli.ads, a-cfhama.ads, a-cfhase.ads, a-cforma.ads, a-cforse.ads, a-cofove.ads: add "Default_Initial_Condition" to container type. 2014-10-10 Vincent Celier * prj-conf.adb (Do_Autoconf): In Codepeer mode, do not try to get any configuration switches from the project file. 2014-10-10 Ed Schonberg * sem_ch12.adb (Build_Wrapper): Renamed as Build_Operator_Wrapper. (Build_Function_Wrapper): New function, to construct a wrapper function for actuals that are functions with an arbitrary number of parameters. Used in GNATProve mode to simplify proof propagation in instantiations. From-SVN: r216092 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f43c709672d..4e232959bc8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2014-10-10 Robert Dewar + + * freeze.adb, sem_attr.adb: Minor reformatting. + +2014-10-10 Johannes Kanig + + * a-cfdlli.ads, a-cfhama.ads, a-cfhase.ads, a-cforma.ads, + a-cforse.ads, a-cofove.ads: add "Default_Initial_Condition" + to container type. + +2014-10-10 Vincent Celier + + * prj-conf.adb (Do_Autoconf): In Codepeer mode, do not try to get + any configuration switches from the project file. + +2014-10-10 Ed Schonberg + + * sem_ch12.adb (Build_Wrapper): Renamed as Build_Operator_Wrapper. + (Build_Function_Wrapper): New function, to construct a wrapper + function for actuals that are functions with an arbitrary + number of parameters. Used in GNATProve mode to simplify proof + propagation in instantiations. + 2014-10-10 Robert Dewar * freeze.adb, gnat1drv.adb, sem_ch13.adb: Minor reformatting and diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads index b5ceacacfd0..98f28e4a8b1 100644 --- a/gcc/ada/a-cfdlli.ads +++ b/gcc/ada/a-cfdlli.ads @@ -69,7 +69,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; pragma Preelaborable_Initialization (List); type Cursor is private; diff --git a/gcc/ada/a-cfhama.ads b/gcc/ada/a-cfhama.ads index b5c440ec74d..976160b8609 100644 --- a/gcc/ada/a-cfhama.ads +++ b/gcc/ada/a-cfhama.ads @@ -74,7 +74,8 @@ package Ada.Containers.Formal_Hashed_Maps is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; pragma Preelaborable_Initialization (Map); type Cursor is private; diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads index 2a2f4e87637..670d720d5d7 100644 --- a/gcc/ada/a-cfhase.ads +++ b/gcc/ada/a-cfhase.ads @@ -76,7 +76,8 @@ package Ada.Containers.Formal_Hashed_Sets is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; pragma Preelaborable_Initialization (Set); type Cursor is private; diff --git a/gcc/ada/a-cforma.ads b/gcc/ada/a-cforma.ads index e9a5f976e91..51e40a2ea2e 100644 --- a/gcc/ada/a-cforma.ads +++ b/gcc/ada/a-cforma.ads @@ -78,7 +78,8 @@ package Ada.Containers.Formal_Ordered_Maps is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; pragma Preelaborable_Initialization (Map); type Cursor is private; diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads index dc174070023..b3e9ff56619 100644 --- a/gcc/ada/a-cforse.ads +++ b/gcc/ada/a-cforse.ads @@ -77,7 +77,8 @@ package Ada.Containers.Formal_Ordered_Sets is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; pragma Preelaborable_Initialization (Set); type Cursor is private; diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads index d99041a4605..f5b9b64347b 100644 --- a/gcc/ada/a-cofove.ads +++ b/gcc/ada/a-cofove.ads @@ -81,7 +81,8 @@ package Ada.Containers.Formal_Vectors is Iterable => (First => First, Next => Next, Has_Element => Has_Element, - Element => Element); + Element => Element), + Default_Initial_Condition; type Cursor is private; pragma Preelaborable_Initialization (Cursor); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 3ae0f50516d..0489baee199 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1858,11 +1858,10 @@ package body Freeze is -- package. Recurse on inner generic packages. function Freeze_Profile (E : Entity_Id) return Boolean; - -- Freeze formals and return type of subprogram. - -- If some type in the profile is a limited view, freezing of the entity - -- will take place elsewhere, and the function returns False. - -- This routine will be modified if and when we can implement AI05-019 - -- efficiently. + -- Freeze formals and return type of subprogram. If some type in the + -- profile is a limited view, freezing of the entity will take place + -- elsewhere, and the function returns False. This routine will be + -- modified if and when we can implement AI05-019 efficiently ??? procedure Freeze_Record_Type (Rec : Entity_Id); -- Freeze record type, including freezing component types, and freezing @@ -2557,8 +2556,8 @@ package body Freeze is Attribute_Name => Name_Range_Length); Analyze_And_Resolve (Ilen); - -- No attempt is made to check number of elements - -- if not compile time known. + -- No attempt is made to check number of elements if not + -- compile time known. if Nkind (Ilen) /= N_Integer_Literal then Elmts := Uint_0; @@ -2601,9 +2600,9 @@ package body Freeze is end if; end if; - -- If any of the index types was an enumeration type with a - -- non-standard rep clause, then we indicate that the array type - -- is always packed (even if it is not bit packed). + -- If any of the index types was an enumeration type with a non- + -- standard rep clause, then we indicate that the array type is + -- always packed (even if it is not bit packed). if Non_Standard_Enum then Set_Has_Non_Standard_Rep (Base_Type (Arr)); @@ -2704,9 +2703,9 @@ package body Freeze is while Present (Formal) loop F_Type := Etype (Formal); - -- AI05-0151: incomplete types can appear in a profile. - -- By the time the entity is frozen, the full view must - -- be available, unless it is a limited view. + -- AI05-0151: incomplete types can appear in a profile. By the + -- time the entity is frozen, the full view must be available, + -- unless it is a limited view. if Is_Incomplete_Type (F_Type) and then Present (Full_View (F_Type)) @@ -2724,12 +2723,11 @@ package body Freeze is and then not Is_Generic_Type (F_Type) and then not Is_Derived_Type (F_Type) then - -- If the type of a formal is incomplete, subprogram - -- is being frozen prematurely. Within an instance - -- (but not within a wrapper package) this is an - -- artifact of our need to regard the end of an - -- instantiation as a freeze point. Otherwise it is - -- a definite error. + -- If the type of a formal is incomplete, subprogram is being + -- frozen prematurely. Within an instance (but not within a + -- wrapper package) this is an artifact of our need to regard + -- the end of an instantiation as a freeze point. Otherwise it + -- is a definite error. if In_Instance then Set_Is_Frozen (E, False); @@ -2741,13 +2739,12 @@ package body Freeze is then Error_Msg_Node_1 := F_Type; Error_Msg - ("type& must be fully defined before this point", - Loc); + ("type & must be fully defined before this point", Loc); end if; end if; - -- Check suspicious parameter for C function. These tests - -- apply only to exported/imported subprograms. + -- Check suspicious parameter for C function. These tests apply + -- only to exported/imported subprograms. if Warn_On_Export_Import and then Comes_From_Source (E) @@ -2780,20 +2777,22 @@ package body Freeze is and then not Has_Size_Clause (F_Type) and then VM_Target = No_VM then - Error_Msg_N ("& is an 8-bit Ada Boolean?x?", Formal); - Error_Msg_N ("\use appropriate corresponding type in C " + Error_Msg_N + ("& is an 8-bit Ada Boolean?x?", Formal); + Error_Msg_N + ("\use appropriate corresponding type in C " & "(e.g. char)?x?", Formal); -- Check suspicious tagged type elsif (Is_Tagged_Type (F_Type) - or else (Is_Access_Type (F_Type) - and then - Is_Tagged_Type - (Designated_Type (F_Type)))) + or else + (Is_Access_Type (F_Type) + and then Is_Tagged_Type (Designated_Type (F_Type)))) and then Convention (E) = Convention_C then - Error_Msg_N ("?x?& involves a tagged type which does not " + Error_Msg_N + ("?x?& involves a tagged type which does not " & "correspond to any C type!", Formal); -- Check wrong convention subprogram pointer @@ -2801,7 +2800,8 @@ package body Freeze is elsif Ekind (F_Type) = E_Access_Subprogram_Type and then not Has_Foreign_Convention (F_Type) then - Error_Msg_N ("?x?subprogram pointer & should " + Error_Msg_N + ("?x?subprogram pointer & should " & "have foreign convention!", Formal); Error_Msg_Sloc := Sloc (F_Type); Error_Msg_NE @@ -2814,8 +2814,8 @@ package body Freeze is Error_Msg_Qual_Level := 0; end if; - -- Check for unconstrained array in exported foreign - -- convention case. + -- Check for unconstrained array in exported foreign convention + -- case. if Has_Foreign_Convention (E) and then not Is_Imported (E) @@ -2830,17 +2830,16 @@ package body Freeze is then Error_Msg_Qual_Level := 1; - -- If this is an inherited operation, place the - -- warning on the derived type declaration, rather - -- than on the original subprogram. + -- If this is an inherited operation, place the warning on + -- the derived type declaration, rather than on the original + -- subprogram. if Nkind (Original_Node (Parent (E))) = N_Full_Type_Declaration then Warn_Node := Parent (E); if Formal = First_Formal (E) then - Error_Msg_NE - ("??in inherited operation&", Warn_Node, E); + Error_Msg_NE ("??in inherited operation&", Warn_Node, E); end if; else Warn_Node := Formal; @@ -2987,8 +2986,7 @@ package body Freeze is end if; -- Give warning for suspicious return of a result of an - -- unconstrained array type in a foreign convention - -- function. + -- unconstrained array type in a foreign convention function. if Has_Foreign_Convention (E) @@ -2997,19 +2995,18 @@ package body Freeze is and then Is_Array_Type (R_Type) and then not Is_Constrained (R_Type) - -- Exclude imported routines, the warning does not - -- belong on the import, but rather on the routine - -- definition. + -- Exclude imported routines, the warning does not belong on + -- the import, but rather on the routine definition. and then not Is_Imported (E) - -- Exclude VM case, since both .NET and JVM can handle - -- return of unconstrained arrays without a problem. + -- Exclude VM case, since both .NET and JVM can handle return + -- of unconstrained arrays without a problem. and then VM_Target = No_VM - -- Check that general warning is enabled, and that it - -- is not suppressed for this particular case. + -- Check that general warning is enabled, and that it is not + -- suppressed for this particular case. and then Warn_On_Export_Import and then not Has_Warnings_Off (E) diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 095c2d1c020..fe1be8fcff8 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -172,7 +172,7 @@ package body Prj.Conf is begin if Config_File = Empty_Node then - -- Create a dummy config file is none was found + -- Create a dummy config file if none was found Name_Len := Auto_Cgpr'Length; Name_Buffer (1 .. Name_Len) := Auto_Cgpr; @@ -587,7 +587,7 @@ package body Prj.Conf is or else (Tgt_Name /= No_Name and then (Length_Of_Name (Tgt_Name) = 0 - or else Target = Get_Name_String (Tgt_Name))); + or else Target = Get_Name_String (Tgt_Name))); if not OK then if Autoconf_Specified then @@ -931,7 +931,8 @@ package body Prj.Conf is declare Obj_Dir : constant String := Name_Buffer (1 .. Name_Len); - Config_Switches : Argument_List_Access; + Config_Switches : Argument_List_Access := + new Argument_List'(1 .. 0 => null); Db_Switches : Argument_List_Access; Args : Argument_List (1 .. 5); Arg_Last : Positive; @@ -979,10 +980,13 @@ package body Prj.Conf is end case; end if; - -- Get the config switches. This should be done only now, as some - -- runtimes may have been found if the Builder switches. + -- If not in Codepeer mode, get the config switches. This should + -- be done only now, as some runtimes may have been found if the + -- Builder switches. - Config_Switches := Get_Config_Switches; + if not CodePeer_Mode then + Config_Switches := Get_Config_Switches; + end if; -- Get eventual --db switches @@ -1082,12 +1086,11 @@ package body Prj.Conf is Write_Eol; elsif not Quiet_Output then + -- Display no message if we are creating auto.cgpr, unless in - -- verbose mode + -- verbose mode. - if Config_File_Name'Length > 0 - or else Verbose_Mode - then + if Config_File_Name'Length > 0 or else Verbose_Mode then Write_Str ("creating "); Write_Str (Simple_Name (Args (3).all)); Write_Eol; @@ -1300,8 +1303,7 @@ package body Prj.Conf is Config_Command : constant String := "--config=" & Get_Name_String (Name); - Runtime_Name : constant String := - Runtime_Name_For (Name); + Runtime_Name : constant String := Runtime_Name_For (Name); begin if Variable = Nil_Variable_Value @@ -1321,14 +1323,14 @@ package body Prj.Conf is if Is_Absolute_Path (Compiler_Command) then Result (Count) := new String' - (Config_Command & ",," & Runtime_Name & "," & - Containing_Directory (Compiler_Command) & "," & - Simple_Name (Compiler_Command)); + (Config_Command & ",," & Runtime_Name & "," + & Containing_Directory (Compiler_Command) & "," + & Simple_Name (Compiler_Command)); else Result (Count) := new String' - (Config_Command & ",," & Runtime_Name & ",," & - Compiler_Command); + (Config_Command & ",," & Runtime_Name & ",," + & Compiler_Command); end if; end; end if; @@ -1350,20 +1352,14 @@ package body Prj.Conf is begin Variable := - Value_Of - (Name_Source_Dirs, - Project.Decl.Attributes, - Shared); + Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared); if Variable = Nil_Variable_Value or else Variable.Default or else Variable.Values /= Nil_String then Variable := - Value_Of - (Name_Source_Files, - Project.Decl.Attributes, - Shared); + Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared); return Variable = Nil_Variable_Value or else Variable.Default or else Variable.Values /= Nil_String; @@ -1373,9 +1369,13 @@ package body Prj.Conf is end if; end Might_Have_Sources; + -- Local Variables + Success : Boolean; Config_Project_Node : Project_Node_Id := Empty_Node; + -- Start of processing for Get_Or_Create_Configuration_File + begin pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path)); @@ -1472,9 +1472,7 @@ package body Prj.Conf is On_New_Tree_Loaded => null); end if; - if Config_Project_Node = Empty_Node - or else Config = No_Project - then + if Config_Project_Node = Empty_Node or else Config = No_Project then Raise_Invalid_Config ("processing of configuration project """ & Config_File_Path.all & """ failed"); @@ -1606,7 +1604,6 @@ package body Prj.Conf is Implicit_Project => Implicit_Project); if User_Project_Node = Empty_Node then - User_Project_Node := Empty_Node; return; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7906041d08b..56c1e6dd1c9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -11021,7 +11021,6 @@ package body Sem_Attr is else Assoc := First (Component_Associations (Aggr)); - while Present (Assoc) loop Comp := First (Choices (Assoc)); Expr := Expression (Assoc); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 595a3b0a8b4..d88dcc29afd 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -954,10 +954,19 @@ package body Sem_Ch12 is -- In Ada 2005, indicates partial parameterization of a formal -- package. As usual an other association must be last in the list. - function Build_Wrapper + function Build_Function_Wrapper (Formal : Entity_Id; Actual : Entity_Id := Empty) return Node_Id; - -- In GNATProve mode, create a wrapper function for actuals that are + -- In GNATprove mode, create a wrapper function for actuals that are + -- functions with any number of formal parameters, in order to propagate + -- their contract to the renaming declarations generated for them. + -- If the actual is absent, the formal has a default, and the name of + -- the function is that of the formal. + + function Build_Operator_Wrapper + (Formal : Entity_Id; + Actual : Entity_Id := Empty) return Node_Id; + -- In GNATprove mode, create a wrapper function for actuals that are -- operators, in order to propagate their contract to the renaming -- declarations generated for them. If the actual is absent, this is -- a formal with a default, and the name of the operator is that of the @@ -1010,11 +1019,84 @@ package body Sem_Ch12 is -- anonymous types, the presence a formal equality will introduce an -- implicit declaration for the corresponding inequality. - ------------------- - -- Build_Wrapper -- - ------------------- + ---------------------------- + -- Build_Function_Wrapper -- + ---------------------------- - function Build_Wrapper + function Build_Function_Wrapper + (Formal : Entity_Id; + Actual : Entity_Id := Empty) return Node_Id + is + Loc : constant Source_Ptr := Sloc (I_Node); + Actuals : List_Id; + Decl : Node_Id; + Func_Name : Node_Id; + Func : Entity_Id; + N_Parms : Natural; + Profile : List_Id; + Spec : Node_Id; + F : Entity_Id; + New_F : Entity_Id; + + begin + -- If there is no actual, the formal has a default and is retrieved + -- by name. Otherwise the wrapper encloses a call to the actual. + + if No (Actual) then + Func_Name := Make_Identifier (Loc, Chars (Formal)); + else + Func_Name := New_Occurrence_Of (Entity (Actual), Loc); + end if; + + Func := Make_Defining_Identifier (Loc, Chars (Formal)); + Set_Ekind (Func, E_Function); + Set_Is_Generic_Actual_Subprogram (Func); + + Actuals := New_List; + Profile := New_List; + + F := First_Formal (Formal); + N_Parms := 0; + while Present (F) loop + + -- Create new formal for profile of wrapper, and add a reference + -- to it in the list of actuals for the enclosing call. + + New_F := Make_Temporary + (Loc, Character'Val (Character'Pos ('A') + N_Parms)); + Append_To (Profile, + Make_Parameter_Specification (Loc, + Defining_Identifier => New_F, + Parameter_Type => + Make_Identifier (Loc, Chars => Chars (Etype (F))))); + + Append_To (Actuals, New_Occurrence_Of (New_F, Loc)); + Next_Formal (F); + N_Parms := N_Parms + 1; + end loop; + + Spec := + Make_Function_Specification (Loc, + Defining_Unit_Name => Func, + Parameter_Specifications => Profile, + Result_Definition => + Make_Identifier (Loc, Chars (Etype (Formal)))); + Decl := + Make_Expression_Function (Loc, + Specification => Spec, + Expression => + Make_Function_Call (Loc, + Name => Func_Name, + Parameter_Associations => Actuals)); + + return Decl; + end Build_Function_Wrapper; + + ---------------------------- + -- Build_Operator_Wrapper -- + ---------------------------- + + function Build_Operator_Wrapper (Formal : Entity_Id; Actual : Entity_Id := Empty) return Node_Id is @@ -1029,8 +1111,7 @@ package body Sem_Ch12 is Func : Entity_Id; Op_Name : Name_Id; Spec : Node_Id; - - L, R : Node_Id; + L, R : Node_Id; begin if No (Actual) then @@ -1089,52 +1170,52 @@ package body Sem_Ch12 is elsif Is_Binary then if Op_Name = Name_Op_And then - Expr := Make_Op_And (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_And (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Or then - Expr := Make_Op_Or (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Or (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Xor then - Expr := Make_Op_Xor (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Xor (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Eq then - Expr := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Ne then - Expr := Make_Op_Ne (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Ne (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Le then - Expr := Make_Op_Le (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Le (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Gt then - Expr := Make_Op_Gt (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Gt (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Ge then - Expr := Make_Op_Ge (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Ge (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Lt then - Expr := Make_Op_Lt (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Lt (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Add then - Expr := Make_Op_Add (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Add (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Subtract then Expr := Make_Op_Subtract (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Concat then - Expr := Make_Op_Concat (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Concat (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Multiply then Expr := Make_Op_Multiply (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Divide then - Expr := Make_Op_Divide (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Divide (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Mod then - Expr := Make_Op_Mod (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Mod (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Rem then - Expr := Make_Op_Rem (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Rem (Loc, Left_Opnd => L, Right_Opnd => R); elsif Op_Name = Name_Op_Expon then - Expr := Make_Op_Expon (Loc, Left_Opnd => L, Right_Opnd => R); + Expr := Make_Op_Expon (Loc, Left_Opnd => L, Right_Opnd => R); end if; -- Unary operators else if Op_Name = Name_Op_Add then - Expr := Make_Op_Plus (Loc, Right_Opnd => L); + Expr := Make_Op_Plus (Loc, Right_Opnd => L); elsif Op_Name = Name_Op_Subtract then Expr := Make_Op_Minus (Loc, Right_Opnd => L); elsif Op_Name = Name_Op_Abs then - Expr := Make_Op_Abs (Loc, Right_Opnd => L); + Expr := Make_Op_Abs (Loc, Right_Opnd => L); elsif Op_Name = Name_Op_Not then - Expr := Make_Op_Not (Loc, Right_Opnd => L); + Expr := Make_Op_Not (Loc, Right_Opnd => L); end if; end if; @@ -1151,7 +1232,7 @@ package body Sem_Ch12 is Expression => Expr); return Decl; - end Build_Wrapper; + end Build_Operator_Wrapper; ---------------------------------------- -- Check_Overloaded_Formal_Subprogram -- @@ -1694,13 +1775,13 @@ package body Sem_Ch12 is Append_To (Assoc, - Build_Wrapper + Build_Operator_Wrapper (Defining_Entity (Analyzed_Formal), Match)); else Append_To (Assoc, - Instantiate_Formal_Subprogram - (Formal, Match, Analyzed_Formal)); + Build_Function_Wrapper + (Defining_Entity (Analyzed_Formal), Match)); end if; -- Ditto if formal is an operator with a default. @@ -1710,15 +1791,15 @@ package body Sem_Ch12 is N_Defining_Operator_Symbol then Append_To (Assoc, - Build_Wrapper + Build_Operator_Wrapper (Defining_Entity (Analyzed_Formal))); -- Otherwise create renaming declaration. else Append_To (Assoc, - Instantiate_Formal_Subprogram - (Formal, Match, Analyzed_Formal)); + Build_Function_Wrapper + (Defining_Entity (Analyzed_Formal))); end if; else @@ -9552,10 +9633,13 @@ package body Sem_Ch12 is Loc := Sloc (Defining_Unit_Name (New_Spec)); - -- Create new entity for the actual (New_Copy_Tree does not) + -- Create new entity for the actual (New_Copy_Tree does not), and + -- indicate that it is an actual. Set_Defining_Unit_Name (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub))); + Set_Ekind (Defining_Unit_Name (New_Spec), Ekind (Analyzed_S)); + Set_Is_Generic_Actual_Subprogram (Defining_Unit_Name (New_Spec)); -- Create new entities for the each of the formals in the specification -- of the renaming declaration built for the actual.