mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 05:30:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-03-04  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb: Minor reformatting.
	* exp_unst.adb (Build_Tables): Fix minor glitch for no separate
	spec case.
	* erroutc.adb (Delete_Msg): add missing decrement of info msg counter.

2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Build_Pragma_Check_Equivalent): Suppress
	references to formal parameters subject to pragma Unreferenced.
	(Suppress_Reference): New routine.
	* sem_attr.adb (Analyze_Attribute): Reimplement the analysis
	of attribute 'Old. Attributes 'Old and 'Result now share
	common processing.
	(Analyze_Old_Result_Attribute): New routine.
	(Check_Placement_In_Check): Removed.
	(Check_Placement_In_Contract_Cases): Removed.
	(Check_Placement_In_Test_Case): Removed.
	(Check_Use_In_Contract_Cases): Removed.
	(Check_Use_In_Test_Case): Removed.
	(In_Refined_Post): Removed.
	(Is_Within): Removed.
	* sem_warn.adb (Check_Low_Bound_Tested): Code cleanup.
	(Check_Low_Bound_Tested_For): New routine.

2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration):
	Generate a runtime check to test the expression of pragma
	Default_Initial_Condition when the object is default initialized.

From-SVN: r221176
This commit is contained in:
Arnaud Charlet 2015-03-04 10:54:19 +01:00
parent 2322588a71
commit b6a56408a6
8 changed files with 514 additions and 545 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2015-03-04 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb: Minor reformatting.
* exp_unst.adb (Build_Tables): Fix minor glitch for no separate
spec case.
* erroutc.adb (Delete_Msg): add missing decrement of info msg counter.
2015-03-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Build_Pragma_Check_Equivalent): Suppress
references to formal parameters subject to pragma Unreferenced.
(Suppress_Reference): New routine.
* sem_attr.adb (Analyze_Attribute): Reimplement the analysis
of attribute 'Old. Attributes 'Old and 'Result now share
common processing.
(Analyze_Old_Result_Attribute): New routine.
(Check_Placement_In_Check): Removed.
(Check_Placement_In_Contract_Cases): Removed.
(Check_Placement_In_Test_Case): Removed.
(Check_Use_In_Contract_Cases): Removed.
(Check_Use_In_Test_Case): Removed.
(In_Refined_Post): Removed.
(Is_Within): Removed.
* sem_warn.adb (Check_Low_Bound_Tested): Code cleanup.
(Check_Low_Bound_Tested_For): New routine.
2015-03-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration):
Generate a runtime check to test the expression of pragma
Default_Initial_Condition when the object is default initialized.
2015-03-02 Robert Dewar <dewar@adacore.com>
* scng.adb (Scan): Ignore illegal character in relaxed

4
gcc/ada/erroutc.adb
View File

@ -141,6 +141,10 @@ package body Erroutc is
if Errors.Table (D).Warn or else Errors.Table (D).Style then
Warnings_Detected := Warnings_Detected - 1;
if Errors.Table (D).Info then
Info_Messages := Info_Messages - 1;
end if;
-- Note: we do not need to decrement Warnings_Treated_As_Errors
-- because this only gets incremented if we actually output the
-- message, which we won't do if we are deleting it here!

9
gcc/ada/exp_ch3.adb
View File

@ -6138,11 +6138,9 @@ package body Exp_Ch3 is
end;
end if;
-- At this point the object is fully initialized by either invoking the
-- related type init proc, routine [Deep_]Initialize or performing in-
-- place assingments for an array object. If the related type is subject
-- to pragma Default_Initial_Condition, add a runtime check to verify
-- the assumption of the pragma. Generate:
-- If the object is default initialized and its type is subject to
-- pragma Default_Initial_Condition, add a runtime check to verify
-- the assumption of the pragma (SPARK RM 7.3.3). Generate:
-- <Base_Typ>Default_Init_Cond (<Base_Typ> (Def_Id));
@ -6152,6 +6150,7 @@ package body Exp_Ch3 is
and then (Has_Default_Init_Cond (Base_Typ)
or else
Has_Inherited_Default_Init_Cond (Base_Typ))
and then not Has_Init_Expression (N)
then
declare
DIC_Call : constant Node_Id :=

58
gcc/ada/exp_ch6.adb
View File

@ -7163,6 +7163,42 @@ package body Exp_Ch6 is
Subp_Id : Entity_Id := Empty;
Inher_Id : Entity_Id := Empty) return Node_Id
is
function Suppress_Reference (N : Node_Id) return Traverse_Result;
-- Detect whether node N references a formal parameter subject to
-- pragma Unreferenced. If this is the case, set Comes_From_Source
-- to False to suppress the generation of a reference when analyzing
-- N later on.
------------------------
-- Suppress_Reference --
------------------------
function Suppress_Reference (N : Node_Id) return Traverse_Result is
Formal : Entity_Id;
begin
if Is_Entity_Name (N) and then Present (Entity (N)) then
Formal := Entity (N);
-- The formal parameter is subject to pragma Unreferenced.
-- Prevent the generation of a reference by resetting the
-- Comes_From_Source flag.
if Is_Formal (Formal)
and then Has_Pragma_Unreferenced (Formal)
then
Set_Comes_From_Source (N, False);
end if;
end if;
return OK;
end Suppress_Reference;
procedure Suppress_References is
new Traverse_Proc (Suppress_Reference);
-- Local variables
Loc : constant Source_Ptr := Sloc (Prag);
Prag_Nam : constant Name_Id := Pragma_Name (Prag);
Check_Prag : Node_Id;
@ -7172,6 +7208,8 @@ package body Exp_Ch6 is
Nam : Name_Id;
Subp_Formal : Entity_Id;
-- Start of processing for Build_Pragma_Check_Equivalent
begin
Formals_Map := No_Elist;
@ -7208,8 +7246,26 @@ package body Exp_Ch6 is
-- Mark the pragma as being internally generated and reset the
-- Analyzed flag.
Set_Comes_From_Source (Check_Prag, False);
Set_Analyzed (Check_Prag, False);
Set_Comes_From_Source (Check_Prag, False);
-- The tree of the original pragma may contain references to the
-- formal parameters of the related subprogram. At the same time
-- the corresponding body may mark the formals as unreferenced:
-- procedure Proc (Formal : ...)
-- with Pre => Formal ...;
-- procedure Proc (Formal : ...) is
-- pragma Unreferenced (Formal);
-- ...
-- This creates problems because all pragma Check equivalents are
-- analyzed at the end of the body declarations. Since all source
-- references have already been accounted for, reset any references
-- to such formals in the generated pragma Check equivalent.
Suppress_References (Check_Prag);
if Present (Corresponding_Aspect (Prag)) then
Nam := Chars (Identifier (Corresponding_Aspect (Prag)));

10
gcc/ada/exp_ch7.adb
View File

@ -7853,12 +7853,10 @@ package body Exp_Ch7 is
(Loc : Source_Ptr;
Ptr_Typ : Entity_Id) return Node_Id
is
-- It is possible for Ptr_Typ to be a partial view, if the access
-- type is a full view declared in the private part of a nested package,
-- and the finalization actions take place when completing analysis
-- of the enclosing unit. For this reason we use Underlying_Type
-- in two places below.
-- It is possible for Ptr_Typ to be a partial view, if the access type
-- is a full view declared in the private part of a nested package, and
-- the finalization actions take place when completing analysis of the
-- enclosing unit. For this reason use Underlying_Type twice below.
Desig_Typ : constant Entity_Id :=
Available_View

18
gcc/ada/exp_unst.adb
View File

@ -491,16 +491,16 @@ package body Exp_Unst is
-- then we won't catch it in the traversal of the body. But we do
-- want to visit the declaration in this case!
declare
Dummy : Traverse_Result;
Decl : constant Node_Id :=
Parent (Declaration_Node (Corresponding_Spec (Subp_Body)));
pragma Assert (Nkind (Decl) = N_Subprogram_Declaration);
begin
if not Acts_As_Spec (Subp_Body) then
if not Acts_As_Spec (Subp_Body) then
declare
Dummy : Traverse_Result;
Decl : constant Node_Id :=
Parent (Declaration_Node (Corresponding_Spec (Subp_Body)));
pragma Assert (Nkind (Decl) = N_Subprogram_Declaration);
begin
Dummy := Visit_Node (Decl);
end if;
end;
end;
end if;
-- Traverse the body to get the rest of the subprograms and calls

883
gcc/ada/sem_attr.adb
View File

File diff suppressed because it is too large Load Diff

45
gcc/ada/sem_warn.adb
View File

@ -723,28 +723,33 @@ package body Sem_Warn is
----------------------------
procedure Check_Low_Bound_Tested (Expr : Node_Id) is
procedure Check_Low_Bound_Tested_For (Opnd : Node_Id);
-- Determine whether operand Opnd denotes attribute 'First whose prefix
-- is a formal parameter. If this is the case, mark the entity of the
-- prefix as having its low bound tested.
--------------------------------
-- Check_Low_Bound_Tested_For --
--------------------------------
procedure Check_Low_Bound_Tested_For (Opnd : Node_Id) is
begin
if Nkind (Opnd) = N_Attribute_Reference
and then Attribute_Name (Opnd) = Name_First
and then Is_Entity_Name (Prefix (Opnd))
and then Present (Entity (Prefix (Opnd)))
and then Is_Formal (Entity (Prefix (Opnd)))
then
Set_Low_Bound_Tested (Entity (Prefix (Opnd)));
end if;
end Check_Low_Bound_Tested_For;
-- Start of processing for Check_Low_Bound_Tested
begin
if Comes_From_Source (Expr) then
declare
L : constant Node_Id := Left_Opnd (Expr);
R : constant Node_Id := Right_Opnd (Expr);
begin
if Nkind (L) = N_Attribute_Reference
and then Attribute_Name (L) = Name_First
and then Is_Entity_Name (Prefix (L))
and then Is_Formal (Entity (Prefix (L)))
then
Set_Low_Bound_Tested (Entity (Prefix (L)));
end if;
if Nkind (R) = N_Attribute_Reference
and then Attribute_Name (R) = Name_First
and then Is_Entity_Name (Prefix (R))
and then Is_Formal (Entity (Prefix (R)))
then
Set_Low_Bound_Tested (Entity (Prefix (R)));
end if;
end;
Check_Low_Bound_Tested_For (Left_Opnd (Expr));
Check_Low_Bound_Tested_For (Right_Opnd (Expr));
end if;
end Check_Low_Bound_Tested;