diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d89e65ac7b23..d50db6c5c2ba 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-04-10 Bob Duff + + * rtsfind.adb (RTE): Put implicit with_clauses on whatever unit needs + them first, rather than on the extended main unit. + +2009-04-10 Ed Schonberg + + * sem_ch6.adb (Check_Discriminant_Conformance): If discriminant + specification of full view carries a null exclusion indicator, create + an itype for it, to check for conformance with partial view. + 2009-04-10 Bob Duff * rtsfind.ads: Minor code change: make RE_Unit_Table constant. diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index e27a2dffa788..1ad8932957d1 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -112,18 +112,16 @@ package body Rtsfind is -- When a unit is implicitly loaded as a result of a call to RTE, it is -- necessary to create an implicit WITH to ensure that the object is - -- correctly loaded by the binder. Such WITH statements are only required - -- when the request is from the extended main unit (if a client needs a - -- WITH, that will be taken care of when the client is compiled). - - -- We always attach the WITH to the main unit. This is not perfectly - -- accurate in terms of elaboration requirements, but it is close enough, - -- since the units that are accessed using rtsfind do not have delicate - -- elaboration requirements. + -- correctly loaded by the binder. We originally added such WITH clauses + -- only if the extended main unit required them, and added them only to the + -- extended main unit. They are currently added to whatever unit first + -- needs them, which is not necessarily the main unit. This works because + -- if the main unit requires some runtime unit also required by some other + -- unit, the other unit's implicit WITH will force a correct elaboration + -- order. This method is necessary for SofCheck Inspector. -- The flag Withed in the unit table record is initially set to False. It - -- is set True if a WITH has been generated for the main unit for the - -- corresponding unit. + -- is set True if a WITH has been generated for the corresponding unit. ----------------------- -- Local Subprograms -- @@ -1065,18 +1063,13 @@ package body Rtsfind is end if; end if; - -- See if we have to generate a WITH for this entity. We generate - -- a WITH if the current unit is part of the extended main code - -- unit, and if we have not already added the with. The WITH is - -- added to the appropriate unit (the current one). We do not need - -- to generate a WITH for a call issued from RTE_Available. + -- See if we have to generate a WITH for this entity. We generate a WITH + -- if we have not already added the with. The WITH is added to the + -- appropriate unit (the current one). We do not need to generate a WITH + -- for a call issued from RTE_Available. <> - if (not U.Withed) - and then - In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit)) - and then not RTE_Available_Call - then + if (not U.Withed) and then not RTE_Available_Call then U.Withed := True; declare diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9f1761e8c992..2691e467c431 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1381,7 +1381,7 @@ package body Sem_Ch6 is -- the case where there is no separate spec. procedure Check_Anonymous_Return; - -- (Ada 2005): if a function returns an access type that denotes a task, + -- Ada 2005: if a function returns an access type that denotes a task, -- or a type that contains tasks, we must create a master entity for -- the anonymous type, which typically will be used in an allocator -- in the body of the function. @@ -4048,6 +4048,20 @@ package body Sem_Ch6 is else Analyze (Discriminant_Type (New_Discr)); New_Discr_Type := Etype (Discriminant_Type (New_Discr)); + + -- Ada 2005: if the discriminant definition carries a null + -- exclusion, create an itype to check properly for consistency + -- with partial declaration. + + if Is_Access_Type (New_Discr_Type) + and then Null_Exclusion_Present (New_Discr) + then + New_Discr_Type := + Create_Null_Excluding_Itype + (T => New_Discr_Type, + Related_Nod => New_Discr, + Scope_Id => Current_Scope); + end if; end if; if not Conforming_Types