Commit 8b64ed4c by Thomas Quinot Committed by Arnaud Charlet

sem_ch13.adb: Complete previous change.

2014-11-20  Thomas Quinot  <quinot@adacore.com>

	* 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
	unconstrained formals.

From-SVN: r217845
parent 5e9d6f05
2014-11-20 Thomas Quinot <quinot@adacore.com>
* 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
unconstrained formals.
2014-11-20 Robert Dewar <dewar@adacore.com> 2014-11-20 Robert Dewar <dewar@adacore.com>
* freeze.adb, exp_dbug.adb, sem_ch13.adb: Minor reformatting. * freeze.adb, exp_dbug.adb, sem_ch13.adb: Minor reformatting.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -146,14 +146,17 @@ package Exp_Dist is ...@@ -146,14 +146,17 @@ package Exp_Dist is
-- declaration is appended to Decls. -- declaration is appended to Decls.
function Build_To_Any_Call function Build_To_Any_Call
(Loc : Source_Ptr; (Loc : Source_Ptr;
N : Node_Id; N : Node_Id;
Decls : List_Id) return Node_Id; Decls : List_Id;
Constrained : Boolean := False) return Node_Id;
-- Build call to To_Any attribute function with expression as actual -- Build call to To_Any attribute function with expression as actual
-- parameter. Loc is the reference location for generated nodes, Decls is -- parameter. Loc is the reference location for generated nodes, Decls is
-- the declarations list for an appropriate enclosing scope of the point -- the declarations list for an appropriate enclosing scope of the point
-- where the call will be inserted; if the To_Any attribute for Typ needs -- where the call will be inserted; if the To_Any attribute for Typ needs
-- to be generated at this point, its declaration is appended to Decls. -- to be generated at this point, its declaration is appended to Decls.
-- For limited types, if Constrained is True then use 'Write else use
-- 'Output.
function Build_TypeCode_Call function Build_TypeCode_Call
(Loc : Source_Ptr; (Loc : Source_Ptr;
......
...@@ -10912,11 +10912,14 @@ package body Sem_Ch13 is ...@@ -10912,11 +10912,14 @@ package body Sem_Ch13 is
end if; end if;
end if; end if;
-- Scalar_Storage_Order (first subtypes only) -- Scalar_Storage_Order
-- Note: the aspect is specified on a first subtype, but recorded
-- in a flag of the base type!
if (Is_Record_Type (Typ) or else Is_Array_Type (Typ)) if (Is_Record_Type (Typ) or else Is_Array_Type (Typ))
and then and then
Is_First_Subtype (Typ) Typ = Bas_Typ
then then
-- For a type extension, always inherit from parent; otherwise -- For a type extension, always inherit from parent; otherwise
...@@ -10924,7 +10927,8 @@ package body Sem_Ch13 is ...@@ -10924,7 +10927,8 @@ package body Sem_Ch13 is
-- an explicit rep item on the parent type when inheriting, -- an explicit rep item on the parent type when inheriting,
-- because the parent SSO may itself have been set by default. -- because the parent SSO may itself have been set by default.
if not Has_Rep_Item (Typ, Name_Scalar_Storage_Order, False) if not Has_Rep_Item (First_Subtype (Typ),
Name_Scalar_Storage_Order, False)
and then (Is_Tagged_Type (Bas_Typ) and then (Is_Tagged_Type (Bas_Typ)
or else or else
not (SSO_Set_Low_By_Default (Bas_Typ) not (SSO_Set_Low_By_Default (Bas_Typ)
...@@ -10932,7 +10936,7 @@ package body Sem_Ch13 is ...@@ -10932,7 +10936,7 @@ package body Sem_Ch13 is
SSO_Set_High_By_Default (Bas_Typ))) SSO_Set_High_By_Default (Bas_Typ)))
then then
Set_Reverse_Storage_Order (Bas_Typ, Set_Reverse_Storage_Order (Bas_Typ,
Reverse_Storage_Order (First_Subtype (Etype (Bas_Typ)))); Reverse_Storage_Order (Base_Type (Etype (Bas_Typ))));
-- Clear default SSO indications, since the inherited aspect -- Clear default SSO indications, since the inherited aspect
-- which was set explicitly overrides the default. -- which was set explicitly overrides the default.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment