From: Arnaud Charlet Date: Thu, 31 Jul 2014 10:02:13 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=aa3efecdfbd42f3ec8dce3a3d85a0cc8f60e01ce;p=gcc.git [multiple changes] 2014-07-31 Robert Dewar * 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 * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bd7154fbdf5..f2b68c64568 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2014-07-31 Robert Dewar + + * 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 + + * 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 + + * 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 * checks.adb (Enable_Overflow_Check): More precise setting of diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index a856ad716dc..0f28ec5be09 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -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); diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 387c83ef839..2932c540cd8 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -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 diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 2218dacb17e..99d1f2de8c7 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index e5fb00c6657..8f6da4eb4c3 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -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 diff --git a/gcc/ada/s-traceb-hpux.adb b/gcc/ada/s-traceb-hpux.adb index 92e36ca06d6..52bca4cea04 100644 --- a/gcc/ada/s-traceb-hpux.adb +++ b/gcc/ada/s-traceb-hpux.adb @@ -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; diff --git a/gcc/ada/s-traceb-mastop.adb b/gcc/ada/s-traceb-mastop.adb index f7da8070e77..79b8eccc61a 100644 --- a/gcc/ada/s-traceb-mastop.adb +++ b/gcc/ada/s-traceb-mastop.adb @@ -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; ------------------ diff --git a/gcc/ada/s-traceb.adb b/gcc/ada/s-traceb.adb index 0c55cfc6b5a..78c759b9932 100644 --- a/gcc/ada/s-traceb.adb +++ b/gcc/ada/s-traceb.adb @@ -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; diff --git a/gcc/ada/s-vaflop.adb b/gcc/ada/s-vaflop.adb index ac50817c8d7..e36c356fc2a 100644 --- a/gcc/ada/s-vaflop.adb +++ b/gcc/ada/s-vaflop.adb @@ -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- -- @@ -444,22 +444,24 @@ package body System.Vax_Float_Operations is end Sub_G; ------------ - -- T_To_D -- + -- T_To_G -- ------------ - function T_To_D (X : T) return D is + -- This function must be located before T_To_D for frontend inlining + + function T_To_G (X : T) return G is begin - return G_To_D (T_To_G (X)); - end T_To_D; + return G (X); + end T_To_G; ------------ - -- T_To_G -- + -- T_To_D -- ------------ - function T_To_G (X : T) return G is + function T_To_D (X : T) return D is begin - return G (X); - end T_To_G; + return G_To_D (T_To_G (X)); + end T_To_D; ------------- -- Valid_D -- diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index ae7f91d9e42..682bb6c72fd 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -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 diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 8ccdda628a5..3e31e5af82d 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -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; diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads index b52a8fb1227..525e5602b82 100644 --- a/gcc/ada/style.ads +++ b/gcc/ada/style.ads @@ -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 diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index c94759c7da0..a421f250285 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -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; diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads index 2369281b0f6..344d4fb7d91 100644 --- a/gcc/ada/styleg.ads +++ b/gcc/ada/styleg.ads @@ -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