+2015-05-12 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch9.adb, einfo.ads, exp_intr.adb: Minor reformatting.
+ * sem_disp.adb: Minor code reorganization (remove junk redundant
+ null statement).
+ * exp_unst.adb (Unnest_Subprogram.Uplev_Refs): Ignore uplevel
+ references to bounds of types coming from original type reference.
+ * checks.ads: Minor reformatting.
+ * checks.adb: Minor reformatting.
+ * sem_prag.adb (Analyze_Pragma, case Check): If in ignored
+ assertion, then make sure we do not drag in bignum stuff.
+
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb (Collect_Interfaces): Initialize
Analyze_And_Resolve (N, Typ);
- Scope_Suppress.Suppress (Overflow_Check) := Svo;
- Scope_Suppress.Overflow_Mode_General := Svg;
- Scope_Suppress.Overflow_Mode_Assertions := Sva;
+ Scope_Suppress.Suppress (Overflow_Check) := Svo;
+ Scope_Suppress.Overflow_Mode_General := Svg;
+ Scope_Suppress.Overflow_Mode_Assertions := Sva;
end Reanalyze;
--------------
Expand (N);
- Scope_Suppress.Suppress (Overflow_Check) := Svo;
- Scope_Suppress.Overflow_Mode_General := Svg;
- Scope_Suppress.Overflow_Mode_Assertions := Sva;
+ Scope_Suppress.Suppress (Overflow_Check) := Svo;
+ Scope_Suppress.Overflow_Mode_General := Svg;
+ Scope_Suppress.Overflow_Mode_Assertions := Sva;
end Reexpand;
-- Start of processing for Minimize_Eliminate_Overflows
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
function Overflow_Check_Mode return Overflow_Mode_Type;
-- Returns current overflow checking mode, taking into account whether
- -- we are inside an assertion expression.
+ -- we are inside an assertion expression and the assertion policy.
- ------------------------------------------
- -- Control of Alignment Check Warnings --
- ------------------------------------------
+ -----------------------------------------
+ -- Control of Alignment Check Warnings --
+ -----------------------------------------
-- When we have address clauses, there is an issue of whether the address
-- specified is appropriate to the alignment. In the general case where the
-- primitives that come from source must be stored in this list in the
-- order of their occurrence in the sources. For incomplete types the
-- list is always empty.
+--
-- When expansion is disabled the corresponding record type of a
-- synchronized type is not constructed. In that case, such types
-- carry this attribute directly, for ASIS use.
-- Defined in all entities. Indicates that the entity is locally defined
-- within a subprogram P, and there is a reference to the entity within
-- a subprogram nested within P (at any depth). Set only for the VM case
--- (where it is set for variables, constants and loop parameters). Note
+-- (where it is set for variables, constants, and loop parameters). Note
-- that this is similar in usage to Is_Uplevel_Referenced_Entity (which
-- is used when we are unnesting subprograms), but the usages are a bit
-- different and it is cleaner to leave the old VM usage unchanged.
Parameter_Associations => New_List (
Relocate_Node (Tag_Arg),
New_Occurrence_Of
- (Node (First_Elmt (Access_Disp_Table
- (Etype (Act_Constr)))),
+ (Node (First_Elmt
+ (Access_Disp_Table (Etype (Act_Constr)))),
Loc))));
Insert_Action (N, Iface_Tag);
end;
goto Continue;
end if;
+ -- Also ignore uplevel references to bounds of types that come
+ -- from the original type reference.
+
+ if Is_Entity_Name (UPJ.Ref)
+ and then Present (Entity (UPJ.Ref))
+ and then Is_Type (Entity (UPJ.Ref))
+ then
+ goto Continue;
+ end if;
+
-- Rewrite one reference
Rewrite_One_Ref : declare
if Present (Interface_List (N)) then
Set_Is_Tagged_Type (T);
- -- The primitive operations of a tagged synchronized type are
- -- placed on the Corresponding_Record for proper dispatching,
- -- but are attached to the synchronized type itself when
- -- expansion is disabled, for ASIS use.
+ -- The primitive operations of a tagged synchronized type are placed
+ -- on the Corresponding_Record for proper dispatching, but are
+ -- attached to the synchronized type itself when expansion is
+ -- disabled, for ASIS use.
Set_Direct_Primitive_Operations (T, New_Elmt_List);
elsif Is_Concurrent_Type (Tagged_Type) then
pragma Assert (not Expander_Active);
- -- Attach operation to list of primitives of the synchronized
- -- type itself, for ASIS use.
+ -- Attach operation to list of primitives of the synchronized type
+ -- itself, for ASIS use.
Append_Elmt (Subp, Direct_Primitive_Operations (Tagged_Type));
- null;
-- If no old subprogram, then we add this as a dispatching operation,
-- but we avoid doing this if an error was posted, to prevent annoying
end case;
-- Check applicable policy. We skip this if Checked/Ignored status
- -- is already set (e.g. in the casse of a pragma from an aspect).
+ -- is already set (e.g. in the case of a pragma from an aspect).
if Is_Checked (N) or else Is_Ignored (N) then
null;
end if;
end case;
- -- Deal with analyzing the string argument.
+ -- Deal with analyzing the string argument
if Arg_Count = 3 then
Left_Opnd => Make_Identifier (Eloc, Name_False),
Right_Opnd => Expr),
Then_Statements => New_List (
- Make_Null_Statement (Eloc))));
+ Make_Null_Statement (Eloc))));
+
+ -- Now go ahead and analyze the if statement
In_Assertion_Expr := In_Assertion_Expr + 1;
- Analyze (N);
+
+ -- One rather special treatment. If we are now in Eliminated
+ -- overflow mode, then suppress overflow checking since we do
+ -- not want to drag in the bignum stuff if we are in Ignore
+ -- mode anyway. This is particularly important if we are using
+ -- a configurable run time that does not support bignum ops.
+
+ if Scope_Suppress.Overflow_Mode_Assertions = Eliminated then
+ declare
+ Svo : constant Boolean :=
+ Scope_Suppress.Suppress (Overflow_Check);
+ begin
+ Scope_Suppress.Overflow_Mode_Assertions := Strict;
+ Scope_Suppress.Suppress (Overflow_Check) := True;
+ Analyze (N);
+ Scope_Suppress.Suppress (Overflow_Check) := Svo;
+ Scope_Suppress.Overflow_Mode_Assertions := Eliminated;
+ end;
+
+ -- Not that special case!
+
+ else
+ Analyze (N);
+ end if;
+
+ -- All done with this check
+
In_Assertion_Expr := In_Assertion_Expr - 1;
-- Check is active or expansion not active. In these cases we can