+2012-08-06 Robert Dewar <dewar@adacore.com>
+
+ * exp_util.adb, switch-c.adb, inline.ads, sem_ch10.adb, types.ads,
+ checks.adb, sem_prag.adb, sem.adb, sem.ads, sem_res.adb, sem_attr.adb,
+ gnat1drv.adb, exp_ch4.adb, exp_ch6.adb, opt.ads, osint.adb: Implement
+ extended overflow checks (step 1).
+ (Overflow_Check_Type, Suppress_Record, Suppress_All): New types.
+ (Suppress_Array): Extended to include switches to control extended
+ overflow checking (and renamed to Suppress_Record).
+ Update all uses of Suppress_Array.
+
+2012-08-06 Thomas Quinot <quinot@adacore.com>
+
+ * makeutl.ads: Minor documentation fix.
+
+2012-08-06 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch7.adb: Minor reformatting.
+
2012-08-06 Geert Bosch <bosch@adacore.com>
* a-ngelfu.adb: Change obsolete comment that this is a non-strict
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Access_Check);
else
- return Scope_Suppress (Access_Check);
+ return Scope_Suppress.Suppress (Access_Check);
end if;
end Access_Checks_Suppressed;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Accessibility_Check);
else
- return Scope_Suppress (Accessibility_Check);
+ return Scope_Suppress.Suppress (Accessibility_Check);
end if;
end Accessibility_Checks_Suppressed;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Alignment_Check);
else
- return Scope_Suppress (Alignment_Check);
+ return Scope_Suppress.Suppress (Alignment_Check);
end if;
end Alignment_Checks_Suppressed;
-- Otherwise result depends on current scope setting
else
- return Scope_Suppress (Atomic_Synchronization);
+ return Scope_Suppress.Suppress (Atomic_Synchronization);
end if;
end Atomic_Synchronization_Disabled;
end if;
end if;
- return Scope_Suppress (Discriminant_Check);
+ return Scope_Suppress.Suppress (Discriminant_Check);
end Discriminant_Checks_Suppressed;
--------------------------------
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Division_Check);
else
- return Scope_Suppress (Division_Check);
+ return Scope_Suppress.Suppress (Division_Check);
end if;
end Division_Checks_Suppressed;
end if;
end if;
- if Scope_Suppress (Elaboration_Check) then
+ if Scope_Suppress.Suppress (Elaboration_Check) then
return True;
elsif Dynamic_Elaboration_Checks then
- return Scope_Suppress (All_Checks);
+ return Scope_Suppress.Suppress (All_Checks);
else
return False;
end if;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Index_Check);
else
- return Scope_Suppress (Index_Check);
+ return Scope_Suppress.Suppress (Index_Check);
end if;
end Index_Checks_Suppressed;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Length_Check);
else
- return Scope_Suppress (Length_Check);
+ return Scope_Suppress.Suppress (Length_Check);
end if;
end Length_Checks_Suppressed;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Overflow_Check);
else
- return Scope_Suppress (Overflow_Check);
+ return Scope_Suppress.Suppress (Overflow_Check);
end if;
end Overflow_Checks_Suppressed;
end if;
end if;
- return Scope_Suppress (Range_Check);
+ return Scope_Suppress.Suppress (Range_Check);
end Range_Checks_Suppressed;
-----------------------------------------
begin
-- Immediate return if scope checks suppressed for either check
- if Scope_Suppress (Range_Check) or Scope_Suppress (Validity_Check) then
+ if Scope_Suppress.Suppress (Range_Check)
+ or
+ Scope_Suppress.Suppress (Validity_Check)
+ then
return True;
end if;
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Storage_Check);
else
- return Scope_Suppress (Storage_Check);
+ return Scope_Suppress.Suppress (Storage_Check);
end if;
end Storage_Checks_Suppressed;
return Is_Check_Suppressed (E, Tag_Check);
end if;
- return Scope_Suppress (Tag_Check);
+ return Scope_Suppress.Suppress (Tag_Check);
end Tag_Checks_Suppressed;
--------------------------
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Validity_Check);
else
- return Scope_Suppress (Validity_Check);
+ return Scope_Suppress.Suppress (Validity_Check);
end if;
end Validity_Checks_Suppressed;
begin
if Ada_Version >= Ada_2005
and then Is_Class_Wide_Type (DesigT)
- and then not Scope_Suppress (Accessibility_Check)
+ and then not Scope_Suppress.Suppress (Accessibility_Check)
and then
(Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT)
or else
elsif Ada_Version >= Ada_2005
and then Tagged_Type_Expansion
and then Is_Class_Wide_Type (R_Type)
- and then not Scope_Suppress (Accessibility_Check)
+ and then not Scope_Suppress.Suppress (Accessibility_Check)
and then
(Is_Class_Wide_Type (Etype (Exp))
or else Nkind_In (Exp, N_Type_Conversion,
Stmts : List_Id;
Temp_Id : Entity_Id;
+ -- Start of processing for Process_Transient_Objects
+
begin
-- Examine all objects in the list First_Object .. Last_Object
end if;
declare
- Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped;
- First_Obj : Node_Id;
- Last_Obj : Node_Id;
- Target : Node_Id;
+ Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped;
+ First_Obj : Node_Id;
+ Last_Obj : Node_Id;
+ Target : Node_Id;
begin
-- If the node to be wrapped is the trigger of an asynchronous
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Insert_Actions (Assoc_Node, Ins_Actions);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_Actions (Assoc_Node, Ins_Actions);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_Actions;
Name_Req : Boolean := False;
Variable_Ref : Boolean := False)
is
- Loc : constant Source_Ptr := Sloc (Exp);
- Exp_Type : constant Entity_Id := Etype (Exp);
- Svg_Suppress : constant Suppress_Array := Scope_Suppress;
+ Loc : constant Source_Ptr := Sloc (Exp);
+ Exp_Type : constant Entity_Id := Etype (Exp);
+ Svg_Suppress : constant Suppress_Record := Scope_Suppress;
Def_Id : Entity_Id;
E : Node_Id;
New_Exp : Node_Id;
-- All this must not have any checks
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
-- If it is a scalar type and we need to capture the value, just make
-- a copy. Likewise for a function call, an attribute reference, an
-- Enable all other language checks
Suppress_Options :=
- (Access_Check => True,
- Alignment_Check => True,
- Division_Check => True,
- Elaboration_Check => True,
- Overflow_Check => True,
- others => False);
- Enable_Overflow_Checks := False;
+ (Suppress => (Access_Check => True,
+ Alignment_Check => True,
+ Division_Check => True,
+ Elaboration_Check => True,
+ Overflow_Check => True,
+ others => False),
+ Overflow_Checks_General => Suppress,
+ Overflow_Checks_Assertions => Suppress);
+
+ Enable_Overflow_Checks := False;
Dynamic_Elaboration_Checks := False;
-- Kill debug of generated code, since it messes up sloc values
and
Targparm.Backend_Overflow_Checks_On_Target))
then
- Suppress_Options (Overflow_Check) := False;
+ Suppress_Options.Suppress (Overflow_Check) := False;
else
- Suppress_Options (Overflow_Check) := True;
+ Suppress_Options.Suppress (Overflow_Check) := True;
+ Suppress_Options.Overflow_Checks_General := Check_All;
+ Suppress_Options.Overflow_Checks_Assertions := Check_All;
end if;
-- Set default for atomic synchronization. As this synchronization
-- on some targets, an optional target parameter can turn the option
-- off. Note Atomic Synchronization is implemented as check.
- Suppress_Options (Atomic_Synchronization) := not Atomic_Sync_Default;
+ Suppress_Options.Suppress (Atomic_Synchronization) :=
+ not Atomic_Sync_Default;
-- Set switch indicating if we can use N_Expression_With_Actions
Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
-- Suppress all language checks since they are handled implicitly by
- -- the formal verification backend.
+ -- the formal verification backend.
-- Turn off dynamic elaboration checks.
-- Turn off alignment checks.
-- Turn off validity checking.
- Suppress_Options := (others => True);
+ Suppress_Options := Suppress_All;
Enable_Overflow_Checks := False;
Dynamic_Elaboration_Checks := False;
Reset_Validity_Check_Options;
-- be restored when compiling the body, to insure that internal enti-
-- ties use the same counter and are unique over spec and body.
- Scope_Suppress : Suppress_Array;
+ Scope_Suppress : Suppress_Record;
Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
-- Save suppress information at the point of instantiation. Used to
-- properly inherit check status active at this point (see RM 11.5
-- Do nothing if Switch is an absolute path switch. If relative, fail if
-- Parent is the empty string, otherwise prepend the path with Parent. This
-- subprogram is only used when using project files. If For_Gnatbind is
- -- True, gnatbind switches that are not paths (-L, -A) are left unchaned.
+ -- True, consider gnatbind specific syntax for -L (not a path, left
+ -- unchanged) and -A (path is optional, preceded with "=" if present).
-- If Including_RTS is True, process also switches --RTS=. Do_Fail is
-- called in case of error. Using Osint.Fail might be appropriate.
Overflow_Checks_Unsuppressed : Boolean := False;
-- GNAT
- -- Set to True if at least one occurrence of pragma Unsuppress
- -- (All_Checks|Overflow_Checks) has been processed.
+ -- This flag is True if there has been at least one pragma with the
+ -- effect of unsuppressing overflow checks, meaning that a more careful
+ -- check of the current mode is required.
Persistent_BSS_Mode : Boolean := False;
-- GNAT
-- GNAT
-- Set to True if -gnatp (suppress all checks) switch present.
- Suppress_Options : Suppress_Array;
+ Suppress_Options : Suppress_Record;
-- GNAT
-- Flags set True to suppress corresponding check, i.e. add an implicit
-- pragma Suppress at the outer level of each unit compiled. Note that
-- be reset later (turning some on if -gnato is not specified, and
-- turning all of them on if -gnatp is specified).
- Suppress_Options := (others => False);
+ Suppress_Options := ((others => False), Check_All, Check_All);
-- Reserve the first slot in the search paths table. This is the
-- directory of the main source file or main library file and is filled
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Analyze (N);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze (N);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Analyze_List (L);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze_List (L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Analyze_List;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Insert_After_And_Analyze (N, M);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_After_And_Analyze (N, M);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_After_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Insert_Before_And_Analyze (N, M);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_Before_And_Analyze (N, M);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_Before_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Insert_List_After_And_Analyze (N, L);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_List_After_And_Analyze (N, L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_List_After_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Insert_List_Before_And_Analyze (N, L);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_List_Before_And_Analyze (N, L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_List_Before_And_Analyze;
-- the All_Checks flag.
if C in Predefined_Check_Id then
- return Scope_Suppress (C);
+ return Scope_Suppress.Suppress (C);
else
- return Scope_Suppress (All_Checks);
+ return Scope_Suppress.Suppress (All_Checks);
end if;
end Is_Check_Suppressed;
-- that are applicable to all entities. A similar search is needed for any
-- non-predefined check even if no specific entity is involved.
- Scope_Suppress : Suppress_Array := Suppress_Options;
- -- This array contains the current scope based settings of the suppress
+ Scope_Suppress : Suppress_Record := Suppress_Options;
+ -- This variable contains the current scope based settings of the suppress
-- switches. It is initialized from the options as shown, and then modified
-- by pragma Suppress. On entry to each scope, the current setting is saved
-- the scope stack, and then restored on exit from the scope. This record
-- Pointer to name of last subprogram body in this scope. Used for
-- testing proper alpha ordering of subprogram bodies in scope.
- Save_Scope_Suppress : Suppress_Array;
+ Save_Scope_Suppress : Suppress_Record;
-- Save contents of Scope_Suppress on entry
Save_Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
begin
if No (E1) then
if C in Predefined_Check_Id then
- R := Scope_Suppress (C);
+ R := Scope_Suppress.Suppress (C);
else
R := Is_Check_Suppressed (Empty, C);
end if;
Num_Scopes : Int := 0;
Use_Clauses : array (1 .. Scope_Stack.Last) of Node_Id;
Enclosing_Child : Entity_Id := Empty;
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
Save_Cunit_Restrictions : constant Save_Cunit_Boolean_Restrictions :=
Cunit_Boolean_Restrictions_Save;
-- affected by this processing).
if R_Id = No_Exceptions and then not Warn then
- for J in Scope_Suppress'Range loop
+ for J in Scope_Suppress.Suppress'Range loop
if J /= Atomic_Synchronization then
- Scope_Suppress (J) := True;
+ Scope_Suppress.Suppress (J) := True;
end if;
end loop;
end if;
-- user code: we want to generate checks for analysis purposes, as
-- set respectively by -gnatC and -gnatd.F
- if (CodePeer_Mode or Alfa_Mode)
- and then Comes_From_Source (N)
- then
+ if (CodePeer_Mode or Alfa_Mode) and then Comes_From_Source (N) then
return;
end if;
("argument of pragma% is not valid check name", Arg1);
end if;
- if not Suppress_Case
- and then (C = All_Checks or else C = Overflow_Check)
- then
- Opt.Overflow_Checks_Unsuppressed := True;
+ -- Special processing for overflow check case
+
+ if C = All_Checks or else C = Overflow_Check then
+ if Suppress_Case then
+ Scope_Suppress.Overflow_Checks_General := Suppress;
+ Scope_Suppress.Overflow_Checks_Assertions := Suppress;
+ else
+ Scope_Suppress.Overflow_Checks_General := Check_All;
+ Scope_Suppress.Overflow_Checks_Assertions := Check_All;
+ Opt.Overflow_Checks_Unsuppressed := True;
+ end if;
end if;
if Arg_Count = 1 then
-- Atomic_Synchronization is also not affected, since this is
-- not a real check.
- for J in Scope_Suppress'Range loop
+ for J in Scope_Suppress.Suppress'Range loop
if J /= Elaboration_Check
- and then J /= Atomic_Synchronization
+ and then
+ J /= Atomic_Synchronization
then
- Scope_Suppress (J) := Suppress_Case;
+ Scope_Suppress.Suppress (J) := Suppress_Case;
end if;
end loop;
and then (not Comes_From_Source (N)
or else C /= Atomic_Synchronization)
then
- Scope_Suppress (C) := Suppress_Case;
+ Scope_Suppress.Suppress (C) := Suppress_Case;
end if;
-- Also make an entry in the Local_Entity_Suppress table
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Analyze_And_Resolve (N, Typ);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
-
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze_And_Resolve (N, Typ);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Analyze_And_Resolve (N);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
-
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze_And_Resolve (N);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
- if Current_Scope /= Scop
- and then Scope_Is_Transient
- then
+ if Current_Scope /= Scop and then Scope_Is_Transient then
Scope_Stack.Table (Scope_Stack.Last).Save_Scope_Suppress :=
Scope_Suppress;
end if;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svg : constant Suppress_Record := Scope_Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress := Suppress_All;
Resolve (N, Typ);
Scope_Suppress := Svg;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Resolve (N, Typ);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Resolve;
-- -gnated switch (disable atomic synchronization)
when 'd' =>
- Suppress_Options (Atomic_Synchronization) := True;
+ Suppress_Options.Suppress (Atomic_Synchronization) :=
+ True;
-- -gnateD switch (preprocessing symbol definition)
when 'o' =>
Ptr := Ptr + 1;
- Suppress_Options (Overflow_Check) := False;
+ Suppress_Options.Suppress (Overflow_Check) := False;
+ Suppress_Options.Overflow_Checks_General := Check_All;
+ Suppress_Options.Overflow_Checks_Assertions := Check_All;
Opt.Enable_Overflow_Checks := True;
-- Processing for O switch
-- exclude Atomic_Synchronization, since this is not a real
-- check.
- for J in Suppress_Options'Range loop
+ for J in Suppress_Options.Suppress'Range loop
if J /= Elaboration_Check
- and then J /= Atomic_Synchronization
+ and then
+ J /= Atomic_Synchronization
then
- Suppress_Options (J) := True;
+ Suppress_Options.Suppress (J) := True;
end if;
+
+ Suppress_Options.Overflow_Checks_General := Suppress;
+ Suppress_Options.Overflow_Checks_Assertions := Suppress;
end loop;
Validity_Checks_On := False;
TS : out Time_Stamp_Type);
-- Given the components of a time stamp, initialize the value
- -----------------------------------------------
- -- Types used for Pragma Suppress Management --
- -----------------------------------------------
+ -------------------------------------
+ -- Types used for Check Management --
+ -------------------------------------
type Check_Id is new Nat;
-- Type used to represent a check id
-- 4. Add a new Do_xxx_Check flag to Sinfo (if required)
-- 5. Add appropriate checks for the new test
+ -- The following provides precise details on the mode used to check
+ -- intermediate overflows in expressions for signed integer arithmetic.
+
+ type Overflow_Check_Type is
+ (Suppress,
+ -- Intermediate overflow suppressed. If an arithmetic operation creates
+ -- an overflow, no exception is raised, and the program is erroneous.
+
+ Check_All,
+ -- All intermediate operations are checked. If the result of any
+ -- arithmetic operation gives a result outside the range of the base
+ -- type, then a Constraint_Error exception is raised.
+
+ Minimize,
+ -- Where appropriate, arithmetic operations are performed with an
+ -- extended range, using Long_Long_Integer if necessary. As long as
+ -- the result fits in this extended range, then no exception is raised
+ -- and computation continues with the extended result. The final value
+ -- of an expression must fit in the base type of the whole expression.
+ -- If an intermediate result is outside the range of Long_Long_Integer
+ -- then a Constraint_Error exception is raised.
+
+ Eliminate);
+ -- In this mode arbitrary precision arithmetic is used as needed to
+ -- ensure that it is impossible for intermediate arithmetic to cause
+ -- an overflow. Again the final value of an expression must fit in
+ -- the base type of the whole expression.
+
+ -- The following structure captures the state of check suppression or
+ -- activation at a particular point in the program execution.
+
+ type Suppress_Record is record
+ Suppress : Suppress_Array;
+ -- Indicates suppression status of each possible check
+
+ Overflow_Checks_General : Overflow_Check_Type;
+ -- This field is relevant only if Suppress (Overflow_Check) is False.
+ -- It indicates the mode of overflow checking to be applied to general
+ -- expressions outside assertions.
+
+ Overflow_Checks_Assertions : Overflow_Check_Type;
+ -- This field is relevant only if Suppress (Overflow_Check) is False.
+ -- It indicates the mode of overflow checking to be applied to any
+ -- expressions occuring inside assertions.
+ end record;
+
+ Suppress_All : constant Suppress_Record :=
+ ((others => True), Suppress, Suppress);
+ -- Constant used to initialize Suppress_Record value to all suppressed.
+
-----------------------------------
-- Global Exception Declarations --
-----------------------------------
projects / thirdparty / gcc.git / commitdiff
