+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.
-- 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.
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;
-- 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);
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;
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
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;
-- 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;
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);
-------------------
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
-- 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
projects / platform / upstream / gcc.git / commitdiff