OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* par-ch13.adb (Get_Aspect_Specifications): Set Inside_Depends.
	* par-ch2.adb (P_Pragma): Set Inside_Depends.
	* par-ch4.adb (P_Simple_Expression): Pass Inside_Depends to
	Check_Unary_Plus_Or_Minus.
	* scans.ads (Inside_Depends): New flag.
	* scng.adb (Scan): Pass Inside_Depends to Check_Arrow.
	* style.ads: Add Inside_Depends parameter to Check_Arrow Add
	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
	* styleg.adb (Check_Arrow): Handle Inside_Depends case.
	(Check_Unary_Plus_Or_Minus): Handle Inside_Depends case.
	* styleg.ads: Add Inside_Depends parameter to Check_Arrow Add.
	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.

2014-07-31  Javier Miranda  <miranda@adacore.com>

	* s-vaflop.adb Move the body of function T_To_G before
	T_To_D. Required for frontend inlining.
	* inline.adb (Has_Excluded_Contract): New subprogram used to
	check if a subprogram inlined by the frontend has contracts
	which cannot be inlined.

2014-07-31  Bob Duff  <duff@adacore.com>

	* s-traceb.adb, s-traceb-hpux.adb, s-traceb-mastop.adb:
	(Call_Chain): Add 1 to number of frames to skip, to account for
	the fact that there's one more frame on the stack.

From-SVN: r213336
This commit is contained in:
Arnaud Charlet 2014-07-31 12:02:13 +02:00
parent b7c874a77c
commit aa3efecdfb
14 changed files with 235 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

@ -1,3 +1,32 @@
2014-07-31 Robert Dewar <dewar@adacore.com>
* par-ch13.adb (Get_Aspect_Specifications): Set Inside_Depends.
* par-ch2.adb (P_Pragma): Set Inside_Depends.
* par-ch4.adb (P_Simple_Expression): Pass Inside_Depends to
Check_Unary_Plus_Or_Minus.
* scans.ads (Inside_Depends): New flag.
* scng.adb (Scan): Pass Inside_Depends to Check_Arrow.
* style.ads: Add Inside_Depends parameter to Check_Arrow Add
Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
* styleg.adb (Check_Arrow): Handle Inside_Depends case.
(Check_Unary_Plus_Or_Minus): Handle Inside_Depends case.
* styleg.ads: Add Inside_Depends parameter to Check_Arrow Add.
Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
2014-07-31 Javier Miranda <miranda@adacore.com>
* s-vaflop.adb Move the body of function T_To_G before
T_To_D. Required for frontend inlining.
* inline.adb (Has_Excluded_Contract): New subprogram used to
check if a subprogram inlined by the frontend has contracts
which cannot be inlined.
2014-07-31 Bob Duff <duff@adacore.com>
* s-traceb.adb, s-traceb-hpux.adb, s-traceb-mastop.adb:
(Call_Chain): Add 1 to number of frames to skip, to account for
the fact that there's one more frame on the stack.
2014-07-31 Robert Dewar <dewar@adacore.com>
* checks.adb (Enable_Overflow_Check): More precise setting of

86
gcc/ada/inline.adb
View File

@ -1828,6 +1828,10 @@ package body Inline is
-- - functions that have exception handlers
-- - functions that have some enclosing body containing instantiations
-- that appear before the corresponding generic body.
-- - functions that have some of the following contracts (and the
-- sources are compiled with assertions enabled):
-- - Pre/post condition
-- - Contract cases
procedure Generate_Body_To_Inline
(N : Node_Id;
@ -1926,6 +1930,9 @@ package body Inline is
Max_Size : constant := 10;
Stat_Count : Integer := 0;
function Has_Excluded_Contract return Boolean;
-- Check for contracts that cannot be inlined
function Has_Excluded_Declaration (Decls : List_Id) return Boolean;
-- Check for declarations that make inlining not worthwhile
@ -1956,6 +1963,70 @@ package body Inline is
-- unconstrained type, the secondary stack is involved, and it
-- is not worth inlining.
---------------------------
-- Has_Excluded_Contract --
---------------------------
function Has_Excluded_Contract return Boolean is
function Check_Excluded_Contracts (E : Entity_Id) return Boolean;
-- Return True if the subprogram E has unsupported contracts
function Check_Excluded_Contracts (E : Entity_Id) return Boolean is
Items : constant Node_Id := Contract (E);
begin
if Present (Items) then
if Present (Pre_Post_Conditions (Items))
or else Present (Contract_Test_Cases (Items))
then
Cannot_Inline
("cannot inline & (non-allowed contract)?",
N, Subp);
return True;
end if;
end if;
return False;
end Check_Excluded_Contracts;
Decl : Node_Id;
P_Id : Pragma_Id;
begin
if Check_Excluded_Contracts (Spec_Id)
or else Check_Excluded_Contracts (Body_Id)
then
return True;
end if;
-- Check pragmas located in the body which may generate contracts
if Present (Declarations (N)) then
Decl := First (Declarations (N));
while Present (Decl) loop
if Nkind (Decl) = N_Pragma then
P_Id := Get_Pragma_Id (Pragma_Name (Decl));
if P_Id = Pragma_Contract_Cases or else
P_Id = Pragma_Pre or else
P_Id = Pragma_Precondition or else
P_Id = Pragma_Post or else
P_Id = Pragma_Postcondition
then
Cannot_Inline
("cannot inline & (non-allowed contract)?",
N, Subp);
return True;
end if;
end if;
Next (Decl);
end loop;
end if;
return False;
end Has_Excluded_Contract;
------------------------------
-- Has_Excluded_Declaration --
------------------------------
@ -2443,6 +2514,16 @@ package body Inline is
elsif Present (Body_To_Inline (Decl)) then
return False;
-- Cannot build the body to inline if the subprogram has unsupported
-- contracts that will be expanded into code (if assertions are not
-- enabled these pragmas will be removed by Generate_Body_To_Inline
-- to avoid reporting spurious errors).
elsif Assertions_Enabled
and then Has_Excluded_Contract
then
return False;
-- Subprograms that have return statements in the middle of the
-- body are inlined with gotos. GNATprove does not currently
-- support gotos, so we prevent such inlining.
@ -2660,7 +2741,10 @@ package body Inline is
Nxt := Next (Decl);
if Nkind (Decl) = N_Pragma
and then Nam_In (Pragma_Name (Decl), Name_Unreferenced,
and then Nam_In (Pragma_Name (Decl), Name_Contract_Cases,
Name_Precondition,
Name_Postcondition,
Name_Unreferenced,
Name_Unmodified)
then
Remove (Decl);

12
gcc/ada/par-ch13.adb
View File

@ -170,6 +170,8 @@ package body Ch13 is
Scan; -- past WITH
Aspects := Empty_List;
-- Loop to scan aspects
loop
OK := True;
@ -445,6 +447,12 @@ package body Ch13 is
end if;
end if;
-- Note if inside Depends aspect
if A_Id = Aspect_Depends then
Inside_Depends := True;
end if;
-- Parse the aspect definition depening on the expected
-- argument kind.
@ -460,6 +468,10 @@ package body Ch13 is
Aspect_Argument (A_Id) = Optional_Expression);
Set_Expression (Aspect, P_Expression);
end if;
-- Unconditionally reset flag for Inside_Depends
Inside_Depends := False;
end if;
-- Add the aspect to the resulting list only when it was properly

15
gcc/ada/par-ch2.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -298,13 +298,19 @@ package body Ch2 is
Import_Check_Required := False;
end if;
-- Set global to indicate if we are within a Depends pragma
if Chars (Ident_Node) = Name_Depends then
Inside_Depends := True;
end if;
-- Scan arguments. We assume that arguments are present if there is
-- a left paren, or if a semicolon is missing and there is another
-- token on the same line as the pragma name.
if Token = Tok_Left_Paren
or else (Token /= Tok_Semicolon
and then not Token_Is_At_Start_Of_Line)
and then not Token_Is_At_Start_Of_Line)
then
Set_Pragma_Argument_Associations (Prag_Node, New_List);
T_Left_Paren;
@ -349,6 +355,11 @@ package body Ch2 is
Semicolon_Loc := Token_Ptr;
-- Cancel indication of being within Depends pragm. Can be done
-- unconditionally, since quicker than doing a test.
Inside_Depends := False;
-- Now we have two tasks left, we need to scan out the semicolon
-- following the pragma, and we have to call Par.Prag to process
-- the pragma. Normally we do them in this order, however, there

2
gcc/ada/par-ch4.adb
View File

@ -2106,7 +2106,7 @@ package body Ch4 is
Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
if Style_Check then
Style.Check_Unary_Plus_Or_Minus;
Style.Check_Unary_Plus_Or_Minus (Inside_Depends);
end if;
Scan; -- past operator

21
gcc/ada/s-traceb-hpux.adb
View File

@ -262,14 +262,15 @@ package body System.Traceback is
-- but it is not usable when frames with dynamically allocated space are
-- on the way.
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
-- procedure Call_Chain
-- (Traceback : System.Address;
-- Max_Len : Natural;
-- Len : out Natural;
-- Exclude_Min : System.Address := System.Null_Address;
-- Exclude_Max : System.Address := System.Null_Address;
-- Skip_Frames : Natural := 1);
-- -- Same as the exported version, but takes Traceback as an Address
-- ???See declaration in the spec for why this is temporarily commented out.
------------------
-- C_Call_Chain --
@ -280,7 +281,6 @@ package body System.Traceback is
Max_Len : Natural) return Natural
is
Val : Natural;
begin
Call_Chain (Traceback, Max_Len, Val);
return Val;
@ -618,7 +618,8 @@ package body System.Traceback is
begin
Call_Chain
(Traceback'Address, Max_Len, Len,
Exclude_Min, Exclude_Max, Skip_Frames);
Exclude_Min, Exclude_Max, Skip_Frames + 1);
-- Skip one extra frame so we skip the other Call_Chain as well
end Call_Chain;
end System.Traceback;

20
gcc/ada/s-traceb-mastop.adb
View File

@ -37,14 +37,15 @@ package body System.Traceback is
use System.Machine_State_Operations;
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
-- procedure Call_Chain
-- (Traceback : System.Address;
-- Max_Len : Natural;
-- Len : out Natural;
-- Exclude_Min : System.Address := System.Null_Address;
-- Exclude_Max : System.Address := System.Null_Address;
-- Skip_Frames : Natural := 1);
-- -- Same as the exported version, but takes Traceback as an Address
-- ???See declaration in the spec for why this is temporarily commented out.
----------------
-- Call_Chain --
@ -113,7 +114,8 @@ package body System.Traceback is
begin
Call_Chain
(Traceback'Address, Max_Len, Len,
Exclude_Min, Exclude_Max, Skip_Frames);
Exclude_Min, Exclude_Max, Skip_Frames + 1);
-- Skip one extra frame so we skip the other Call_Chain as well
end Call_Chain;
------------------

24
gcc/ada/s-traceb.adb
View File

@ -38,14 +38,15 @@ pragma Compiler_Unit_Warning;
package body System.Traceback is
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
-- procedure Call_Chain
-- (Traceback : System.Address;
-- Max_Len : Natural;
-- Len : out Natural;
-- Exclude_Min : System.Address := System.Null_Address;
-- Exclude_Max : System.Address := System.Null_Address;
-- Skip_Frames : Natural := 1);
-- -- Same as the exported version, but takes Traceback as an Address
-- ???See declaration in the spec for why this is temporarily commented out.
------------------
-- C_Call_Chain --
@ -53,11 +54,9 @@ package body System.Traceback is
function C_Call_Chain
(Traceback : System.Address;
Max_Len : Natural)
return Natural
Max_Len : Natural) return Natural
is
Val : Natural;
begin
Call_Chain (Traceback, Max_Len, Val);
return Val;
@ -110,7 +109,8 @@ package body System.Traceback is
begin
Call_Chain
(Traceback'Address, Max_Len, Len,
Exclude_Min, Exclude_Max, Skip_Frames);
Exclude_Min, Exclude_Max, Skip_Frames + 1);
-- Skip one extra frame so we skip the other Call_Chain as well
end Call_Chain;
end System.Traceback;

22
gcc/ada/s-vaflop.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2014, 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- --
@ -443,6 +443,17 @@ package body System.Vax_Float_Operations is
return X - Y;
end Sub_G;
------------
-- T_To_G --
------------
-- This function must be located before T_To_D for frontend inlining
function T_To_G (X : T) return G is
begin
return G (X);
end T_To_G;
------------
-- T_To_D --
------------
@ -452,15 +463,6 @@ package body System.Vax_Float_Operations is
return G_To_D (T_To_G (X));
end T_To_D;
------------
-- T_To_G --
------------
function T_To_G (X : T) return G is
begin
return G (X);
end T_To_G;
-------------
-- Valid_D --
-------------

4
gcc/ada/scans.ads
View File

@ -472,6 +472,10 @@ package Scans is
-- Is it really right for this to be a Name rather than a String, what
-- about the case of Wide_Wide_Characters???
Inside_Depends : Boolean := False;
-- Flag set True for parsing the argument of a Depends pragma or aspect
-- (used to allow/require non-standard style rules for =>+ with -gnatyt).
Inside_If_Expression : Nat := 0;
-- This is a counter that is set non-zero while scanning out an if
-- expression (incremented on entry, decremented on exit). It is used to

2
gcc/ada/scng.adb
View File

@ -1571,7 +1571,7 @@ package body Scng is
Token := Tok_Arrow;
if Style_Check then
Style.Check_Arrow;
Style.Check_Arrow (Inside_Depends);
end if;
return;

6
gcc/ada/style.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -79,7 +79,7 @@ package Style is
renames Style_Inst.Check_Apostrophe;
-- Called after scanning an apostrophe to check spacing
procedure Check_Arrow
procedure Check_Arrow (Inside_Depends : Boolean := False)
renames Style_Inst.Check_Arrow;
-- Called after scanning out an arrow to check spacing
@ -180,7 +180,7 @@ package Style is
-- procedure is called only if THEN appears at the start of a line with
-- Token_Ptr pointing to the THEN keyword.
procedure Check_Unary_Plus_Or_Minus
procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False)
renames Style_Inst.Check_Unary_Plus_Or_Minus;
-- Called after scanning a unary plus or minus to check spacing

36
gcc/ada/styleg.adb
View File

@ -126,13 +126,32 @@ package body Styleg is
-- Check_Arrow --
-----------------
-- In check tokens mode (-gnatys), arrow must be surrounded by spaces
-- In check tokens mode (-gnatys), arrow must be surrounded by spaces,
-- except that within the argument of a Depends macro the required format
-- is =>+ rather than => +).
procedure Check_Arrow is
procedure Check_Arrow (Inside_Depends : Boolean := False) is
begin
if Style_Check_Tokens then
Require_Preceding_Space;
Require_Following_Space;
if not Inside_Depends then
Require_Following_Space;
-- Special handling for Inside_Depends
else
if Source (Scan_Ptr) = ' '
and then Source (Scan_Ptr + 1) = '+'
then
Error_Space_Not_Allowed (Scan_Ptr);
elsif Source (Scan_Ptr) /= ' '
and then Source (Scan_Ptr) /= '+'
then
Require_Following_Space;
end if;
end if;
end if;
end Check_Arrow;
@ -1032,10 +1051,17 @@ package body Styleg is
-- In check token mode (-gnatyt), unary plus or minus must not be
-- followed by a space.
procedure Check_Unary_Plus_Or_Minus is
-- Annoying exception: if we have the sequence =>+ within a Depends pragma
-- or aspect, then we insist on a space rather than forbidding it.
procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False) is
begin
if Style_Check_Tokens then
Check_No_Space_After;
if not Inside_Depends then
Check_No_Space_After;
else
Require_Following_Space;
end if;
end if;
end Check_Unary_Plus_Or_Minus;

16
gcc/ada/styleg.ads
View File

@ -2,11 +2,11 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S T Y L E G --
-- S T Y L E G --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -52,8 +52,10 @@ package Styleg is
procedure Check_Apostrophe;
-- Called after scanning an apostrophe to check spacing
procedure Check_Arrow;
-- Called after scanning out an arrow to check spacing
procedure Check_Arrow (Inside_Depends : Boolean := False);
-- Called after scanning out an arrow to check spacing. Inside_Depends is
-- true if the call is from an argument of the Depends pragma (where the
-- allowed/required format is =>+).
procedure Check_Attribute_Name (Reserved : Boolean);
-- The current token is an attribute designator. Check that it
@ -143,8 +145,10 @@ package Styleg is
-- would interfere with coverage testing). Handles case of THEN ABORT as
-- an exception, as well as PRAGMA after ELSE.
procedure Check_Unary_Plus_Or_Minus;
-- Called after scanning a unary plus or minus to check spacing
procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False);
-- Called after scanning a unary plus or minus to check spacing. The flag
-- Inside_Depends is set if we are scanning within a Depends pragma or
-- Aspect, in which case =>+ requires a following space).
procedure Check_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing