[multiple changes]
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com> * sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs for subunit in generic units. 2015-05-12 Robert Dewar <dewar@adacore.com> * sem_elab.adb (Check_A_Call): Avoid checking internal call from Valid_Scalars 2015-05-12 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Process_Formals): An untagged incomplete type is legal in the profile of a null procedure. 2015-05-12 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly the checks on a derived formal whose parent type is a previous formal that is not a derived type. 2015-05-12 Robert Dewar <dewar@adacore.com> * aspects.ads, aspects.adb: Add entries for aspect Volatile_Full_Access * einfo.adb (Has_Volatile_Full_Access): New flag. (Has_Volatile_Full_Access): New flag. * einfo.ads (Has_Volatile_Full_Access): New flag. * par-prag.adb: Add dummy entry for Volatile_Full_Access. * sem_prag.adb (Analyze_Pragma, case Volatile_Full_Access): Implement new pragma. * snames.ads-tmpl: Add entries for pragma Volatile_Full_Access. 2015-05-12 Robert Dewar <dewar@adacore.com> * targparm.ads: Minor reformatting. 2015-05-12 Robert Dewar <dewar@adacore.com> * a-reatim.adb (Time_Of): Properly detect overflow when TS = 0.0. * a-reatim.ads: Minor reformatting. From-SVN: r223074
This commit is contained in:
parent
98b5dc6118
commit
c8d3b4ff3f
@ -1,3 +1,44 @@
|
||||
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>
|
||||
|
||||
* sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs
|
||||
for subunit in generic units.
|
||||
|
||||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_elab.adb (Check_A_Call): Avoid checking internal call
|
||||
from Valid_Scalars
|
||||
|
||||
2015-05-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Process_Formals): An untagged incomplete type
|
||||
is legal in the profile of a null procedure.
|
||||
|
||||
2015-05-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly
|
||||
the checks on a derived formal whose parent type is a previous
|
||||
formal that is not a derived type.
|
||||
|
||||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* aspects.ads, aspects.adb: Add entries for aspect Volatile_Full_Access
|
||||
* einfo.adb (Has_Volatile_Full_Access): New flag.
|
||||
(Has_Volatile_Full_Access): New flag.
|
||||
* einfo.ads (Has_Volatile_Full_Access): New flag.
|
||||
* par-prag.adb: Add dummy entry for Volatile_Full_Access.
|
||||
* sem_prag.adb (Analyze_Pragma, case Volatile_Full_Access):
|
||||
Implement new pragma.
|
||||
* snames.ads-tmpl: Add entries for pragma Volatile_Full_Access.
|
||||
|
||||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* targparm.ads: Minor reformatting.
|
||||
|
||||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* a-reatim.adb (Time_Of): Properly detect overflow when TS = 0.0.
|
||||
* a-reatim.ads: Minor reformatting.
|
||||
|
||||
2015-05-12 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* einfo.ads: Update the documentation of flags
|
||||
|
@ -228,6 +228,28 @@ package body Ada.Real_Time is
|
||||
|
||||
function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
|
||||
begin
|
||||
-- Simple case first, TS = 0.0, we need to make sure SC is in range
|
||||
|
||||
if TS = 0.0 then
|
||||
if SC >= Seconds_Count (Duration (Time_Span_First) + Duration'(0.5))
|
||||
and then
|
||||
SC <= Seconds_Count (Duration (Time_Span_Last) - Duration'(0.5))
|
||||
then
|
||||
-- Don't need any further checks after that manual check
|
||||
|
||||
declare
|
||||
pragma Suppress (All_Checks);
|
||||
begin
|
||||
return Time (SC);
|
||||
end;
|
||||
|
||||
-- Here we have a Seconds_Count value that is out of range
|
||||
|
||||
else
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- We want to return Time (SC) + TS. To avoid spurious overflows in
|
||||
-- the intermediate result Time (SC) we take advantage of the different
|
||||
-- signs in SC and TS (when that is the case).
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
@ -91,18 +91,23 @@ package Ada.Real_Time is
|
||||
pragma Ada_05 (Minutes);
|
||||
|
||||
type Seconds_Count is new Long_Long_Integer;
|
||||
-- Seconds_Count needs 64 bits, since Time has the full range of
|
||||
-- Seconds_Count needs 64 bits, since the type Time has the full range of
|
||||
-- Duration. The delta of Duration is 10 ** (-9), so the maximum number of
|
||||
-- seconds is 2**63/10**9 = 8*10**9 which does not quite fit in 32 bits.
|
||||
-- However, rather than make this explicitly 64-bits we derive from
|
||||
-- Long_Long_Integer. In normal usage this will have the same effect.
|
||||
-- But in the case of CodePeer with a target configuration file with a
|
||||
-- maximum integer size of 32, it allows analysis of this unit.
|
||||
-- Long_Long_Integer. In normal usage this will have the same effect. But
|
||||
-- in the case of CodePeer with a target configuration file with a maximum
|
||||
-- integer size of 32, it allows analysis of this unit.
|
||||
|
||||
procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span);
|
||||
function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time;
|
||||
|
||||
private
|
||||
-- Time and Time_Span are represented in 64-bit Duration value in
|
||||
-- nanoseconds. For example, 1 second and 1 nanosecond is represented
|
||||
-- as the stored integer 1_000_000_001. This is for the 64-bit Duration
|
||||
-- case, not clear if this also is used for 32-bit Duration values.
|
||||
|
||||
type Time is new Duration;
|
||||
|
||||
Time_First : constant Time := Time'First;
|
||||
@ -122,10 +127,6 @@ private
|
||||
Tick : constant Time_Span :=
|
||||
Time_Span (System.Task_Primitives.Operations.RT_Resolution);
|
||||
|
||||
-- Time and Time_Span are represented in 64-bit Duration value in
|
||||
-- nanoseconds. For example, 1 second and 1 nanosecond is represented
|
||||
-- as the stored integer 1_000_000_001.
|
||||
|
||||
pragma Import (Intrinsic, "<");
|
||||
pragma Import (Intrinsic, "<=");
|
||||
pragma Import (Intrinsic, ">");
|
||||
|
@ -55,6 +55,7 @@ package body Aspects is
|
||||
Aspect_Unchecked_Union => True,
|
||||
Aspect_Variable_Indexing => True,
|
||||
Aspect_Volatile => True,
|
||||
Aspect_Volatile_Full_Access => True,
|
||||
others => False);
|
||||
|
||||
-- The following array indicates type aspects that are inherited and apply
|
||||
@ -606,6 +607,7 @@ package body Aspects is
|
||||
Aspect_Value_Size => Aspect_Value_Size,
|
||||
Aspect_Volatile => Aspect_Volatile,
|
||||
Aspect_Volatile_Components => Aspect_Volatile_Components,
|
||||
Aspect_Volatile_Full_Access => Aspect_Volatile_Full_Access,
|
||||
Aspect_Warnings => Aspect_Warnings,
|
||||
Aspect_Write => Aspect_Write);
|
||||
|
||||
|
@ -201,7 +201,8 @@ package Aspects is
|
||||
Aspect_Unreferenced, -- GNAT
|
||||
Aspect_Unreferenced_Objects, -- GNAT
|
||||
Aspect_Volatile,
|
||||
Aspect_Volatile_Components);
|
||||
Aspect_Volatile_Components,
|
||||
Aspect_Volatile_Full_Access); -- GNAT
|
||||
|
||||
subtype Aspect_Id_Exclude_No_Aspect is
|
||||
Aspect_Id range Aspect_Id'Succ (No_Aspect) .. Aspect_Id'Last;
|
||||
@ -503,6 +504,7 @@ package Aspects is
|
||||
Aspect_Variable_Indexing => Name_Variable_Indexing,
|
||||
Aspect_Volatile => Name_Volatile,
|
||||
Aspect_Volatile_Components => Name_Volatile_Components,
|
||||
Aspect_Volatile_Full_Access => Name_Volatile_Full_Access,
|
||||
Aspect_Warnings => Name_Warnings,
|
||||
Aspect_Write => Name_Write);
|
||||
|
||||
@ -737,7 +739,8 @@ package Aspects is
|
||||
Aspect_Storage_Size => Rep_Aspect,
|
||||
Aspect_Value_Size => Rep_Aspect,
|
||||
Aspect_Volatile => Rep_Aspect,
|
||||
Aspect_Volatile_Components => Rep_Aspect);
|
||||
Aspect_Volatile_Components => Rep_Aspect,
|
||||
Aspect_Volatile_Full_Access => Rep_Aspect);
|
||||
|
||||
------------------------------------------------
|
||||
-- Handling of Aspect Specifications on Stubs --
|
||||
|
@ -591,8 +591,8 @@ package body Einfo is
|
||||
-- Has_Nested_Subprogram Flag282
|
||||
-- Is_Uplevel_Referenced_Entity Flag283
|
||||
-- Is_Unimplemented Flag284
|
||||
-- Has_Volatile_Full_Access Flag285
|
||||
|
||||
-- (unused) Flag285
|
||||
-- (unused) Flag286
|
||||
-- (unused) Flag287
|
||||
-- (unused) Flag288
|
||||
@ -1849,6 +1849,11 @@ package body Einfo is
|
||||
return Flag87 (Implementation_Base_Type (Id));
|
||||
end Has_Volatile_Components;
|
||||
|
||||
function Has_Volatile_Full_Access (Id : E) return B is
|
||||
begin
|
||||
return Flag285 (Id);
|
||||
end Has_Volatile_Full_Access;
|
||||
|
||||
function Has_Xref_Entry (Id : E) return B is
|
||||
begin
|
||||
return Flag182 (Id);
|
||||
@ -4730,6 +4735,11 @@ package body Einfo is
|
||||
Set_Flag87 (Id, V);
|
||||
end Set_Has_Volatile_Components;
|
||||
|
||||
procedure Set_Has_Volatile_Full_Access (Id : E; V : B := True) is
|
||||
begin
|
||||
Set_Flag285 (Id, V);
|
||||
end Set_Has_Volatile_Full_Access;
|
||||
|
||||
procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
|
||||
begin
|
||||
Set_Flag182 (Id, V);
|
||||
@ -8695,6 +8705,7 @@ package body Einfo is
|
||||
W ("Has_Uplevel_Reference", Flag215 (Id));
|
||||
W ("Has_Visible_Refinement", Flag263 (Id));
|
||||
W ("Has_Volatile_Components", Flag87 (Id));
|
||||
W ("Has_Volatile_Full_Access", Flag285 (Id));
|
||||
W ("Has_Xref_Entry", Flag182 (Id));
|
||||
W ("In_Package_Body", Flag48 (Id));
|
||||
W ("In_Private_Part", Flag45 (Id));
|
||||
|
@ -2046,6 +2046,12 @@ package Einfo is
|
||||
-- type the pragma will be chained to the rep item chain of the first
|
||||
-- subtype in the usual manner.
|
||||
|
||||
-- Has_Volatile_Full_Access (Flag285)
|
||||
-- Defined in all type entities, and also in constants, components and
|
||||
-- variables. Set if a pragma Volatile_Full_Access applies to the entity.
|
||||
-- In the case of private and incomplete types, this flag is set in
|
||||
-- both the partial view and the full view.
|
||||
|
||||
-- Has_Xref_Entry (Flag182)
|
||||
-- Defined in all entities. Set if an entity has an entry in the Xref
|
||||
-- information generated in ali files. This is true for all source
|
||||
@ -5412,6 +5418,7 @@ package Einfo is
|
||||
-- Has_Task (Flag30) (base type only)
|
||||
-- Has_Unchecked_Union (Flag123) (base type only)
|
||||
-- Has_Volatile_Components (Flag87) (base type only)
|
||||
-- Has_Volatile_Full_Access (Flag285)
|
||||
-- In_Use (Flag8)
|
||||
-- Is_Abstract_Type (Flag146)
|
||||
-- Is_Asynchronous (Flag81)
|
||||
@ -5423,10 +5430,10 @@ package Einfo is
|
||||
-- Is_Frozen (Flag4)
|
||||
-- Is_Generic_Actual_Type (Flag94)
|
||||
-- Is_Independent (Flag268)
|
||||
-- Is_RACW_Stub_Type (Flag244)
|
||||
-- Is_Non_Static_Subtype (Flag109)
|
||||
-- Is_Packed (Flag51) (base type only)
|
||||
-- Is_Private_Composite (Flag107)
|
||||
-- Is_RACW_Stub_Type (Flag244)
|
||||
-- Is_Unsigned_Type (Flag144)
|
||||
-- Is_Volatile (Flag16)
|
||||
-- Itype_Printed (Flag202) (itypes only)
|
||||
@ -5595,12 +5602,13 @@ package Einfo is
|
||||
-- Related_Type (Node27)
|
||||
-- Has_Biased_Representation (Flag139)
|
||||
-- Has_Per_Object_Constraint (Flag154)
|
||||
-- Has_Volatile_Full_Access (Flag285)
|
||||
-- Is_Atomic (Flag85)
|
||||
-- Is_Independent (Flag268)
|
||||
-- Is_Return_Object (Flag209)
|
||||
-- Is_Tag (Flag78)
|
||||
-- Is_Volatile (Flag16)
|
||||
-- Treat_As_Volatile (Flag41)
|
||||
-- Is_Return_Object (Flag209)
|
||||
-- Next_Component (synth)
|
||||
-- Next_Component_Or_Discriminant (synth)
|
||||
|
||||
@ -5633,6 +5641,7 @@ package Einfo is
|
||||
-- Has_Size_Clause (Flag29)
|
||||
-- Has_Thunks (Flag228) (constants only)
|
||||
-- Has_Volatile_Components (Flag87)
|
||||
-- Has_Volatile_Full_Access (Flag285)
|
||||
-- Is_Atomic (Flag85)
|
||||
-- Is_Eliminated (Flag124)
|
||||
-- Is_Independent (Flag268)
|
||||
@ -5641,9 +5650,9 @@ package Einfo is
|
||||
-- Is_True_Constant (Flag163)
|
||||
-- Is_Uplevel_Referenced_Entity (Flag283)
|
||||
-- Is_Volatile (Flag16)
|
||||
-- Stores_Attribute_Old_Prefix (Flag270) (constants only)
|
||||
-- Optimize_Alignment_Space (Flag241) (constants only)
|
||||
-- Optimize_Alignment_Time (Flag242) (constants only)
|
||||
-- Stores_Attribute_Old_Prefix (Flag270) (constants only)
|
||||
-- Treat_As_Volatile (Flag41)
|
||||
-- Address_Clause (synth)
|
||||
-- Alignment_Clause (synth)
|
||||
@ -6364,16 +6373,17 @@ package Einfo is
|
||||
-- Has_Initial_Value (Flag219)
|
||||
-- Has_Size_Clause (Flag29)
|
||||
-- Has_Volatile_Components (Flag87)
|
||||
-- Has_Volatile_Full_Access (Flag285)
|
||||
-- Is_Atomic (Flag85)
|
||||
-- Is_Eliminated (Flag124)
|
||||
-- Is_Independent (Flag268)
|
||||
-- Is_Processed_Transient (Flag252)
|
||||
-- Is_Return_Object (Flag209)
|
||||
-- Is_Safe_To_Reevaluate (Flag249)
|
||||
-- Is_Shared_Passive (Flag60)
|
||||
-- Is_True_Constant (Flag163)
|
||||
-- Is_Volatile (Flag16)
|
||||
-- Is_Return_Object (Flag209)
|
||||
-- Is_Uplevel_Referenced_Entity (Flag283)
|
||||
-- Is_Volatile (Flag16)
|
||||
-- OK_To_Rename (Flag247)
|
||||
-- Optimize_Alignment_Space (Flag241)
|
||||
-- Optimize_Alignment_Time (Flag242)
|
||||
@ -6630,12 +6640,11 @@ package Einfo is
|
||||
function Associated_Node_For_Itype (Id : E) return N;
|
||||
function Associated_Storage_Pool (Id : E) return E;
|
||||
function Barrier_Function (Id : E) return N;
|
||||
function BIP_Initialization_Call (Id : E) return N;
|
||||
function Block_Node (Id : E) return N;
|
||||
function Body_Entity (Id : E) return E;
|
||||
function Body_Needed_For_SAL (Id : E) return B;
|
||||
function Body_References (Id : E) return L;
|
||||
function BIP_Initialization_Call (Id : E) return N;
|
||||
function CR_Discriminant (Id : E) return E;
|
||||
function C_Pass_By_Copy (Id : E) return B;
|
||||
function Can_Never_Be_Null (Id : E) return B;
|
||||
function Can_Use_Internal_Rep (Id : E) return B;
|
||||
@ -6655,12 +6664,9 @@ package Einfo is
|
||||
function Corresponding_Protected_Entry (Id : E) return E;
|
||||
function Corresponding_Record_Type (Id : E) return E;
|
||||
function Corresponding_Remote_Type (Id : E) return E;
|
||||
function CR_Discriminant (Id : E) return E;
|
||||
function Current_Use_Clause (Id : E) return E;
|
||||
function Current_Value (Id : E) return N;
|
||||
function DTC_Entity (Id : E) return E;
|
||||
function DT_Entry_Count (Id : E) return U;
|
||||
function DT_Offset_To_Top_Func (Id : E) return E;
|
||||
function DT_Position (Id : E) return U;
|
||||
function Debug_Info_Off (Id : E) return B;
|
||||
function Debug_Renaming_Link (Id : E) return E;
|
||||
function Default_Aspect_Component_Value (Id : E) return N;
|
||||
@ -6685,6 +6691,10 @@ package Einfo is
|
||||
function Discriminant_Default_Value (Id : E) return N;
|
||||
function Discriminant_Number (Id : E) return U;
|
||||
function Dispatch_Table_Wrappers (Id : E) return L;
|
||||
function DT_Entry_Count (Id : E) return U;
|
||||
function DT_Offset_To_Top_Func (Id : E) return E;
|
||||
function DT_Position (Id : E) return U;
|
||||
function DTC_Entity (Id : E) return E;
|
||||
function Elaborate_Body_Desirable (Id : E) return B;
|
||||
function Elaboration_Entity (Id : E) return E;
|
||||
function Elaboration_Entity_Required (Id : E) return B;
|
||||
@ -6815,6 +6825,7 @@ package Einfo is
|
||||
function Has_Uplevel_Reference (Id : E) return B;
|
||||
function Has_Visible_Refinement (Id : E) return B;
|
||||
function Has_Volatile_Components (Id : E) return B;
|
||||
function Has_Volatile_Full_Access (Id : E) return B;
|
||||
function Has_Xref_Entry (Id : E) return B;
|
||||
function Hiding_Loop_Variable (Id : E) return E;
|
||||
function Homonym (Id : E) return E;
|
||||
@ -6836,7 +6847,6 @@ package Einfo is
|
||||
function Is_Asynchronous (Id : E) return B;
|
||||
function Is_Atomic (Id : E) return B;
|
||||
function Is_Bit_Packed_Array (Id : E) return B;
|
||||
function Is_CPP_Class (Id : E) return B;
|
||||
function Is_Called (Id : E) return B;
|
||||
function Is_Character_Type (Id : E) return B;
|
||||
function Is_Checked_Ghost_Entity (Id : E) return B;
|
||||
@ -6844,12 +6854,13 @@ package Einfo is
|
||||
function Is_Class_Wide_Equivalent_Type (Id : E) return B;
|
||||
function Is_Compilation_Unit (Id : E) return B;
|
||||
function Is_Completely_Hidden (Id : E) return B;
|
||||
function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;
|
||||
function Is_Constr_Subt_For_U_Nominal (Id : E) return B;
|
||||
function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;
|
||||
function Is_Constrained (Id : E) return B;
|
||||
function Is_Constructor (Id : E) return B;
|
||||
function Is_Controlled (Id : E) return B;
|
||||
function Is_Controlling_Formal (Id : E) return B;
|
||||
function Is_CPP_Class (Id : E) return B;
|
||||
function Is_Default_Init_Cond_Procedure (Id : E) return B;
|
||||
function Is_Descendent_Of_Address (Id : E) return B;
|
||||
function Is_Discrim_SO_Function (Id : E) return B;
|
||||
@ -6976,7 +6987,6 @@ package Einfo is
|
||||
function Original_Record_Component (Id : E) return E;
|
||||
function Overlays_Constant (Id : E) return B;
|
||||
function Overridden_Operation (Id : E) return E;
|
||||
function PPC_Wrapper (Id : E) return E;
|
||||
function Package_Instantiation (Id : E) return N;
|
||||
function Packed_Array_Impl_Type (Id : E) return E;
|
||||
function Parent_Subtype (Id : E) return E;
|
||||
@ -6984,6 +6994,7 @@ package Einfo is
|
||||
function Partial_View_Has_Unknown_Discr (Id : E) return B;
|
||||
function Pending_Access_Types (Id : E) return L;
|
||||
function Postconditions_Proc (Id : E) return E;
|
||||
function PPC_Wrapper (Id : E) return E;
|
||||
function Prival (Id : E) return E;
|
||||
function Prival_Link (Id : E) return E;
|
||||
function Private_Dependents (Id : E) return L;
|
||||
@ -6991,7 +7002,6 @@ package Einfo is
|
||||
function Protected_Body_Subprogram (Id : E) return E;
|
||||
function Protected_Formal (Id : E) return E;
|
||||
function Protection_Object (Id : E) return E;
|
||||
function RM_Size (Id : E) return U;
|
||||
function Reachable (Id : E) return B;
|
||||
function Referenced (Id : E) return B;
|
||||
function Referenced_As_LHS (Id : E) return B;
|
||||
@ -7014,6 +7024,7 @@ package Einfo is
|
||||
function Returns_Limited_View (Id : E) return B;
|
||||
function Reverse_Bit_Order (Id : E) return B;
|
||||
function Reverse_Storage_Order (Id : E) return B;
|
||||
function RM_Size (Id : E) return U;
|
||||
function Scalar_Range (Id : E) return N;
|
||||
function Scale_Value (Id : E) return U;
|
||||
function Scope_Depth_Value (Id : E) return U;
|
||||
@ -7031,9 +7042,9 @@ package Einfo is
|
||||
function Spec_Entity (Id : E) return E;
|
||||
function SSO_Set_High_By_Default (Id : E) return B;
|
||||
function SSO_Set_Low_By_Default (Id : E) return B;
|
||||
function Static_Discrete_Predicate (Id : E) return S;
|
||||
function Static_Elaboration_Desired (Id : E) return B;
|
||||
function Static_Initialization (Id : E) return N;
|
||||
function Static_Discrete_Predicate (Id : E) return S;
|
||||
function Static_Real_Or_String_Predicate (Id : E) return N;
|
||||
function Status_Flag_Or_Transient_Decl (Id : E) return E;
|
||||
function Storage_Size_Variable (Id : E) return E;
|
||||
@ -7282,12 +7293,11 @@ package Einfo is
|
||||
procedure Set_Associated_Node_For_Itype (Id : E; V : N);
|
||||
procedure Set_Associated_Storage_Pool (Id : E; V : E);
|
||||
procedure Set_Barrier_Function (Id : E; V : N);
|
||||
procedure Set_BIP_Initialization_Call (Id : E; V : N);
|
||||
procedure Set_Block_Node (Id : E; V : N);
|
||||
procedure Set_Body_Entity (Id : E; V : E);
|
||||
procedure Set_Body_Needed_For_SAL (Id : E; V : B := True);
|
||||
procedure Set_Body_References (Id : E; V : L);
|
||||
procedure Set_BIP_Initialization_Call (Id : E; V : N);
|
||||
procedure Set_CR_Discriminant (Id : E; V : E);
|
||||
procedure Set_C_Pass_By_Copy (Id : E; V : B := True);
|
||||
procedure Set_Can_Never_Be_Null (Id : E; V : B := True);
|
||||
procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True);
|
||||
@ -7307,12 +7317,9 @@ package Einfo is
|
||||
procedure Set_Corresponding_Protected_Entry (Id : E; V : E);
|
||||
procedure Set_Corresponding_Record_Type (Id : E; V : E);
|
||||
procedure Set_Corresponding_Remote_Type (Id : E; V : E);
|
||||
procedure Set_CR_Discriminant (Id : E; V : E);
|
||||
procedure Set_Current_Use_Clause (Id : E; V : E);
|
||||
procedure Set_Current_Value (Id : E; V : N);
|
||||
procedure Set_DTC_Entity (Id : E; V : E);
|
||||
procedure Set_DT_Entry_Count (Id : E; V : U);
|
||||
procedure Set_DT_Offset_To_Top_Func (Id : E; V : E);
|
||||
procedure Set_DT_Position (Id : E; V : U);
|
||||
procedure Set_Debug_Info_Off (Id : E; V : B := True);
|
||||
procedure Set_Debug_Renaming_Link (Id : E; V : E);
|
||||
procedure Set_Default_Aspect_Component_Value (Id : E; V : N);
|
||||
@ -7337,6 +7344,10 @@ package Einfo is
|
||||
procedure Set_Discriminant_Default_Value (Id : E; V : N);
|
||||
procedure Set_Discriminant_Number (Id : E; V : U);
|
||||
procedure Set_Dispatch_Table_Wrappers (Id : E; V : L);
|
||||
procedure Set_DT_Entry_Count (Id : E; V : U);
|
||||
procedure Set_DT_Offset_To_Top_Func (Id : E; V : E);
|
||||
procedure Set_DT_Position (Id : E; V : U);
|
||||
procedure Set_DTC_Entity (Id : E; V : E);
|
||||
procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True);
|
||||
procedure Set_Elaboration_Entity (Id : E; V : E);
|
||||
procedure Set_Elaboration_Entity_Required (Id : E; V : B := True);
|
||||
@ -7465,6 +7476,7 @@ package Einfo is
|
||||
procedure Set_Has_Uplevel_Reference (Id : E; V : B := True);
|
||||
procedure Set_Has_Visible_Refinement (Id : E; V : B := True);
|
||||
procedure Set_Has_Volatile_Components (Id : E; V : B := True);
|
||||
procedure Set_Has_Volatile_Full_Access (Id : E; V : B := True);
|
||||
procedure Set_Has_Xref_Entry (Id : E; V : B := True);
|
||||
procedure Set_Hiding_Loop_Variable (Id : E; V : E);
|
||||
procedure Set_Homonym (Id : E; V : E);
|
||||
@ -7486,7 +7498,6 @@ package Einfo is
|
||||
procedure Set_Is_Asynchronous (Id : E; V : B := True);
|
||||
procedure Set_Is_Atomic (Id : E; V : B := True);
|
||||
procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True);
|
||||
procedure Set_Is_CPP_Class (Id : E; V : B := True);
|
||||
procedure Set_Is_Called (Id : E; V : B := True);
|
||||
procedure Set_Is_Character_Type (Id : E; V : B := True);
|
||||
procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True);
|
||||
@ -7495,12 +7506,13 @@ package Einfo is
|
||||
procedure Set_Is_Compilation_Unit (Id : E; V : B := True);
|
||||
procedure Set_Is_Completely_Hidden (Id : E; V : B := True);
|
||||
procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True);
|
||||
procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);
|
||||
procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True);
|
||||
procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);
|
||||
procedure Set_Is_Constrained (Id : E; V : B := True);
|
||||
procedure Set_Is_Constructor (Id : E; V : B := True);
|
||||
procedure Set_Is_Controlled (Id : E; V : B := True);
|
||||
procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
|
||||
procedure Set_Is_CPP_Class (Id : E; V : B := True);
|
||||
procedure Set_Is_Default_Init_Cond_Procedure (Id : E; V : B := True);
|
||||
procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True);
|
||||
procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
|
||||
@ -7632,7 +7644,6 @@ package Einfo is
|
||||
procedure Set_Original_Record_Component (Id : E; V : E);
|
||||
procedure Set_Overlays_Constant (Id : E; V : B := True);
|
||||
procedure Set_Overridden_Operation (Id : E; V : E);
|
||||
procedure Set_PPC_Wrapper (Id : E; V : E);
|
||||
procedure Set_Package_Instantiation (Id : E; V : N);
|
||||
procedure Set_Packed_Array_Impl_Type (Id : E; V : E);
|
||||
procedure Set_Parent_Subtype (Id : E; V : E);
|
||||
@ -7640,6 +7651,7 @@ package Einfo is
|
||||
procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True);
|
||||
procedure Set_Pending_Access_Types (Id : E; V : L);
|
||||
procedure Set_Postconditions_Proc (Id : E; V : E);
|
||||
procedure Set_PPC_Wrapper (Id : E; V : E);
|
||||
procedure Set_Prival (Id : E; V : E);
|
||||
procedure Set_Prival_Link (Id : E; V : E);
|
||||
procedure Set_Private_Dependents (Id : E; V : L);
|
||||
@ -7647,7 +7659,6 @@ package Einfo is
|
||||
procedure Set_Protected_Body_Subprogram (Id : E; V : E);
|
||||
procedure Set_Protected_Formal (Id : E; V : E);
|
||||
procedure Set_Protection_Object (Id : E; V : E);
|
||||
procedure Set_RM_Size (Id : E; V : U);
|
||||
procedure Set_Reachable (Id : E; V : B := True);
|
||||
procedure Set_Referenced (Id : E; V : B := True);
|
||||
procedure Set_Referenced_As_LHS (Id : E; V : B := True);
|
||||
@ -7670,6 +7681,7 @@ package Einfo is
|
||||
procedure Set_Returns_Limited_View (Id : E; V : B := True);
|
||||
procedure Set_Reverse_Bit_Order (Id : E; V : B := True);
|
||||
procedure Set_Reverse_Storage_Order (Id : E; V : B := True);
|
||||
procedure Set_RM_Size (Id : E; V : U);
|
||||
procedure Set_Scalar_Range (Id : E; V : N);
|
||||
procedure Set_Scale_Value (Id : E; V : U);
|
||||
procedure Set_Scope_Depth_Value (Id : E; V : U);
|
||||
@ -7687,9 +7699,9 @@ package Einfo is
|
||||
procedure Set_Spec_Entity (Id : E; V : E);
|
||||
procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True);
|
||||
procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True);
|
||||
procedure Set_Static_Discrete_Predicate (Id : E; V : S);
|
||||
procedure Set_Static_Elaboration_Desired (Id : E; V : B);
|
||||
procedure Set_Static_Initialization (Id : E; V : N);
|
||||
procedure Set_Static_Discrete_Predicate (Id : E; V : S);
|
||||
procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N);
|
||||
procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E);
|
||||
procedure Set_Storage_Size_Variable (Id : E; V : E);
|
||||
@ -8055,12 +8067,11 @@ package Einfo is
|
||||
pragma Inline (Associated_Node_For_Itype);
|
||||
pragma Inline (Associated_Storage_Pool);
|
||||
pragma Inline (Barrier_Function);
|
||||
pragma Inline (BIP_Initialization_Call);
|
||||
pragma Inline (Block_Node);
|
||||
pragma Inline (Body_Entity);
|
||||
pragma Inline (Body_Needed_For_SAL);
|
||||
pragma Inline (Body_References);
|
||||
pragma Inline (BIP_Initialization_Call);
|
||||
pragma Inline (CR_Discriminant);
|
||||
pragma Inline (C_Pass_By_Copy);
|
||||
pragma Inline (Can_Never_Be_Null);
|
||||
pragma Inline (Can_Use_Internal_Rep);
|
||||
@ -8079,12 +8090,9 @@ package Einfo is
|
||||
pragma Inline (Corresponding_Protected_Entry);
|
||||
pragma Inline (Corresponding_Record_Type);
|
||||
pragma Inline (Corresponding_Remote_Type);
|
||||
pragma Inline (CR_Discriminant);
|
||||
pragma Inline (Current_Use_Clause);
|
||||
pragma Inline (Current_Value);
|
||||
pragma Inline (DTC_Entity);
|
||||
pragma Inline (DT_Entry_Count);
|
||||
pragma Inline (DT_Offset_To_Top_Func);
|
||||
pragma Inline (DT_Position);
|
||||
pragma Inline (Debug_Info_Off);
|
||||
pragma Inline (Debug_Renaming_Link);
|
||||
pragma Inline (Default_Aspect_Component_Value);
|
||||
@ -8109,6 +8117,10 @@ package Einfo is
|
||||
pragma Inline (Discriminant_Default_Value);
|
||||
pragma Inline (Discriminant_Number);
|
||||
pragma Inline (Dispatch_Table_Wrappers);
|
||||
pragma Inline (DT_Entry_Count);
|
||||
pragma Inline (DT_Offset_To_Top_Func);
|
||||
pragma Inline (DT_Position);
|
||||
pragma Inline (DTC_Entity);
|
||||
pragma Inline (Elaborate_Body_Desirable);
|
||||
pragma Inline (Elaboration_Entity);
|
||||
pragma Inline (Elaboration_Entity_Required);
|
||||
@ -8236,6 +8248,7 @@ package Einfo is
|
||||
pragma Inline (Has_Uplevel_Reference);
|
||||
pragma Inline (Has_Visible_Refinement);
|
||||
pragma Inline (Has_Volatile_Components);
|
||||
pragma Inline (Has_Volatile_Full_Access);
|
||||
pragma Inline (Has_Xref_Entry);
|
||||
pragma Inline (Hiding_Loop_Variable);
|
||||
pragma Inline (Homonym);
|
||||
@ -8262,7 +8275,6 @@ package Einfo is
|
||||
pragma Inline (Is_Asynchronous);
|
||||
pragma Inline (Is_Atomic);
|
||||
pragma Inline (Is_Bit_Packed_Array);
|
||||
pragma Inline (Is_CPP_Class);
|
||||
pragma Inline (Is_Called);
|
||||
pragma Inline (Is_Character_Type);
|
||||
pragma Inline (Is_Checked_Ghost_Entity);
|
||||
@ -8275,12 +8287,13 @@ package Einfo is
|
||||
pragma Inline (Is_Concurrent_Body);
|
||||
pragma Inline (Is_Concurrent_Record_Type);
|
||||
pragma Inline (Is_Concurrent_Type);
|
||||
pragma Inline (Is_Constr_Subt_For_UN_Aliased);
|
||||
pragma Inline (Is_Constr_Subt_For_U_Nominal);
|
||||
pragma Inline (Is_Constr_Subt_For_UN_Aliased);
|
||||
pragma Inline (Is_Constrained);
|
||||
pragma Inline (Is_Constructor);
|
||||
pragma Inline (Is_Controlled);
|
||||
pragma Inline (Is_Controlling_Formal);
|
||||
pragma Inline (Is_CPP_Class);
|
||||
pragma Inline (Is_Decimal_Fixed_Point_Type);
|
||||
pragma Inline (Is_Default_Init_Cond_Procedure);
|
||||
pragma Inline (Is_Descendent_Of_Address);
|
||||
@ -8444,7 +8457,6 @@ package Einfo is
|
||||
pragma Inline (Original_Record_Component);
|
||||
pragma Inline (Overlays_Constant);
|
||||
pragma Inline (Overridden_Operation);
|
||||
pragma Inline (PPC_Wrapper);
|
||||
pragma Inline (Package_Instantiation);
|
||||
pragma Inline (Packed_Array_Impl_Type);
|
||||
pragma Inline (Parameter_Mode);
|
||||
@ -8453,6 +8465,7 @@ package Einfo is
|
||||
pragma Inline (Partial_View_Has_Unknown_Discr);
|
||||
pragma Inline (Pending_Access_Types);
|
||||
pragma Inline (Postconditions_Proc);
|
||||
pragma Inline (PPC_Wrapper);
|
||||
pragma Inline (Prival);
|
||||
pragma Inline (Prival_Link);
|
||||
pragma Inline (Private_Dependents);
|
||||
@ -8460,7 +8473,6 @@ package Einfo is
|
||||
pragma Inline (Protected_Body_Subprogram);
|
||||
pragma Inline (Protected_Formal);
|
||||
pragma Inline (Protection_Object);
|
||||
pragma Inline (RM_Size);
|
||||
pragma Inline (Reachable);
|
||||
pragma Inline (Referenced);
|
||||
pragma Inline (Referenced_As_LHS);
|
||||
@ -8483,6 +8495,7 @@ package Einfo is
|
||||
pragma Inline (Returns_Limited_View);
|
||||
pragma Inline (Reverse_Bit_Order);
|
||||
pragma Inline (Reverse_Storage_Order);
|
||||
pragma Inline (RM_Size);
|
||||
pragma Inline (Scalar_Range);
|
||||
pragma Inline (Scale_Value);
|
||||
pragma Inline (Scope_Depth_Value);
|
||||
@ -8500,9 +8513,9 @@ package Einfo is
|
||||
pragma Inline (Spec_Entity);
|
||||
pragma Inline (SSO_Set_High_By_Default);
|
||||
pragma Inline (SSO_Set_Low_By_Default);
|
||||
pragma Inline (Static_Discrete_Predicate);
|
||||
pragma Inline (Static_Elaboration_Desired);
|
||||
pragma Inline (Static_Initialization);
|
||||
pragma Inline (Static_Discrete_Predicate);
|
||||
pragma Inline (Static_Real_Or_String_Predicate);
|
||||
pragma Inline (Status_Flag_Or_Transient_Decl);
|
||||
pragma Inline (Storage_Size_Variable);
|
||||
@ -8554,12 +8567,11 @@ package Einfo is
|
||||
pragma Inline (Set_Associated_Node_For_Itype);
|
||||
pragma Inline (Set_Associated_Storage_Pool);
|
||||
pragma Inline (Set_Barrier_Function);
|
||||
pragma Inline (Set_BIP_Initialization_Call);
|
||||
pragma Inline (Set_Block_Node);
|
||||
pragma Inline (Set_Body_Entity);
|
||||
pragma Inline (Set_Body_Needed_For_SAL);
|
||||
pragma Inline (Set_Body_References);
|
||||
pragma Inline (Set_BIP_Initialization_Call);
|
||||
pragma Inline (Set_CR_Discriminant);
|
||||
pragma Inline (Set_C_Pass_By_Copy);
|
||||
pragma Inline (Set_Can_Never_Be_Null);
|
||||
pragma Inline (Set_Can_Use_Internal_Rep);
|
||||
@ -8578,12 +8590,9 @@ package Einfo is
|
||||
pragma Inline (Set_Corresponding_Protected_Entry);
|
||||
pragma Inline (Set_Corresponding_Record_Type);
|
||||
pragma Inline (Set_Corresponding_Remote_Type);
|
||||
pragma Inline (Set_CR_Discriminant);
|
||||
pragma Inline (Set_Current_Use_Clause);
|
||||
pragma Inline (Set_Current_Value);
|
||||
pragma Inline (Set_DTC_Entity);
|
||||
pragma Inline (Set_DT_Entry_Count);
|
||||
pragma Inline (Set_DT_Offset_To_Top_Func);
|
||||
pragma Inline (Set_DT_Position);
|
||||
pragma Inline (Set_Debug_Info_Off);
|
||||
pragma Inline (Set_Debug_Renaming_Link);
|
||||
pragma Inline (Set_Default_Aspect_Component_Value);
|
||||
@ -8608,6 +8617,10 @@ package Einfo is
|
||||
pragma Inline (Set_Discriminant_Default_Value);
|
||||
pragma Inline (Set_Discriminant_Number);
|
||||
pragma Inline (Set_Dispatch_Table_Wrappers);
|
||||
pragma Inline (Set_DT_Entry_Count);
|
||||
pragma Inline (Set_DT_Offset_To_Top_Func);
|
||||
pragma Inline (Set_DT_Position);
|
||||
pragma Inline (Set_DTC_Entity);
|
||||
pragma Inline (Set_Elaborate_Body_Desirable);
|
||||
pragma Inline (Set_Elaboration_Entity);
|
||||
pragma Inline (Set_Elaboration_Entity_Required);
|
||||
@ -8732,6 +8745,7 @@ package Einfo is
|
||||
pragma Inline (Set_Has_Unknown_Discriminants);
|
||||
pragma Inline (Set_Has_Visible_Refinement);
|
||||
pragma Inline (Set_Has_Volatile_Components);
|
||||
pragma Inline (Set_Has_Volatile_Full_Access);
|
||||
pragma Inline (Set_Has_Xref_Entry);
|
||||
pragma Inline (Set_Hiding_Loop_Variable);
|
||||
pragma Inline (Set_Homonym);
|
||||
@ -8752,7 +8766,6 @@ package Einfo is
|
||||
pragma Inline (Set_Is_Asynchronous);
|
||||
pragma Inline (Set_Is_Atomic);
|
||||
pragma Inline (Set_Is_Bit_Packed_Array);
|
||||
pragma Inline (Set_Is_CPP_Class);
|
||||
pragma Inline (Set_Is_Called);
|
||||
pragma Inline (Set_Is_Character_Type);
|
||||
pragma Inline (Set_Is_Checked_Ghost_Entity);
|
||||
@ -8761,12 +8774,13 @@ package Einfo is
|
||||
pragma Inline (Set_Is_Compilation_Unit);
|
||||
pragma Inline (Set_Is_Completely_Hidden);
|
||||
pragma Inline (Set_Is_Concurrent_Record_Type);
|
||||
pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);
|
||||
pragma Inline (Set_Is_Constr_Subt_For_U_Nominal);
|
||||
pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);
|
||||
pragma Inline (Set_Is_Constrained);
|
||||
pragma Inline (Set_Is_Constructor);
|
||||
pragma Inline (Set_Is_Controlled);
|
||||
pragma Inline (Set_Is_Controlling_Formal);
|
||||
pragma Inline (Set_Is_CPP_Class);
|
||||
pragma Inline (Set_Is_Default_Init_Cond_Procedure);
|
||||
pragma Inline (Set_Is_Descendent_Of_Address);
|
||||
pragma Inline (Set_Is_Discrim_SO_Function);
|
||||
@ -8898,7 +8912,6 @@ package Einfo is
|
||||
pragma Inline (Set_Original_Record_Component);
|
||||
pragma Inline (Set_Overlays_Constant);
|
||||
pragma Inline (Set_Overridden_Operation);
|
||||
pragma Inline (Set_PPC_Wrapper);
|
||||
pragma Inline (Set_Package_Instantiation);
|
||||
pragma Inline (Set_Packed_Array_Impl_Type);
|
||||
pragma Inline (Set_Parent_Subtype);
|
||||
@ -8906,6 +8919,7 @@ package Einfo is
|
||||
pragma Inline (Set_Partial_View_Has_Unknown_Discr);
|
||||
pragma Inline (Set_Pending_Access_Types);
|
||||
pragma Inline (Set_Postconditions_Proc);
|
||||
pragma Inline (Set_PPC_Wrapper);
|
||||
pragma Inline (Set_Prival);
|
||||
pragma Inline (Set_Prival_Link);
|
||||
pragma Inline (Set_Private_Dependents);
|
||||
@ -8913,7 +8927,6 @@ package Einfo is
|
||||
pragma Inline (Set_Protected_Body_Subprogram);
|
||||
pragma Inline (Set_Protected_Formal);
|
||||
pragma Inline (Set_Protection_Object);
|
||||
pragma Inline (Set_RM_Size);
|
||||
pragma Inline (Set_Reachable);
|
||||
pragma Inline (Set_Referenced);
|
||||
pragma Inline (Set_Referenced_As_LHS);
|
||||
@ -8936,6 +8949,7 @@ package Einfo is
|
||||
pragma Inline (Set_Returns_Limited_View);
|
||||
pragma Inline (Set_Reverse_Bit_Order);
|
||||
pragma Inline (Set_Reverse_Storage_Order);
|
||||
pragma Inline (Set_RM_Size);
|
||||
pragma Inline (Set_Scalar_Range);
|
||||
pragma Inline (Set_Scale_Value);
|
||||
pragma Inline (Set_Scope_Depth_Value);
|
||||
@ -8953,9 +8967,9 @@ package Einfo is
|
||||
pragma Inline (Set_Spec_Entity);
|
||||
pragma Inline (Set_SSO_Set_High_By_Default);
|
||||
pragma Inline (Set_SSO_Set_Low_By_Default);
|
||||
pragma Inline (Set_Static_Discrete_Predicate);
|
||||
pragma Inline (Set_Static_Elaboration_Desired);
|
||||
pragma Inline (Set_Static_Initialization);
|
||||
pragma Inline (Set_Static_Discrete_Predicate);
|
||||
pragma Inline (Set_Static_Real_Or_String_Predicate);
|
||||
pragma Inline (Set_Status_Flag_Or_Transient_Decl);
|
||||
pragma Inline (Set_Storage_Size_Variable);
|
||||
|
@ -1487,6 +1487,7 @@ begin
|
||||
Pragma_Use_VADS_Size |
|
||||
Pragma_Volatile |
|
||||
Pragma_Volatile_Components |
|
||||
Pragma_Volatile_Full_Access |
|
||||
Pragma_Warning_As_Error |
|
||||
Pragma_Weak_External |
|
||||
Pragma_Validity_Checks =>
|
||||
|
@ -1713,6 +1713,16 @@ package body Sem_Ch10 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Collect SCO information for loaded subunit if we are in the
|
||||
-- extended main unit.
|
||||
|
||||
if Generate_SCO
|
||||
and then In_Extended_Main_Source_Unit
|
||||
(Cunit_Entity (Current_Sem_Unit))
|
||||
then
|
||||
SCO_Record_Raw (Get_Cunit_Unit_Number (Library_Unit (N)));
|
||||
end if;
|
||||
|
||||
Analyze_Subunit (Library_Unit (N));
|
||||
|
||||
-- Otherwise we must load the subunit and link to it
|
||||
@ -1873,7 +1883,7 @@ package body Sem_Ch10 is
|
||||
Version_Update (Cunit (Main_Unit), Comp_Unit);
|
||||
|
||||
-- Collect SCO information for loaded subunit if we are in
|
||||
-- the main unit.
|
||||
-- the extended main unit.
|
||||
|
||||
if Generate_SCO
|
||||
and then
|
||||
|
@ -11698,6 +11698,14 @@ package body Sem_Ch12 is
|
||||
Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
|
||||
end if;
|
||||
|
||||
-- Check whether parent is a previous formal of the current generic
|
||||
|
||||
elsif Is_Derived_Type (A_Gen_T)
|
||||
and then Is_Generic_Type (Etype (A_Gen_T))
|
||||
and then Scope (A_Gen_T) = Scope (Etype (A_Gen_T))
|
||||
then
|
||||
Ancestor := Get_Instance_Of (First_Subtype (Etype (A_Gen_T)));
|
||||
|
||||
-- An unusual case: the actual is a type declared in a parent unit,
|
||||
-- but is not a formal type so there is no instance_of for it.
|
||||
-- Retrieve it by analyzing the record extension.
|
||||
@ -11733,6 +11741,9 @@ package body Sem_Ch12 is
|
||||
Actual, Ancestor);
|
||||
end if;
|
||||
|
||||
-- Finally verify that the (instance of) the ancestor is an ancestor
|
||||
-- of the actual.
|
||||
|
||||
elsif not Is_Ancestor (Base_Type (Ancestor), Act_T) then
|
||||
Error_Msg_NE
|
||||
("expect type derived from & in instantiation",
|
||||
|
@ -9882,6 +9882,7 @@ package body Sem_Ch6 is
|
||||
(T : List_Id;
|
||||
Related_Nod : Node_Id)
|
||||
is
|
||||
Context : constant Node_Id := Parent (Parent (T));
|
||||
Param_Spec : Node_Id;
|
||||
Formal : Entity_Id;
|
||||
Formal_Type : Entity_Id;
|
||||
@ -10027,6 +10028,8 @@ package body Sem_Ch6 is
|
||||
|
||||
-- Incomplete formal untagged types are not allowed in
|
||||
-- subprogram bodies (but are legal in their declarations).
|
||||
-- This excludes bodies created for null procedures, which
|
||||
-- are basic declarations.
|
||||
|
||||
if Is_Generic_Type (Formal_Type)
|
||||
and then not Is_Tagged_Type (Formal_Type)
|
||||
@ -10042,13 +10045,14 @@ package body Sem_Ch6 is
|
||||
then
|
||||
null;
|
||||
|
||||
elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement,
|
||||
N_Accept_Alternative,
|
||||
N_Entry_Body,
|
||||
N_Subprogram_Body)
|
||||
elsif Nkind_In (Context, N_Accept_Statement,
|
||||
N_Accept_Alternative,
|
||||
N_Entry_Body)
|
||||
or else (Nkind (Context) = N_Subprogram_Body
|
||||
and then Comes_From_Source (Context))
|
||||
then
|
||||
Error_Msg_NE
|
||||
("invalid use of untagged incomplete type&",
|
||||
("invalid use of untagged incomplete type &",
|
||||
Ptype, Formal_Type);
|
||||
end if;
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1997-2015, 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- --
|
||||
@ -619,6 +619,18 @@ package body Sem_Elab is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If this is a rewrite of a Valid_Scalars attribute, then nothing to
|
||||
-- check, we don't mind in this case if the call occurs before the body
|
||||
-- since this is all generated code.
|
||||
|
||||
if Nkind (Original_Node (N)) = N_Attribute_Reference
|
||||
and then Attribute_Name (Original_Node (N)) = Name_Valid_Scalars
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Proceed with check
|
||||
|
||||
Ent := E;
|
||||
|
||||
-- For a variable reference, just set Body_Acts_As_Spec to False
|
||||
|
@ -3058,9 +3058,9 @@ package body Sem_Prag is
|
||||
-- Issue fatal error message for misplaced pragma
|
||||
|
||||
procedure Process_Atomic_Independent_Shared_Volatile;
|
||||
-- Common processing for pragmas Atomic, Independent, Shared, Volatile.
|
||||
-- Note that Shared is an obsolete Ada 83 pragma and treated as being
|
||||
-- identical in effect to pragma Atomic.
|
||||
-- Common processing for pragmas Atomic, Independent, Shared, Volatile,
|
||||
-- Volatile_Full_Access. Note that Shared is an obsolete Ada 83 pragma
|
||||
-- and treated as being identical in effect to pragma Atomic.
|
||||
|
||||
procedure Process_Compile_Time_Warning_Or_Error;
|
||||
-- Common processing for Compile_Time_Error and Compile_Time_Warning
|
||||
@ -5822,24 +5822,28 @@ package body Sem_Prag is
|
||||
K : Node_Kind;
|
||||
Utyp : Entity_Id;
|
||||
|
||||
procedure Set_Atomic (E : Entity_Id);
|
||||
-- Set given type as atomic, and if no explicit alignment was given,
|
||||
-- set alignment to unknown, since back end knows what the alignment
|
||||
-- requirements are for atomic arrays. Note: this step is necessary
|
||||
-- for derived types.
|
||||
procedure Set_Atomic_Full (E : Entity_Id);
|
||||
-- Set given type as Is_Atomic or Has_Volatile_Full_Access. Also, if
|
||||
-- no explicit alignment was given, set alignment to unknown, since
|
||||
-- back end knows what the alignment requirements are for atomic and
|
||||
-- full access arrays. Note: this is necessary for derived types.
|
||||
|
||||
----------------
|
||||
-- Set_Atomic --
|
||||
----------------
|
||||
---------------------
|
||||
-- Set_Atomic_Full --
|
||||
---------------------
|
||||
|
||||
procedure Set_Atomic (E : Entity_Id) is
|
||||
procedure Set_Atomic_Full (E : Entity_Id) is
|
||||
begin
|
||||
Set_Is_Atomic (E);
|
||||
if Prag_Id = Pragma_Volatile_Full_Access then
|
||||
Set_Has_Volatile_Full_Access (E);
|
||||
else
|
||||
Set_Is_Atomic (E);
|
||||
end if;
|
||||
|
||||
if not Has_Alignment_Clause (E) then
|
||||
Set_Alignment (E, Uint_0);
|
||||
end if;
|
||||
end Set_Atomic;
|
||||
end Set_Atomic_Full;
|
||||
|
||||
-- Start of processing for Process_Atomic_Independent_Shared_Volatile
|
||||
|
||||
@ -5874,13 +5878,18 @@ package body Sem_Prag is
|
||||
Check_First_Subtype (Arg1);
|
||||
end if;
|
||||
|
||||
if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared then
|
||||
Set_Atomic (E);
|
||||
Set_Atomic (Underlying_Type (E));
|
||||
Set_Atomic (Base_Type (E));
|
||||
if Prag_Id = Pragma_Atomic
|
||||
or else
|
||||
Prag_Id = Pragma_Shared
|
||||
or else
|
||||
Prag_Id = Pragma_Volatile_Full_Access
|
||||
then
|
||||
Set_Atomic_Full (E);
|
||||
Set_Atomic_Full (Underlying_Type (E));
|
||||
Set_Atomic_Full (Base_Type (E));
|
||||
end if;
|
||||
|
||||
-- Atomic/Shared imply both Independent and Volatile
|
||||
-- Atomic/Shared/Volatile_Full_Access imply Independent
|
||||
|
||||
if Prag_Id /= Pragma_Volatile then
|
||||
Set_Is_Independent (E);
|
||||
@ -5896,6 +5905,11 @@ package body Sem_Prag is
|
||||
-- currently private, it also belongs on the underlying type.
|
||||
|
||||
if Prag_Id /= Pragma_Independent then
|
||||
if Prag_Id = Pragma_Volatile_Full_Access then
|
||||
Set_Has_Volatile_Full_Access (Base_Type (E));
|
||||
Set_Has_Volatile_Full_Access (Underlying_Type (E));
|
||||
end if;
|
||||
|
||||
Set_Is_Volatile (Base_Type (E));
|
||||
Set_Is_Volatile (Underlying_Type (E));
|
||||
|
||||
@ -5911,8 +5925,17 @@ package body Sem_Prag is
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared then
|
||||
Set_Is_Atomic (E);
|
||||
if Prag_Id = Pragma_Atomic
|
||||
or else
|
||||
Prag_Id = Pragma_Shared
|
||||
or else
|
||||
Prag_Id = Pragma_Volatile_Full_Access
|
||||
then
|
||||
if Prag_Id = Pragma_Volatile_Full_Access then
|
||||
Set_Has_Volatile_Full_Access (E);
|
||||
else
|
||||
Set_Is_Atomic (E);
|
||||
end if;
|
||||
|
||||
-- If the object declaration has an explicit initialization, a
|
||||
-- temporary may have to be created to hold the expression, to
|
||||
@ -5939,6 +5962,9 @@ package body Sem_Prag is
|
||||
-- treated as atomic, thus incurring a potentially costly
|
||||
-- synchronization operation for every access.
|
||||
|
||||
-- For Volatile_Full_Access we can do this for elementary
|
||||
-- types too, since there is no issue of atomic sync.
|
||||
|
||||
-- Of course it would be best if the back end could just adjust
|
||||
-- the alignment etc for the specific object, but that's not
|
||||
-- something we are capable of doing at this point.
|
||||
@ -5946,14 +5972,21 @@ package body Sem_Prag is
|
||||
Utyp := Underlying_Type (Etype (E));
|
||||
|
||||
if Present (Utyp)
|
||||
and then Is_Composite_Type (Utyp)
|
||||
and then (Is_Composite_Type (Utyp)
|
||||
or else Prag_Id = Pragma_Volatile_Full_Access)
|
||||
and then Sloc (E) > No_Location
|
||||
and then Sloc (Utyp) > No_Location
|
||||
and then
|
||||
Get_Source_File_Index (Sloc (E)) =
|
||||
Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
|
||||
then
|
||||
Set_Is_Atomic (Underlying_Type (Etype (E)));
|
||||
if Prag_Id = Pragma_Volatile_Full_Access then
|
||||
Set_Has_Volatile_Full_Access
|
||||
(Underlying_Type (Etype (E)));
|
||||
else
|
||||
Set_Is_Atomic
|
||||
(Underlying_Type (Etype (E)));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -21220,7 +21253,17 @@ package body Sem_Prag is
|
||||
when Pragma_Volatile =>
|
||||
Process_Atomic_Independent_Shared_Volatile;
|
||||
|
||||
-------------------------
|
||||
--------------------------
|
||||
-- Volatile_Full_Access --
|
||||
--------------------------
|
||||
|
||||
-- pragma Volatile_Full_Access (LOCAL_NAME);
|
||||
|
||||
when Pragma_Volatile_Full_Access =>
|
||||
GNAT_Pragma;
|
||||
Process_Atomic_Independent_Shared_Volatile;
|
||||
|
||||
-------------------------
|
||||
-- Volatile_Components --
|
||||
-------------------------
|
||||
|
||||
@ -26148,6 +26191,7 @@ package body Sem_Prag is
|
||||
Pragma_Validity_Checks => 0,
|
||||
Pragma_Volatile => 0,
|
||||
Pragma_Volatile_Components => 0,
|
||||
Pragma_Volatile_Full_Access => 0,
|
||||
Pragma_Warning_As_Error => 0,
|
||||
Pragma_Warnings => 0,
|
||||
Pragma_Weak_External => 0,
|
||||
|
@ -632,6 +632,7 @@ package Snames is
|
||||
Name_Unreserve_All_Interrupts : constant Name_Id := N + $; -- GNAT
|
||||
Name_Volatile : constant Name_Id := N + $;
|
||||
Name_Volatile_Components : constant Name_Id := N + $;
|
||||
Name_Volatile_Full_Access : constant Name_Id := N + $; -- GNAT
|
||||
Name_Weak_External : constant Name_Id := N + $; -- GNAT
|
||||
Last_Pragma_Name : constant Name_Id := N + $;
|
||||
|
||||
@ -1939,6 +1940,7 @@ package Snames is
|
||||
Pragma_Unreserve_All_Interrupts,
|
||||
Pragma_Volatile,
|
||||
Pragma_Volatile_Components,
|
||||
Pragma_Volatile_Full_Access,
|
||||
Pragma_Weak_External,
|
||||
|
||||
-- The following pragmas are on their own, out of order, because of the
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1999-2015, 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- --
|
||||
@ -362,13 +362,13 @@ package Targparm is
|
||||
---------------------
|
||||
|
||||
-- By default, type Duration is a 64-bit fixed-point type with a delta
|
||||
-- and small of 10**(-9) (i.e. it is a count in nanoseconds. This flag
|
||||
-- and small of 10**(-9) (i.e. it is a count in nanoseconds). This flag
|
||||
-- allows that standard format to be modified.
|
||||
|
||||
Duration_32_Bits_On_Target : Boolean := False;
|
||||
-- If True, then Duration is represented in 32 bits and the delta and
|
||||
-- small values are set to 20.0*(10**(-3)) (i.e. it is a count in units
|
||||
-- of 20 milliseconds.
|
||||
-- of 20 milliseconds).
|
||||
|
||||
------------------------------------
|
||||
-- Back-End Code Generation Flags --
|
||||
|
Loading…
Reference in New Issue
Block a user