diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 26 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 5 |
6 files changed, 62 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4aafa83..1c13735 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2012-12-05 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Build_Derived_Private_Type): Handle properly a + completion in a grand-child unit when the parent type is itself + a private type in a child unit whose full view is itself a + derivation from a private type. + +2012-12-05 Gary Dismukes <dismukes@adacore.com> + + * exp_attr.adb (Expand_N_Attribute_Reference, case + Attribute_Valid): Remove code for issuing warning on Valid within + a predicate. Moved to Sem_Attr. Remove with and use of Errout. + * sem_attr.adb (Analyze_Attribute, case Attribute_Valid): + Test for prefix's subtype having a predicate and issue warning + about infinite recursion if Valid occurs within the subtype's + predicate. Warning moved here from Exp_Attr. + +2012-12-05 Yannick Moy <moy@adacore.com> + + * debug.adb: Minor comment addition. + +2012-12-05 Yannick Moy <moy@adacore.com> + + * gnat1drv.adb (Adjust_Global_Switches): In CodePeer mode, check + overflows by default, even when the user suppresses overflow checks. + 2012-12-05 Thomas Quinot <quinot@adacore.com> * err_vars.ads: Fix minor typo in comment. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 02f04bc..bcb6ee3 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -658,6 +658,10 @@ package body Debug is -- reverts to the behavior of earlier compilers, which ignored -- indirect calls. + -- d.V Extensions for formal verification. New attributes/aspects/pragmas + -- defined in GNAT for formal verification with the tool GNATprove are + -- only accepted under this switch. + -- d.W Print out debugging information for Walk_Library_Items, including -- the order in which units are walked. This is primarily for use in -- debugging CodePeer mode. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index dcaac0c..cb31c22 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -27,7 +27,6 @@ with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; with Elists; use Elists; -with Errout; use Errout; with Exp_Atag; use Exp_Atag; with Exp_Ch2; use Exp_Ch2; with Exp_Ch3; use Exp_Ch3; @@ -5611,7 +5610,7 @@ package body Exp_Attr is -- If a predicate is present, then we do the predicate test, even if -- within the predicate function (infinite recursion is warned about - -- in that case). + -- in Sem_Attr in that case). declare Pred_Func : constant Entity_Id := Predicate_Function (Ptyp); @@ -5622,19 +5621,6 @@ package body Exp_Attr is Make_And_Then (Loc, Left_Opnd => Relocate_Node (N), Right_Opnd => Make_Predicate_Call (Ptyp, Pref))); - - -- If the attribute appears within the subtype's own predicate - -- function, then issue a warning that this will cause infinite - -- recursion. - - -- Do we have to issue these warnings in the expander rather - -- than during analysis (means they are skipped in -gnatc???). - - if Current_Scope = Pred_Func then - Error_Msg_N - ("attribute Valid requires a predicate check?", N); - Error_Msg_N ("\and will result in infinite recursion?", N); - end if; end if; end; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index ee6ca09..4d0485a 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -180,8 +180,8 @@ procedure Gnat1drv is Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True; Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0; - -- Suppress overflow, division by zero and access checks since they - -- are handled implicitly by CodePeer. + -- Suppress division by zero and access checks since they are handled + -- implicitly by CodePeer. -- Turn off dynamic elaboration checks: generates inconsistencies in -- trees between specs compiled as part of a main unit or as part of @@ -201,6 +201,13 @@ procedure Gnat1drv is Dynamic_Elaboration_Checks := False; + -- Set STRICT mode for overflow checks if not set explicitly + + if Suppress_Options.Overflow_Checks_General = Not_Set then + Suppress_Options.Overflow_Checks_General := Strict; + Suppress_Options.Overflow_Checks_Assertions := Strict; + end if; + -- Kill debug of generated code, since it messes up sloc values Debug_Generated_Code := False; @@ -328,7 +335,8 @@ procedure Gnat1drv is -- Set proper status for overflow check mechanism - -- If already set (by -gnato) then we have nothing to do + -- If already set (by -gnato or above in CodePeer mode) then we have + -- nothing to do. if Opt.Suppress_Options.Overflow_Checks_General /= Not_Set then null; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index cfb0983..773b502 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5557,6 +5557,21 @@ package body Sem_Attr is Error_Attr_P ("object for % attribute must be of scalar type"); end if; + -- If the attribute appears within the subtype's own predicate + -- function, then issue a warning that this will cause infinite + -- recursion. + + declare + Pred_Func : constant Entity_Id := Predicate_Function (P_Type); + + begin + if Present (Pred_Func) and then Current_Scope = Pred_Func then + Error_Msg_N + ("attribute Valid requires a predicate check?", N); + Error_Msg_N ("\and will result in infinite recursion?", N); + end if; + end; + Set_Etype (N, Standard_Boolean); ------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e6f76e2..51d7250 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6516,6 +6516,7 @@ package body Sem_Ch3 is and then Is_Completion and then In_Private_Part (Current_Scope) and then Scope (Parent_Type) /= Current_Scope + and then Present (Full_View (Parent_Type)) then -- This is the unusual case where a type completed by a private -- derivation occurs within a package nested in a child unit, and @@ -6524,6 +6525,10 @@ package body Sem_Ch3 is -- the enclosing child, and only then will the current type be -- possibly non-private. We build a underlying full view that -- will be installed when the enclosing child body is compiled. + -- Note that if the parent has a completion in the private part, + -- (which is itself a derivation from some other private type) + -- it is that completion that is visible, there is no full view + -- view available, and no special processing is needed. Full_Der := Make_Defining_Identifier |