diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
| -rw-r--r-- | gcc/ada/restrict.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 31 |
3 files changed, 42 insertions, 16 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 30c5d35..cf11985 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-08-01 Ed Schonberg <schonberg@adacore.com> + + * restrict.adb (Update_Restrictions): For restrictions with a + maximum parameter (e.g. number of protected entries in Ravenscar) + do not compute the maximum of the violation over several objects, + because the restriction is per-object. + (Check_Restriction): After possible message, reset the value + of of a checked max_parameter restriction to zero, to prevent + cascaded errors. + * sem_ch3.adb (Build_Derived_Private_Type): Use base of parent + (sub)type to determine whether derived type should be on the + list of private dependents of a type whose full view may become + visible subsequently. + 2014-08-01 Olivier Hainque <hainque@adacore.com> * gcc-interface/Make-lang.in (ADA_TOOLS_FLAGS_TO_PASS, native): use diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 3027ffa..ff44e6f 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -427,6 +427,7 @@ package body Restrict is if VV < 0 then Info.Unknown (R) := True; Info.Count (R) := 1; + else Info.Count (R) := VV; end if; @@ -442,10 +443,11 @@ package body Restrict is if VV < 0 then Info.Unknown (R) := True; - -- If checked by maximization, do maximization + -- If checked by maximization, nothing to do because the + -- check is per-object. elsif R in Checked_Max_Parameter_Restrictions then - Info.Count (R) := Integer'Max (Info.Count (R), VV); + null; -- If checked by adding, do add, checking for overflow @@ -554,6 +556,13 @@ package body Restrict is Msg_Issued := True; Restriction_Msg (R, N); end if; + + -- For Max_Entries and the like, do not carry forward the violation + -- count because it does not affect later declarations. + + if R in Checked_Max_Parameter_Restrictions then + Restrictions.Count (R) := 0; + end if; end Check_Restriction; ------------------------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 871f543..ce46257 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6540,13 +6540,14 @@ package body Sem_Ch3 is Is_Completion : Boolean; Derive_Subps : Boolean := True) is - Loc : constant Source_Ptr := Sloc (N); - Der_Base : Entity_Id; - Discr : Entity_Id; - Full_Der : Entity_Id; - Full_P : Entity_Id; - Last_Discr : Entity_Id; - Par_Scope : constant Entity_Id := Scope (Base_Type (Parent_Type)); + Loc : constant Source_Ptr := Sloc (N); + Par_Base : constant Entity_Id := Base_Type (Parent_Type); + Par_Scope : constant Entity_Id := Scope (Par_Base); + Der_Base : Entity_Id; + Discr : Entity_Id; + Full_Der : Entity_Id; + Full_P : Entity_Id; + Last_Discr : Entity_Id; procedure Build_Full_Derivation; -- Build full derivation, i.e. derive from the full view @@ -6984,10 +6985,12 @@ package body Sem_Ch3 is Set_Private_Dependents (Derived_Type, New_Elmt_List); end if; - if Is_Private_Type (Parent_Type) - and then Base_Type (Parent_Type) = Parent_Type - and then In_Open_Scopes (Scope (Parent_Type)) - then + -- If the parent base type is in scope, add the derived type to its + -- list of private dependents, because its full view may become + -- visible subsequently (in a nested private part, a body, or in a + -- further child unit). + + if Is_Private_Type (Par_Base) and then In_Open_Scopes (Par_Scope) then Append_Elmt (Derived_Type, Private_Dependents (Parent_Type)); -- Check for unusual case where a type completed by a private @@ -7008,9 +7011,9 @@ package body Sem_Ch3 is then -- In this case, the full view of the parent type will become -- visible in the body of the enclosing child, and only then will - -- the current type be possibly non-private. We build an - -- underlying full view that will be installed when the enclosing - -- child body is compiled. + -- the current type be possibly non-private. Build an underlying + -- full view that will be installed when the enclosing child body + -- is compiled. if Present (Underlying_Full_View (Derived_Type)) then Full_Der := Underlying_Full_View (Derived_Type); |