+2017-09-06 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch5.adb: Minor reformatting and a typo fix
+
+2017-09-06 Arnaud Charlet <charlet@adacore.com>
+
+ * sinput-l.ads: minor remove extra period at the end of comment
+
+2017-09-06 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_prag.adb (Add_Item_To_Name_Buffer): remove support for
+ E_Discriminant.
+ (Find_Role): remove support for E_Discriminant.
+
+2017-09-06 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch6.adb (Expand_Simple_Function_Return):
+ Add missing implicit type conversion to force displacement of the
+ "this" pointer.
+
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, sem_aux.adb, sem_res.adb: Minor reformatting.
-- the reason for the link is R. Ea_Id is the contents to be placed in the
-- Elab_All_Link of the entry.
- procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id;
- Msg : String);
+ procedure Choose
+ (Elab_Order : in out Unit_Id_Table;
+ Chosen : Unit_Id;
+ Msg : String);
-- Chosen is the next entry chosen in the elaboration order. This procedure
-- updates all data structures appropriately.
-- Choose --
------------
- procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id;
- Msg : String)
+ procedure Choose
+ (Elab_Order : in out Unit_Id_Table;
+ Chosen : Unit_Id;
+ Msg : String)
is
pragma Assert (Chosen /= No_Unit_Id);
S : Successor_Id;
(Errors_Detected > 0 or else Num_Chosen = Last (Elab_Order));
pragma Assert (Units.Last = UNR.Last);
pragma Assert (Num_Chosen + Num_Left = Int (UNR.Last));
+
if Debug_Flag_C then
Write_Str (" ");
Write_Int (Int (Num_Chosen));
then
null;
else
- Choose (Elab_Order, Corresponding_Body (Chosen),
- " [Elaborate_Body]");
+ Choose
+ (Elab_Order => Elab_Order,
+ Chosen => Corresponding_Body (Chosen),
+ Msg => " [Elaborate_Body]");
end if;
end if;
end Choose;
if Pessimistic_Elab_Order or Debug_Flag_Old or Debug_Flag_Older then
pragma Assert
(Last (Elab_Order) = 0
- or else Last (Elab_Order) = Old_Order'Last);
+ or else Last (Elab_Order) = Old_Order'Last);
+
Init (Elab_Order);
Append_All (Elab_Order, Old_Order);
end if;
end if;
if Choose_The_Body then
- Choose (Elab_Order, Corresponding_Body (Best_So_Far),
- " [body]");
+ Choose
+ (Elab_Order => Elab_Order,
+ Chosen => Corresponding_Body (Best_So_Far),
+ Msg => " [body]");
end if;
end;
end if;
Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
+ -- Ada 2005 (AI-251): If the type of the returned object is
+ -- an interface then add an implicit type conversion to force
+ -- displacement of the "this" pointer.
+
+ if Is_Interface (R_Type) then
+ Rewrite (Exp, Convert_To (R_Type, Relocate_Node (Exp)));
+ end if;
+
+ Analyze_And_Resolve (Exp, R_Type);
+
-- For controlled types, do the allocation on the secondary stack
-- manually in order to call adjust at the right time:
declare
Comp_Type : constant Entity_Id := Etype (Comp);
Comp_Size : constant Uint := RM_Size (Comp_Type);
- SSU : constant Int := Ttypes.System_Storage_Unit;
+ SSU : constant Int := Ttypes.System_Storage_Unit;
+
begin
Sized_Component_Total_RM_Size :=
Sized_Component_Total_RM_Size + Comp_Size;
Set_Assignment_Type (Lhs, T1);
- -- If the target of the assignment is an entity of a mutable type
- -- and the expression is a conditional expression, its alternatives
- -- can be of different subtypes of the nominal type of the LHS, so
- -- they must be resolved with the base type, given that their subtype
- -- may differ frok that of the target mutable object.
+ -- If the target of the assignment is an entity of a mutable type and
+ -- the expression is a conditional expression, its alternatives can be
+ -- of different subtypes of the nominal type of the LHS, so they must be
+ -- resolved with the base type, given that their subtype may differ from
+ -- that of the target mutable object.
if Is_Entity_Name (Lhs)
- and then Ekind_In (Entity (Lhs),
- E_Variable,
- E_Out_Parameter,
- E_In_Out_Parameter)
+ and then Ekind_In (Entity (Lhs), E_In_Out_Parameter,
+ E_Out_Parameter,
+ E_Variable)
and then Is_Composite_Type (T1)
and then not Is_Constrained (Etype (Entity (Lhs)))
and then Nkind_In (Rhs, N_If_Expression, N_Case_Expression)
-- to the name buffer. The individual kinds are as follows:
-- E_Abstract_State - "state"
-- E_Constant - "constant"
- -- E_Discriminant - "discriminant"
-- E_Generic_In_Out_Parameter - "generic parameter"
-- E_Generic_In_Parameter - "generic parameter"
-- E_In_Parameter - "parameter"
elsif Ekind (Item_Id) = E_Constant then
Add_Str_To_Name_Buffer ("constant");
- elsif Ekind (Item_Id) = E_Discriminant then
- Add_Str_To_Name_Buffer ("discriminant");
-
elsif Ekind_In (Item_Id, E_Generic_In_Out_Parameter,
E_Generic_In_Parameter)
then
else
SPARK_Msg_N
("item must denote parameter, variable, state or "
- & "current instance of concurren type", Item);
+ & "current instance of concurrent type", Item);
end if;
-- All other input/output items are illegal
-- Constants
elsif Ekind_In (Item_Id, E_Constant,
- E_Discriminant,
E_Loop_Parameter)
then
Item_Is_Input := True;
function Source_File_Is_Body (X : Source_File_Index) return Boolean;
-- Returns true if the designated source file contains a subprogram body
-- or a package body. This is a limited scan just to determine the answer
- -- to this question..
+ -- to this question.
function Source_File_Is_No_Body (X : Source_File_Index) return Boolean;
-- Returns true if the designated source file contains pragma No_Body;
projects / gcc.git / commitdiff