[PING][PATCH] [AArch64] Implement automod load and store for Thunderx2t99
Hi, Please consider this as a personal reminder to review the patch at following link and let me know your comments on the same. https://gcc.gnu.org/ml/gcc-patches/2017-03/msg00226.html Thanks, Naveen
[PING][PATCH][AArch64] Add crypto_pmull attribute
Hi, Please consider this as a personal reminder to review the patch at following link and let me know your comments on the same. https://gcc.gnu.org/ml/gcc-patches/2017-03/msg00504.html Thanks, Naveen
[PING}[PATCH][AArch64] Add neon_pairwise_add & neon_pairwise_add_q types
Hi, Please consider this as a personal reminder to review the patch at following link and let me know your comments on the same. https://gcc.gnu.org/ml/gcc-patches/2017-03/msg00505.html Thanks, Naveen
[PATCH] For broken exception handling in GDB on AIX platform
Hi, I work with nitish. Just wanted to check on this patch contribution if anyone has comments yet or changes are fine. As of now all the comments are answered. Here is link https://gcc.gnu.org/ml/gcc-patches/2017-04/msg00121.html Thanks, -Sangamesh
[PING][PATCH] Move the check for any_condjump_p from sched-deps to target macros
Hi, Please consider this as a personal reminder to review the patch at following link and let me know your comments on the same. https://gcc.gnu.org/ml/gcc-patches/2017-03/msg01368.html Thanks, Naveen
Re: [PING][PATCH][AArch64] Implement ALU_BRANCH fusion
Hi, Please consider this as a personal reminder to review the patch at following link and let me know your comments on the same. https://gcc.gnu.org/ml/gcc-patches/2017-03/msg01369.html Thanks, Naveen
Re: X /[ex] 4 < Y /[ex] 4
On Mon, 24 Apr 2017, Jeff Law wrote: Martin Sebor was considering looking at a variety of issues affecting our ability to do a good job with std::vector. You might want to coordinate with him to make sure y'all don't duplicate work. I don't really have any plans for std::vector that might overlap with someone else's. I just have a couple more transformations of the type (X OP Y) CMP (X OP Z), but that will not affect std::vector. My first guess for improving std::vector would be around the lack of magic in new/delete, compared to malloc/free. -- Marc Glisse
[PATCH, C++] Fix-it info for invalid class/struct after enum
Hi,
the following patch adds fix-it information for a pedwarn in the C++
parser about the invalid use of class/struct after enum.
I factored out the call to cp_lexer_peek_token, because it was called
already 3 times (twice from within cp_lexer_next_token_is_keyword)
and I didn't want to add a 4th call to get the token's location.
I also fixed the broken indentation of the pedwarn.
Thanks to David for suggesting to use gcc_rich_location::add_range
to highlight multiple tokens.
Bootstrapped and regtested on x86_64-pc-linux-gnu.
OK for trunk?
Regards,
Volker
2017-04-25 Volker Reichelt
* parser.c (cp_parser_elaborated_type_specifier): Add fix-it to
diagnostic of invalid class/struct keyword after enum.
Index: gcc/cp/parser.c
===
--- gcc/cp/parser.c (revision 247110)
+++ gcc/cp/parser.c (working copy)
@@ -17270,12 +17270,16 @@
tag_type = enum_type;
/* Issue a warning if the `struct' or `class' key (for C++0x scoped
enums) is used here. */
- if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CLASS)
- || cp_lexer_next_token_is_keyword (parser->lexer, RID_STRUCT))
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+ if (cp_parser_is_keyword (token, RID_CLASS)
+ || cp_parser_is_keyword (token, RID_STRUCT))
{
- pedwarn (input_location, 0, "elaborated-type-specifier "
- "for a scoped enum must not use the %qD keyword",
- cp_lexer_peek_token (parser->lexer)->u.value);
+ gcc_rich_location richloc (token->location);
+ richloc.add_range (input_location, false);
+ richloc.add_fixit_remove ();
+ pedwarn_at_rich_loc (&richloc, 0, "elaborated-type-specifier for "
+ "a scoped enum must not use the %qD keyword",
+ token->u.value);
/* Consume the `struct' or `class' and parse it anyway. */
cp_lexer_consume_token (parser->lexer);
}
===
2017-04-25 Volker Reichelt
* g++.dg/cpp0x/enum34.C: New test.
Index: gcc/testsuite/g++.dg/cpp0x/enum34.C
===
--- gcc/testsuite/g++.dg/cpp0x/enum34.C 2017-04-25
+++ gcc/testsuite/g++.dg/cpp0x/enum34.C 2017-04-25
@@ -0,0 +1,11 @@
+// { dg-options "-fdiagnostics-show-caret" }
+// { dg-do compile { target c++11 } }
+
+enum class E;
+
+enum class E e; /* { dg-warning "scoped enum must not use" }
+ { dg-begin-multiline-output "" }
+ enum class E e;
+ ^
+ -
+ { dg-end-multiline-output "" } */
===
Re: [PATCH, rs6000] pr80482 Relax vector builtin parameter checks
On Mon, Apr 24, 2017 at 11:58:03PM -0500, Segher Boessenkool wrote: > On Mon, Apr 24, 2017 at 05:38:58PM -0500, Bill Seurer wrote: > > [PATCH, rs6000] pr80482 Relax vector builtin parameter checks > > > > This patch changes the parameter testing for powerpc vector builtins to > > relax > > the existing requirement that the parameters be identical to instead that > > they > > be compatible. This allows for mixing parameters with differing qualified > > (const, volatile, etc.) types. > > > > See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=80482 for more information. > > > > Bootstrapped and tested on powerpc64le-unknown-linux-gnu and > > powerpc64be-unknown-linux-gnu with no regressions. Is this ok for trunk? > > It looks fine to me, okay for trunk, thanks (with Jakub's comment taken > care of). > > Also okay for the 7 branch if the RMs agree (it fixes a regression from > GCC 6 and it seems unlikely to cause new problems). Ok for 7.1 if you commit soon. Jakub
Re: [PATCH v5] S/390: Optimize atomic_compare_exchange and atomic_compare builtins.
On 04/11/2017 04:20 PM, Dominik Vogt wrote: > On Mon, Mar 27, 2017 at 09:27:35PM +0100, Dominik Vogt wrote: >> The attached patch optimizes the atomic_exchange and >> atomic_compare patterns on s390 and s390x (mostly limited to >> SImode and DImode). Among general optimizaation, the changes fix >> most of the problems reported in PR 80080: >> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=80080 >> >> Bootstrapped and regression tested on a zEC12 with s390 and s390x >> biarch. > > v5: > * Generate LT pattern directly for const 0 value. > * Split into three patches. > > Bootstrapped and regression tested on a zEC12 with s390 and s390x > biarch. Applied to mainline. Thanks! -Andreas-
[Ada] Support for locking policies in Linux
This patch allows the locking policies Ceiling_Locking and Inheritance_Locking to be supported under Linux. No small test case is available. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * s-osinte-linux.ads (pthread_mutexattr_setprotocol, pthread_mutexattr_setprioceiling): Add new interfaces for these pthread operations. * s-taprop-linux.adb (Initialize_Lock, Initialize_TCB): Set protocols as appropriate for Locking_Policy 'C' and 'I'. * s-taprop-posix.adb: Minor reformatting to make it more similar to s-taprop-linux.adb. Index: s-osinte-linux.ads === --- s-osinte-linux.ads (revision 247135) +++ s-osinte-linux.ads (working copy) @@ -452,6 +452,20 @@ -- POSIX.1c Section 13 -- -- + PTHREAD_PRIO_NONE: constant := 0; + PTHREAD_PRIO_INHERIT : constant := 1; + PTHREAD_PRIO_PROTECT : constant := 2; + + function pthread_mutexattr_setprotocol + (attr : access pthread_mutexattr_t; + protocol : int) return int; + pragma Import (C, pthread_mutexattr_setprotocol); + + function pthread_mutexattr_setprioceiling + (attr: access pthread_mutexattr_t; + prioceiling : int) return int; + pragma Import (C, pthread_mutexattr_setprioceiling); + type struct_sched_param is record sched_priority : int; -- scheduling priority end record; Index: s-taprop-linux.adb === --- s-taprop-linux.adb (revision 247135) +++ s-taprop-linux.adb (working copy) @@ -111,6 +111,14 @@ -- Constant to indicate that the thread identifier has not yet been -- initialized. + function geteuid return Integer; + pragma Import (C, geteuid, "geteuid"); + pragma Warnings (Off, "non-static call not allowed in preelaborated unit"); + Superuser : constant Boolean := geteuid = 0; + pragma Warnings (On, "non-static call not allowed in preelaborated unit"); + -- True if we are running as 'root'. On Linux, ceiling priorities work only + -- in that case, so if this is False, we ignore Locking_Policy = 'C'. + -- Local Packages -- @@ -161,6 +169,11 @@ procedure Abort_Handler (signo : Signal); + function GNAT_pthread_condattr_setup + (attr : access pthread_condattr_t) return int; + pragma Import (C, + GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); + --- -- Abort_Handler -- --- @@ -261,8 +274,6 @@ (Prio : System.Any_Priority; L: not null access Lock) is - pragma Unreferenced (Prio); - begin if Locking_Policy = 'R' then declare @@ -291,36 +302,91 @@ else declare +Attributes : aliased pthread_mutexattr_t; Result : Interfaces.C.int; begin -Result := pthread_mutex_init (L.WO'Access, null); +Result := pthread_mutexattr_init (Attributes'Access); +pragma Assert (Result = 0 or else Result = ENOMEM); +if Result = ENOMEM then + raise Storage_Error; +end if; + +if Locking_Policy = 'C' then + if Superuser then + Result := pthread_mutexattr_setprotocol +(Attributes'Access, PTHREAD_PRIO_PROTECT); + pragma Assert (Result = 0); + + Result := pthread_mutexattr_setprioceiling + (Attributes'Access, Interfaces.C.int (Prio)); + pragma Assert (Result = 0); + end if; + +elsif Locking_Policy = 'I' then + Result := pthread_mutexattr_setprotocol + (Attributes'Access, PTHREAD_PRIO_INHERIT); + pragma Assert (Result = 0); +end if; + +Result := pthread_mutex_init (L.WO'Access, Attributes'Access); pragma Assert (Result = 0 or else Result = ENOMEM); if Result = ENOMEM then + Result := pthread_mutexattr_destroy (Attributes'Access); raise Storage_Error with "Failed to allocate a lock"; end if; + +Result := pthread_mutexattr_destroy (Attributes'Access); +pragma Assert (Result = 0); end; end if; end Initialize_Lock; procedure Initialize_Lock - (L : not null access RTS_Lock; - Level : Lock_Level) + (L : not null access RTS_Lock; Level : Lock_Level) is pragma Unreferenced (Level); - Result : Interfaces.C.int; + Attributes : aliased pthread_mutexattr_t; + Result : Interfaces.C.int; begin - Result := pthread_mutex_init (L, null); + Result := pthread_mutexattr_init (Attributes'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + if Result
[Ada] Private tagged subtype with renamed and constrained discriminants.
This patch fixes a compiler abort on an object declaration for a private type with discriminants, when the full view of the type is derived from an ancestor with additional discriminants and the derivation chain includes discriminant renamings. Executing gnatmake -q main main must yield: 13 --- with Types; use Types; with Text_IO; use Text_IO; procedure Main is Obj : Deriv_13 (13); begin Put_Line (Integer'Image (Obj.D_1)); end Main; --- package Types is type Par_13 (D_1 : Integer; D_2 : Integer) is tagged private; type Mid_13 (D_3 : Integer) is new Par_13 with private; type Deriv_13 (D_1 : Integer) is tagged private; private type Par_13 (D_1 : Integer; D_2 : Integer) is tagged null record; type Mid_13 (D_3 : Integer) is new Par_13 (D_1 => 123, D_2 => D_3) with null record; type Deriv_13 (D_1 : Integer) is new Mid_13 (D_3 => D_1) with null record; end Types; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg * sem_ch3.adb (Get_Discriminant_Value, Search_Derivation_Levels): Handle properly a multi- level derivation involving both renamed and constrained parent discriminants, when the type to be constrained has fewer discriminants that the ultimate ancestor. Index: sem_ch3.adb === --- sem_ch3.adb (revision 247135) +++ sem_ch3.adb (working copy) @@ -17660,8 +17660,13 @@ end if; while Present (Disc) loop -pragma Assert (Present (Assoc)); +-- If no further associations return the discriminant, value +-- will be found on the second pass. +if No (Assoc) then + return Result; +end if; + if Original_Record_Component (Disc) = Result_Entity then return Node (Assoc); end if; @@ -17690,6 +17695,8 @@ -- ??? This routine is a gigantic mess and will be deleted. For the -- time being just test for the trivial case before calling recurse. + -- We are now celebrating the 20th anniversary of this comment! + if Base_Type (Scope (Discriminant)) = Base_Type (Typ_For_Constraint) then declare D : Entity_Id;
[Ada] Illegal renaming of conditional expression
This patch corrects a compiler bug that caused an illegal renaming to not be detected. In particular, it wasn't detected if the name in the renaming is a qualified expression whose operand is a conditional expression, and the type is a by-reference type. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * sem_util.adb (Is_Object_Reference): In the case of N_Explicit_Dereference, return False if it came from a conditional expression. Index: sem_util.adb === --- sem_util.adb(revision 247137) +++ sem_util.adb(working copy) @@ -13548,8 +13548,14 @@ (Is_Object_Reference (Prefix (N)) or else Is_Access_Type (Etype (Prefix (N; +-- An explicit dereference denotes an object, except that a +-- conditional expression gets turned into an explicit dereference +-- in some cases, and conditional expressions are not object +-- names. + when N_Explicit_Dereference => - return True; + return not Nkind_In + (Original_Node (N), N_If_Expression, N_Case_Expression); -- A view conversion of a tagged object is an object reference
[Ada] Syntactic error recovery for case expressions
This patch improves the synactic error recovery in the case where a ";"
is used instead of "," in a case expression. The following test should
get these errors:
case_exp_semi.ads:5:28: ";" should be ","
package Case_Exp_Semi is
X : Integer := 1;
Y : Integer :=
(case X is when 1 => 1; when 2 => 2, when others => 3);
end Case_Exp_Semi;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* par-ch4.adb (P_Case_Expression): If a semicolon
is followed by "when", assume that ";" was meant to be ",".
Index: par-ch4.adb
===
--- par-ch4.adb (revision 247135)
+++ par-ch4.adb (working copy)
@@ -3199,6 +3199,20 @@
if Token = Tok_When then
T_Comma;
+ -- A semicolon followed by "when" is probably meant to be a comma
+
+ elsif Token = Tok_Semicolon then
+Save_Scan_State (Save_State);
+Scan; -- past the semicolon
+
+if Token /= Tok_When then
+ Restore_Scan_State (Save_State);
+ exit;
+end if;
+
+Error_Msg_SP -- CODEFIX
+ ("|"";"" should be "",""");
+
-- If comma/WHEN, skip comma and we have another alternative
elsif Token = Tok_Comma then
[Ada] Spurious error on deferred constant in expression function
This patch removes a spurious error on a deferred constant that appears within an expression function, when the expression is being frozen by the presence of its generated body. Such bodies are not a freeze point unless they are completions. The following must compile quietly: --- package P is package S is type T is private; No_T : constant T; function Is_Null (A_T : T) return Boolean is (A_T = No_T); private type T is null record; No_T : constant T := (null record); end; end P; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg * freeze.adb (Check_Expression_Function): Do not check for the use of deferred constants if the freezing of the expression function is triggered by its generated body, rather than a premature use. Index: freeze.adb === --- freeze.adb (revision 247140) +++ freeze.adb (working copy) @@ -1384,8 +1384,12 @@ begin Decl := Original_Node (Unit_Declaration_Node (Nam)); + -- The subprogram body created for the expression function is not + -- itself a freeze point. + if Scope (Nam) = Current_Scope and then Nkind (Decl) = N_Expression_Function +and then Nkind (N) /= N_Subprogram_Body then Check_Deferred (Expression (Decl)); end if;
[Ada] Spurious error on subtypes of private tagged types
When a private tagged record type has some component whose type is the public declaration of a private subtype the compiler may report an spurious error on invalid conversion. The same error may be also reported on package instantiations when the actual type of some generic formal is a private type that is used in the instantiation to declare a component of a tagged type declaration. After this patch the following test compiles without errors. package Pkg1 is type Bounded_String is private; private type Super_String (Max_Length : Positive) is record null; end record; type Bounded_String is new Super_String (10); end; with Pkg1; package Pkg2 is type Key_Type is private; private type Key_Type is new Pkg1.Bounded_String; end; package Pkg2.Child is subtype A_T is Key_Type; -- Test private type Derived is tagged record X : A_T;-- Test end record; end; Command: gcc -c pkg2-child.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Javier Miranda * exp_attr.adb (Rewrite_Stream_Proc_Call): Handle subtypes of private types when performing the view conversion. Index: exp_attr.adb === --- exp_attr.adb(revision 247135) +++ exp_attr.adb(working copy) @@ -1650,8 +1650,8 @@ -- Perform a view conversion when either the argument or the -- formal parameter are of a private type. -if Is_Private_Type (Formal_Typ) - or else Is_Private_Type (Item_Typ) +if Is_Private_Type (Base_Type (Formal_Typ)) + or else Is_Private_Type (Base_Type (Item_Typ)) then Rewrite (Item, Unchecked_Convert_To (Formal_Typ, Relocate_Node (Item)));
[Ada] Support for discriminants in pragma Default_Initial_Condition
This patch adds support for tagged discriminants in assertion expressions such
as those of pragma Default_Initial_Condition or Type_Invariant'Class. In these
contexts, tagged discriminants behave as primitives and exhibit "overriding"-
like properties. For instance, if a derived type constrains its parent and
inherits a Default_Initial_Condition from it which checks the discriminant of
the parent, the runtime check must verify the discriminant of the derived type.
-- Source --
-- tester.ads
package Tester is
type Type_Id is
(No_Type,
Deriv_1_Id,
Deriv_2_Id,
Deriv_3_Id,
Deriv_4_Id,
Deriv_5_Id,
Deriv_6_Id,
Deriv_7_Id,
Deriv_8_Id,
Deriv_9_Id,
Deriv_10_Id,
Deriv_11_Id,
Deriv_12_Id,
Deriv_13_Id,
Deriv_14_Id,
Deriv_15_Id,
Deriv_16_Id,
Deriv_17_Id,
Deriv_18_Id,
Deriv_19_Id,
Deriv_20_Id,
Mid_13_Id,
Mid_14_Id,
Mid_19_Id,
Par_1_Id,
Par_2_Id,
Par_3_Id,
Par_4_Id,
Par_5_Id,
Par_6_Id,
Par_7_Id,
Par_8_Id,
Par_9_Id,
Par_10_Id,
Par_11_Id,
Par_12_Id,
Par_13_Id,
Par_14_Id,
Par_15_Id,
Par_16_Id,
Par_17_Id,
Par_18_Id,
Par_19_Id,
Par_20_Id);
type Result is record
X : Integer;
Y : Integer;
end record;
No_Result : constant Result := (0, 0);
type Results is array (Type_Id) of Result;
procedure Mark (Id : Type_Id; X : Integer; Y : Integer);
-- Record the result for a particular type
procedure Reset_Results;
-- Reset the internally kept result state
procedure Test_Result (Test_Id : String; Exp : Results);
-- Ensure that the internally kept result state agrees with expected
-- results Exp. Emit an error if this is not the case.
end Tester;
-- tester.ads
with Ada.Text_IO; use Ada.Text_IO;
package body Tester is
State : Results;
--
-- Mark --
--
procedure Mark (Id : Type_Id; X : Integer; Y : Integer) is
begin
State (Id) := (X, Y);
end Mark;
---
-- Reset_Results --
---
procedure Reset_Results is
begin
State := (others => No_Result);
end Reset_Results;
-
-- Test_Result --
-
procedure Test_Result (Test_Id : String; Exp : Results) is
Exp_Val : Result;
Posted: Boolean := False;
State_Val : Result;
begin
for Index in Results'Range loop
Exp_Val := Exp (Index);
State_Val := State (Index);
if State_Val /= Exp_Val then
if not Posted then
Posted := True;
Put_Line (Test_Id & ": ERROR");
end if;
Put_Line
(" Index : " & Index'Img);
Put_Line
(" Expected:" & Exp_Val.X'Img & ',' & Exp_Val.Y'Img);
Put_Line
(" Got :" & State_Val.X'Img & ',' & State_Val.Y'Img);
end if;
end loop;
if not Posted then
Put_Line (Test_Id & ": OK");
end if;
end Test_Result;
end Tester;
-- dic_aspects.ads
package DIC_Aspects is
---
-- 1) No derivations --
---
type No_Deriv_1 (D_1 : Integer; D_2 : Integer) is private
with Default_Initial_Condition => No_Deriv_1.D_1 > 1 and then D_2 > 2;
type No_Deriv_2 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => No_Deriv_2.D_1 > 1 and then D_2 > 2;
---
-- 2) Tagged derivations --
---
-- No overriding
-- No discriminants
-- Visible derivation
type Par_1 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => A (Par_1, Par_1.D_1, D_2);
function A (Obj : Par_1; X : Integer; Y : Integer) return Boolean;
type Deriv_1 is new Par_1 with private;
-- DIC calls: A (Par_1, Par_1.D_1, Par_1.D_2)
-- No overriding
-- Unknown discriminants
-- Hidden derivation
type Par_2 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => B (Par_2, Par_2.D_1, D_2);
function B (Obj : Par_2; X : Integer; Y : Integer) return Boolean;
type Deriv_2 (<>) is tagged private;
-- DIC calls: B (Par_2, Par_2.D_1, Par_2.D_2)
-- No overriding
-- Renaming
-- Visible derivation
type Par_3 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => C (Par_3, Par_3.D_1, D_2);
function C (Obj : Par_3; X : Integer; Y : Integer) return Boolean;
type Deriv_3 (D_2 : Integer; D_3 : Integer) is new Par_3 with private;
-- D_2 renames Par_3.D_2
-- D_3 renames Par_3.D_1
-- DIC calls: C (Par_3, Deriv_3.D_3, Deriv_3.D_2)
-- No overriding
-- Renaming
-- Hidden derivation
type Par_4 (D_1 : Integer; D_2 : I
[Ada] Latent bug in Uintp.Most_Sig_2_Digits
This patch fixes a latent bug in Uintp.Most_Sig_2_Digits, that would cause a crash if Left is indirect and Right is direct. In fact, that combination never occurs in any existing calls. No test is available, because the bug is latent. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * uintp.adb (Most_Sig_2_Digits): In case Direct (Right), fetch Direct_Val (Right), instead of the incorrect Direct_Val (Left). (UI_GCD): Remove ??? comment involving possible efficiency improvements. This just isn't important after all these years. Also minor cleanup. * uintp.ads: Minor cleanup. Index: uintp.adb === --- uintp.adb (revision 247135) +++ uintp.adb (working copy) @@ -52,7 +52,7 @@ UI_Power_2 : array (Int range 0 .. 64) of Uint; -- This table is used to memoize exponentiations by powers of 2. The Nth - -- entry, if set, contains the Uint value 2 ** N. Initially UI_Power_2_Set + -- entry, if set, contains the Uint value 2**N. Initially UI_Power_2_Set -- is zero and only the 0'th entry is set, the invariant being that all -- entries in the range 0 .. UI_Power_2_Set are initialized. @@ -149,9 +149,9 @@ Left_Hat : out Int; Right_Hat : out Int); -- Returns leading two significant digits from the given pair of Uint's. - -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K) where + -- Mathematically: returns Left / (Base**K) and Right / (Base**K) where -- K is as small as possible S.T. Right_Hat < Base * Base. It is required - -- that Left > Right for the algorithm to work. + -- that Left >= Right for the algorithm to work. function N_Digits (Input : Uint) return Int; pragma Inline (N_Digits); @@ -264,7 +264,7 @@ --- function Better_In_Hex return Boolean is - T16 : constant Uint := Uint_2 ** Int'(16); + T16 : constant Uint := Uint_2**Int'(16); A : Uint; begin @@ -506,6 +506,7 @@ pragma Assert (Left >= Right); if Direct (Left) then + pragma Assert (Direct (Right)); Left_Hat := Direct_Val (Left); Right_Hat := Direct_Val (Right); return; @@ -533,7 +534,7 @@ begin if Direct (Right) then -T := Direct_Val (Left); +T := Direct_Val (Right); R1 := abs (T / Base); R2 := T rem Base; Length_R := 2; @@ -1370,7 +1371,7 @@ elsif Right <= Uint_64 then - -- 2 ** N for N in 2 .. 64 + -- 2**N for N in 2 .. 64 if Left = Uint_2 then declare @@ -1390,7 +1391,7 @@ return UI_Power_2 (Right_Int); end; - -- 10 ** N for N in 2 .. 64 + -- 10**N for N in 2 .. 64 elsif Left = Uint_10 then declare @@ -1585,20 +1586,6 @@ else -- Use prior single precision steps to compute this Euclid step --- For constructs such as: --- sqrt_2: constant := 1.41421_35623_73095_04880_16887_24209_698; --- sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2) ---** long_float'machine_mantissa; --- --- we spend 80% of our time working on this step. Perhaps we need --- a special case Int / Uint dot product to speed things up. ??? - --- Alternatively we could increase the single precision iterations --- to handle Uint's of some small size ( <5 digits?). Then we --- would have more iterations on small Uint. On the code above, we --- only get 5 (on average) single precision iterations per large --- iteration. ??? - Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V); V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V); U := Tmp_UI; Index: uintp.ads === --- uintp.ads (revision 247135) +++ uintp.ads (working copy) @@ -238,7 +238,7 @@ (B : Uint; E : Uint; Modulo : Uint) return Uint; - -- Efficiently compute (B ** E) rem Modulo + -- Efficiently compute (B**E) rem Modulo function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint; -- Compute the multiplicative inverse of N in modular arithmetics with the @@ -438,7 +438,7 @@ Base_Bits : constant := 15; -- Number of bits in base value - Base : constant Int := 2 ** Base_Bits; + Base : constant Int := 2**Base_Bits; -- Values in the range -(Base-1) .. Max_Direct are encoded directly as -- Uint values by adding a bias value. The value of Max_Direct is chosen @@ -454,13 +454,13 @@ -- avoid accidental use of Uint arithmetic on these values, which is never -- correct. - type Ctrl is range Int'First
Re: [PATCH] [AArch64] PR target/71663 Improve Vector Initializtion
Hi Naveen,
On 09/12/16 07:02, Hurugalawadi, Naveen wrote:
Hi,
Sorry. Missed out the testcase in patch submission.
Added the missing testcase along with the ChangeLog.
Please review the same and let us know if thats okay?
It would be useful if you expanded a bit on the approach used to
generate the improved codegen, or at least show for the testcase
what code was generated before this patch and what is generated
after this patch.
2016-12-09 Andrew PInski
gcc
* config/aarch64/aarch64.c (aarch64_expand_vector_init):
Improve vector initialization code gen.
gcc/testsuite
* gcc.target/aarch64/pr71663.c: New Testcase.
+ /* If there is only varables, try to optimize
+ the inseration using dup for the most common element
+ followed by insertations. */
Some typos: s/is only varables/are only variable elements/,
s/inseration/insertion/,
s/insertations/insertions/.
+ if (n_var == n_elts && n_elts <= 16)
diff --git a/gcc/testsuite/gcc.target/aarch64/pr71663.c
b/gcc/testsuite/gcc.target/aarch64/pr71663.c
new file mode 100644
index 000..c8df847
--- /dev/null
+++ b/gcc/testsuite/gcc.target/aarch64/pr71663.c
@@ -0,0 +1,14 @@
+/* { dg-do compile } */
+/* { dg-options "-O2" } */
+
+#define vector __attribute__((vector_size(16)))
+
+vector float combine (float a, float b, float c, float d)
+{
+ return (vector float) { a, b, c, d };
+}
A large part of the aarch64.c hunk of your patch deals with finding the most
commonly-occuring
element in the vector of variables, yet in your testcase all variables appear
exactly once.
Perhaps worth adding a testcase where one of the vector elements appears more
than the others?
I'd guess the codegen then would be better with this patch?
Cheers,
Kyrill
[Ada] Crash processing discriminants of private subtype
The compiler may crash processing a private tagged record type has some component whose type is a subtype of a private type. After this patch the following test compiles without errors. package Other_Type is package BS is type Bounded_String is private; private type Super_String (Max_Length : Positive) is record null; end record; type Bounded_String is new Super_String (10); end; type S is new BS.Bounded_String; end; with Other_Type; package Pkg is type Key_Type is private; private type Key_Type is new Other_Type.S; end; package Pkg.Gen_Instance is type T is tagged null record; private subtype A_T is Key_Type; type Derived is new T with record -- Test X : A_T; end record; end; Command: gcc -c pkg-gen_instance.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Javier Miranda * exp_ch3.adb (Build_Initialization_Call): Handle subtypes of private types when searching for the underlying full view of a private type. Index: exp_ch3.adb === --- exp_ch3.adb (revision 247143) +++ exp_ch3.adb (working copy) @@ -1451,6 +1451,12 @@ elsif Is_Generic_Actual_Type (Full_Type) then Full_Type := Base_Type (Full_Type); +elsif Ekind (Full_Type) = E_Private_Subtype + and then (not Has_Discriminants (Full_Type) + or else No (Discriminant_Constraint (Full_Type))) +then + Full_Type := Etype (Full_Type); + -- The loop has recovered the [underlying] full view, stop the -- traversal.
[Ada] Crash on expression function with fixed point types
The compiler may crash processing a conditional expression that is part of an arithmetic expression computing a fixed point value. After this patch the following test compiles without errors. procedure P (B : Boolean) is type Fixed is delta 0.01 range -100.0 .. 100.0; X : Fixed := 10.0; begin X := X * (case B is when True => 1.0, when False => -1.0); end; Command: gcc -c p.adb Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Javier Miranda * sem_res.adb (Set_Mixed_Mode_Operand): A universal real conditional expression can appear in a fixed-type context and must be resolved with that context to facilitate the code generation to the backend. Index: sem_res.adb === --- sem_res.adb (revision 247135) +++ sem_res.adb (working copy) @@ -5353,6 +5353,16 @@ Resolve (Op2, T2); end; + -- A universal real conditional expression can appear in a fixed-type + -- context and must be resolved with that context to facilitate the + -- code generation to the backend. + + elsif Nkind_In (N, N_Case_Expression, N_If_Expression) + and then Etype (N) = Universal_Real + and then Is_Fixed_Point_Type (B_Typ) + then +Resolve (N, B_Typ); + else Resolve (N); end if;
[Ada] Better error message for illegal use of 'Access in a call.
This patch improves the error message in the case of an attribute reference
that is an actual in a call to a subprogram inherited from a generic formal
type with unknown discriminants, which makes the subprogram and its formal
parameters intrinsic (see RM 6.3.1 (8) and (13)).
Compiling l.adb must yield:
l.adb:6:08: subprogram and its formal paramenters have convention Intrinsic
l.adb:6:22: actual cannot be access attribute
with G;
generic
type D (<>) is new G.T with private;
package L is
type DT is new D with null record;
procedure Foo (A_T : DT; P : access procedure);
end;
---
package body L is
procedure Foo (A_T : DT; P : access procedure) is
procedure Q is begin null; end;
begin
D (A_T).Foo (Q'Access);
end Foo;
end;
---
package G is
type T is tagged null record;
procedure Foo (A_T : T; P : access procedure);
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_attr.adb (Analyze_Attribute, case 'Access): Specialize
the error message when the attribute reference is an actual in
a call to a subprogram inherited from a generic formal type with
unknown discriminants, which makes the subprogram and its formal
parameters intrinsic (see RM 6.3.1 (8) and (13)).
Index: sem_attr.adb
===
--- sem_attr.adb(revision 247147)
+++ sem_attr.adb(working copy)
@@ -10532,11 +10532,34 @@
if Convention (Designated_Type (Btyp)) /=
Convention (Entity (P))
then
- Error_Msg_FE
- ("subprogram & has wrong convention", P, Entity (P));
- Error_Msg_Sloc := Sloc (Btyp);
- Error_Msg_FE ("\does not match & declared#", P, Btyp);
+ -- The rule in 6.3.1 (8) deserves a special error
+ -- message.
+ if Convention (Btyp) = Convention_Intrinsic
+ and then Nkind (Parent (N)) = N_Procedure_Call_Statement
+ and then Is_Entity_Name (Name (Parent (N)))
+ and then Inside_A_Generic
+ then
+declare
+ Subp : constant Entity_Id :=
+Entity (Name (Parent (N)));
+begin
+ if Convention (Subp) = Convention_Intrinsic then
+ Error_Msg_FE ("subprogram and its formal "
+ & "parameters have convention Intrinsic",
+Parent (N), Subp);
+ Error_Msg_N
+("actual cannot be access attribute", N);
+ end if;
+end;
+
+ else
+Error_Msg_FE
+ ("subprogram & has wrong convention", P, Entity (P));
+Error_Msg_Sloc := Sloc (Btyp);
+Error_Msg_FE ("\does not match & declared#", P, Btyp);
+ end if;
+
if not Is_Itype (Btyp)
and then not Has_Convention_Pragma (Btyp)
then
[Ada] Support for discriminants in pragma Default_Initial_Condition
This patch adds support for tagged discriminants in assertion expressions such
as those of pragma Default_Initial_Condition or Type_Invariant'Class. In these
contexts, tagged discriminants behave as primitives and exhibit "overriding"-
like properties. For instance, if a derived type constrains its parent and
inherits a Default_Initial_Condition from it which checks the discriminant of
the parent, the runtime check must verify the discriminant of the derived type.
-- Source --
-- tester.ads
package Tester is
type Type_Id is
(No_Type,
Deriv_1_Id,
Deriv_2_Id,
Deriv_3_Id,
Deriv_4_Id,
Deriv_5_Id,
Deriv_6_Id,
Deriv_7_Id,
Deriv_8_Id,
Deriv_9_Id,
Deriv_10_Id,
Deriv_11_Id,
Deriv_12_Id,
Deriv_13_Id,
Deriv_14_Id,
Deriv_15_Id,
Deriv_16_Id,
Deriv_17_Id,
Deriv_18_Id,
Deriv_19_Id,
Deriv_20_Id,
Deriv_21_Id,
Deriv_22_Id,
Deriv_23_Id,
Deriv_24_Id,
Deriv_25_Id,
Deriv_26_Id,
Deriv_27_Id,
Deriv_28_Id,
Deriv_29_Id,
Deriv_30_Id,
Deriv_31_Id,
Deriv_32_Id,
Deriv_33_Id,
Deriv_34_Id,
Deriv_35_Id,
Deriv_36_Id,
Deriv_37_Id,
Deriv_38_Id,
Deriv_39_Id,
Deriv_40_Id,
Mid_13_Id,
Mid_14_Id,
Mid_19_Id,
Mid_33_Id,
Mid_34_Id,
Mid_39_Id,
Par_1_Id,
Par_2_Id,
Par_3_Id,
Par_4_Id,
Par_5_Id,
Par_6_Id,
Par_7_Id,
Par_8_Id,
Par_9_Id,
Par_10_Id,
Par_11_Id,
Par_12_Id,
Par_13_Id,
Par_14_Id,
Par_15_Id,
Par_16_Id,
Par_17_Id,
Par_18_Id,
Par_19_Id,
Par_20_Id);
type Result is record
X : Integer;
Y : Integer;
end record;
No_Result : constant Result := (0, 0);
type Results is array (Type_Id) of Result;
procedure Mark (Id : Type_Id; X : Integer; Y : Integer);
-- Record the result for a particular type
procedure Reset_Results;
-- Reset the internally kept result state
procedure Test_Result (Test_Id : String; Exp : Results);
-- Ensure that the internally kept result state agrees with expected
-- results Exp. Emit an error if this is not the case.
end Tester;
-- tester.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Tester is
State : Results;
--
-- Mark --
--
procedure Mark (Id : Type_Id; X : Integer; Y : Integer) is
begin
State (Id) := (X, Y);
end Mark;
---
-- Reset_Results --
---
procedure Reset_Results is
begin
State := (others => No_Result);
end Reset_Results;
-
-- Test_Result --
-
procedure Test_Result (Test_Id : String; Exp : Results) is
Exp_Val : Result;
Posted: Boolean := False;
State_Val : Result;
begin
for Index in Results'Range loop
Exp_Val := Exp (Index);
State_Val := State (Index);
if State_Val /= Exp_Val then
if not Posted then
Posted := True;
Put_Line (Test_Id & ": ERROR");
end if;
Put_Line
(" Index : " & Index'Img);
Put_Line
(" Expected:" & Exp_Val.X'Img & ',' & Exp_Val.Y'Img);
Put_Line
(" Got :" & State_Val.X'Img & ',' & State_Val.Y'Img);
end if;
end loop;
if not Posted then
Put_Line (Test_Id & ": OK");
end if;
end Test_Result;
end Tester;
-- dic_pack1.ads
package DIC_Pack1 is
---
-- 1) No derivations --
---
type No_Deriv_1 (D_1 : Integer; D_2 : Integer) is private
with Default_Initial_Condition => No_Deriv_1.D_1 > 1 and then D_2 > 2;
type No_Deriv_2 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => No_Deriv_2.D_1 > 1 and then D_2 > 2;
---
-- 2) Tagged derivations --
---
-- No overriding
-- No discriminants
-- Visible derivation
type Par_1 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => A (Par_1, Par_1.D_1, D_2);
function A (Obj : Par_1; X : Integer; Y : Integer) return Boolean;
type Deriv_1 is new Par_1 with private;
-- DIC calls: A (Par_1, Par_1.D_1, Par_1.D_2)
-- No overriding
-- Unknown discriminants
-- Hidden derivation
type Par_2 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => B (Par_2, Par_2.D_1, D_2);
function B (Obj : Par_2; X : Integer; Y : Integer) return Boolean;
type Deriv_2 (<>) is tagged private;
-- DIC calls: B (Par_2, Par_2.D_1, Par_2.D_2)
-- No overriding
-- Renaming
-- Visible derivation
type Par_3 (D_1 : Integer; D_2 : Integer) is tagged privat
[PATCH] Fix PR80492
The following fixes redundant hard-register "stores" to be not eliminated
by FRE/PRE and the alias machinery to properly handle different
local VAR_DECLs with the same asm specification.
Comments are welcome. I tested the testcase on x86_64, ppc64le and
aarch64 and all seem to be happy with *4 as register specification.
Bootstrap / regtest running on x86_64-unknown-linux-gnu.
Richard.
2017-04-25 Richard Biener
PR tree-optimization/80492
* tree-ssa-pre.c (eliminate_dom_walker::before_dom_children):
Do not eliminate redundant hardregister stores.
* alias.c (compare_base_decls): Handle registers with asm
specification conservatively.
* tree-ssa-alias.c (decl_refs_may_alias_p): Handle
compare_base_decls returning dont-know properly.
* gcc.dg/pr80492.c: New testcase.
Index: gcc/tree-ssa-pre.c
===
*** gcc/tree-ssa-pre.c (revision 247095)
--- gcc/tree-ssa-pre.c (working copy)
*** eliminate_dom_walker::before_dom_childre
*** 4495,4500
--- 4519,4526
if (gimple_assign_single_p (stmt)
&& !gimple_has_volatile_ops (stmt)
&& !is_gimple_reg (gimple_assign_lhs (stmt))
+ && !(TREE_CODE (gimple_assign_lhs (stmt)) == VAR_DECL
+ && DECL_HARD_REGISTER (gimple_assign_lhs (stmt)))
&& (TREE_CODE (gimple_assign_rhs1 (stmt)) == SSA_NAME
|| is_gimple_min_invariant (gimple_assign_rhs1 (stmt
{
Index: gcc/alias.c
===
*** gcc/alias.c (revision 247095)
--- gcc/alias.c (working copy)
*** compare_base_decls (tree base1, tree bas
*** 2046,2051
--- 2046,2063
if (base1 == base2)
return 1;
+ /* If we have two register decls with register specification we
+ cannot decide unless their assembler name is the same. */
+ if (DECL_REGISTER (base1)
+ && DECL_REGISTER (base2)
+ && DECL_ASSEMBLER_NAME_SET_P (base1)
+ && DECL_ASSEMBLER_NAME_SET_P (base2))
+ {
+ if (DECL_ASSEMBLER_NAME (base1) == DECL_ASSEMBLER_NAME (base2))
+ return 1;
+ return -1;
+ }
+
/* Declarations of non-automatic variables may have aliases. All other
decls are unique. */
if (!decl_in_symtab_p (base1)
Index: gcc/tree-ssa-alias.c
===
*** gcc/tree-ssa-alias.c(revision 247095)
--- gcc/tree-ssa-alias.c(working copy)
*** decl_refs_may_alias_p (tree ref1, tree b
*** 1096,1116
{
gcc_checking_assert (DECL_P (base1) && DECL_P (base2));
/* If both references are based on different variables, they cannot alias.
*/
! if (compare_base_decls (base1, base2) == 0)
return false;
/* If both references are based on the same variable, they cannot alias if
the accesses do not overlap. */
! if (!ranges_overlap_p (offset1, max_size1, offset2, max_size2))
! return false;
! /* For components with variable position, the above test isn't sufficient,
! so we disambiguate component references manually. */
! if (ref1 && ref2
! && handled_component_p (ref1) && handled_component_p (ref2)
! && nonoverlapping_component_refs_of_decl_p (ref1, ref2))
! return false;
return true;
}
--- 1128,1153
{
gcc_checking_assert (DECL_P (base1) && DECL_P (base2));
+ int cmp = compare_base_decls (base1, base2);
+
/* If both references are based on different variables, they cannot alias.
*/
! if (cmp == 0)
return false;
/* If both references are based on the same variable, they cannot alias if
the accesses do not overlap. */
! if (cmp == 1)
! {
! if (!ranges_overlap_p (offset1, max_size1, offset2, max_size2))
! return false;
! /* For components with variable position, the above test isn't
sufficient,
!so we disambiguate component references manually. */
! if (ref1 && ref2
! && handled_component_p (ref1) && handled_component_p (ref2)
! && nonoverlapping_component_refs_of_decl_p (ref1, ref2))
! return false;
! }
return true;
}
Index: gcc/testsuite/gcc.dg/pr80492.c
===
*** gcc/testsuite/gcc.dg/pr80492.c (nonexistent)
--- gcc/testsuite/gcc.dg/pr80492.c (working copy)
***
*** 0
--- 1,20
+ /* { dg-do compile } */
+ /* { dg-options "-w -O2 -fdump-tree-optimized" } */
+
+ static __inline__ __attribute__((__always_inline__))
+ void syscall_7 (int val)
+ {
+ register int reg __asm ("4") = val;
+ __asm __volatile__ ("/* Some Code %0 */" :: "r" (reg));
+ }
+
+ void do_syscalls (void)
+ {
+ for (int s = 0; s < 2; s++)
+ {
+ syscall_7 (0);
+ syscall_7 (1);
+ }
+ }
+
+ /* { dg-final { scan-tree-dump-times
Re: [PATCH] Remove dead code from c_common_get_alias_set
On Mon, 24 Apr 2017, Bernd Edlinger wrote:
> On 04/24/17 09:00, Richard Biener wrote:
> > On Fri, 21 Apr 2017, Bernd Edlinger wrote:
> >
> >> Hi!
> >>
> >>
> >> This removes some dead and unreachable code in c_common_get_alias_set:
> >> Because cc1 was recently changed to be only called with one file at a
> >> time, the code after "if (num_in_fnames == 1) return -1;" is no longer
> >> reachable, and can thus be removed.
> >
> > While I think you are correct it looks like c_common_parse_file still
> > happily parses multiple infiles. That is, only for
> > flag_preprocess_only we have a
> >
> > if (num_in_fnames > 1)
> > error ("too many filenames given. Type %s --help for usage",
> >progname);
> >
> > and:
> >
> > gcc> ./cc1 -quiet t.c t2.c
> > t2.c:5:6: error: conflicting types for ‘bar’
> > void bar () { struct X x; *(volatile char *)x.buf = 1; }
> > ^~~
> > t.c:8:1: note: previous definition of ‘bar’ was here
> > bar (int x)
> > ^~~
> >
> > which means it actually still "works" to combine two source files
> > (yes, the driver no longer seems to have the ability to pass down
> > multiple inputs to cc1).
> >
> > Thus, can you first remove that "feature"?
> >
>
> Yes, sure. See updated patch.
Ok.
Thanks,
Richard.
[Ada] Implementation of AI12-0125, use of @ as abbreviation for LHS.
With this patch the compiler now handles properly the use of @ as a prefix
of a reference to a discriminated record component and to its bounds.
The following must compile quietly in gnat2020 mode:
---
procedure Discrs is
begin
declare
-- Discrim-dependent subtypes
subtype Index is Integer range 0 .. 123;
type R1 (D1 : Index := 0) is record F1 : String (1 .. D1); end record;
type R2 (D2 : Index := 0) is record F2 : R1 (D1 => D2); end record;
X : R2;
begin
for I in 1 .. Index'Last loop
X := (I, (I, (others => 'A')));
X.F2.F1 (1) := 'B';
X.F2.F1:= 'C' & @ (@'First .. @'Last - 1);
X.F2 := (@.D1, 'D' & @.F1 (@.F1'First .. @.F1'Last - 1));
X := (D2 => @.D2,
F2 =>
(D1 => @.D2,
F1 => 'E' & @.F2.F1 (@.F2.F1'First .. @.F2.F1'Last - 1)));
pragma Assert
(X.F2.F1 = (if I <= 4
then String'("EDCB")(1..I)
else "EDCB" & (1 .. I-4 => 'A')));
end loop;
end;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_ch5.adb (Analyze_Assignment): Reset Full_Analysis flag on
the first pass over an assignment statement with target names,
to prevent the generation of subtypes (such as discriminated
record components)that may carry the target name outside of the
tree for the assignment. The subtypes will be generated when
the assignment is reanalyzed in full.
(Analyze_Target_Name): Handle properly class-wide types.
Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 247146)
+++ sem_ch5.adb (working copy)
@@ -64,10 +64,12 @@
package body Sem_Ch5 is
- Current_LHS : Node_Id := Empty;
- -- Holds the left-hand side of the assignment statement being analyzed.
- -- Used to determine the type of a target_name appearing on the RHS, for
- -- AI12-0125 and the use of '@' as an abbreviation for the LHS.
+ Current_Assignment : Node_Id := Empty;
+ -- This variable holds the node for an assignment that contains target
+ -- names. The corresponding flag has been set by the parser, and when
+ -- set the analysis of the RHS must be done with all expansion disabled,
+ -- because the assignment is reanalyzed after expansion has replaced all
+ -- occurrences of the target name appropriately.
Unblocked_Exit_Count : Nat := 0;
-- This variable is used when processing if statements, case statements,
@@ -98,11 +100,12 @@
-- Ghost mode.
procedure Analyze_Assignment (N : Node_Id) is
- Lhs : constant Node_Id := Name (N);
- Rhs : constant Node_Id := Expression (N);
- T1 : Entity_Id;
- T2 : Entity_Id;
- Decl : Node_Id;
+ Lhs: constant Node_Id := Name (N);
+ Rhs: constant Node_Id := Expression (N);
+ T1 : Entity_Id;
+ T2 : Entity_Id;
+ Decl : Node_Id;
+ Save_Full_Analysis : Boolean;
procedure Diagnose_Non_Variable_Lhs (N : Node_Id);
-- N is the node for the left hand side of an assignment, and it is not
@@ -284,10 +287,6 @@
-- Start of processing for Analyze_Assignment
begin
- -- Save LHS for use in target names (AI12-125)
-
- Current_LHS := Lhs;
-
Mark_Coextensions (N, Rhs);
-- Analyze the target of the assignment first in case the expression
@@ -301,7 +300,12 @@
-- during analysis and expansion are properly marked as Ghost.
if Has_Target_Names (N) then
+ Current_Assignment := N;
Expander_Mode_Save_And_Set (False);
+ Save_Full_Analysis := Full_Analysis;
+ Full_Analysis := False;
+ else
+ Current_Assignment := Empty;
end if;
Mark_And_Set_Ghost_Assignment (N, Mode);
@@ -932,7 +936,6 @@
Analyze_Dimension (N);
<>
- Current_LHS := Empty;
Restore_Ghost_Mode (Mode);
-- If the right-hand side contains target names, expansion has been
@@ -942,6 +945,7 @@
if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then
Expander_Mode_Restore;
+ Full_Analysis := Save_Full_Analysis;
end if;
end Analyze_Assignment;
@@ -3543,14 +3547,10 @@
procedure Analyze_Target_Name (N : Node_Id) is
begin
- if No (Current_LHS) then
- Error_Msg_N ("target name can only appear within an assignment", N);
- Set_Etype (N, Any_Type);
+ -- A target name has the type of the left-hand side of the enclosing
+ -- assignment.
- else
- Set_Has_Target_Names (Parent (Current_LHS));
- Set_Etype (N, Etype (Current_LHS));
- end if;
+ Set_Etype (N, Etype (Name (Current_Assignment)));
end Analyze_Target_Name;
[Ada] Spurious compile failure with nested packages
This patch adds another condition to an edge case used to delay expression function freezing (P804-015). The offending package is within the body of a library-level unit where this edge-case does not apply. By adding a condition that only delays freezing of expression functions if we are in a library-level spec we can avoid spurious disambiguation errors. -- Source -- -- pkg.ads package Pkg is pragma Elaborate_Body; end; -- pkg.adb with Ada.Containers.Vectors; package body Pkg is package SubPkg1 is type T1 is private; function Foo (T : T1) return Boolean is (True); subtype ST1 is T1 with Dynamic_Predicate => Foo (ST1); private type T1 is null record; end; package SubPkg2 is type T2 is private; function Foo (T : T2) return Boolean is (True); private package V2 is new Ada.Containers.Vectors (Positive, SubPkg1.ST1, SubPkg1."="); type T2 is record SubPkg1 : V2.Vector; end record; end; type C is record Count : Natural; end record; type CA is array (1 .. 3) of C; package VC is new Ada.Containers.Vectors (Positive, CA); V : VC.Vector; procedure Bar is begin for P in V.Iterate loop for X of V (P) loop X.Count := X.Count - 1; end loop; end loop; end; end; -- Compilation and output -- $ gcc -c pkg.adb pkg.adb:15:07: warning: in instantiation at a-convec.ads:375 pkg.adb:15:07: warning: component of "Elements_Array" padded by 8 bits Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Justin Squirek * sem_ch3.adb (Analyze_Declarations): Add additional condition for edge case. Index: sem_ch3.adb === --- sem_ch3.adb (revision 247146) +++ sem_ch3.adb (working copy) @@ -2646,6 +2646,8 @@ and then Was_Expression_Function (Next_Decl) and then not Is_Compilation_Unit (Current_Scope) and then not Is_Generic_Instance (Current_Scope) + and then not In_Package_Body + (Enclosing_Lib_Unit_Entity (Current_Scope)) then -- Loop through all entities in the current scope to identify -- an instance of the edge case outlined above and ignore
[Ada] Remove uses of global variables from Sem_Prag
This patch cleans up some uses of global variables in Sem_Prag.
No change in behavior; no test available.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* sem_prag.adb: Remove suspicious uses of Name_Buf.
* stringt.ads, stringt.adb, exp_dbug.adb, sem_dim.adb: Remove
Add_String_To_Name_Buffer, to avoid using the global Name_Buf.
Add String_To_Name with no side effects.
Index: sem_dim.adb
===
--- sem_dim.adb (revision 247135)
+++ sem_dim.adb (working copy)
@@ -2521,8 +2521,9 @@
Add_Str_To_Name_Buffer ("has dimension ");
end if;
- Add_String_To_Name_Buffer
- (From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_N, System, True));
+ Append
+ (Global_Name_Buffer,
+From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_N, System, True));
-- N is dimensionless
@@ -2562,12 +2563,12 @@
Name_Len := 0;
- Add_String_To_Name_Buffer (String_From_Numeric_Literal (N));
+ Append (Global_Name_Buffer, String_From_Numeric_Literal (N));
-- Insert a blank between the literal and the symbol
Add_Str_To_Name_Buffer (" ");
- Add_String_To_Name_Buffer (Symbol_Of (Typ));
+ Append (Global_Name_Buffer, Symbol_Of (Typ));
Error_Msg_Name_1 := Name_Find;
Error_Msg_N ("assumed to be%%??", N);
Index: stringt.adb
===
--- stringt.adb (revision 247135)
+++ stringt.adb (working copy)
@@ -75,15 +75,10 @@
-- Release to get a snapshot of the tables and to restore them to their
-- previous situation.
- ---
- -- Add_String_To_Name_Buffer --
- ---
+
+ -- Append --
+
- procedure Add_String_To_Name_Buffer (S : String_Id) is
- begin
- Append (Global_Name_Buffer, S);
- end Add_String_To_Name_Buffer;
-
procedure Append (Buf : in out Bounded_String; S : String_Id) is
begin
for X in 1 .. String_Length (S) loop
@@ -324,6 +319,17 @@
return Strings.Table (Id).Length;
end String_Length;
+
+ -- String_To_Name --
+
+
+ function String_To_Name (S : String_Id) return Name_Id is
+ Buf : Bounded_String;
+ begin
+ Append (Buf, S);
+ return Name_Find (Buf);
+ end String_To_Name;
+
---
-- String_To_Name_Buffer --
---
Index: stringt.ads
===
--- stringt.ads (revision 247135)
+++ stringt.ads (working copy)
@@ -47,9 +47,9 @@
-- is implemented in the scanner.
-- There is no guarantee that hashing is used in the implementation, although
--- it maybe. This means that the caller cannot count on having the same Id
+-- it may be. This means that the caller cannot count on having the same Id
-- value for two identical strings stored separately and also cannot count on
--- the two Id values being different.
+-- the two such Id values being different.
Null_String_Id : String_Id;
-- Gets set to a null string with length zero
@@ -119,18 +119,18 @@
function String_Equal (L, R : String_Id) return Boolean;
-- Determines if two string literals represent the same string
- procedure String_To_Name_Buffer (S : String_Id);
- -- Place characters of given string in Name_Buffer, setting Name_Len.
- -- Error if any characters are out of Character range. Does not attempt
- -- to do any encoding of any characters.
+ function String_To_Name (S : String_Id) return Name_Id;
+ -- Convert String_Id to Name_Id
procedure Append (Buf : in out Bounded_String; S : String_Id);
-- Append characters of given string to Buf. Error if any characters are
- -- out of Character range. Does not attempt to do any encoding of any
+ -- out of Character range. Does not attempt to do any encoding of
-- characters.
- procedure Add_String_To_Name_Buffer (S : String_Id);
- -- Same as Append (Global_Name_Buffer, S)
+ procedure String_To_Name_Buffer (S : String_Id);
+ -- Place characters of given string in Name_Buffer, setting Name_Len.
+ -- Error if any characters are out of Character range. Does not attempt
+ -- to do any encoding of any characters.
function String_Chars_Address return System.Address;
-- Return address of String_Chars table (used by Back_End call to Gigi)
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247148)
+++ sem_prag.adb(working copy)
@@ -5941,9 +5941,7 @@
procedure Check_Optional_Identifier (Arg : Node_Id; Id : String) is
begin
- Name_Buffer (1 .. Id'Length) := Id;
- Name_Len := Id'Length;
- Check_Optional_Identifier (Arg, Name_Find);
+
[Ada] Support for discriminants in pragma Default_Initial_Condition
This patch augments the existing support for tagged discriminants in assertion
expressions such as those of pragma Default_Initial_Condition or Type_Invariant
'Class by adding support for ancestor subtypes.
-- Source --
-- tester.ads
package Tester is
type Type_Id is
(Deriv_1_Id,
Deriv_2_Id,
Deriv_3_Id,
Deriv_4_Id,
Deriv_5_Id,
Deriv_6_Id,
Deriv_7_Id,
Deriv_8_Id,
Deriv_9_Id,
Deriv_10_Id,
Deriv_11_Id,
Par_1_Id,
Par_2_Id,
Par_3_Id,
Par_4_Id,
Par_5_Id,
Par_6_Id,
Par_7_Id,
Par_8_Id,
Par_9_Id,
Par_10_Id,
Par_11_Id);
type Result is record
X : Integer;
Y : Integer;
end record;
No_Result : constant Result := (0, 0);
type Results is array (Type_Id) of Result;
procedure Mark (Id : Type_Id; X : Integer; Y : Integer);
-- Record the result for a particular type
procedure Reset_Results;
-- Reset the internally kept result state
procedure Test_Result (Test_Id : String; Exp : Results);
-- Ensure that the internally kept result state agrees with expected
-- results Exp. Emit an error if this is not the case.
end Tester;
-- tester.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Tester is
State : Results;
--
-- Mark --
--
procedure Mark (Id : Type_Id; X : Integer; Y : Integer) is
begin
State (Id) := (X, Y);
end Mark;
---
-- Reset_Results --
---
procedure Reset_Results is
begin
State := (others => No_Result);
end Reset_Results;
-
-- Test_Result --
-
procedure Test_Result (Test_Id : String; Exp : Results) is
Exp_Val : Result;
Posted: Boolean := False;
State_Val : Result;
begin
for Index in Results'Range loop
Exp_Val := Exp (Index);
State_Val := State (Index);
if State_Val /= Exp_Val then
if not Posted then
Posted := True;
Put_Line (Test_Id & ": ERROR");
end if;
Put_Line
(" Index : " & Index'Img);
Put_Line
(" Expected:" & Exp_Val.X'Img & ',' & Exp_Val.Y'Img);
Put_Line
(" Got :" & State_Val.X'Img & ',' & State_Val.Y'Img);
end if;
end loop;
if not Posted then
Put_Line (Test_Id & ": OK");
end if;
end Test_Result;
end Tester;
-- dic_pack1.ads
package DIC_Pack1 is
---
-- 1) Tagged derivations --
---
-- No overriding
-- Hidden derivation
-- Subtype in the middle
-- Subtype constrains
type Par_1 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => A (Par_1, Par_1.D_1, D_2);
function A (Obj : Par_1; X : Integer; Y : Integer) return Boolean;
-- subtype Sub_1 is Par_1 (...);
-- Par_1.D_1 constrained by 123
-- Par_1.D_2 constrained by 456
-- DIC calls: A (Par_1, 123, 456)
type Deriv_1 is tagged private;
-- DIC calls: A (Par_1, 123, 456)
-- Overriding
-- Hidden derivation
-- Subtype in the middle
-- Subtype constrains
type Par_2 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => B (Par_2, Par_2.D_1, D_2);
function B (Obj : Par_2; X : Integer; Y : Integer) return Boolean;
-- subtype Sub_2 is Par_2 (...);
-- Par_2.D_1 constrained by 123
-- Par_2.D_2 constrained by 456
-- DIC calls: B (Par_2, 123, 456)
type Deriv_2 is tagged private;
-- DIC calls: B (Deriv_2, 123, 456)
function B (Obj : Deriv_2; X : Integer; Y : Integer) return Boolean;
-- No overriding
-- Hidden derivation
-- Subtype in the middle
-- Subtype renames
type Par_3 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => C (Par_3, Par_3.D_1, D_2);
function C (Obj : Par_3; X : Integer; Y : Integer) return Boolean;
-- subtype Sub_3 is Par_3;
-- inherits Par_3.D_1
-- inherits Par_3.D_2
-- DIC calls: C (Par_3, Sub_3.D_1, Sub_3.D_2)
type Deriv_3 (D_3 : Integer; D_4 : Integer) is tagged private;
-- Sub_3.D_1 constrained by 123
-- Sub_3.D_2 renamed by Deriv_3.D_3
-- DIC calls: C (Par_3, 123, Deriv_3.D_3)
-- Overriding
-- Hidden derivation
-- Subtype in the middle
-- Subtype renames
type Par_4 (D_1 : Integer; D_2 : Integer) is tagged private
with Default_Initial_Condition => D (Par_4, Par_4.D_1, D_2);
function D (Obj : Par_4; X : Integer; Y : Integer) return Boolean;
-- subtype Sub_4 is Par_4;
-- inherits Par_4.D_1
-- inherits Par_4.D_1
-- DIC calls: D (Par_4, Sub_4.D_1, Sub_4.D_2)
type Deriv_4 (D_3 : Integer; D_4 : Integer) is tagged private;
-- Sub_4.D_1 renamed by D_4
-- Sub_4.D_2 constrained by 45
[Ada] pragma Ignore_Pragma(Interface); is illegal
This patch fixes a bug in which pragma Ignore_Pragma(Interface); is illegal, except in Ada 83 mode. It should be legal in all modes. The following test should compile quietly. -- gnat.adc pragma Ignore_Pragma(Interface); -- legal_interface.ads package Legal_Interface is procedure Interface_Or_Not; pragma Interface (Esperanto, Interface_Or_Not); -- The pragma should be ignored, so the body of Interface_Or_Not is legal, -- and the fact that Esperanto is not a supported language is irrelevant. end Legal_Interface; -- legal_interface.adb package body Legal_Interface is procedure Interface_Or_Not is begin null; end Interface_Or_Not; end Legal_Interface; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * par-ch2.adb, scans.ads, scn.adb: Do not give an error for reserved words inside pragmas. This is necessary to allow the pragma name Interface to be used in pragma Ignore_Pragma. * par.adb: Minor comment fix. Index: par-ch2.adb === --- par-ch2.adb (revision 247135) +++ par-ch2.adb (working copy) @@ -268,6 +268,7 @@ -- Start of processing for P_Pragma begin + Inside_Pragma := True; Prag_Node := New_Node (N_Pragma, Token_Ptr); Scan; -- past PRAGMA Prag_Name := Token_Name; @@ -362,9 +363,10 @@ Semicolon_Loc := Token_Ptr; - -- Cancel indication of being within Depends pragm. Can be done - -- unconditionally, since quicker than doing a test. + -- Cancel indication of being within a pragma or in particular a Depends + -- pragma. + Inside_Pragma := False; Inside_Depends := False; -- Now we have two tasks left, we need to scan out the semicolon @@ -388,12 +390,11 @@ Skip_Pragma_Semicolon; return Par.Prag (Prag_Node, Semicolon_Loc); end if; - exception when Error_Resync => Resync_Past_Semicolon; + Inside_Pragma := False; return Error; - end P_Pragma; -- This routine is called if a pragma is encountered in an inappropriate Index: scans.ads === --- scans.ads (revision 247135) +++ scans.ads (working copy) @@ -484,9 +484,13 @@ -- Is it really right for this to be a Name rather than a String, what -- about the case of Wide_Wide_Characters??? + Inside_Pragma : Boolean := False; + -- True within a pragma. Used to avoid complaining about reserved words + -- within pragmas (see Scan_Reserved_Identifier). + 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). + -- True while 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 Index: par.adb === --- par.adb (revision 247146) +++ par.adb (working copy) @@ -70,8 +70,8 @@ -- Par.Ch5.Get_Loop_Block_Name). Inside_Record_Definition : Boolean := False; - -- Flag set True within a record definition. Used to control warning - -- for redefinition of standard entities (not issued for field names). + -- True within a record definition. Used to control warning for + -- redefinition of standard entities (not issued for field names). -- Error Recovery -- Index: scn.adb === --- scn.adb (revision 247135) +++ scn.adb (working copy) @@ -255,9 +255,7 @@ -- Clear flags for reserved words used as identifiers - for J in Token_Type loop - Used_As_Identifier (J) := False; - end loop; + Used_As_Identifier := (others => False); end Initialize_Scanner; --- @@ -380,8 +378,8 @@ -- procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is - Token_Chars : constant String := Token_Type'Image (Token); - + Token_Chars : String := Token_Type'Image (Token); + Len : Natural := 0; begin -- AI12-0125 : '@' denotes the target_name, i.e. serves as an -- abbreviation for the LHS of an assignment. @@ -394,16 +392,24 @@ -- We have in Token_Chars the image of the Token name, i.e. Tok_xxx. -- This code extracts the xxx and makes an identifier out of it. - Name_Len := 0; - for J in 5 .. Token_Chars'Length loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Fold_Lower (Token_Chars (J)); + Len := Len + 1; + Token_Chars (Len) := Fold_Lower (Token_Chars (J)); end loop; - T
[Ada] Crash on illegal specification for a configuration file.
The -gnatec switch is used to specify configuration files containing that contain configuration pragmas. With This patch the compiler rejects properly a name for a configuration file that designates a directory rather than crashing. Executing gcc -c pkg.ads -gnatec=. must yield: gnat1: cannot find configuration pragmas file . --- package pkg is private end; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg * osint.adb (Find_File): Handle properly a request for a configuration file whose name is a directory. Index: osint.adb === --- osint.adb (revision 247135) +++ osint.adb (working copy) @@ -1189,16 +1189,25 @@ Found := N; Attr.all := Unknown_Attributes; -if T = Config and then Full_Name then - declare - Full_Path : constant String := -Normalize_Pathname (Get_Name_String (N)); - Full_Size : constant Natural := Full_Path'Length; - begin - Name_Buffer (1 .. Full_Size) := Full_Path; - Name_Len := Full_Size; - Found := Name_Find; - end; +if T = Config then + if Full_Name then + declare + Full_Path : constant String := + Normalize_Pathname (Get_Name_String (N)); + Full_Size : constant Natural := Full_Path'Length; + + begin + Name_Buffer (1 .. Full_Size) := Full_Path; + Name_Len := Full_Size; + Found := Name_Find; + end; + end if; + + -- Check that it is a file, not a directory + + if not Is_Regular_File (Get_Name_String (Found)) then + Found := No_File; + end if; end if; return;
[Ada] Ignore_Pragma causes errors in the run-time system
This patch fixes a bug in which pragma Ignore_Pragma can cause errors in the
run-time system, if it applies to pragmas actually used in the run-time
system. Pragma Ignore_Pragma no longer applies to pragmas in the run-time
system.
The following test should compile quietly.
-- gnat.adc
pragma Ignore_Pragma(Import);
-- ignore_pragmas.adb
with Text_IO;
procedure Ignore_Pragmas is
begin
null;
end Ignore_Pragmas;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* sem_util.ads, sem_util.adb (Should_Ignore_Pragma): New function
that returns True when appropriate.
* par-prag.adb, exp_prag.adb, sem_prag.adb: Do not ignore pragmas
when compiling predefined files.
* fname.ads, fname.adb (Is_Predefined_File_Name): Fix bug:
"gnat.adc" should not be considered a predefined file name.
That required (or at least encouraged) a lot of cleanup of global
variable usage. We shouldn't be communicating information via
the global name buffer.
* bindgen.adb, errout.adb, fname-uf.adb, lib-load.adb, make.adb,
* restrict.adb, sem_ch10.adb, sem_ch6.adb, sem_ch8.adb: Changes
required by the above-mentioned cleanup.
Index: exp_prag.adb
===
--- exp_prag.adb(revision 247135)
+++ exp_prag.adb(working copy)
@@ -168,7 +168,7 @@
-- the back end or the expander here does not get overenthusiastic and
-- start processing such a pragma!
- if Get_Name_Table_Boolean3 (Pname) then
+ if Should_Ignore_Pragma (Pname) then
Rewrite (N, Make_Null_Statement (Sloc (N)));
return;
end if;
Index: make.adb
===
--- make.adb(revision 247135)
+++ make.adb(working copy)
@@ -2944,7 +2944,9 @@
Fname : constant File_Name_Type := Strip_Directory (S);
begin
-if Is_Predefined_File_Name (Fname, False) then
+if Is_Predefined_File_Name
+ (Fname, Renamings_Included => False)
+then
if Check_Readonly_Files or else Must_Compile then
Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
Comp_Args (Comp_Args'First + 1 .. Comp_Last);
Index: bindgen.adb
===
--- bindgen.adb (revision 247135)
+++ bindgen.adb (working copy)
@@ -1275,6 +1275,7 @@
(No_Run_Time_Mode
and then Is_Predefined_File_Name (U.Sfile))
then
+ Get_Name_String (U.Sfile);
Set_String (" ");
Set_String ("E");
Set_Unit_Number (Unum);
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247150)
+++ sem_prag.adb(working copy)
@@ -10352,7 +10352,7 @@
-- Ignore pragma if Ignore_Pragma applies
- if Get_Name_Table_Boolean3 (Pname) then
+ if Should_Ignore_Pragma (Pname) then
return;
end if;
Index: fname-uf.adb
===
--- fname-uf.adb(revision 247135)
+++ fname-uf.adb(working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
@@ -302,10 +302,9 @@
-- Determine if we have a predefined file name
- Name_Len := Uname'Length;
- Name_Buffer (1 .. Name_Len) := Uname;
Is_Predef :=
-Is_Predefined_File_Name (Renamings_Included => True);
+Is_Predefined_File_Name
+ (Uname, Renamings_Included => True);
-- Found a match, execute the pattern
Index: sem_util.adb
===
--- sem_util.adb(revision 247142)
+++ sem_util.adb(working copy)
@@ -20499,6 +20499,16 @@
Set_Alignment (T1, Alignment (T2));
end Set_Size_Info;
+ --
+ -- Should_Ignore_Pragma --
+ --
+
+ function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean is
+ begin
+ return not Is_Internal_File_Name (File_Name (Cur
Enable Go for AIX
Description:
This patch enables libffi, libgo, and Go to be built on AIX.
It is the first patch of a series of patches for Go on AIX.
Do not use --enable-languages=go on AIX till all patches (FSF and Google) are
available.
Tests (done with a .spec file):
* AIX 7.2/PowerPC:
- ./configure --enable-languages=go ... ; gmake : failed while building Go,
as expected.
- ./configure (without go language) ; gmake : SUCCESS.
* Ubuntu/x86_64 :
- ./configure --disable-multilib --enable-languages=go ... ; make :
Build broke at 74%, after libgo has been successfully built, due to a lack
of disk space.
ChangeLog:
* configure.ac: Enable Go for AIX.
* contrib/config-list.mk: Enable Go for AIX.
Cordialement,
Tony Reix
Bull - ATOS
IBM Coop Architect & Technical Leader
Office : +33 (0) 4 76 29 72 67
1 rue de Provence - 38432 Échirolles - France
www.atos.net
--- ./configure.ac.ORIGIN 2017-04-19 15:31:23 -0500
+++ ./configure.ac 2017-04-19 15:38:59 -0500
@@ -790,10 +790,6 @@ case "${target}" in
mmix-*-*)
noconfigdirs="$noconfigdirs target-libffi"
;;
- powerpc-*-aix*)
-# copied from rs6000-*-* entry
-noconfigdirs="$noconfigdirs target-libffi"
-;;
rs6000-*-aix*)
noconfigdirs="$noconfigdirs target-libffi"
;;
@@ -808,7 +804,7 @@ esac
# Disable the go frontend on systems where it is known to not work. Please keep
# this in sync with contrib/config-list.mk.
case "${target}" in
-*-*-darwin* | *-*-cygwin* | *-*-mingw* | *-*-aix*)
+*-*-darwin* | *-*-cygwin* | *-*-mingw* | rs6000-*-aix*)
unsupported_languages="$unsupported_languages go"
;;
esac
@@ -824,7 +820,7 @@ if test x$enable_libgo = x; then
*-*-cygwin* | *-*-mingw*)
noconfigdirs="$noconfigdirs target-libgo"
;;
-*-*-aix*)
+rs6000-*-aix*)
noconfigdirs="$noconfigdirs target-libgo"
;;
esac
--- ./contrib/config-list.mk.ORIGIN 2017-04-19 15:39:40 -0500
+++ ./contrib/config-list.mk2017-04-19 15:42:10 -0500
@@ -121,7 +121,7 @@ $(LIST): make-log-dir
TGT=`echo $@ | awk 'BEGIN { FS = "OPT" }; { print $$1 }'` &&
\
TGT=`$(GCC_SRC_DIR)/config.sub $$TGT` &&
\
case $$TGT in
\
- *-*-darwin* | *-*-cygwin* | *-*-mingw* | *-*-aix*)
\
+ *-*-darwin* | *-*-cygwin* | *-*-mingw* | rs6000-*-aix*)
\
ADDITIONAL_LANGUAGES="";
\
;;
\
*)
\
[Ada] Missing error on illegal reference to Part_Of constituent
This patch corrects the mechanism which verifies the legality of references to variables and constants acting as Part_Of constituents of single protected or task types to continue examining the context of the reference when it appears in an expression function. -- Source -- -- prot.ads package Prot with SPARK_Mode is protected P is end P; function Func return Boolean; private G : Boolean := False with Part_Of => P; end Prot; -- prot.adb package body Prot with SPARK_Mode is protected body P is end P; function Flip return Boolean is (G); function Func return Boolean is begin return G; end Func; end Prot; -- Compilation and output -- $ gcc -c prot.adb prot.adb:5:37: reference to variable "G" cannot appear in this context prot.adb:5:37: "G" is constituent of single task type "P" prot.adb:9:14: reference to variable "G" cannot appear in this context prot.adb:9:14: "G" is constituent of single task type "P" Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Hristian Kirtchev * sem_util.adb (Check_Part_Of_Reference): Continue to examine the context if the reference appears within an expression function. Index: sem_util.adb === --- sem_util.adb(revision 247151) +++ sem_util.adb(working copy) @@ -1823,9 +1823,21 @@ N_Subprogram_Declaration) and then not Comes_From_Source (Par) then -OK_Use := True; -exit; +-- Continue to examine the context if the reference appears in a +-- subprogram body which was previously an expression function. +if Nkind (Par) = N_Subprogram_Body + and then Was_Expression_Function (Par) +then + null; + +-- Otherwise the reference is legal + +else + OK_Use := True; + exit; +end if; + -- The reference has been relocated to an inlined body for GNATprove. -- Assume that the reference is legal as the real check was already -- performed in the original context of the reference.
[Ada] Spurious error on call to protected op. of same type as current instance.
If the prefix of a selected component denotes a synchronized object the
selected component is part of an external call (or requeue) that can only
access public operations of the object. The previous check on this construct
was too restrictive, and did not allow public protected operations, only task
entries.
No short example available.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_ch4.adb (Analyze_Selected_Component): Refine analysis
of prefix whose type is a current instance of a synchronized
type. If the prefix is an object this is an external call (or
requeue) that can only access public operations of the object. The
previous predicate was too restrictive, and did not allow public
protected operations, only task entries.
Index: sem_ch4.adb
===
--- sem_ch4.adb (revision 247135)
+++ sem_ch4.adb (working copy)
@@ -4295,6 +4295,7 @@
Comp : Entity_Id;
Has_Candidate : Boolean := False;
In_Scope : Boolean;
+ Is_Private_Op : Boolean;
Parent_N : Node_Id;
Pent : Entity_Id := Empty;
Prefix_Type : Entity_Id;
@@ -4825,7 +4826,7 @@
-- Find visible operation with given name. For a protected type,
-- the possible candidates are discriminants, entries or protected
- -- procedures. For a task type, the set can only include entries or
+ -- subprograms. For a task type, the set can only include entries or
-- discriminants if the task type is not an enclosing scope. If it
-- is an enclosing scope (e.g. in an inner task) then all entities
-- are visible, but the prefix must denote the enclosing scope, i.e.
@@ -4833,6 +4834,7 @@
Set_Etype (Sel, Any_Type);
In_Scope := In_Open_Scopes (Prefix_Type);
+ Is_Private_Op := False;
while Present (Comp) loop
@@ -4845,6 +4847,9 @@
or else Comp /= First_Private_Entity (Type_To_Use))
then
Add_One_Interp (Sel, Comp, Etype (Comp));
+ if Comp = First_Private_Entity (Type_To_Use) then
+ Is_Private_Op := True;
+ end if;
-- If the prefix is tagged, the correct interpretation may
-- lie in the primitive or class-wide operations of the
@@ -4924,6 +4929,12 @@
then
null;
+elsif Is_Protected_Type (Prefix_Type)
+ and then Is_Overloadable (Entity (Sel))
+ and then not Is_Private_Op
+then
+ null;
+
else
Error_Msg_NE
("invalid reference to internal operation of some object of "
[Ada] Spurious compile failure with nested packages
This patch adds a predicate to verify that entities within an inner package do not rely on library unit level private types in cases where the full view of said private types are unseen. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Justin Squirek * sem_ch3.adb (Analyze_Declarations): Minor correction to comments, move out large conditional and scope traversal into a predicate. (Uses_Unseen_Lib_Unit_Priv): Predicate function made from extracted logic. Index: sem_ch3.adb === --- sem_ch3.adb (revision 247152) +++ sem_ch3.adb (working copy) @@ -2195,6 +2195,10 @@ -- Utility to resolve the expressions of aspects at the end of a list of -- declarations. + function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean; + -- Check if an inner package has entities within it that rely on library + -- level private types where the full view has not been seen. + - -- Adjust_Decl -- - @@ -2480,6 +2484,40 @@ end loop; end Resolve_Aspects; + --- + -- Uses_Unseen_Lib_Unit_Priv -- + --- + + function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean is + Curr : Entity_Id; + + begin + -- Avoid looking through scopes that do not meet the precondition of + -- Pkg not being within a library unit spec. + + if not Is_Compilation_Unit (Pkg) + and then not Is_Generic_Instance (Pkg) + and then not In_Package_Body (Enclosing_Lib_Unit_Entity (Pkg)) + then +-- Loop through all entities in the current scope to identify +-- an entity that depends on a private type. + +Curr := First_Entity (Pkg); +loop + if Nkind (Curr) in N_Entity + and then Depends_On_Private (Curr) + then + return True; + end if; + + exit when Last_Entity (Current_Scope) = Curr; + Curr := Next_Entity (Curr); +end loop; + end if; + + return False; + end Uses_Unseen_Lib_Unit_Priv; + -- Local variables Context : Node_Id := Empty; @@ -2489,10 +2527,6 @@ Body_Seen : Boolean := False; -- Flag set when the first body [stub] is encountered - Ignore_Freezing : Boolean; - -- Flag set when deciding to freeze an expression function in the - -- current scope. - -- Start of processing for Analyze_Declarations begin @@ -2631,89 +2665,57 @@ -- care to attach the bodies at a proper place in the tree so as to -- not cause unwanted freezing at that point. - elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl) then + -- It is also necessary to check for a case where both an expression + -- function is used and the current scope depends on an unseen + -- private type from a library unit, otherwise premature freezing of + -- the private type will occur. --- Check for an edge case that may cause premature freezing of --- a private type. If there is a type which depends on another --- private type from an enclosing package that is in the same --- scope as a non-completing expression function then we cannot --- freeze here. + elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl) + and then ((Nkind (Next_Decl) /= N_Subprogram_Body + or else not Was_Expression_Function (Next_Decl)) + or else not Uses_Unseen_Lib_Unit_Priv (Current_Scope)) + then +-- When a controlled type is frozen, the expander generates stream +-- and controlled-type support routines. If the freeze is caused +-- by the stand-alone body of Initialize, Adjust, or Finalize, the +-- expander will end up using the wrong version of these routines, +-- as the body has not been processed yet. To remedy this, detect +-- a late controlled primitive and create a proper spec for it. +-- This ensures that the primitive will override its inherited +-- counterpart before the freeze takes place. -Ignore_Freezing := False; +-- If the declaration we just processed is a body, do not attempt +-- to examine Next_Decl as the late primitive idiom can only apply +-- to the first encountered body. -if Nkind (Next_Decl) = N_Subprogram_Body - and then Was_Expression_Function (Next_Decl) - and then not Is_Compilation_Unit (Current_Scope) - and then not Is_Generic_Instance (Current_Scope) - and
[Ada] New pragma No_Heap_Finalization
This patch introduces support for pragma No_Heap_Finalization which has the
following syntax and semantics:
pragma No_Heap_Finalization [ (first_subtype_LOCAL_NAME) ];
Pragma `No_Heap_Finalization` may be used as a configuration pragma or as a
type-specific pragma.
In its configuration form, the pragma must appear within a configuration file
such as gnat.adc, without an argument. The pragma suppresses the call to
`Finalize` for heap-allocated objects created through library-level named
access-to-object types in case the designated type requires finalization
actions.
In its type-specific form, the argument of the pragma must denote a library-
level named access-to-object. The pragma suppresses the call to `Finalize` for
heap-allocated objects created through the specific access type in case the
designated type requires finalization actions.
It is still possible to finalize such heap-allocated objects by explicitly
deallocating them.
A library-level named access-to-object type declared within a generic unit will
lose its `No_Heap_Finalization` pragma when the instance unit does not appear
at the library level.
-- Source --
-- gen.ads
generic
type Desig is private;
package Gen is
type Ptr is access all Desig;
pragma No_Heap_Finalization (Ptr);
Obj : constant Ptr := new Desig;
end Gen;
-- types.ads
with Ada.Finalization; use Ada.Finalization;
package Types is
type Location_Kind is
(None,
Library_In_Spec,
Library_In_Body,
Instance_Library,
Instance_Nested,
Nested);
type Ctrl is new Controlled with record
Id : Natural := 0;
Loc : Location_Kind := None;
end record;
procedure Finalize (Obj : in out Ctrl);
procedure Initialize (Obj : in out Ctrl);
function New_Id return Natural;
end Types;
-- types.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Types is
Id_Gen : Natural := 0;
procedure Finalize (Obj : in out Ctrl) is
begin
if Obj.Id = 0 then
Put_Line ("ERROR: finalizing a finalized object");
else
Put_Line (" fin:" & Obj.Id'Img);
Put_Line (" loc: " & Obj.Loc'Img);
Obj.Id := 0;
end if;
end Finalize;
procedure Initialize (Obj : in out Ctrl) is
begin
Obj.Id := New_Id;
end Initialize;
function New_Id return Natural is
begin
Id_Gen := Id_Gen + 100;
return Id_Gen;
end New_Id;
end Types;
-- pack.ads
with Ada.Finalization; use Ada.Finalization;
with Gen;
with Types;use Types;
package Pack is
type Ptr is access all Ctrl;
pragma No_Heap_Finalization (Ptr);
Obj_1 : Ptr := new Ctrl'(Controlled with
Id => New_Id,
Loc => Library_In_Spec);
Obj_2 : Ptr := new Ctrl'(Controlled with
Id => New_Id,
Loc => Library_In_Spec);
package Inst_1 is new Gen (Ctrl);
procedure Proc;
end Pack;
-- pack.adb
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
package body Pack is
Obj_3 : Ptr := new Ctrl'(Controlled with
Id => New_Id,
Loc => Library_In_Body);
Obj_4 : Ptr := new Ctrl'(Controlled with
Id => New_Id,
Loc => Library_In_Body);
procedure Proc is
procedure Free is new Ada.Unchecked_Deallocation (Ctrl, Ptr);
package Inst_2 is new Gen (Ctrl);
Obj_5 : Ptr;
Obj_6 : Ptr;
begin
Put_Line ("Proc start");
Inst_1.Obj.Loc := Instance_Library;
Inst_2.Obj.Loc := Instance_Nested;
Obj_5 := new Ctrl'(Controlled with Id => New_Id, Loc => Nested);
Obj_6 := new Ctrl'(Controlled with Id => New_Id, Loc => Nested);
Free (Obj_1);
Free (Obj_3);
Free (Obj_5);
Put_Line ("Proc end");
end Proc;
end Pack;
-- main.adb
with Pack; use Pack;
procedure Main is
begin
Proc;
end Main;
-- Compilation and output --
$ gnatmake -q main.adb
$ ./main
Proc start
fin: 100
loc: LIBRARY_IN_SPEC
fin: 400
loc: LIBRARY_IN_BODY
fin: 700
loc: NESTED
Proc end
fin: 600
loc: INSTANCE_NESTED
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Hristian Kirtchev
* einfo.adb (Is_Anonymous_Access_Type): New routine.
* einfo.ads Update the placement of
E_Anonymous_Access_Subprogram_Type along with all subtypes that
mention the ekind.
(Is_Anonymous_Access_Type): New routine.
* exp_ch7.adb (Allows_Finalization_Master): Do not generate a
master for an access type subject to pragma No_Heap_Finalization.
* exp_util.adb (Build_Allocate_Deallocate_Proc): An object being
allocated or deallocated does not finalization actions if the
associated access type is subject to pragma No_Heap_Finalization.
* opt.
Re: [PATCH] Fix PR79201 (half-way)
On Mon, 24 Apr 2017, Richard Biener wrote:
>
> One issue in PR79201 is that we don't sink pure/const calls which is
> what the following simple patch fixes.
>
> Bootstrap and regtest running on x86_64-unknown-linux-gnu.
Needed some gimple_assign_lhs -> gimple_get_lhs adjustments and
adjustment of gcc.target/i386/pr22152.c where we now sink the
assignment out of the pointless loop. Not sure what the original
bug was about (well, reg allocation) so I simply disabled sinking
for it.
Bootstrapped and tested on x86_64-unknown-linux-gnu, applied to trunk.
Richard.
2017-04-25 Richard Biener
PR tree-optimization/79201
* tree-ssa-sink.c (statement_sink_location): Handle calls.
* gcc.dg/tree-ssa/ssa-sink-16.c: New testcase.
* gcc.target/i386/pr22152.c: Disable sinking.
Index: gcc/tree-ssa-sink.c
===
*** gcc/tree-ssa-sink.c (revision 247092)
--- gcc/tree-ssa-sink.c (working copy)
*** statement_sink_location (gimple *stmt, b
*** 256,263
*zero_uses_p = false;
! /* We only can sink assignments. */
! if (!is_gimple_assign (stmt))
return false;
/* We only can sink stmts with a single definition. */
--- 257,268
*zero_uses_p = false;
! /* We only can sink assignments and non-looping const/pure calls. */
! int cf;
! if (!is_gimple_assign (stmt)
! && (!is_gimple_call (stmt)
! || !((cf = gimple_call_flags (stmt)) & (ECF_CONST|ECF_PURE))
! || (cf & ECF_LOOPING_CONST_OR_PURE)))
return false;
/* We only can sink stmts with a single definition. */
*** statement_sink_location (gimple *stmt, b
*** 291,297
if (stmt_ends_bb_p (stmt)
|| gimple_has_side_effects (stmt)
|| (cfun->has_local_explicit_reg_vars
! && TYPE_MODE (TREE_TYPE (gimple_assign_lhs (stmt))) == BLKmode))
return false;
/* Return if there are no immediate uses of this stmt. */
--- 296,302
if (stmt_ends_bb_p (stmt)
|| gimple_has_side_effects (stmt)
|| (cfun->has_local_explicit_reg_vars
! && TYPE_MODE (TREE_TYPE (gimple_get_lhs (stmt))) == BLKmode))
return false;
/* Return if there are no immediate uses of this stmt. */
*** statement_sink_location (gimple *stmt, b
*** 323,337
/* A killing definition is not a use. */
if ((gimple_has_lhs (use_stmt)
! && operand_equal_p (gimple_assign_lhs (stmt),
gimple_get_lhs (use_stmt), 0))
! || stmt_kills_ref_p (use_stmt, gimple_assign_lhs (stmt)))
{
/* If use_stmt is or might be a nop assignment then USE_STMT
acts as a use as well as definition. */
if (stmt != use_stmt
&& ref_maybe_used_by_stmt_p (use_stmt,
! gimple_assign_lhs (stmt)))
return false;
continue;
}
--- 328,342
/* A killing definition is not a use. */
if ((gimple_has_lhs (use_stmt)
! && operand_equal_p (gimple_get_lhs (stmt),
gimple_get_lhs (use_stmt), 0))
! || stmt_kills_ref_p (use_stmt, gimple_get_lhs (stmt)))
{
/* If use_stmt is or might be a nop assignment then USE_STMT
acts as a use as well as definition. */
if (stmt != use_stmt
&& ref_maybe_used_by_stmt_p (use_stmt,
! gimple_get_lhs (stmt)))
return false;
continue;
}
Index: gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-16.c
===
*** gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-16.c (nonexistent)
--- gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-16.c (working copy)
***
*** 0
--- 1,14
+ /* { dg-do compile } */
+ /* Note PRE rotates the loop and blocks the sinking opportunity. */
+ /* { dg-options "-O2 -fno-tree-pre -fdump-tree-sink -fdump-tree-optimized" }
*/
+
+ int f(int n)
+ {
+ int i,j=0;
+ for (i = 0; i < 31; i++)
+ j = __builtin_ffs(i);
+ return j;
+ }
+
+ /* { dg-final { scan-tree-dump "Sinking j_. = __builtin_ffs" "sink" } } */
+ /* { dg-final { scan-tree-dump "return 2;" "optimized" } } */
Index: gcc/testsuite/gcc.target/i386/pr22152.c
===
*** gcc/testsuite/gcc.target/i386/pr22152.c (revision 247092)
--- gcc/testsuite/gcc.target/i386/pr22152.c (working copy)
***
*** 1,5
/* { dg-do compile } */
! /* { dg-options "-O2 -msse2 -mtune=core2" } */
/* { dg-additional-options "-mno-vect8-ret-in-mem" { target *-*-vxworks* } }
*/
/* { dg-additional-options "-mabi=sysv" { target x86_64-*-mingw* } } */
--- 1,5
/* { dg-do com
[Ada] Visibility problem using Import aspect
This patch corrects an issue whereby an import aspect used within a generic
package would fail to resolve. By analyzing the expresions within the aspect's
arguments (a.k.a "interfacing" aspects) in addition to the generated pragma's
arguments the generic template gets properly resolved names for instance
creation.
-- Source --
-- p.ads
package P is
type T1 is new Integer;
end P;
-- p-q.ads
generic package P.Q is
type T2 is new Integer;
end P.Q;
-- p-q-r.adb
with Ada.Text_IO;
with P.W.Z;
package body P.Q.R is
X : constant Integer
with Import,
Convention=> Ada,
External_Name => W.Z.S;
procedure Proc is
begin
Ada.Text_IO.Put_Line (Item => X'Img);
end Proc;
end P.Q.R;
-- p-q-r.ads
generic package P.Q.R is
procedure Proc;
end P.Q.R;
-- p-w.ads
package P.W is
type T3 is new Integer;
end P.W;
-- p-w-z.ads
package P.W.Z is
S : constant String := "Halloween";
end P.W.Z;
-- x.ads
with P.Q.R;
package X is
package X1 is new P.Q;
package X2 is new X1.R;
end X;
-- Compilation and output --
$ gcc -c x.ads
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Justin Squirek
* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
Add extra parameter for Process_Interface_Name.
(Process_Interface_Name): Add parameter for pragma to analyze
corresponding aspect.
* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
from sem_ch13.adb
Index: sem_ch13.adb
===
--- sem_ch13.adb(revision 247146)
+++ sem_ch13.adb(working copy)
@@ -147,27 +147,6 @@
-- Uint value. If the value is inappropriate, then error messages are
-- posted as required, and a value of No_Uint is returned.
- procedure Get_Interfacing_Aspects
- (Iface_Asp : Node_Id;
- Conv_Asp : out Node_Id;
- EN_Asp: out Node_Id;
- Expo_Asp : out Node_Id;
- Imp_Asp : out Node_Id;
- LN_Asp: out Node_Id;
- Do_Checks : Boolean := False);
- -- Given a single interfacing aspect Iface_Asp, retrieve other interfacing
- -- aspects that apply to the same related entity. The aspects considered by
- -- this routine are as follows:
- --
- --Conv_Asp - aspect Convention
- --EN_Asp - aspect External_Name
- --Expo_Asp - aspect Export
- --Imp_Asp - aspect Import
- --LN_Asp - aspect Link_Name
- --
- -- When flag Do_Checks is set, this routine will flag duplicate uses of
- -- aspects.
-
function Is_Operational_Item (N : Node_Id) return Boolean;
-- A specification for a stream attribute is allowed before the full type
-- is declared, as explained in AI-00137 and the corrigendum. Attributes
@@ -11214,106 +11193,6 @@
end if;
end Get_Alignment_Value;
- -
- -- Get_Interfacing_Aspects --
- -
-
- procedure Get_Interfacing_Aspects
- (Iface_Asp : Node_Id;
- Conv_Asp : out Node_Id;
- EN_Asp: out Node_Id;
- Expo_Asp : out Node_Id;
- Imp_Asp : out Node_Id;
- LN_Asp: out Node_Id;
- Do_Checks : Boolean := False)
- is
- procedure Save_Or_Duplication_Error
-(Asp : Node_Id;
- To : in out Node_Id);
- -- Save the value of aspect Asp in node To. If To already has a value,
- -- then this is considered a duplicate use of aspect. Emit an error if
- -- flag Do_Checks is set.
-
- ---
- -- Save_Or_Duplication_Error --
- ---
-
- procedure Save_Or_Duplication_Error
-(Asp : Node_Id;
- To : in out Node_Id)
- is
- begin
- -- Detect an extra aspect and issue an error
-
- if Present (To) then
-if Do_Checks then
- Error_Msg_Name_1 := Chars (Identifier (Asp));
- Error_Msg_Sloc := Sloc (To);
- Error_Msg_N ("aspect % previously given #", Asp);
-end if;
-
- -- Otherwise capture the aspect
-
- else
-To := Asp;
- end if;
- end Save_Or_Duplication_Error;
-
- -- Local variables
-
- Asp: Node_Id;
- Asp_Id : Aspect_Id;
-
- -- The following variables capture each individual aspect
-
- Conv : Node_Id := Empty;
- EN : Node_Id := Empty;
- Expo : Node_Id := Empty;
- Imp : Node_Id := Empty;
- LN : Node_Id := Empty;
-
- -- Start of processing for Get_Interfacing_Aspects
-
- begin
- -- The input interfacing aspect should reside in an aspect specification
- -- list.
-
- pragma Assert (Is_List_Member (Iface_Asp));
-
- -- Examine the aspect specifications of
Re: [PATCH] Fix PR79814
On Apr 21 2017, Richard Biener wrote:
> The following fixes uninitialized uses in pass_manager::pass_manager
> which causes bootstrap failure when a fix for PR2972 is applied.
This fails to properly initialize the pass_manager instance, causing cc1
to crash later.
Program received signal SIGSEGV, Segmentation fault.
0x40b417c1 in hash_table, opt_pass*>
>::hash_entry, xcallocator>::find_with_hash (this=0x20988140
<_IO_2_1_stderr_>,
comparable=@0x600ee790: 0x602f3870 "tree-omplower",
hash=1802803413) at ../../gcc/hash-map.h:57
57 static bool is_empty (const hash_entry &e) { return
Traits::is_empty (e); }
(gdb) bt
#0 0x40b417c1 in hash_table, opt_pass*>
>::hash_entry, xcallocator>::find_with_hash (this=0x20988140
<_IO_2_1_stderr_>,
comparable=@0x600ee790: 0x602f3870 "tree-omplower",
hash=1802803413) at ../../gcc/hash-map.h:57
#1 0x40b28e30 in hash_map, opt_pass*>
>::get (
k=@0x600ee790: 0x602f3870 "tree-omplower",
this=0x20988140 <_IO_2_1_stderr_>) at ../../gcc/hash-map.h:150
#2 gcc::pass_manager::register_pass_name (this=0x602ea0c0,
pass=0x602e7750, name=0x602f3870 "tree-omplower")
at ../../gcc/passes.c:857
#3 0x40b29850 in gcc::pass_manager::register_one_dump_file (
this=0x602ea0c0, pass=0x602e7750) at ../../gcc/passes.c:827
#4 0x40b29b00 in gcc::pass_manager::register_dump_files (
this=0x602ea0c0, pass=0x602e7750) at ../../gcc/passes.c:839
#5 0x40b3f4b0 in gcc::pass_manager::pass_manager (
this=0x602ea0c0, ctxt=) at ../../gcc/passes.c:1607
#6 0x4049f110 in gcc::context::context (this=0x602a2f00)
at ../../gcc/context.c:39
#7 0x4017def0 in general_init (init_signals=,
argv0=) at ../../gcc/toplev.c:1159
#8 toplev::main (this=0x600ef0e0, argc=2, argv=0x600ef388)
at ../../gcc/toplev.c:2089
#9 0x40183e90 in main (argc=2, argv=0x600ef388)
at ../../gcc/main.c:39
(gdb) f 5
#5 0x40b3f4b0 in gcc::pass_manager::pass_manager (
this=0x602ea0c0, ctxt=) at ../../gcc/passes.c:1607
1607 register_dump_files (all_lowering_passes);
(gdb) p m_name_to_pass_map
$13 = (hash_map, opt_pass*> > *)
0x20988140 <_IO_2_1_stderr_>
Andreas.
--
Andreas Schwab, sch...@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756 01D3 44D5 214B 8276 4ED5
"And now for something completely different."
Re: [PATCH] Fix test-case on ppc64le (PR testsuite/79455).
On 04/24/2017 05:19 PM, Jakub Jelinek wrote:
> On Mon, Apr 24, 2017 at 03:04:43PM +0200, Martin Liška wrote:
>> gcc/testsuite/ChangeLog:
>>
>> 2017-04-24 Martin Liska
>>
>> * c-c++-common/tsan/race_on_mutex.c: Make the scanned pattern
>> more generic.
>> ---
>> gcc/testsuite/c-c++-common/tsan/race_on_mutex.c | 6 +++---
>> 1 file changed, 3 insertions(+), 3 deletions(-)
>>
>> diff --git a/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
>> b/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
>> index ae30d053c92..80c193789d7 100644
>> --- a/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
>> +++ b/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
>> @@ -40,6 +40,6 @@ int main() {
>> /* { dg-output " Atomic read of size 1 at .* by thread T2:(\n|\r\n|\r)" }
>> */
>
> In that case you should also change the above 1 to \[0-9]\+ or so.
Yes
>
>> /* { dg-output "#0 pthread_mutex_lock.*" } */
>> /* { dg-output "#1 Thread2.* .*(race_on_mutex.c:22|\\?{2}:0) (.*)" } */
>> -/* { dg-output " Previous write of size 1 at .* by thread T1:(\n|\r\n|\r)"
>> } */
>> -/* { dg-output "#0 pthread_mutex_init .* (.)*" } */
>> -/* { dg-output "#1 Thread1.* .*(race_on_mutex.c:12|\\?{2}:0) .*" } */
>> +/* { dg-output " Previous write of size . at .* by thread T1:(\n|\r\n|\r)"
>> } */
>
> And here too instead of . Also, the .* will accept newlines, so you want to
> use \[^\n\r]* instead of .* everywhere.
Fixed that. I need to conditionaly catch line:
#0 memset
../../../../libsanitizer/sanitizer_common/sanitizer_common_interceptors.inc:558
(libtsan.so.0+0x00036194)
>
>> +/* { dg-output "#. .*pthread_mutex_init .* (.)*" } */
>> +/* { dg-output "#. Thread1.* .*(race_on_mutex.c:12|\\?{2}:0) .*" } */
>
> Why the (.)* ? Is anything matching that?
There should be just (__)?
Martin
>
> Jakub
>
>From 8001530f2041a0a390e62a710f28ef42ef730cc7 Mon Sep 17 00:00:00 2001
From: marxin
Date: Mon, 24 Apr 2017 14:59:18 +0200
Subject: [PATCH] Fix test-case on ppc64le (PR testsuite/79455).
gcc/testsuite/ChangeLog:
2017-04-24 Martin Liska
* c-c++-common/tsan/race_on_mutex.c: Make the scanned pattern
more generic.
---
gcc/testsuite/c-c++-common/tsan/race_on_mutex.c | 9 +
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c b/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
index ae30d053c92..b3274a60ce5 100644
--- a/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
+++ b/gcc/testsuite/c-c++-common/tsan/race_on_mutex.c
@@ -37,9 +37,10 @@ int main() {
}
/* { dg-output "WARNING: ThreadSanitizer: data race.*(\n|\r\n|\r)" } */
-/* { dg-output " Atomic read of size 1 at .* by thread T2:(\n|\r\n|\r)" } */
+/* { dg-output " Atomic read of size \[0-9]\+ at .* by thread T2:(\n|\r\n|\r)" } */
/* { dg-output "#0 pthread_mutex_lock.*" } */
/* { dg-output "#1 Thread2.* .*(race_on_mutex.c:22|\\?{2}:0) (.*)" } */
-/* { dg-output " Previous write of size 1 at .* by thread T1:(\n|\r\n|\r)" } */
-/* { dg-output "#0 pthread_mutex_init .* (.)*" } */
-/* { dg-output "#1 Thread1.* .*(race_on_mutex.c:12|\\?{2}:0) .*" } */
+/* { dg-output " Previous write of size \[0-9]\+ at .* by thread T1:(\n|\r\n|\r)" } */
+/* { dg-output "(#. \[^\n\r\]*(\n|\r\n|\r))?" } */
+/* { dg-output "#. (__)?pthread_mutex_init \[^\n\r\]* (.)*" } */
+/* { dg-output "#. Thread1.* .*(race_on_mutex.c:12|\\?{2}:0) .*" } */
--
2.12.2
Re: [PATCH] Fix PR79814
On Tue, 25 Apr 2017, Andreas Schwab wrote:
> On Apr 21 2017, Richard Biener wrote:
>
> > The following fixes uninitialized uses in pass_manager::pass_manager
> > which causes bootstrap failure when a fix for PR2972 is applied.
>
> This fails to properly initialize the pass_manager instance, causing cc1
> to crash later.
>
> Program received signal SIGSEGV, Segmentation fault.
> 0x40b417c1 in hash_table simple_hashmap_traits, opt_pass*>
> >::hash_entry, xcallocator>::find_with_hash (this=0x20988140
> <_IO_2_1_stderr_>,
> comparable=@0x600ee790: 0x602f3870 "tree-omplower",
> hash=1802803413) at ../../gcc/hash-map.h:57
> 57 static bool is_empty (const hash_entry &e) { return
> Traits::is_empty (e); }
> (gdb) bt
> #0 0x40b417c1 in hash_table simple_hashmap_traits, opt_pass*>
> >::hash_entry, xcallocator>::find_with_hash (this=0x20988140
> <_IO_2_1_stderr_>,
> comparable=@0x600ee790: 0x602f3870 "tree-omplower",
> hash=1802803413) at ../../gcc/hash-map.h:57
> #1 0x40b28e30 in hash_map simple_hashmap_traits, opt_pass*>
> >::get (
> k=@0x600ee790: 0x602f3870 "tree-omplower",
> this=0x20988140 <_IO_2_1_stderr_>) at ../../gcc/hash-map.h:150
> #2 gcc::pass_manager::register_pass_name (this=0x602ea0c0,
> pass=0x602e7750, name=0x602f3870 "tree-omplower")
> at ../../gcc/passes.c:857
> #3 0x40b29850 in gcc::pass_manager::register_one_dump_file (
> this=0x602ea0c0, pass=0x602e7750) at
> ../../gcc/passes.c:827
> #4 0x40b29b00 in gcc::pass_manager::register_dump_files (
> this=0x602ea0c0, pass=0x602e7750) at
> ../../gcc/passes.c:839
> #5 0x40b3f4b0 in gcc::pass_manager::pass_manager (
> this=0x602ea0c0, ctxt=) at ../../gcc/passes.c:1607
> #6 0x4049f110 in gcc::context::context (this=0x602a2f00)
> at ../../gcc/context.c:39
> #7 0x4017def0 in general_init (init_signals=,
> argv0=) at ../../gcc/toplev.c:1159
> #8 toplev::main (this=0x600ef0e0, argc=2, argv=0x600ef388)
> at ../../gcc/toplev.c:2089
> #9 0x40183e90 in main (argc=2, argv=0x600ef388)
> at ../../gcc/main.c:39
> (gdb) f 5
> #5 0x40b3f4b0 in gcc::pass_manager::pass_manager (
> this=0x602ea0c0, ctxt=) at ../../gcc/passes.c:1607
> 1607 register_dump_files (all_lowering_passes);
> (gdb) p m_name_to_pass_map
> $13 = (hash_map simple_hashmap_traits, opt_pass*> >
> *) 0x20988140 <_IO_2_1_stderr_>
>
> Andreas.
I am testing
2017-04-25 Richard Biener
PR middle-end/80509
* passes.c (pass_manager::pass_manager): Initialize
m_name_to_pass_map.
Index: gcc/passes.c
===
--- gcc/passes.c(revision 247147)
+++ gcc/passes.c(working copy)
@@ -1532,7 +1532,7 @@ pass_manager::pass_manager (context *ctx
: all_passes (NULL), all_small_ipa_passes (NULL), all_lowering_passes (NULL),
all_regular_ipa_passes (NULL),
all_late_ipa_passes (NULL), passes_by_id (NULL), passes_by_id_size (0),
- m_ctxt (ctxt)
+ m_ctxt (ctxt), m_name_to_pass_map (NULL)
{
opt_pass **p;
[Ada] Reduce rounding overhead in sin/cos/tan functions on x86
The trigonometric functions of children of Ada.Numerics are implemented by inline assembly statements on the x86 architecture, and for sin/cos/tan a special range reduction algorithm is used to avoid a loss of accuracy in range reduction implemented in hardware on x86 processors. This algorithm contains a rounding step and it was implemented inefficiently by a call to a routine of the runtime. This patch changes it to using a more efficient inline sequence of machine instructions instead. The same change is applied to the range reduction algorithm used prior to calling the libc routines on PowerPC/Darwin. The patch also changes the definition of the Double type used to interface the libc routines in other implementations so as to use the built-in type corresponding to the C type (Long_Float, except for Long_Long_Float on x86). Compiling the following package at -O2 -gnatpgn must yield no calls to the rounding routines of the runtime on x86: with Ada.Numerics.Generic_Elementary_Functions; package P is new Ada.Numerics.Generic_Elementary_Functions (Long_Float); Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Eric Botcazou * a-numaux.ads: Fix description of a-numaux-darwin and a-numaux-x86. (Double): Define to Long_Float. * a-numaux-vxworks.ads (Double): Likewise. * a-numaux-darwin.ads (Double): Likewise. * a-numaux-libc-x86.ads (Double): Define to Long_Long_Float. * a-numaux-x86.ads: Fix package description. * a-numaux-x86.adb (Is_Nan): Minor tweak. (Reduce): Adjust and complete description. Call Is_Nan instead of testing manually. Use an integer temporary to hold rounded value. * a-numaux-darwin.adb (Reduce): Likewise. (Is_Nan): New function. Index: a-numaux-vxworks.ads === --- a-numaux-vxworks.ads(revision 247135) +++ a-numaux-vxworks.ads(working copy) @@ -36,7 +36,7 @@ package Ada.Numerics.Aux is pragma Pure; - type Double is digits 15; + type Double is new Long_Float; -- Type Double is the type used to call the C routines -- We import these functions directly from C. Note that we label them Index: a-numaux-x86.adb === --- a-numaux-x86.adb(revision 247135) +++ a-numaux-x86.adb(working copy) @@ -49,8 +49,11 @@ -- for values of Y in the open interval (-0.25, 0.25) procedure Reduce (X : in out Double; Q : out Natural); - -- Implements reduction of X by Pi/2. Q is the quadrant of the final - -- result in the range 0 .. 3. The absolute value of X is at most Pi. + -- Implement reduction of X by Pi/2. Q is the quadrant of the final + -- result in the range 0..3. The absolute value of X is at most Pi/4. + -- It is needed to avoid a loss of accuracy for sin near Pi and cos + -- near Pi/2 due to the use of an insufficiently precise value of Pi + -- in the range reduction. pragma Inline (Is_Nan); pragma Inline (Reduce); @@ -117,7 +120,7 @@ begin -- The IEEE NaN values are the only ones that do not equal themselves - return not (X = X); + return X /= X; end Is_Nan; - @@ -154,32 +157,36 @@ P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3 - P4, HM); P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5); - K : Double := X * Two_Over_Pi; + K : Double; + R : Integer; + begin - -- For X < 2.0**32, all products below are computed exactly. + -- For X < 2.0**HM, all products below are computed exactly. -- Due to cancellation effects all subtractions are exact as well. -- As no double extended floating-point number has more than 75 -- zeros after the binary point, the result will be the correctly -- rounded result of X - K * (Pi / 2.0). + K := X * Two_Over_Pi; while abs K >= 2.0**HM loop K := K * M - (K * M - K); - X := (X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + X := + (X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; K := X * Two_Over_Pi; end loop; - if K /= K then + -- If K is not a number (because X was not finite) raise exception - -- K is not a number, because X was not finite - + if Is_Nan (K) then raise Constraint_Error; end if; - K := Double'Rounding (K); - Q := Integer (K) mod 4; - X := (X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + -- Go through an integer temporary so as to use machine instructions + + R := Integer (Double'Rounding (K)); + Q := R mod 4; + K := Double (R); + X := (X - K * P1) -
[Ada] Specifying Address clause on controlled objects
This patch removes the restriction on attribute definition clause 'Address
which prevented it from being used with controlled objects. The restriction
was a legacy left over from the previous controlled type implementation where
each controlled type had hidden components that should not be overlayed.
-- Source --
-- types.ads
with Ada.Finalization; use Ada.Finalization;
package Types is
type Ctrl is new Controlled with record
Comp_1 : Integer;
end record;
type Rec is record
Comp_1 : Ctrl;
Comp_2 : Integer;
end record;
type Tag_Typ is tagged record
Comp_1 : Integer;
Comp_2 : Integer;
Comp_3 : Integer;
end record;
end Types;
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
with Types; use Types;
procedure Main is
Obj_1 : constant Integer := 1;
Obj_1_Addr : constant Address := Obj_1'Address;
-- The objects are declared in one order, but their address clauses order
-- them in reverse declarative order.
Obj_4_Addr : constant Address := Obj_1_Addr + Integer'Size;
Obj_3_Addr : constant Address := Obj_4_Addr + Tag_Typ'Size;
Obj_2_Addr : constant Address := Obj_3_Addr + Ctrl'Size;
Obj_2 : Ctrl;
for Obj_2'Address use Obj_2_Addr;
Obj_3 : Rec;
for Obj_3'Address use Obj_3_Addr;
Obj_4 : Tag_Typ;
for Obj_4'Address use Obj_4_Addr;
begin
if Obj_2'Address /= Obj_2_Addr then
Put_Line ("ERROR: Obj_2 is in the wrong place");
end if;
if Obj_3'Address /= Obj_3_Addr then
Put_Line ("ERROR: Obj_3 is in the wrong place");
end if;
if Obj_4'Address /= Obj_4_Addr then
Put_Line ("ERROR: Obj_4 is in the wrong place");
end if;
end Main;
-
-- Compilation --
-
$ gnatmake -q -gnatws main.adb
$ ./main
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Hristian Kirtchev
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Remove the
restriction converning the use of 'Address where the prefix is
of a controlled type.
Index: sem_ch13.adb
===
--- sem_ch13.adb(revision 247160)
+++ sem_ch13.adb(working copy)
@@ -4887,21 +4887,6 @@
("\?j?use interrupt procedure instead", N);
end if;
--- Case of an address clause for a controlled object, which we
--- consider to be erroneous.
-
-elsif Is_Controlled (Etype (U_Ent))
- or else Has_Controlled_Component (Etype (U_Ent))
-then
- Error_Msg_NE
- ("??controlled object & must not be overlaid", Nam, U_Ent);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Nam);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
- return;
-
-- Case of an address clause for a class-wide object, which is
-- considered erroneous.
@@ -4915,9 +4900,9 @@
Reason => PE_Overlaid_Controlled_Object));
return;
--- Case of address clause for a (non-controlled) object
+-- Case of address clause for an object
-elsif Ekind_In (U_Ent, E_Variable, E_Constant) then
+elsif Ekind_In (U_Ent, E_Constant, E_Variable) then
declare
Expr : constant Node_Id := Expression (N);
O_Ent : Entity_Id;
@@ -5006,28 +4991,11 @@
end;
end if;
- -- Overlaying controlled objects is erroneous. Emit warning
- -- but continue analysis because program is itself legal,
- -- and back end must see address clause.
-
- if Present (O_Ent)
-and then (Has_Controlled_Component (Etype (O_Ent))
- or else Is_Controlled (Etype (O_Ent)))
-and then not Inside_A_Generic
- then
- Error_Msg_N
- ("??cannot use overlays with controlled objects", Expr);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Expr);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
-
-- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only
-- if the variable is modified.
- elsif Ekind (U_Ent) = E_Constant
+
[Ada] Use out-of-line string concatenation at library level
String concatenation can be implemented either in-line or out-of-line by the
compiler, depending on the optimization level and other factors. But doing
in-line concatenation at library level is undesirable in general and the
compiler already avoids it for simple declarations:
S : String := S1 & S2; -- out-of-line at all optimization levels
but not for slightly more complex ones:
S : String := Ada.Characters.Handling.To_Upper (S1 & S2);
which are implemented in-line for -O1 and above.
This patch changes the second case to using out-of-line concatenation at all
optimization levels which, among other things, generates more compact code.
The following package must always use out-of-line concatenation:
with Ada.Characters.Handling;
package P is
Scope: constant String := Ada.Characters.Handling.To_Upper ("P");
function Full_String return String;
end P;
package body P is
Full_Scope : constant String
:= Ada.Characters.Handling.To_Upper (Scope & ".body");
function Full_String return String is (Full_Scope);
end P;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Eric Botcazou
* exp_ch4.adb (Library_Level_Target): New function.
(Expand_Concatenate): When optimization is enabled, also expand
the operation out-of-line if the concatenation is present within
the expression of the declaration of a library-level object and
not only if it is the expression of the declaration.
Index: exp_ch4.adb
===
--- exp_ch4.adb (revision 247135)
+++ exp_ch4.adb (working copy)
@@ -2767,6 +2767,10 @@
-- Set True during generation of the assignments of operands into
-- result once an operand known to be non-null has been seen.
+ function Library_Level_Target return Boolean;
+ -- Return True if the concatenation is within the expression of the
+ -- declaration of a library-level object.
+
function Make_Artyp_Literal (Val : Nat) return Node_Id;
-- This function makes an N_Integer_Literal node that is returned in
-- analyzed form with the type set to Artyp. Importantly this literal
@@ -2782,6 +2786,30 @@
function To_Ityp (X : Node_Id) return Node_Id;
-- The inverse function (uses Val in the case of enumeration types)
+ --
+ -- Library_Level_Target --
+ --
+
+ function Library_Level_Target return Boolean is
+ P : Node_Id := Parent (Cnode);
+
+ begin
+ while Present (P) loop
+if Nkind (P) = N_Object_Declaration then
+ return Is_Library_Level_Entity (Defining_Identifier (P));
+
+-- Prevent the search from going too far
+
+elsif Is_Body_Or_Package_Declaration (P) then
+ return False;
+end if;
+
+P := Parent (P);
+ end loop;
+
+ return False;
+ end Library_Level_Target;
+
-- Make_Artyp_Literal --
@@ -2842,16 +2870,6 @@
-- Local Declarations
- Lib_Level_Target : constant Boolean :=
-Nkind (Parent (Cnode)) = N_Object_Declaration
- and then
-Is_Library_Level_Entity (Defining_Identifier (Parent (Cnode)));
-
- -- If the concatenation declares a library level entity, we call the
- -- built-in concatenation routines to prevent code bloat, regardless
- -- of optimization level. This is space-efficient, and prevent linking
- -- problems when units are compiled with different optimizations.
-
Opnd_Typ : Entity_Id;
Ent : Entity_Id;
Len : Uint;
@@ -3372,22 +3390,27 @@
--There are nine or fewer retained (non-null) operands
- --The optimization level is -O0
+ --The optimization level is -O0 or the debug flag gnatd.C is set,
+ --and the debug flag gnatd.c is not set.
--The corresponding System.Concat_n.Str_Concat_n routine is
--available in the run time.
- --The debug flag gnatd.c is not set
-
-- If all these conditions are met then we generate a call to the
-- relevant concatenation routine. The purpose of this is to avoid
-- undesirable code bloat at -O0.
+ -- If the concatenation is within the declaration of a library-level
+ -- object, we call the built-in concatenation routines to prevent code
+ -- bloat, regardless of the optimization level. This is space efficient
+ -- and prevents linking problems when units are compiled with different
+ -- optimization levels.
+
if Atyp = Standard_String
and then NN in 2 .. 9
-and then (Lib_Level_Target
- or else ((Optimization_Level = 0 or else Debug_Flag_Dot_CC)
- and then not Debug_Flag_Dot_C))
+and then (((Optimization_Level = 0 or else
[Ada] Static intialization with pragma Linker_Section
This patch is an improvement that causes an array object that has a pragma Linker_Section with a compile-time-known initial value to be statically initialized in place in the appropriate section. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * freeze.adb (Freeze_Object_Declaration): Do not Remove_Side_Effects if there is a pragma Linker_Section, because in that case we want static initialization in the appropriate section. Index: freeze.adb === --- freeze.adb (revision 247155) +++ freeze.adb (working copy) @@ -3197,12 +3197,15 @@ -- Similar processing is needed for aspects that may affect -- object layout, like Alignment, if there is an initialization - -- expression. + -- expression. We don't do this if there is a pragma Linker_Section, + -- because it would prevent the back end from statically initializing + -- the object; we don't want elaboration code in that case. if Has_Delayed_Aspects (E) and then Expander_Active and then Is_Array_Type (Etype (E)) and then Present (Expression (Parent (E))) + and then No (Linker_Section_Pragma (E)) then declare Decl : constant Node_Id := Parent (E);
[Ada] Wrong casing of restriction and check names
Fixes bugs in which the wrong casing was used for restriction names in
pragmas Restrictions and Restriction_Warnings, and check names in pragma
Check. No test is available -- too complicated to make it fail.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Use Source_Index (Current_Sem_Unit) to find the correct casing.
* exp_prag.adb (Expand_Pragma_Check): Use Source_Index
(Current_Sem_Unit) to find the correct casing.
* par.adb (Par): Null out Current_Source_File, to ensure that
the above bugs won't rear their ugly heads again.
Index: exp_prag.adb
===
--- exp_prag.adb(revision 247162)
+++ exp_prag.adb(working copy)
@@ -33,6 +33,7 @@
with Exp_Util; use Exp_Util;
with Expander; use Expander;
with Inline; use Inline;
+with Lib; use Lib;
with Namet;use Namet;
with Nlists; use Nlists;
with Nmake;use Nmake;
@@ -432,11 +433,12 @@
Add_Str_To_Name_Buffer ("failed invariant from ");
-- For all other checks, the string is "xxx failed at yyy"
- -- where xxx is the check name with current source file casing.
+ -- where xxx is the check name with appropriate casing.
else
Get_Name_String (Nam);
- Set_Casing (Identifier_Casing (Current_Source_File));
+ Set_Casing
+(Identifier_Casing (Source_Index (Current_Sem_Unit)));
Add_Str_To_Name_Buffer (" failed at ");
end if;
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247165)
+++ sem_prag.adb(working copy)
@@ -9416,7 +9416,8 @@
if Is_Bad_Spelling_Of (Chars (Expr), Name_Enter) then
Set_Casing
- (Identifier_Casing (Current_Source_File));
+ (Identifier_Casing
+ (Source_Index (Current_Sem_Unit)));
Error_Msg_String (1 .. Rnm'Length) :=
Name_Buffer (1 .. Name_Len);
Error_Msg_Strlen := Rnm'Length;
Index: par.adb
===
--- par.adb (revision 247150)
+++ par.adb (working copy)
@@ -1457,6 +1457,8 @@
procedure Labl is separate;
procedure Load is separate;
+ Result : List_Id := Empty_List;
+
-- Start of processing for Par
begin
@@ -1472,13 +1474,13 @@
begin
loop
if Token = Tok_EOF then
- Compiler_State := Analyzing;
- return Pragmas;
+ Result := Pragmas;
+ exit;
elsif Token /= Tok_Pragma then
Error_Msg_SC ("only pragmas allowed in configuration file");
- Compiler_State := Analyzing;
- return Error_List;
+ Result := Error_List;
+ exit;
else
P_Node := P_Pragma;
@@ -1690,7 +1692,9 @@
Restore_Opt_Config_Switches (Save_Config_Switches);
Set_Comes_From_Source_Default (False);
- Compiler_State := Analyzing;
- return Empty_List;
end if;
+
+ Compiler_State := Analyzing;
+ Current_Source_File := No_Source_File;
+ return Result;
end Par;
[Ada] For CodePeer, omit some tag checks which confuse gnat2scil
CodePeer does not do anything useful with the various components of the record type Ada.Tags.Type_Specific_Data. Suppress generation of some checks which reference these components in cases where these checks cause CodePeer to generate unwanted messages. This change has no user-visible effect except when Gnat2scil is running. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Steve Baird * exp_ch6.adb (Expand_Simple_Function_Return): if CodePeer_Mode is True, then don't generate the accessibility check for the tag of a tagged result. * exp_intr.adb (Expand_Dispatching_Constructor_Call): if CodePeer_Mode is True, then don't generate the tag checks for the result of call to an instance of Ada.Tags.Generic_Dispatching_Constructor (i.e., both the "is a descendant of" check and the accessibility check). Index: exp_ch6.adb === --- exp_ch6.adb (revision 247136) +++ exp_ch6.adb (working copy) @@ -6635,15 +6635,20 @@ Attribute_Name => Name_Tag); end if; -Insert_Action (Exp, - Make_Raise_Program_Error (Loc, -Condition => - Make_Op_Gt (Loc, -Left_Opnd => Build_Get_Access_Level (Loc, Tag_Node), -Right_Opnd => - Make_Integer_Literal (Loc, -Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id, -Reason => PE_Accessibility_Check_Failed)); +if not CodePeer_Mode then + -- CodePeer doesn't do anything useful with + -- Ada.Tags.Type_Specific_Data components + + Insert_Action (Exp, + Make_Raise_Program_Error (Loc, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => Build_Get_Access_Level (Loc, Tag_Node), + Right_Opnd => + Make_Integer_Literal (Loc, + Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id, + Reason => PE_Accessibility_Check_Failed)); +end if; end; -- AI05-0073: If function has a controlling access result, check that Index: exp_intr.adb === --- exp_intr.adb(revision 247150) +++ exp_intr.adb(working copy) @@ -421,20 +421,22 @@ Result_Typ := Class_Wide_Type (Etype (Act_Constr)); -- Check that the accessibility level of the tag is no deeper than that - -- of the constructor function. + -- of the constructor function (unless CodePeer_Mode) - Insert_Action (N, -Make_Implicit_If_Statement (N, - Condition => -Make_Op_Gt (Loc, - Left_Opnd => -Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), - Right_Opnd => -Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), + if not CodePeer_Mode then + Insert_Action (N, + Make_Implicit_If_Statement (N, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => + Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), + Right_Opnd => + Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), - Then_Statements => New_List ( -Make_Raise_Statement (Loc, - New_Occurrence_Of (RTE (RE_Tag_Error), Loc); + Then_Statements => New_List ( + Make_Raise_Statement (Loc, + New_Occurrence_Of (RTE (RE_Tag_Error), Loc); + end if; if Is_Interface (Etype (Act_Constr)) then @@ -505,10 +507,11 @@ -- Do not generate a run-time check on the built object if tag -- checks are suppressed for the result type or tagged type expansion - -- is disabled. + -- is disabled or if CodePeer_Mode. if Tag_Checks_Suppressed (Etype (Result_Typ)) or else not Tagged_Type_Expansion +or else CodePeer_Mode then null;
[Ada] Use type clause in parent of a generic package
This patch fixes a bug in the handling of use_type_clauses
If a use_type_clause "use type X;" appears in the parent of
a generic child package, and "use type X;" also appears before an
instantiation of that generic child package, the second "use type X;"
is ineffective; the primitive operators of type X are not directly
visible where they should be.
The following test should compile quietly:
package Utl is
type Timerep_T is (Red);
function "+"
(Time : Timerep_T;
Interval : Timerep_T) return Timerep_T;
end Utl;
with Utl;
package Pfw is
use type Utl.Timerep_T;
end Pfw;
generic
package Pfw.Server is
end Pfw.Server;
with Pfw.Server;
with Utl;
package Beacon is
use type Utl.Timerep_T;
package Code_Server_Pkg is new Pfw.Server;
One_Hour : Utl.Timerep_T;
Two_hours : Utl.Timerep_T := One_Hour + One_Hour;
end Beacon;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* sem_ch8.adb (Use_One_Type): If a use_type_clause
is redundant, set its Used_Operations to empty. This is only
necessary for use clauses that appear in the parent of a generic
child unit, because those use clauses get reanalyzed when we
instantiate the generic, and we don't want the Used_Operations
carried over from the original context (where it was probably
not redundant).
Index: sem_ch8.adb
===
--- sem_ch8.adb (revision 247168)
+++ sem_ch8.adb (working copy)
@@ -9200,11 +9200,22 @@
("incomplete type from limited view "
& "cannot appear in use clause", Id);
+ -- If the use clause is redundant, Used_Operations will usually be
+ -- empty, but we need to set it to empty here in one case: If we are
+ -- instantiating a generic library unit, then we install the ancestors
+ -- of that unit in the scope stack, which involves reprocessing use
+ -- clauses in those ancestors. Such a use clause will typically have a
+ -- nonempty Used_Operations unless it was redundant in the generic unit,
+ -- even if it is redundant at the place of the instantiation.
+
+ elsif Redundant_Use (Id) then
+ Set_Used_Operations (Parent (Id), New_Elmt_List);
+
-- If the subtype mark designates a subtype in a different package,
-- we have to check that the parent type is visible, otherwise the
-- use type clause is a noop. Not clear how to do that???
- elsif not Redundant_Use (Id) then
+ else
Set_In_Use (T);
-- If T is tagged, primitive operators on class-wide operands
Re: [PATCH] squash spurious warnings in dominance.c
On Mon, Apr 24, 2017 at 11:07 PM, Martin Sebor wrote: > On 04/24/2017 01:32 AM, Richard Biener wrote: >> >> On Sat, Apr 22, 2017 at 2:51 AM, Martin Sebor wrote: >>> >>> Bug 80486 - spurious -Walloc-size-larger-than and >>> -Wstringop-overflow in dominance.c during profiledbootstrap >>> points out a number of warnings that show up in dominance.c >>> during a profiledbootstrap. I'm pretty sure the warnings >>> are due to the size check the C++ new expression introduces >>> to avoid unsigned overflow before calling operator new, and >>> by some optimization like jump threading introducing a branch >>> with the call to the allocation function and memset with >>> the excessive constant size. >>> >>> Two ways to avoid it come to mind: 1) use the libiberty >>> XCNEWVEC and XNEWVEC macros instead of C++ new expressions, >>> and 2) constraining the size variable to a valid range. >>> >>> Either of these approaches should result in better code than >>> the new expression because they both eliminate the test for >>> the overflow. Attached is a patch that implements (1). I >>> chose it mainly because it seems in line with GCC's memory >>> management policy and with avoiding exceptions. >>> >>> An alternate patch should be straightforward. Either add >>> an assert like the one below or change the type of >>> m_n_basic_blocks from size_t to unsigned. This approach, >>> though less intrusive, will likely bring the warning back >>> in ILP32 builds; I'm not sure if it matters. >> >> >> Please change m_n_basic_blocks (and local copies) from size_t >> to unsigned int. This is an odd inconsistency that's worth fixing >> in any case. > > > Attached is this version of the patch. It also eliminates > the warnings and passes profiledbootstrap/regression test > on x86_64. Ok. Thanks, Richard. > Martin >
[AARCH64 ABI PATCH] Change AARCH64 ABI to match AAPCS, provide -Wpsabi notes (PR target/77728)
Hi!
Similarly to the previous patch, just hopefully triggers less often,
because 128-bit alignment is more rare.
Ok for trunk/7.1 if it passes testing?
2017-04-25 Ramana Radhakrishnan
Jakub Jelinek
PR target/77728
* config/aarch64/aarch64.c (struct aarch64_fn_arg_alignment): New
type.
(aarch64_function_arg_alignment): Return aarch64_fn_arg_alignment
struct. Ignore DECL_ALIGN of decls other than FIELD_DECL for
the alignment computation, but return their maximum in warn_alignment.
(aarch64_layout_arg): Adjust aarch64_function_arg_alignment caller.
Emit a -Wpsabi note if warn_alignment is 16 bytes, but alignment
is smaller.
(aarch64_function_arg_boundary): Likewise. Simplify using MIN/MAX.
(aarch64_gimplify_va_arg_expr): Adjust aarch64_function_arg_alignment
caller.
testsuite/
* g++.dg/abi/pr77728-2.C: New test.
--- gcc/config/aarch64/aarch64.c.jj 2017-04-24 19:28:02.518970890 +0200
+++ gcc/config/aarch64/aarch64.c2017-04-25 11:07:55.169532408 +0200
@@ -2256,33 +2256,58 @@ aarch64_vfp_is_call_candidate (cumulativ
NULL);
}
-/* Given MODE and TYPE of a function argument, return the alignment in
+struct aarch64_fn_arg_alignment
+{
+ /* Alignment for FIELD_DECLs in function arguments. */
+ unsigned int alignment;
+ /* Alignment for decls other than FIELD_DECLs in function arguments. */
+ unsigned int warn_alignment;
+};
+
+/* Given MODE and TYPE of a function argument, return a pair of alignments in
bits. The idea is to suppress any stronger alignment requested by
the user and opt for the natural alignment (specified in AAPCS64 \S 4.1).
This is a helper function for local use only. */
-static unsigned int
+static struct aarch64_fn_arg_alignment
aarch64_function_arg_alignment (machine_mode mode, const_tree type)
{
+ struct aarch64_fn_arg_alignment aa;
+ aa.alignment = 0;
+ aa.warn_alignment = 0;
+
if (!type)
-return GET_MODE_ALIGNMENT (mode);
+{
+ aa.alignment = GET_MODE_ALIGNMENT (mode);
+ return aa;
+}
+
if (integer_zerop (TYPE_SIZE (type)))
-return 0;
+return aa;
gcc_assert (TYPE_MODE (type) == mode);
if (!AGGREGATE_TYPE_P (type))
-return TYPE_ALIGN (TYPE_MAIN_VARIANT (type));
+{
+ aa.alignment = TYPE_ALIGN (TYPE_MAIN_VARIANT (type));
+ return aa;
+}
if (TREE_CODE (type) == ARRAY_TYPE)
-return TYPE_ALIGN (TREE_TYPE (type));
-
- unsigned int alignment = 0;
+{
+ aa.alignment = TYPE_ALIGN (TREE_TYPE (type));
+ return aa;
+}
for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
-alignment = std::max (alignment, DECL_ALIGN (field));
+{
+ if (TREE_CODE (field) == FIELD_DECL)
+ aa.alignment = std::max (aa.alignment, DECL_ALIGN (field));
+ else
+ aa.warn_alignment = std::max (aa.warn_alignment, DECL_ALIGN (field));
+}
- return alignment;
+ return aa;
}
/* Layout a function argument according to the AAPCS64 rules. The rule
@@ -2369,24 +2394,35 @@ aarch64_layout_arg (cumulative_args_t pc
entirely general registers. */
if (allocate_ncrn && (ncrn + nregs <= NUM_ARG_REGS))
{
- unsigned int alignment = aarch64_function_arg_alignment (mode, type);
gcc_assert (nregs == 0 || nregs == 1 || nregs == 2);
/* C.8 if the argument has an alignment of 16 then the NGRN is
rounded up to the next even number. */
- if (nregs == 2 && alignment == 16 * BITS_PER_UNIT && ncrn % 2)
+ if (nregs == 2 && ncrn % 2)
{
- ++ncrn;
- gcc_assert (ncrn + nregs <= NUM_ARG_REGS);
+ struct aarch64_fn_arg_alignment aa
+ = aarch64_function_arg_alignment (mode, type);
+
+ if (aa.warn_alignment == 16 * BITS_PER_UNIT
+ && aa.alignment < aa.warn_alignment
+ && warn_psabi
+ && currently_expanding_gimple_stmt)
+ inform (input_location,
+ "parameter passing for argument of type %qT "
+ "changed in GCC 7.1", type);
+ else if (aa.alignment == 16 * BITS_PER_UNIT)
+ {
+ ++ncrn;
+ gcc_assert (ncrn + nregs <= NUM_ARG_REGS);
+ }
}
+
/* NREGS can be 0 when e.g. an empty structure is to be passed.
A reg is still generated for it, but the caller should be smart
enough not to use it. */
if (nregs == 0 || nregs == 1 || GET_MODE_CLASS (mode) == MODE_INT)
- {
- pcum->aapcs_reg = gen_rtx_REG (mode, R0_REGNUM + ncrn);
- }
+ pcum->aapcs_reg = gen_rtx_REG (mode, R0_REGNUM + ncrn);
else
{
rtx par;
@@ -2414,7 +2450,10 @@ aarch64_layout_arg (cumulative_args_t pc
this argument and align the total size if necessary. */
on_stack:
pcum->aapcs_stack_words = size / UNITS_PER_WO
[ARM ABI PATCH] Change ARM ABI to match AAPCS, provide -Wpsabi notes (PR target/77728)
Hi!
As mentioned in the PR, r225465 aka PR65956 changed the ABI
on ARM to match updated AAPCS, but the change had a bug - for structures
it considered DECL_ALIGN of any TYPE_FIELDS, rather than just
actual data components (AAPCS says members, for C++ and Itanium C++ ABI
that is likely direct non-static data members and non-virtual base classes;
that means it also considered alignment of static data members (at least
this was consistent ABI difference), or DECL_ALIGN of TYPE_DECLs (which is
bigger problem, because that alignment is pretty randomish, it has different
value in types in templates depending on whether they have been instantiated
earlier or not)).
The following patch fixes the ABI bug and adds -Wpsabi diagnostics (inform
rather than warning, so it doesn't break with -Werror and matches i386.c
-Wpsabi notes where there is no bug on the compiled code side).
Earlier version of the patch has been bootstrapped/regtested on
armv7hl-linux-gnueabi, but there have been various changes since then.
Ok for trunk/7.1 if it passes testing?
2017-04-25 Ramana Radhakrishnan
Jakub Jelinek
PR target/77728
* config/arm/arm.c: Include gimple.h.
(aapcs_layout_arg): Emit -Wpsabi note if arm_needs_doubleword_align
returns negative, increment ncrn only if it returned positive.
(arm_needs_doubleword_align): Return int instead of bool,
ignore DECL_ALIGN of non-FIELD_DECL TYPE_FIELDS chain
members, but if there is any such non-FIELD_DECL
> PARM_BOUNDARY aligned decl, return -1 instead of false.
(arm_function_arg): Emit -Wpsabi note if arm_needs_doubleword_align
returns negative, increment nregs only if it returned positive.
(arm_setup_incoming_varargs): Likewise.
(arm_function_arg_boundary): Emit -Wpsabi note if
arm_needs_doubleword_align returns negative, return
DOUBLEWORD_ALIGNMENT only if it returned positive.
testsuite/
* g++.dg/abi/pr77728-1.C: New test.
--- gcc/config/arm/arm.c.jj 2017-04-25 09:20:49.740670794 +0200
+++ gcc/config/arm/arm.c2017-04-25 11:07:11.003121070 +0200
@@ -64,6 +64,7 @@
#include "rtl-iter.h"
#include "optabs-libfuncs.h"
#include "gimplify.h"
+#include "gimple.h"
/* This file should be included last. */
#include "target-def.h"
@@ -81,7 +82,7 @@ struct four_ints
/* Forward function declarations. */
static bool arm_const_not_ok_for_debug_p (rtx);
-static bool arm_needs_doubleword_align (machine_mode, const_tree);
+static int arm_needs_doubleword_align (machine_mode, const_tree);
static int arm_compute_static_chain_stack_bytes (void);
static arm_stack_offsets *arm_get_frame_offsets (void);
static void arm_add_gc_roots (void);
@@ -6349,8 +6350,20 @@ aapcs_layout_arg (CUMULATIVE_ARGS *pcum,
/* C3 - For double-word aligned arguments, round the NCRN up to the
next even number. */
ncrn = pcum->aapcs_ncrn;
- if ((ncrn & 1) && arm_needs_doubleword_align (mode, type))
-ncrn++;
+ if (ncrn & 1)
+{
+ int res = arm_needs_doubleword_align (mode, type);
+ /* Only warn during RTL expansion of call stmts, otherwise we would
+warn e.g. during gimplification even on functions that will be
+always inlined, and we'd warn multiple times. Don't warn when
+called in expand_function_start either, as we warn instead in
+arm_function_arg_boundary in that case. */
+ if (res < 0 && warn_psabi && currently_expanding_gimple_stmt)
+ inform (input_location, "parameter passing for argument of type "
+ "%qT changed in GCC 7.1", type);
+ else if (res > 0)
+ ncrn++;
+}
nregs = ARM_NUM_REGS2(mode, type);
@@ -6455,12 +6468,16 @@ arm_init_cumulative_args (CUMULATIVE_ARG
}
}
-/* Return true if mode/type need doubleword alignment. */
-static bool
+/* Return 1 if double word alignment is required for argument passing.
+ Return -1 if double word alignment used to be required for argument
+ passing before PR77728 ABI fix, but is not required anymore.
+ Return 0 if double word alignment is not required and wasn't requried
+ before either. */
+static int
arm_needs_doubleword_align (machine_mode mode, const_tree type)
{
if (!type)
-return PARM_BOUNDARY < GET_MODE_ALIGNMENT (mode);
+return GET_MODE_ALIGNMENT (mode) > PARM_BOUNDARY;
/* Scalar and vector types: Use natural alignment, i.e. of base type. */
if (!AGGREGATE_TYPE_P (type))
@@ -6470,12 +6487,21 @@ arm_needs_doubleword_align (machine_mode
if (TREE_CODE (type) == ARRAY_TYPE)
return TYPE_ALIGN (TREE_TYPE (type)) > PARM_BOUNDARY;
+ int ret = 0;
/* Record/aggregate types: Use greatest member alignment of any member. */
for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
if (DECL_ALIGN (field) > PARM_BOUNDARY)
- return true;
+ {
+ if (TREE_CODE (field) == FIELD_DECL)
+ return 1;
+ else
+ /* B
[Ada] for CodePeer, omit Finalize_Address routines
Calls to Finalize_Address routines were already being omitted for CodePeer. If we are never going to call them, then we also shouldn't generate them. This change has no user-visible effect except when Gnat2scil is running. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Steve Baird * exp_ch7.adb (Build_Array_Deep_Procs, Build_Record_Deep_Procs, Make_Finalize_Address_Body): Don't generate Finalize_Address routines for CodePeer. Index: exp_ch7.adb === --- exp_ch7.adb (revision 247157) +++ exp_ch7.adb (working copy) @@ -787,13 +787,15 @@ Typ => Typ, Stmts => Make_Deep_Array_Body (Finalize_Case, Typ))); - -- Create TSS primitive Finalize_Address. + -- Create TSS primitive Finalize_Address (unless CodePeer_Mode). - Set_TSS (Typ, - Make_Deep_Proc - (Prim => Address_Case, - Typ => Typ, - Stmts => Make_Deep_Array_Body (Address_Case, Typ))); + if not CodePeer_Mode then +Set_TSS (Typ, + Make_Deep_Proc +(Prim => Address_Case, + Typ => Typ, + Stmts => Make_Deep_Array_Body (Address_Case, Typ))); + end if; end if; end Build_Array_Deep_Procs; @@ -3669,13 +3671,15 @@ Typ => Typ, Stmts => Make_Deep_Record_Body (Finalize_Case, Typ))); - -- Create TSS primitive Finalize_Address + -- Create TSS primitive Finalize_Address (unless CodePeer_Mode). - Set_TSS (Typ, - Make_Deep_Proc - (Prim => Address_Case, - Typ => Typ, - Stmts => Make_Deep_Record_Body (Address_Case, Typ))); + if not CodePeer_Mode then +Set_TSS (Typ, + Make_Deep_Proc +(Prim => Address_Case, + Typ => Typ, + Stmts => Make_Deep_Record_Body (Address_Case, Typ))); + end if; end if; end Build_Record_Deep_Procs; @@ -7797,6 +7801,11 @@ return; end if; + -- Don't generate Finalize_Address routine for CodePeer + if CodePeer_Mode then + return; + end if; + Proc_Id := Make_Defining_Identifier (Loc, Make_TSS_Name (Typ, TSS_Finalize_Address));
[Ada] Legality rules on class-wide preconditions of overriding operations.
AI12-0131, part of the Ada2012 Corrigendum, places restrictions on class-wide
preconditions of overriding operations, to prevent anomalies that would violate
LSP if an overriding operation could declare such a precondition without an
acestor of the operation having such a precondition to override.
Tested in ACATS 4.1B test B611017.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_prag.adb (Inherits_Class_Wide_Pre): subsidiary of
Analyze_Pre_Post_Condition, to implement the legality checks
mandated by AI12-0131: Pre'Class shall not be specified for an
overriding primitive subprogram of a tagged type T unless the
Pre'Class aspect is specified for the corresponding primitive
subprogram of some ancestor of T.
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247168)
+++ sem_prag.adb(working copy)
@@ -4208,6 +4208,85 @@
-- Flag set when the pragma is one of Pre, Pre_Class, Post or
-- Post_Class.
+ function Inherits_Class_Wide_Pre (E : Entity_Id) return Boolean;
+ -- Implement rules in AI12-0131: an overriding operation can have
+ -- a class-wide precondition only if one of its ancestors has an
+ -- explicit class-wide precondition.
+
+ -
+ -- Inherits_Class_Wide_Pre --
+ -
+
+ function Inherits_Class_Wide_Pre (E : Entity_Id) return Boolean is
+Prev : Entity_Id := Overridden_Operation (E);
+Cont : Node_Id;
+Prag : Node_Id;
+Typ : Entity_Id;
+
+ begin
+-- Check ancestors on the overriding operation to examine the
+-- preconditions that may apply to them.
+
+while Present (Prev) loop
+ Cont := Contract (Prev);
+ if Present (Cont) then
+ Prag := Pre_Post_Conditions (Cont);
+ while Present (Prag) loop
+ if Class_Present (Prag) then
+return True;
+ end if;
+
+ Prag := Next_Pragma (Prag);
+ end loop;
+ end if;
+
+ Prev := Overridden_Operation (Prev);
+end loop;
+
+-- If the controlling type of the subprogram has progenitors,
+-- an interface operation implemented by the current operation
+-- may have a class-wide precondition.
+
+Typ := Find_Dispatching_Type (E);
+if Has_Interfaces (Typ) then
+ declare
+ Ints : Elist_Id;
+ Elmt : Elmt_Id;
+ Prim_List : Elist_Id;
+ Prim_Elmt : Elmt_Id;
+ Prim : Entity_Id;
+ begin
+ Collect_Interfaces (Typ, Ints);
+ Elmt := First_Elmt (Ints);
+
+ -- Iterate over the primitive operations of each
+ -- interface.
+
+ while Present (Elmt) loop
+ Prim_List :=
+ (Direct_Primitive_Operations (Node (Elmt)));
+ Prim_Elmt := First_Elmt (Prim_List);
+ while Present (Prim_Elmt) loop
+Prim := Node (Prim_Elmt);
+if Chars (Prim) = Chars (E)
+ and then Present (Contract (Prim))
+ and then Class_Present
+(Pre_Post_Conditions (Contract (Prim)))
+then
+ return True;
+end if;
+
+Next_Elmt (Prim_Elmt);
+ end loop;
+
+ Next_Elmt (Elmt);
+ end loop;
+ end;
+end if;
+
+return False;
+ end Inherits_Class_Wide_Pre;
+
begin
-- Change the name of pragmas Pre, Pre_Class, Post and Post_Class to
-- offer uniformity among the various kinds of pre/postconditions by
@@ -4326,6 +4405,43 @@
Error_Pragma ("aspect % requires ''Class for null procedure");
end if;
+-- Implement the legality checks mandated by AI12-0131:
+--Pre'Class shall not be specified for an overriding primitive
+--subprogram of a tagged type T unless the Pre'Class aspect is
+--specified for the corresponding primitive subprogram of some
+--ancestor of T.
+
+declare
+ E : constant Entity_Id := Defining_Entity (Subp_Decl);
+ H : constant Entity_Id := Homonym (E);
+
+begin
+ if Class_Present (N)
+ and then Present (Overridden_Operation (E))
+ and then no
[Ada] Validity checks and volatility
This patch partially reimplements validity checks to prevent multiple reads or
copies of volatile expressions. This is achieved by first capturing the value
of a volatile object into a variable (rather than a constant). The variable is
then tested for validity (rather than the object again) and used in place of
the original object reference (rather than the object again). In addition, if
the object reference is utilized as an actual in a call where the corresponding
formal is of mode IN OUT or OUT, any changes to the value upon return from the
call are now properly reflected back into the object.
-- Source --
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
type Small_Int is new Integer range 1 .. 31;
pragma Volatile (Small_Int);
procedure Double_Swap (A : in out Small_Int; B : in out Small_Int);
procedure Read (A : Small_Int; B : Small_Int);
function Self (A : Small_Int) return Small_Int;
procedure Swap (A : in out Small_Int; B : in out Small_Int);
procedure Tripple_Swap (A : in out Small_Int; B : in out Small_Int);
procedure Write (A : out Small_Int; B : out Small_Int);
procedure Double_Swap (A : in out Small_Int; B : in out Small_Int) is
begin
Swap (A, B);
Swap (B, A);
end Double_Swap;
procedure Read (A : Small_Int; B : Small_Int) is
begin
Put_Line ("A:" & A'Img);
Put_Line ("B:" & B'Img);
end Read;
function Self (A : Small_Int) return Small_Int is
begin
return A;
end Self;
procedure Swap (A : in out Small_Int; B : in out Small_Int) is
T : Small_Int;
begin
T := A;
A := B;
B := T;
end Swap;
procedure Tripple_Swap (A : in out Small_Int; B : in out Small_Int) is
begin
Swap (A, B);
Swap (B, A);
Swap (A, B);
end Tripple_Swap;
procedure Write (A : out Small_Int; B : out Small_Int) is
begin
A := 3;
B := 4;
end Write;
X : Small_Int := 1;
Y : Small_Int := 2;
begin
Double_Swap (X, Y);
if X /= 1 or else Y /= 2 then
Put_Line ("ERROR: Double_Swap failed");
end if;
Read (X, Y);
Read (Self (X), Self (Y));
Swap (X, Y);
if X /= 2 or else Y /= 1 then
Put_Line ("ERROR: Swap failed");
end if;
Tripple_Swap (X, Y);
if X /= 1 or else Y /= 2 then
Put_Line ("ERROR: Tripple_Swap failed");
end if;
Write (X, Y);
if X /= 3 or else Y /= 4 then
Put_Line ("ERROR: Write failed");
end if;
end Main;
-- Compilation and output --
$ gnatmake -q -gnatVa main.adb
$ ./main
A: 1
B: 2
A: 1
B: 2
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Steve Baird
* exp_ch7.adb (Build_Array_Deep_Procs,
Build_Record_Deep_Procs, Make_Finalize_Address_Body): Don't
generate Finalize_Address routines for CodePeer.
Index: exp_attr.adb
===
--- exp_attr.adb(revision 247141)
+++ exp_attr.adb(working copy)
@@ -6488,32 +6488,48 @@
-
function Make_Range_Test return Node_Id is
-Temp : constant Node_Id := Duplicate_Subexpr (Pref);
+Temp : Node_Id;
begin
--- The value whose validity is being checked has been captured in
--- an object declaration. We certainly don't want this object to
--- appear valid because the declaration initializes it.
+-- The prefix of attribute 'Valid should always denote an object
+-- reference. The reference is either coming directly from source
+-- or is produced by validity check expansion.
-if Is_Entity_Name (Temp) then
- Set_Is_Known_Valid (Entity (Temp), False);
+-- If the prefix denotes a variable which captures the value of
+-- an object for validation purposes, use the variable in the
+-- range test. This ensures that no extra copies or extra reads
+-- are produced as part of the test. Generate:
+
+--Temp : ... := Object;
+--if not Temp in ... then
+
+if Is_Validation_Variable_Reference (Pref) then
+ Temp := New_Occurrence_Of (Entity (Pref), Loc);
+
+-- Otherwise the prefix is either a source object or a constant
+-- produced by validity check expansion. Generate:
+
+--Temp : constant ... := Pref;
+--if not Temp in ... then
+
+else
+ Temp := Duplicate_Subexpr (Pref);
end if;
return
Make_In (Loc,
-Left_Opnd =>
- Unchecked_Convert_To (Btyp, Temp),
+Left_Opnd => Unchecked_Convert_To (Btyp, Temp),
Right_Opnd =>
Make_Range (Loc,
-Low_Bound =>
+
[Ada] Improve computation of real bounds of type conversion expressions
Function Determine_Range_R is used in GNATprove to compute the maximal
bounds of floating-point expressions. This computation now also deals
with type conversion expressions, for conversions from integer to float.
This allows to prove more checks (range and overflow) in GNATprove with
a simple interval analysis rather than with calling provers.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Yannick Moy
* checks.adb (Determine_Range_R): Special case type conversions
from integer to float in order to get bounds in that case too.
* eval_fat.adb (Machine): Avoid issuing warnings in GNATprove
mode, for computations involved in interval checking.
Index: checks.adb
===
--- checks.adb (revision 247170)
+++ checks.adb (working copy)
@@ -5119,12 +5119,34 @@
end if;
end if;
- -- For type conversion from one floating-point type to another, we
- -- can refine the range using the converted value.
-
when N_Type_Conversion =>
-Determine_Range_R (Expression (N), OK1, Lor, Hir, Assume_Valid);
+-- For type conversion from one floating-point type to another, we
+-- can refine the range using the converted value.
+
+if Is_Floating_Point_Type (Etype (Expression (N))) then
+ Determine_Range_R (Expression (N), OK1, Lor, Hir, Assume_Valid);
+
+-- When converting an integer to a floating-point type, determine
+-- the range in integer first, and then convert the bounds.
+
+elsif Is_Discrete_Type (Etype (Expression (N))) then
+ declare
+ Lor_Int, Hir_Int : Uint;
+ begin
+ Determine_Range (Expression (N), OK1, Lor_Int, Hir_Int,
+ Assume_Valid);
+
+ if OK1 then
+ Lor := Round_Machine (UR_From_Uint (Lor_Int));
+ Hir := Round_Machine (UR_From_Uint (Hir_Int));
+ end if;
+ end;
+
+else
+ OK1 := False;
+end if;
+
-- Nothing special to do for all other expression kinds
when others =>
Index: eval_fat.adb
===
--- eval_fat.adb(revision 247135)
+++ eval_fat.adb(working copy)
@@ -25,6 +25,7 @@
with Einfo;use Einfo;
with Errout; use Errout;
+with Opt; use Opt;
with Sem_Util; use Sem_Util;
package body Eval_Fat is
@@ -505,15 +506,23 @@
Emin_Den : constant UI := Machine_Emin_Value (RT)
- Machine_Mantissa_Value (RT) + Uint_1;
begin
+-- Do not issue warnings about underflows in GNATprove mode,
+-- as calling Machine as part of interval checking may lead
+-- to spurious warnings.
+
if X_Exp < Emin_Den or not Has_Denormals (RT) then
if Has_Signed_Zeros (RT) and then UR_Is_Negative (X) then
- Error_Msg_N
-("floating-point value underflows to -0.0??", Enode);
+ if not GNATprove_Mode then
+ Error_Msg_N
+ ("floating-point value underflows to -0.0??", Enode);
+ end if;
return Ureal_M_0;
else
- Error_Msg_N
-("floating-point value underflows to 0.0??", Enode);
+ if not GNATprove_Mode then
+ Error_Msg_N
+ ("floating-point value underflows to 0.0??", Enode);
+ end if;
return Ureal_0;
end if;
@@ -543,10 +552,16 @@
UR_Is_Negative (X));
begin
+ -- Do not issue warnings about loss of precision in
+ -- GNATprove mode, as calling Machine as part of
+ -- interval checking may lead to spurious warnings.
+
if X_Frac_Denorm /= X_Frac then
- Error_Msg_N
- ("gradual underflow causes loss of precision??",
-Enode);
+ if not GNATprove_Mode then
+Error_Msg_N
+ ("gradual underflow causes loss of precision??",
+ Enode);
+ end if;
X_Frac := X_Frac_Denorm;
end if;
end;
[Ada] Better range checking in GNATprove mode for float-to-int conversions
Range checks are now optimized away on float-to-int conversions when bound analysis can determine that the value is always in range. This is only possible in GNATprove mode, where NaN and infinite values are ruled out by the analysis. Also improve the computation of bounds for expressions that involve conversions from float to int, also only in GNATprove mode. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Yannick Moy * checks.adb (Apply_Scalar_Range_Check): Analyze precisely conversions from float to integer in GNATprove mode. (Apply_Type_Conversion_Checks): Make sure in GNATprove mode to call Apply_Type_Conversion_Checks, so that range checks are properly positioned when needed on conversions, including when converting from float to integer. (Determine_Range): In GNATprove mode, take into account the possibility of conversion from float to integer. * sem_res.adb (Resolve_Type_Conversion): Only enforce range check on conversions from fixed-point to integer, not anymore on conversions from floating-point to integer, when in GNATprove mode. Index: checks.adb === --- checks.adb (revision 247172) +++ checks.adb (working copy) @@ -2943,20 +2943,24 @@ -- The additional less-precise tests below catch these cases + -- In GNATprove_Mode, also deal with the case of a conversion from + -- floating-point to integer. It is only possible because analysis + -- in GNATprove rules out the possibility of a NaN or infinite value. + -- Note: skip this if we are given a source_typ, since the point of -- supplying a Source_Typ is to stop us looking at the expression. -- We could sharpen this test to be out parameters only ??? if Is_Discrete_Type (Target_Typ) -and then Is_Discrete_Type (Etype (Expr)) +and then (Is_Discrete_Type (Etype (Expr)) + or else (GNATprove_Mode + and then Is_Floating_Point_Type (Etype (Expr and then not Is_Unconstrained_Subscr_Ref and then No (Source_Typ) then declare Tlo : constant Node_Id := Type_Low_Bound (Target_Typ); Thi : constant Node_Id := Type_High_Bound (Target_Typ); -Lo : Uint; -Hi : Uint; begin if Compile_Time_Known_Value (Tlo) @@ -2965,6 +2969,8 @@ declare Lov : constant Uint := Expr_Value (Tlo); Hiv : constant Uint := Expr_Value (Thi); + Lo : Uint; + Hi : Uint; begin -- If range is null, we for sure have a constraint error @@ -2991,8 +2997,35 @@ -- Otherwise determine range of value - Determine_Range (Expr, OK, Lo, Hi, Assume_Valid => True); + if Is_Discrete_Type (Etype (Expr)) then + Determine_Range (Expr, OK, Lo, Hi, + Assume_Valid => True); + -- When converting a float to an integer type, determine the + -- range in real first, and then convert the bounds using + -- UR_To_Uint which correctly rounds away from zero when + -- half way between two integers, as required by normal + -- Ada 95 rounding semantics. It is only possible because + -- analysis in GNATprove rules out the possibility of a NaN + -- or infinite value. + + elsif GNATprove_Mode +and then Is_Floating_Point_Type (Etype (Expr)) + then + declare +Lor : Ureal; +Hir : Ureal; + begin +Determine_Range_R (Expr, OK, Lor, Hir, + Assume_Valid => True); + +if OK then + Lo := UR_To_Uint (Lor); + Hi := UR_To_Uint (Hir); +end if; + end; + end if; + if OK then -- If definitely in range, all OK @@ -3449,7 +3482,9 @@ if not Range_Checks_Suppressed (Target_Type) and then not Range_Checks_Suppressed (Expr_Type) then - if Float_To_Int then + if Float_To_Int + and then not GNATprove_Mode + then Apply_Float_Conversion_Check (Expr, Target_Type); else Apply_Scalar_Range_Check @@ -4688,12 +4723,40 @@ end case; - -- For type conversion from one discrete type to another, we can - -- refine the range usi
Re: [ARM ABI PATCH] Change ARM ABI to match AAPCS, provide -Wpsabi notes (PR target/77728)
On 25/04/17 11:00, Jakub Jelinek wrote:
> Hi!
>
> As mentioned in the PR, r225465 aka PR65956 changed the ABI
> on ARM to match updated AAPCS, but the change had a bug - for structures
> it considered DECL_ALIGN of any TYPE_FIELDS, rather than just
> actual data components (AAPCS says members, for C++ and Itanium C++ ABI
> that is likely direct non-static data members and non-virtual base classes;
> that means it also considered alignment of static data members (at least
> this was consistent ABI difference), or DECL_ALIGN of TYPE_DECLs (which is
> bigger problem, because that alignment is pretty randomish, it has different
> value in types in templates depending on whether they have been instantiated
> earlier or not)).
>
> The following patch fixes the ABI bug and adds -Wpsabi diagnostics (inform
> rather than warning, so it doesn't break with -Werror and matches i386.c
> -Wpsabi notes where there is no bug on the compiled code side).
>
> Earlier version of the patch has been bootstrapped/regtested on
> armv7hl-linux-gnueabi, but there have been various changes since then.
> Ok for trunk/7.1 if it passes testing?
>
> 2017-04-25 Ramana Radhakrishnan
> Jakub Jelinek
>
> PR target/77728
> * config/arm/arm.c: Include gimple.h.
> (aapcs_layout_arg): Emit -Wpsabi note if arm_needs_doubleword_align
> returns negative, increment ncrn only if it returned positive.
> (arm_needs_doubleword_align): Return int instead of bool,
> ignore DECL_ALIGN of non-FIELD_DECL TYPE_FIELDS chain
> members, but if there is any such non-FIELD_DECL
> > PARM_BOUNDARY aligned decl, return -1 instead of false.
> (arm_function_arg): Emit -Wpsabi note if arm_needs_doubleword_align
> returns negative, increment nregs only if it returned positive.
> (arm_setup_incoming_varargs): Likewise.
> (arm_function_arg_boundary): Emit -Wpsabi note if
> arm_needs_doubleword_align returns negative, return
> DOUBLEWORD_ALIGNMENT only if it returned positive.
> testsuite/
> * g++.dg/abi/pr77728-1.C: New test.
This is ok if it passes testing.
R.
>
> --- gcc/config/arm/arm.c.jj 2017-04-25 09:20:49.740670794 +0200
> +++ gcc/config/arm/arm.c 2017-04-25 11:07:11.003121070 +0200
> @@ -64,6 +64,7 @@
> #include "rtl-iter.h"
> #include "optabs-libfuncs.h"
> #include "gimplify.h"
> +#include "gimple.h"
>
> /* This file should be included last. */
> #include "target-def.h"
> @@ -81,7 +82,7 @@ struct four_ints
>
> /* Forward function declarations. */
> static bool arm_const_not_ok_for_debug_p (rtx);
> -static bool arm_needs_doubleword_align (machine_mode, const_tree);
> +static int arm_needs_doubleword_align (machine_mode, const_tree);
> static int arm_compute_static_chain_stack_bytes (void);
> static arm_stack_offsets *arm_get_frame_offsets (void);
> static void arm_add_gc_roots (void);
> @@ -6349,8 +6350,20 @@ aapcs_layout_arg (CUMULATIVE_ARGS *pcum,
>/* C3 - For double-word aligned arguments, round the NCRN up to the
> next even number. */
>ncrn = pcum->aapcs_ncrn;
> - if ((ncrn & 1) && arm_needs_doubleword_align (mode, type))
> -ncrn++;
> + if (ncrn & 1)
> +{
> + int res = arm_needs_doubleword_align (mode, type);
> + /* Only warn during RTL expansion of call stmts, otherwise we would
> + warn e.g. during gimplification even on functions that will be
> + always inlined, and we'd warn multiple times. Don't warn when
> + called in expand_function_start either, as we warn instead in
> + arm_function_arg_boundary in that case. */
> + if (res < 0 && warn_psabi && currently_expanding_gimple_stmt)
> + inform (input_location, "parameter passing for argument of type "
> + "%qT changed in GCC 7.1", type);
> + else if (res > 0)
> + ncrn++;
> +}
>
>nregs = ARM_NUM_REGS2(mode, type);
>
> @@ -6455,12 +6468,16 @@ arm_init_cumulative_args (CUMULATIVE_ARG
> }
> }
>
> -/* Return true if mode/type need doubleword alignment. */
> -static bool
> +/* Return 1 if double word alignment is required for argument passing.
> + Return -1 if double word alignment used to be required for argument
> + passing before PR77728 ABI fix, but is not required anymore.
> + Return 0 if double word alignment is not required and wasn't requried
> + before either. */
> +static int
> arm_needs_doubleword_align (machine_mode mode, const_tree type)
> {
>if (!type)
> -return PARM_BOUNDARY < GET_MODE_ALIGNMENT (mode);
> +return GET_MODE_ALIGNMENT (mode) > PARM_BOUNDARY;
>
>/* Scalar and vector types: Use natural alignment, i.e. of base type. */
>if (!AGGREGATE_TYPE_P (type))
> @@ -6470,12 +6487,21 @@ arm_needs_doubleword_align (machine_mode
>if (TREE_CODE (type) == ARRAY_TYPE)
> return TYPE_ALIGN (TREE_TYPE (type)) > PARM_BOUNDARY;
>
> + int ret = 0;
>/* Record/aggregate types: Use greatest member alignment of any member.
[Ada] Use of convention aspect Stdcall on a record component.
This patch fixes a spurious error on a record component whose type is an
anonymous access to subprogram, when the component carries the Windows
convention Stdcall.
The following must compile quietly:
---
package P is
type T is record
AF : access function (i:Integer) return integer with
convention => stdcall;
end record;
-- the convention stdcall,dll,win32 are not supported,while
-- C,CPP,FORTRAN etc. are supported.
-- Of course,we can write as below,but one line more.
type AF_Type is access function (i:Integer) return integer with
convention => stdcall;
type TOK is record
AF : AF_Type;
end record;
end p;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_prag.adb (Set_Convention_From_Pragma): Cleanup code for
convention Stdcall, which has a number of exceptions. Convention
is legal on a component declaration whose type is an anonymous
access to subprogram.
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247175)
+++ sem_prag.adb(working copy)
@@ -7401,24 +7401,32 @@
("dispatching subprogram# cannot use Stdcall convention!",
Arg1);
- -- Subprograms are not allowed
+ -- Several allowed cases
- elsif not Is_Subprogram_Or_Generic_Subprogram (E)
+ elsif Is_Subprogram_Or_Generic_Subprogram (E)
-- A variable is OK
- and then Ekind (E) /= E_Variable
+ or else Ekind (E) = E_Variable
+ -- A component as well. The entity does not have its
+ -- Ekind set until the enclosing record declaration is
+ -- fully analyzed.
+
+ or else Nkind (Parent (E)) = N_Component_Declaration
+
-- An access to subprogram is also allowed
- and then not
- (Is_Access_Type (E)
- and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
+ or else (Is_Access_Type (E)
+ and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
-- Allow internal call to set convention of subprogram type
- and then not (Ekind (E) = E_Subprogram_Type)
+ or else (Ekind (E) = E_Subprogram_Type)
then
+ null;
+
+ else
Error_Pragma_Arg
("second argument of pragma% must be subprogram (type)",
Arg2);
[Ada] Missing error on illegal object.operation call
This patch modifies the mechanism which determines whether A.B denotes an object.operation call to work with the base type when the candidate type is a private extension. -- Source -- -- base.ads package Base is type A is tagged private; private type A is tagged null record; procedure Foo (Self : A) is null; end Base; -- base-der.ads package Base.Der is type B (A : Integer) is new A with private; private type B (A : Integer) is new A with null record; overriding procedure Foo (Self : B) is null; end Base.Der; -- main.adb with Base.Der; use Base.Der; procedure Main is Bz : B (12); begin Bz.Foo; end Main; -- Compilation and output -- $ gcc -c main.adb main.adb:6:06: no selector "Foo" for private type "B" defined at base-der.ads:2 Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Hristian Kirtchev * sem_ch4.adb: sem_ch4.adb Various reformattings. (Try_One_Prefix_Interpretation): Use the base type when dealing with a subtype created for purposes of constraining a private type with discriminants. Index: sem_ch4.adb === --- sem_ch4.adb (revision 247162) +++ sem_ch4.adb (working copy) @@ -8297,7 +8297,7 @@ Loc: constant Source_Ptr := Sloc (N); Obj: constant Node_Id:= Prefix (N); - Subprog : constant Node_Id:= + Subprog : constant Node_Id := Make_Identifier (Sloc (Selector_Name (N)), Chars => Chars (Selector_Name (N))); -- Identifier on which possible interpretations will be collected @@ -8308,18 +8308,11 @@ Actual : Node_Id; Candidate : Entity_Id := Empty; - New_Call_Node : Node_Id := Empty; + New_Call_Node : Node_Id := Empty; Node_To_Replace : Node_Id; Obj_Type: Entity_Id := Etype (Obj); - Success : Boolean := False; + Success : Boolean := False; - function Valid_Candidate -(Success : Boolean; - Call: Node_Id; - Subp: Entity_Id) return Entity_Id; - -- If the subprogram is a valid interpretation, record it, and add - -- to the list of interpretations of Subprog. Otherwise return Empty. - procedure Complete_Object_Operation (Call_Node : Node_Id; Node_To_Replace : Node_Id); @@ -8328,8 +8321,8 @@ -- in the call, and complete the analysis of the call. procedure Report_Ambiguity (Op : Entity_Id); - -- If a prefixed procedure call is ambiguous, indicate whether the - -- call includes an implicit dereference or an implicit 'Access. + -- If a prefixed procedure call is ambiguous, indicate whether the call + -- includes an implicit dereference or an implicit 'Access. procedure Transform_Object_Operation (Call_Node : out Node_Id; @@ -8342,107 +8335,28 @@ function Try_Class_Wide_Operation (Call_Node : Node_Id; Node_To_Replace : Node_Id) return Boolean; - -- Traverse all ancestor types looking for a class-wide subprogram - -- for which the current operation is a valid non-dispatching call. + -- Traverse all ancestor types looking for a class-wide subprogram for + -- which the current operation is a valid non-dispatching call. procedure Try_One_Prefix_Interpretation (T : Entity_Id); -- If prefix is overloaded, its interpretation may include different - -- tagged types, and we must examine the primitive operations and - -- the class-wide operations of each in order to find candidate + -- tagged types, and we must examine the primitive operations and the + -- class-wide operations of each in order to find candidate -- interpretations for the call as a whole. function Try_Primitive_Operation (Call_Node : Node_Id; Node_To_Replace : Node_Id) return Boolean; -- Traverse the list of primitive subprograms looking for a dispatching - -- operation for which the current node is a valid call . + -- operation for which the current node is a valid call. - - - -- Valid_Candidate -- - - - function Valid_Candidate (Success : Boolean; Call: Node_Id; - Subp: Entity_Id) return Entity_Id - is - Arr_Type : Entity_Id; - Comp_Type : Entity_Id; + Subp: Entity_Id) return Entity_Id; + -- If the subprogram is a valid interpretation, record it, and add to + -- the list of interpretations of Subprog. Otherwise return Empty. - begin - -- If the subprogram is a valid interpretation, record it in global - -- variable Subprog, to collect all possible overloading
[Ada] New warning on late dispatching primitives
Ada allows adding visible operations to a tagged type after deriving a
private extension from it, which leads to confusing specifications on
which declarations of public primitives of different types are mixed.
This patch adds a new warning (enabled by means of -gnatw.j or -gnatwa)
that warns on public primitives of a tagged type defined after some
private extension of it.
For example:
$ gcc -c -gnatwa pkg.ads -gnatl
Compiling: pkg.ads
Source file time stamp: 2016-11-25 12:11:17
Compiled at: 2016-11-25 07:12:20
1. package Pkg is
2.type T1 is tagged private;
3.type T2 is new T1 with private;
4.
5.function F (T : access T1) return Integer;
|
>>> warning: primitive of type "T1" defined after private extension
"T2" at line 3
>>> warning: spec of "F" should appear before declaration of type "T2"
6.function G (T : access T2) return Integer;
7.
8. private
9.type T1 is tagged null record;
10.type T2 is new T1 with null record;
11. end Pkg;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Javier Miranda
* einfo.ads, einfo.adb (Has_Private_Extension): new attribute.
* warnsw.ads, warnsw.adb (All_Warnings): Set warning on late
dispatching primitives (Restore_Warnings): Restore warning on
late dispatching primitives (Save_Warnings): Save warning on late
dispatching primitives (Do_Warning_Switch): Use -gnatw.j/-gnatw.J
to enable/disable this warning.
(WA_Warnings): Set warning on late dispatching primitives.
* sem_ch3.adb (Analyze_Private_Extension_Declaration): Remember
that its parent type has a private extension.
* sem_disp.adb (Warn_On_Late_Primitive_After_Private_Extension):
New subprogram.
* usage.adb: Document -gnatw.j and -gnatw.J.
Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 247163)
+++ sem_ch3.adb (working copy)
@@ -4897,6 +4897,12 @@
end if;
end if;
+ -- Remember that its parent type has a private extension. Used to warn
+ -- on public primitives of the parent type defined after its private
+ -- extensions (see Check_Dispatching_Operation).
+
+ Set_Has_Private_Extension (Parent_Type);
+
<>
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, T);
Index: usage.adb
===
--- usage.adb (revision 247135)
+++ usage.adb (working copy)
@@ -507,6 +507,10 @@
"(annex J) feature");
Write_Line ("J* turn off warnings for obsolescent " &
"(annex J) feature");
+ Write_Line (".j+ turn on warnings for late dispatching " &
+ "primitives");
+ Write_Line (".J* turn off warnings for late dispatching " &
+ "primitives");
Write_Line ("k+ turn on warnings on constant variable");
Write_Line ("K* turn off warnings on constant variable");
Write_Line (".k turn on warnings for standard redefinition");
Index: einfo.adb
===
--- einfo.adb (revision 247170)
+++ einfo.adb (working copy)
@@ -619,7 +619,7 @@
--Is_Underlying_Full_View Flag298
--Body_Needed_For_InliningFlag299
- --(unused)Flag300
+ --Has_Private_Extension Flag300
--(unused)Flag301
--(unused)Flag302
--(unused)Flag303
@@ -1818,6 +1818,12 @@
return Flag155 (Id);
end Has_Private_Declaration;
+ function Has_Private_Extension (Id : E) return B is
+ begin
+ pragma Assert (Is_Tagged_Type (Id));
+ return Flag300 (Id);
+ end Has_Private_Extension;
+
function Has_Protected (Id : E) return B is
begin
return Flag271 (Base_Type (Id));
@@ -4891,6 +4897,12 @@
Set_Flag155 (Id, V);
end Set_Has_Private_Declaration;
+ procedure Set_Has_Private_Extension (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Tagged_Type (Id));
+ Set_Flag300 (Id, V);
+ end Set_Has_Private_Extension;
+
procedure Set_Has_Protected (Id : E; V : B := True) is
begin
Set_Flag271 (Id, V);
@@ -9363,6 +9375,7 @@
W ("Has_Primitive_Operations",Flag120 (Id));
W ("Has_Private_Ancestor",Flag151 (Id));
W ("Has_Private_Declaration", Flag155 (Id));
+ W ("Has_Private_Extension", Flag300 (Id));
W ("Has_Protected", Flag271 (Id));
W ("Has_Qualified_Name", Flag161 (Id));
W ("Has_
[Ada] Failure to detect illegal pragma No_Return
A pragma No_Return that applies to a procedure body is illegal. This
patch fixes a bug that caused the compiler to fail to give an error.
The following test should get an error:
no_return.adb:6:04: representation item appears too late
package No_Return is
procedure P;
end No_Return;
package body No_Return is
procedure P is
begin
null;
end P;
pragma No_Return(P);
end No_Return;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* sem_prag.adb (No_Return): Give an error if the pragma applies
to a body. Specialize the error for the specless body case,
as is done for (e.g.) pragma Convention.
* debug.adb: Add switch -gnatd.J to disable the above legality
checks. This is mainly for use in our test suite, to avoid
rewriting a lot of illegal (but working) code. It might also
be useful to customers. Under this switch, if a pragma No_Return
applies to a body, and the procedure raises an exception (as it
should), the pragma has no effect. If the procedure does return,
execution is erroneous.
Index: debug.adb
===
--- debug.adb (revision 247177)
+++ debug.adb (working copy)
@@ -127,7 +127,7 @@
-- d.G Ignore calls through generic formal parameters for elaboration
-- d.H GNSA mode for ASIS
-- d.I Do not ignore enum representation clauses in CodePeer mode
- -- d.J
+ -- d.J Relaxed rules for pragma No_Return
-- d.K Enable generation of contract-only procedures in CodePeer mode
-- d.L Depend on back end for limited types in if and case expressions
-- d.M Relaxed RM semantics
@@ -645,6 +645,11 @@
-- cases being able to change this default might be useful to remove
-- some false positives.
+ -- d.J Relaxed rules for pragma No_Return. A pragma No_Return is illegal
+ -- if it applies to a body. This switch disables the legality check
+ -- for that. If the procedure does in fact return normally, execution
+ -- is erroneous, and therefore unpredictable.
+
-- d.K Enable generation of contract-only procedures in CodePeer mode and
-- report a warning on subprograms for which the contract-only body
-- cannot be built. Currently reported on subprograms defined in
Index: sem_prag.adb
===
--- sem_prag.adb(revision 247177)
+++ sem_prag.adb(working copy)
@@ -7621,7 +7621,7 @@
end if;
-- Check that we are not applying this to a specless body. Relax this
- -- check if Relaxed_RM_Semantics to accomodate other Ada compilers.
+ -- check if Relaxed_RM_Semantics to accommodate other Ada compilers.
if Is_Subprogram (E)
and then Nkind (Parent (Declaration_Node (E))) = N_Subprogram_Body
@@ -8084,8 +8084,8 @@
N_Subprogram_Body
then
Error_Pragma
-("pragma% requires separate spec"
- & " and must come before body");
+("pragma% requires separate spec" &
+ " and must come before body");
end if;
-- Test result type if given, note that the result type
@@ -18177,6 +18177,29 @@
and then Scope (E) = Current_Scope
loop
if Ekind_In (E, E_Procedure, E_Generic_Procedure) then
+ -- Check that the pragma is not applied to a body.
+ -- First check the specless body case, to give a
+ -- different error message. These checks do not apply
+ -- if Relaxed_RM_Semantics, to accommodate other Ada
+ -- compilers. Disable these checks under -gnatd.J.
+
+ if not Debug_Flag_Dot_JJ then
+if Nkind (Parent (Declaration_Node (E))) =
+N_Subprogram_Body
+ and then not Relaxed_RM_Semantics
+then
+ Error_Pragma
+ ("pragma% requires separate spec" &
+" and must come before body");
+end if;
+
+-- Now the "specful" body case
+
+if Rep_Item_Too_Late (E, N) then
+ raise Pragma_Exit;
+end if;
+ end if;
+
Set_No_Return (E);
-- A pragma that applies to a Ghost entity becomes Ghost
@@ -26125,7 +26148,7 @@
raise Program_Error;
end if;
- -- To accomodate partial decoration of disabled SPARK features, this
+ -- To accommodate partial decor
[Ada] Compiler crash on function with 'in out' parameter
This patch fixes the following bug: If a function returns an
unconstrained array whose component type is nonlimited controlled, and
the function has an 'out' or 'in out' parameter, calls to that function
can cause the compiler to crash.
The following test must compile quietly.
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package In_Out_Func is
type Unbounded_String_Array is
array (Positive range <>) of Unbounded_String;
function F
(Xpath : String; Num_Values : in out Integer)
return Unbounded_String_Array;
procedure Main;
end In_Out_Func;
package body In_Out_Func is
procedure Main is
Num_Values : Natural := 0;
Arglist : constant Unbounded_String_Array := F ("", Num_Values);
begin
null;
end Main;
function F
(Xpath : String; Num_Values : in out Integer)
return Unbounded_String_Array
is
X : Unbounded_String_Array (1 .. 0);
begin
return X;
end F;
end In_Out_Func;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff
* exp_ch6.adb (Expand_Actuals): This is the
root of the problem. It took N as an 'in out' parameter, and in
some cases, rewrote N, but then set N to Original_Node(N). So
the node returned in N had no Parent. The caller continued
processing of this orphaned node. In some cases that caused a
crash (e.g. Remove_Side_Effects climbs up Parents in a loop,
and trips over the Empty Parent). The solution is to make N an
'in' parameter. Instead of rewriting it, return the list of
post-call actions, so the caller can do the rewriting later,
after N has been fully processed.
(Expand_Call_Helper): Move most of Expand_Call here. It has
too many premature 'return' statements, and we want to do the
rewriting on return.
(Insert_Post_Call_Actions): New procedure to insert the post-call
actions in the appropriate place. In the problematic case,
that involves rewriting N as an Expression_With_Actions.
(Expand_Call): Call the new procedures Expand_Call_Helper and
Insert_Post_Call_Actions.
Index: exp_ch6.adb
===
--- exp_ch6.adb (revision 247177)
+++ exp_ch6.adb (working copy)
@@ -158,7 +158,12 @@
-- the values are not changed for the call, we know immediately that
-- we have an infinite recursion.
- procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id);
+ procedure Expand_Actuals
+ (N : Node_Id; Subp : Entity_Id; Post_Call : out List_Id);
+ -- Return in Post_Call a list of actions to take place after the call.
+ -- The call will later be rewritten as an Expression_With_Actions,
+ -- with the Post_Call actions inserted, and the call inside.
+ --
-- For each actual of an in-out or out parameter which is a numeric
-- (view) conversion of the form T (A), where A denotes a variable,
-- we insert the declaration:
@@ -190,12 +195,15 @@
--
-- For OUT and IN OUT parameters, add predicate checks after the call
-- based on the predicates of the actual type.
- --
- -- The parameter N is IN OUT because in some cases, the expansion code
- -- rewrites the call as an expression actions with the call inside. In
- -- this case N is reset to point to the inside call so that the caller
- -- can continue processing of this call.
+ procedure Expand_Call_Helper (N : Node_Id; Post_Call : out List_Id);
+ -- Does the main work of Expand_Call. Post_Call is as for Expand_Actuals
+
+ procedure Insert_Post_Call_Actions
+ (N : Node_Id; Post_Call : List_Id);
+ -- Insert the Post_Call list (previously produced by
+ -- Expand_Actuals/Expand_Call_Helper) into the tree.
+
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- N is a function call which returns a controlled object. Transform the
-- call into a temporary which retrieves the returned object from the
@@ -1146,12 +1154,13 @@
-- Expand_Actuals --
- procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id) is
+ procedure Expand_Actuals
+ (N : Node_Id; Subp : Entity_Id; Post_Call : out List_Id)
+ is
Loc : constant Source_Ptr := Sloc (N);
Actual: Node_Id;
Formal: Entity_Id;
N_Node: Node_Id;
- Post_Call : List_Id;
E_Actual : Entity_Id;
E_Formal : Entity_Id;
@@ -2122,135 +2131,23 @@
Next_Formal (Formal);
Next_Actual (Actual);
end loop;
-
- -- Find right place to put post call stuff if it is present
-
- if not Is_Empty_List (Post_Call) then
-
- -- Cases where the call is not a member of a statement list.
- -- This includes the case where the call is an actual in another
- -- function call or indexing, i.e. an expression context as well.
-
- if not Is_List_Member (N)
-
[Ada] Duplicate copy of IN OUT parameter with -gnatVa
Thic patch modifies the expansion of actual parameters to account for a case
where a validation variable may act as the argument of a type conversion and
produce proper code to avoid a potential duplicate copy of the variable.
-- Source --
-- types.ads
package Types is
type FD_Set (Size : Natural) is abstract tagged private;
type FD_Set_Access is access all FD_Set'Class;
procedure Next (Obj : FD_Set; Index : in out Positive) is abstract;
type Set (Size : Natural) is new FD_Set with private;
overriding procedure Next (Obj : Set; Index : in out Positive);
type Socket_Set_Type is tagged private;
procedure Initialize (Obj : in out Socket_Set_Type);
type Socket_Count is new Natural;
subtype Socket_Index is Socket_Count range 1 .. Socket_Count'Last;
procedure Next (Set : Socket_Set_Type; Index : in out Socket_Index);
private
type FD_Set (Size : Natural) is abstract tagged null record;
type Set (Size : Natural) is new FD_Set (Size) with record
Comp : Integer := 1;
end record;
type Socket_Set_Type is tagged record
Poll : FD_Set_Access;
end record;
end Types;
-- types.adb
package body Types is
procedure Initialize (Obj : in out Socket_Set_Type) is
begin
Obj.Poll := new Set'(Size => 123, Comp => 456);
end Initialize;
procedure Next (Obj : Set; Index : in out Positive) is
begin
Index := Index + 1;
end Next;
procedure Next (Set : Socket_Set_Type; Index : in out Socket_Index) is
begin
Set.Poll.Next (Positive (Index));
end Next;
end Types;
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
procedure Main is
Set : Socket_Set_Type;
Val : Socket_Index;
begin
Set.Initialize;
Val := 1;
Set.Next (Val);
if Val /= 2 then
Put_Line ("ERROR");
end if;
end Main;
-
-- Compilation --
-
$ gnatmake -q -gnatVa main.adb
$ ./main
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Hristian Kirtchev
* checks.adb (Insert_Valid_Check): Code cleanup.
* exp_ch6.adb (Add_Validation_Call_By_Copy_Code): New routine.
(Expand_Actuals): Generate proper copy-back for a validation
variable when it acts as the argument of a type conversion.
* sem_util.adb (Is_Validation_Variable_Reference): Augment the
predicate to operate on type qualifications.
Index: checks.adb
===
--- checks.adb (revision 247177)
+++ checks.adb (working copy)
@@ -7286,11 +7286,12 @@
declare
DRC : constant Boolean := Do_Range_Check (Exp);
- CE : Node_Id;
- Obj : Node_Id;
- PV : Node_Id;
- Var : Entity_Id;
+ CE : Node_Id;
+ Obj: Node_Id;
+ PV : Node_Id;
+ Var_Id : Entity_Id;
+
begin
Set_Do_Range_Check (Exp, False);
@@ -7301,14 +7302,14 @@
--1) The evaluation of the object results in only one read in the
-- case where the object is atomic or volatile.
- -- Temp ... := Object; -- read
+ -- Var ... := Object; -- read
--2) The captured value is the one verified by attribute 'Valid.
-- As a result the object is not evaluated again, which would
-- result in an unwanted read in the case where the object is
-- atomic or volatile.
- -- if not Temp'Valid then-- OK, no read of Object
+ -- if not Var'Valid then -- OK, no read of Object
-- if not Object'Valid then -- Wrong, extra read of Object
@@ -7316,7 +7317,7 @@
-- As a result the object is not evaluated again, in the same
-- vein as 2).
- -- ... Temp ...-- OK, no read of Object
+ -- ... Var ... -- OK, no read of Object
-- ... Object ... -- Wrong, extra read of Object
@@ -7326,24 +7327,24 @@
-- procedure Call (Val : in out ...);
- -- Temp : ... := Object; -- read Object
- -- if not Temp'Valid then -- validity check
- -- Call (Temp);-- modify Temp
- -- Object := Temp; -- update Object
+ -- Var : ... := Object; -- read Object
+ -- if not Var'Valid then -- validity check
+ -- Call (Var);-- modify Var
+ -- Object := Var; -- update Object
if Is_Variable (Exp) then
-Obj := New_Copy_Tree (Exp);
-Var := Make_Temporary (Loc, 'T', Exp);
+Obj:= New_Copy_Tree (Exp);
+Var_Id := Make_Temporary (Loc, 'T', Exp);
Insert_Action (Exp,
Make_Object_Declaration (Loc,
-Defining_Ident
[Ada] Recover from significant slowdown in the front-end
Recent changes made to New_Copy_Tree significantly slowed down the front-end of the compiler, up to 10% of the compilation time spent in the front-end, which translated into a 5% slowdown of the entire compiler at -O0 for typical files of real codebases. The function was wasting tens of millions of cycles creating/accessing/destroying hash tables that are useless in the common case. This patch reverts the problematic changes and brings back (almost all) the original run time performance. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Eric Botcazou * sem_util.adb (New_Copy_Tree): Put back the declarations of the hash tables at library level. Reinstate the NCT_Hash_Tables_Used variable and set it to True whenever the main hash table is populated. Short- circuit the Assoc function if it is false and add associated guards. Index: sem_util.adb === --- sem_util.adb(revision 247180) +++ sem_util.adb(working copy) @@ -16488,7 +16488,74 @@ end if; end New_Copy_List_Tree; + -- + -- New_Copy_Tree Auxiliary Data and Subprograms -- + -- + + use Atree.Unchecked_Access; + use Atree_Private_Part; + + -- Our approach here requires a two pass traversal of the tree. The + -- first pass visits all nodes that eventually will be copied looking + -- for defining Itypes. If any defining Itypes are found, then they are + -- copied, and an entry is added to the replacement map. In the second + -- phase, the tree is copied, using the replacement map to replace any + -- Itype references within the copied tree. + + -- The following hash tables are used to speed up access to the map. They + -- are declared at library level to avoid elaborating them for every call + -- to New_Copy_Tree. This can save up to 2% of the entire compilation time + -- spent in the front end. + + subtype NCT_Header_Num is Int range 0 .. 511; + -- Defines range of headers in hash tables (512 headers) + + function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num; + -- Hash function used for hash operations + --- + -- New_Copy_Hash -- + --- + + function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is + begin + return Nat (E) mod (NCT_Header_Num'Last + 1); + end New_Copy_Hash; + + --- + -- NCT_Assoc -- + --- + + -- The hash table NCT_Assoc associates old entities in the table with their + -- corresponding new entities (i.e. the pairs of entries presented in the + -- original Map argument are Key-Element pairs). + + package NCT_Assoc is new Simple_HTable ( + Header_Num => NCT_Header_Num, + Element=> Entity_Id, + No_Element => Empty, + Key=> Entity_Id, + Hash => New_Copy_Hash, + Equal => Types."="); + + - + -- NCT_Itype_Assoc -- + - + + -- The hash table NCT_Itype_Assoc contains entries only for those old + -- nodes which have a non-empty Associated_Node_For_Itype set. The key + -- is the associated node, and the element is the new node itself (NOT + -- the associated node for the new node). + + package NCT_Itype_Assoc is new Simple_HTable ( + Header_Num => NCT_Header_Num, + Element=> Entity_Id, + No_Element => Empty, + Key=> Entity_Id, + Hash => New_Copy_Hash, + Equal => Types."="); + + --- -- New_Copy_Tree -- --- @@ -16509,64 +16576,11 @@ -- variables for declarations located in blocks or subprograms defined -- in Expression_With_Action nodes. - - -- Auxiliary Data and Subprograms -- - + NCT_Hash_Tables_Used : Boolean := False; + -- Set to True if hash tables are in use. It is intended to speed up the + -- common case, which is no hash tables in use. This can save up to 8% + -- of the entire compilation time spent in the front end. - use Atree.Unchecked_Access; - use Atree_Private_Part; - - -- Our approach here requires a two pass traversal of the tree. The - -- first pass visits all nodes that eventually will be copied looking - -- for defining Itypes. If any defining Itypes are found, then they are - -- copied, and an entry is added to the replacement map. In the second - -- phase, the tree is copied, using the replacement map to replace any - -- Itype references within the copied tree. - - -- The following hash tables are used if the Map supplied has more than - -- hash threshold entries to speed up access to the map. If there are - -- fewer entries, the
[Ada] Fix elab counter handling when preserving control flow
When control flow preservation is requested, we want to be explicit about the
units elaboration order in a partition, and we want to have in the executable
an object file for all the units involved in the partition.
This requires special processing for units which wouldn't produce any
object code in normal circumstances, e.g. lone specs only defining simple
types and marked with a No_Elaboration_Code pragma.
Our scheme involves two parts:
1) make sure that all the units compiled with
-fpreserve-control-flow have an elaboration counter, including lone specs
with pragma No_Elaboration_Code.
2) arrange to have that elaboration counter updated by the binder generated
code, even though there's no elab subprogram called. This materializes the
unit elaboration explicitly and introduces a variable reference which will
drag the unit object file in the link closure.
So far, we were building an elaboration counter entity but were not
advertising it in the ALI information and were not referencing it from the
binder generated code. This change fixes this.
For this set of sources:
In subdir mylib/
library project mylib is
for Languages use ("Ada");
for Source_Dirs use (".");
for Library_Name use Project'Name;
for Library_Dir use "lib";
for Library_Kind use "static";
end mylib;
package Types is
type R is range 1 .. 500;
end;
And one level up:
with "mylib/mylib.gpr";
project p is
end p;
with Types;
procedure P is
V : Types.R;
pragma Volatile (V);
begin
null;
end;
Out of this build command:
gprbuild -f -g -p -Pp.gpr p.adb -cargs -fpreserve-control-flow
We expect b__p.adb to feature something like:
E04 : Short_Integer; pragma Import (Ada, E04, "types_E");
procedure adainit
...
E04 := E04 + 1;
end adainit;
and the final executable to include types.o.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Olivier Hainque
* bindgen.adb (Gen_Elab_Calls): Also update counter of lone
specs without elaboration code that have an elaboration counter
nevertheless, e.g. when compiled with -fpreserve-control-flow.
* sem_ch10.adb (Analyze_Compilation_Unit):
Set_Elaboration_Entity_Required when requested to preserve
control flow, to ensure the unit elaboration is materialized at
bind time, resulting in the inclusion of the unit object file
in the executable closure at link time.
Index: sem_ch10.adb
===
--- sem_ch10.adb(revision 247177)
+++ sem_ch10.adb(working copy)
@@ -1204,32 +1204,38 @@
-- where the elaboration routine might otherwise be called more
-- than once.
--- Case of units which do not require elaboration checks
+-- They are also needed to ensure explicit visibility from the
+-- binder generated code of all the units involved in a partition
+-- when control-flow preservation is requested.
-if
- -- Pure units do not need checks
+-- Case of units which do not require an elaboration entity
- Is_Pure (Spec_Id)
+if not Opt.Suppress_Control_Flow_Optimizations
+ and then
+ ( -- Pure units do not need checks
- -- Preelaborated units do not need checks
+Is_Pure (Spec_Id)
- or else Is_Preelaborated (Spec_Id)
+-- Preelaborated units do not need checks
- -- No checks needed if pragma Elaborate_Body present
+or else Is_Preelaborated (Spec_Id)
- or else Has_Pragma_Elaborate_Body (Spec_Id)
+-- No checks needed if pragma Elaborate_Body present
- -- No checks needed if unit does not require a body
+or else Has_Pragma_Elaborate_Body (Spec_Id)
- or else not Unit_Requires_Body (Spec_Id)
+-- No checks needed if unit does not require a body
- -- No checks needed for predefined files
+or else not Unit_Requires_Body (Spec_Id)
- or else Is_Predefined_File_Name (Unit_File_Name (Unum))
+-- No checks needed for predefined files
- -- No checks required if no separate spec
+or else Is_Predefined_File_Name (Unit_File_Name (Unum))
- or else Acts_As_Spec (N)
+-- No checks required if no separate spec
+
+or else Acts_As_Spec (N)
+ )
then
-- This is a case where we only need the entity for
-- checking to prevent multiple elaboration checks.
Index: bindgen.adb
===
--- bindgen.adb (revision 247177)
+++ bindgen.adb (working copy)
@@ -1117,9 +1117,13 @@
then
-- In the case of a body with a separate s
[Ada] Do not mention an error on continuation message of info message
Info messages are used in GNATprove to inform the user of subtleties in
how source constructs are verified. They should not be mistaken for
error messages in continuation messages. Now fixed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Yannick Moy
* errout.adb (Error_Msg): Adapt continuation
message in instantiations and inlined bodies for info messages.
Index: errout.adb
===
--- errout.adb (revision 247177)
+++ errout.adb (working copy)
@@ -423,9 +423,14 @@
-- or
- -- warning: in instantiation at
+ -- warning: in instantiation at ...
-- warning: original warning message
+ -- or
+
+ -- info: in instantiation at ...
+ -- info: original info message
+
-- All these messages are posted at the location of the top level
-- instantiation. If there are nested instantiations, then the
-- instantiation error message can be repeated, pointing to each
@@ -440,9 +445,14 @@
-- or
- -- warning: in inlined body at
+ -- warning: in inlined body at ...
-- warning: original warning message
+ -- or
+
+ -- info: in inlined body at ...
+ -- info: original info message
+
-- OK, here we have an instantiation error, and we need to generate the
-- error on the instantiation, rather than on the template.
@@ -494,8 +504,12 @@
-- Case of inlined body
if Inlined_Body (X) then
- if Is_Warning_Msg or Is_Style_Msg then
+ if Is_Info_Msg then
Error_Msg_Internal
+ ("info: in inlined body #",
+Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ elsif Is_Warning_Msg or Is_Style_Msg then
+ Error_Msg_Internal
(Warn_Insertion & "in inlined body #",
Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
else
@@ -507,8 +521,12 @@
-- Case of generic instantiation
else
- if Is_Warning_Msg or else Is_Style_Msg then
+ if Is_Info_Msg then
Error_Msg_Internal
+ ("info: in instantiation #",
+Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ elsif Is_Warning_Msg or else Is_Style_Msg then
+ Error_Msg_Internal
(Warn_Insertion & "in instantiation #",
Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
else
[Ada] Micro-optimize again Is_Internal_File_Name & Is_Predefined_File_Name
This micro-optimizes again the implementation of a couple of hot functions
after recent changes. No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Eric Botcazou
* fname.adb (Has_Internal_Extension): Add pragma Inline.
Use direct 4-character slice comparisons.
(Has_Prefix): Add
pragma Inline. (Has_Suffix): Delete.
(Is_Internal_File_Name):
Test Is_Predefined_File_Name first.
(Is_Predefined_File_Name):
Use direct slice comparisons as much as possible and limit all
comparisons to at most 8 characters.
Index: fname.adb
===
--- fname.adb (revision 247177)
+++ fname.adb (working copy)
@@ -58,27 +58,30 @@
Table_Name => "Fname_Dummy_Table");
function Has_Internal_Extension (Fname : String) return Boolean;
+ pragma Inline (Has_Internal_Extension);
-- True if the extension is appropriate for an internal/predefined
-- unit. That means ".ads" or ".adb" for source files, and ".ali" for
-- ALI files.
function Has_Prefix (X, Prefix : String) return Boolean;
+ pragma Inline (Has_Prefix);
-- True if Prefix is at the beginning of X. For example,
-- Has_Prefix("a-filename.ads", Prefix => "a-") is True.
- function Has_Suffix (X, Suffix : String) return Boolean;
- -- True if Suffix is at the end of X
-
-- Has_Internal_Extension --
function Has_Internal_Extension (Fname : String) return Boolean is
begin
- return
-Has_Suffix (Fname, Suffix => ".ads")
- or else Has_Suffix (Fname, Suffix => ".adb")
- or else Has_Suffix (Fname, Suffix => ".ali");
+ if Fname'Length >= 4 then
+ declare
+S : String renames Fname (Fname'Last - 3 .. Fname'Last);
+ begin
+return S = ".ads" or else S = ".adb" or else S = ".ali";
+ end;
+ end if;
+ return False;
end Has_Internal_Extension;
@@ -89,32 +92,14 @@
begin
if X'Length >= Prefix'Length then
declare
-Slice : String renames
- X (X'First .. X'First + Prefix'Length - 1);
+S : String renames X (X'First .. X'First + Prefix'Length - 1);
begin
-return Slice = Prefix;
+return S = Prefix;
end;
end if;
return False;
end Has_Prefix;
-
- -- Has_Suffix --
-
-
- function Has_Suffix (X, Suffix : String) return Boolean is
- begin
- if X'Length >= Suffix'Length then
- declare
-Slice : String renames
- X (X'Last - Suffix'Length + 1 .. X'Last);
- begin
-return Slice = Suffix;
- end;
- end if;
- return False;
- end Has_Suffix;
-
---
-- Is_Internal_File_Name --
---
@@ -124,6 +109,10 @@
Renamings_Included : Boolean := True) return Boolean
is
begin
+ if Is_Predefined_File_Name (Fname, Renamings_Included) then
+ return True;
+ end if;
+
-- Check for internal extensions first, so we don't think (e.g.)
-- "gnat.adc" is internal.
@@ -131,10 +120,7 @@
return False;
end if;
- return
-Is_Predefined_File_Name (Fname, Renamings_Included)
- or else Has_Prefix (Fname, Prefix => "g-")
- or else Has_Prefix (Fname, Prefix => "gnat.");
+ return Has_Prefix (Fname, "g-") or else Has_Prefix (Fname, "gnat.");
end Is_Internal_File_Name;
function Is_Internal_File_Name
@@ -156,16 +142,38 @@
(Fname : String;
Renamings_Included : Boolean := True) return Boolean
is
+ subtype Str8 is String (1 .. 8);
+
+ Renaming_Names : constant array (1 .. 8) of Str8 :=
+("calendar", -- Calendar
+ "machcode", -- Machine_Code
+ "unchconv", -- Unchecked_Conversion
+ "unchdeal", -- Unchecked_Deallocation
+ "directio", -- Direct_IO
+ "ioexcept", -- IO_Exceptions
+ "sequenio", -- Sequential_IO
+ "text_io."); -- Text_IO
+
+ -- Note: the implementation is optimized to perform uniform comparisons
+ -- on string slices whose length is known at compile time and at most 8
+ -- characters; the remaining calls to Has_Prefix must be inlined so as
+ -- to expose the compile-time known length.
+
begin
if not Has_Internal_Extension (Fname) then
return False;
end if;
- if Has_Prefix (Fname, "a-")
-or else Has_Prefix (Fname, "i-")
-or else Has_Prefix (Fname, "s-")
- then
- return True;
+ -- Definitely predefined if prefix is a- i- or s-
+
+ if Fname'Length >= 2 then
+
[Ada] Spurious error on missing SPARK_Mode annotation with inlining
This patch augments the generic instantiation machinery to preserve a key property of a package or subprogram spec for the corresponding body which may be instantiated or inlined later. Whenever a generic is instantiated in an environment where the SPARK_Mode is Off, any SPARK_Mode pragma found within the spec and body must be ignored. Due to late instantiation or inlining of bodies, this property was previously lost which in turn led to spurious errors about missing SPARK_Mode annotations in specs. -- Source -- -- gen.ads generic package Gen is task type Tsk; end Gen; -- gen.adb with Ada.Real_Time; use Ada.Real_Time; package body Gen is task body Tsk is Now : constant Time := Time_Of (0, Time_Span_First); Later : Time; begin Later := Now + Milliseconds (1); end Tsk; end Gen; -- pack.ads with Gen; package Pack is package Inst is new Gen; end Pack; - -- Compilation -- - $ gcc -c -gnatn pack.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Hristian Kirtchev * einfo.adb Flag301 is now known as Ignore_SPARK_Mode_Pragmas. (Ignore_SPARK_Mode_Pragmas): New routine. (Set_Ignore_SPARK_Mode_Pragmas): New routine. (Write_Entity_Flags): Add an entry for Ignore_SPARK_Mode_Pragmas. * einfo.ads Add new attribute Ignore_SPARK_Mode_Pragmas and update related entities. (Ignore_SPARK_Mode_Pragmas): New routine along with pragma Inline. (Set_Ignore_SPARK_Mode_Pragmas): New routine along with pragma Inline. * opt.ads Rename flag Ignore_Pragma_SPARK_Mode to Ignore_SPARK_Mode_Pragmas_In_Instance. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Set or reinstate the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance when either the corresponding spec or the body must ignore all SPARK_Mode pragmas found within. (Analyze_Subprogram_Declaration): Mark the spec when it needs to ignore all SPARK_Mode pragmas found within to allow the body to infer this property in case it is instantiated or inlined later. * sem_ch7.adb (Analyze_Package_Body_Helper): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Set the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance when the corresponding spec also ignored all SPARK_Mode pragmas found within. (Analyze_Package_Declaration): Mark the spec when it needs to ignore all SPARK_Mode pragmas found within to allow the body to infer this property in case it is instantiated or inlined later. * sem_ch12.adb (Analyze_Formal_Package_Declaration): Save and restore the value of flag Ignore_SPARK_Mode_Pragmas_In_Instance. Mark the formal spec when it needs to ignore all SPARK_Mode pragmas found within to allow the body to infer this property in case it is instantiated or inlined later. (Analyze_Package_Instantiation): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Mark the instance spec when it needs to ignore all SPARK_Mode pragmas found within to allow the body to infer this property in case it is instantiated or inlined later. (Analyze_Subprogram_Instantiation): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Mark the instance spec and anonymous package when they need to ignore all SPARK_Mode pragmas found within to allow the body to infer this property in case it is instantiated or inlined later. (Instantiate_Package_Body): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Set the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance when the corresponding instance spec also ignored all SPARK_Mode pragmas found within. (Instantiate_Subprogram_Body): Save and restore the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance. Set the value of global flag Ignore_SPARK_Mode_Pragmas_In_Instance when the corresponding instance spec also ignored all SPARK_Mode pragmas found within. * sem_prag.adb (Analyze_Pragma): Update the reference to Ignore_Pragma_SPARK_Mode. * sem_util.adb (SPARK_Mode_Is_Off): A construct which ignored all SPARK_Mode pragmas defined within yields mode "off". Index: sem_ch7.adb === --- sem_ch7.adb (revision 247177) +++ sem_ch7.adb (working copy) @@ -539,6 +539,8 @@ -- Local variables + Save_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; + Body_Id : En
[Ada] Compiler crash on large array aggregate
This patch fixes a bug in which the compiler crashes if the number of subcomponents in an array aggregate is 2**31 or more. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Bob Duff * exp_aggr.adb (Component_Count): Protect the arithmetic from attempting to convert a value >= 2**31 to Int, which would otherwise raise Constraint_Error. Index: exp_aggr.adb === --- exp_aggr.adb(revision 247177) +++ exp_aggr.adb(working copy) @@ -352,7 +352,7 @@ -- which hit memory limits in the backend. function Component_Count (T : Entity_Id) return Nat; - -- The limit is applied to the total number of components that the + -- The limit is applied to the total number of subcomponents that the -- aggregate will have, which is the number of static expressions -- that will appear in the flattened array. This requires a recursive -- computation of the number of scalar components of the structure. @@ -399,8 +399,20 @@ return 0; else - return -Siz * UI_To_Int (Expr_Value (Hi) - Expr_Value (Lo) + 1); + -- If the number of components is greater than Int'Last, + -- then return Int'Last, so caller will return False (Aggr + -- size is not OK). Otherwise, UI_To_Int will crash. + + declare + UI : constant Uint := +Expr_Value (Hi) - Expr_Value (Lo) + 1; + begin + if UI_Is_In_Int_Range (UI) then +return Siz * UI_To_Int (UI); + else +return Int'Last; + end if; + end; end if; end;
Re: [PING for gcc 8] Re: [PATCH] Fix spelling suggestions for reserved words (PR c++/80177)
On 04/24/2017 02:58 PM, David Malcolm wrote: Ping for gcc 8. On Fri, 2017-03-31 at 12:41 -0400, David Malcolm wrote: As noted in the PR, the C++ frontend currently offers a poor suggestion for this misspelling: Successfully bootstrapped®rtested on x86_64-pc-linux-gnu. Adds 7 PASS and 1 UNSUPPORTED (for -std=c++98) to g++.sum OK for next stage 1? Ok. nathan -- Nathan Sidwell
Re: [PING][PATCH] Move the check for any_condjump_p from sched-deps to target macros
Hi Naveen,
> https://gcc.gnu.org/ml/gcc-patches/2017-03/msg01368.html
This looks good to me - I have just one comment:
--- a/gcc/config/aarch64/aarch64.c
+++ b/gcc/config/aarch64/aarch64.c
@@ -13972,6 +13972,15 @@ aarch_macro_fusion_pair_p (rtx_insn *prev, rtx_insn
*curr)
{
enum attr_type prev_type = get_attr_type (prev);
+ unsigned int condreg1, condreg2;
+ rtx cc_reg_1;
+ aarch64_fixed_condition_code_regs (&condreg1, &condreg2);
+ cc_reg_1 = gen_rtx_REG (CCmode, condreg1);
+ if (!reg_referenced_p (cc_reg_1, PATTERN (curr))
+ || !prev
+ || !modified_in_p (cc_reg_1, prev))
+ return false;
+
The return false seems incorrect - it means a core can either have
FUSE_CMP_BRANCH or
FUSE_ALU_BRANCH but not both.
The way aarch_macro_fusion_pair_p works is to return true if fusion is possible
but fallthrough
if not so other, less likely, fusion candidates can still be tried.
Wilco
Re: [PING][PATCH][AArch64] Implement ALU_BRANCH fusion
Hi Naveen, > https://gcc.gnu.org/ml/gcc-patches/2017-03/msg01369.html Same comment for this part, we want to return true if we match: + if (SET_DEST (curr_set) != (pc_rtx) + || GET_CODE (SET_SRC (curr_set)) != IF_THEN_ELSE + || ! REG_P (XEXP (XEXP (SET_SRC (curr_set), 0), 0)) + || ! REG_P (SET_DEST (prev_set)) + || REGNO (SET_DEST (prev_set)) +!= REGNO (XEXP (XEXP (SET_SRC (curr_set), 0), 0))) + return false; Note writing these complex conditions using positive logic makes them much more readable - if you have to negate use !(X && Y && Z) rather than !X || !Y || !Z. Wilco
Re: [PATCH] Fix PR80492
On Tue, 25 Apr 2017, Richard Biener wrote:
>
> The following fixes redundant hard-register "stores" to be not eliminated
> by FRE/PRE and the alias machinery to properly handle different
> local VAR_DECLs with the same asm specification.
>
> Comments are welcome. I tested the testcase on x86_64, ppc64le and
> aarch64 and all seem to be happy with *4 as register specification.
>
> Bootstrap / regtest running on x86_64-unknown-linux-gnu.
So in bugzilla the conclusion is that the DSE is valid (for the
testcase it's not because it failed to compute aliasing properly).
And I can't see any reason to not do the transform (the corresponding
CSE is not done to avoid increasing register pressure by increased
lifetime). That is, removing a redundant setting of a hardreg
reduces the lifetime of the value stored.
Bootstrapped on x86_64-unknown-linux-gnu, testing still in progress.
Richard.
2017-04-25 Richard Biener
PR tree-optimization/80492
* alias.c (compare_base_decls): Handle registers with asm
specification conservatively.
* tree-ssa-alias.c (decl_refs_may_alias_p): Handle
compare_base_decls returning dont-know properly.
* gcc.dg/pr80492.c: New testcase.
Index: gcc/alias.c
===
--- gcc/alias.c (revision 247147)
+++ gcc/alias.c (working copy)
@@ -2046,6 +2046,18 @@ compare_base_decls (tree base1, tree bas
if (base1 == base2)
return 1;
+ /* If we have two register decls with register specification we
+ cannot decide unless their assembler name is the same. */
+ if (DECL_REGISTER (base1)
+ && DECL_REGISTER (base2)
+ && DECL_ASSEMBLER_NAME_SET_P (base1)
+ && DECL_ASSEMBLER_NAME_SET_P (base2))
+{
+ if (DECL_ASSEMBLER_NAME (base1) == DECL_ASSEMBLER_NAME (base2))
+ return 1;
+ return -1;
+}
+
/* Declarations of non-automatic variables may have aliases. All other
decls are unique. */
if (!decl_in_symtab_p (base1)
Index: gcc/passes.c
===
--- gcc/passes.c(revision 247147)
+++ gcc/passes.c(working copy)
@@ -1532,7 +1532,7 @@ pass_manager::pass_manager (context *ctx
: all_passes (NULL), all_small_ipa_passes (NULL), all_lowering_passes (NULL),
all_regular_ipa_passes (NULL),
all_late_ipa_passes (NULL), passes_by_id (NULL), passes_by_id_size (0),
- m_ctxt (ctxt)
+ m_ctxt (ctxt), m_name_to_pass_map (NULL)
{
opt_pass **p;
Index: gcc/testsuite/gcc.dg/pr80492.c
===
--- gcc/testsuite/gcc.dg/pr80492.c (nonexistent)
+++ gcc/testsuite/gcc.dg/pr80492.c (working copy)
@@ -0,0 +1,20 @@
+/* { dg-do compile } */
+/* { dg-options "-w -O2 -fdump-tree-optimized" } */
+
+static __inline__ __attribute__((__always_inline__))
+void syscall_7 (int val)
+{
+ register int reg __asm ("4") = val;
+ __asm __volatile__ ("/* Some Code %0 */" :: "r" (reg));
+}
+
+void do_syscalls (void)
+{
+ for (int s = 0; s < 2; s++)
+{
+ syscall_7 (0);
+ syscall_7 (1);
+}
+}
+
+/* { dg-final { scan-tree-dump-times "reg = " 4 "optimized" } } */
Index: gcc/tree-ssa-alias.c
===
--- gcc/tree-ssa-alias.c(revision 247147)
+++ gcc/tree-ssa-alias.c(working copy)
@@ -1096,13 +1096,16 @@ decl_refs_may_alias_p (tree ref1, tree b
{
gcc_checking_assert (DECL_P (base1) && DECL_P (base2));
+ int cmp = compare_base_decls (base1, base2);
+
/* If both references are based on different variables, they cannot alias.
*/
- if (compare_base_decls (base1, base2) == 0)
+ if (cmp == 0)
return false;
/* If both references are based on the same variable, they cannot alias if
the accesses do not overlap. */
- if (!ranges_overlap_p (offset1, max_size1, offset2, max_size2))
+ if (cmp == 1
+ && !ranges_overlap_p (offset1, max_size1, offset2, max_size2))
return false;
/* For components with variable position, the above test isn't sufficient,
Re: [PATCH, gcc 8] C++: hints for missing std:: headers
On 04/24/2017 03:53 PM, David Malcolm wrote: If the user forgets to include an STL header, then an attempt to use a class in an explicitly scoped "std::" currently leads to this error: + if (scope == NULL_TREE) +return; + if (TREE_CODE (scope) != NAMESPACE_DECL) +return; + /* We only offer suggestions for the "std" namespace. */ + if (scope != std_node) +return; You might also consider if the current scope has a using directive naming ::std? That could be a separate patch, if you care. Ok for trunk. nathan -- Nathan Sidwell
Re: [PATCH] C: fix-it hint for removing stray semicolons
On 04/24/2017 03:58 PM, David Malcolm wrote: Patch adds a fix-it hint to a pre-existing pedwarn to make it easier for IDEs to assist in fixing the mistake. Successfully bootstrapped®rtested on x86_64-pc-linux-gnu. OK for trunk? gcc/c/ChangeLog: * c-parser.c (c_parser_struct_or_union_specifier): Add fix-it hint for removing extra semicolon. ok -- Nathan Sidwell
Re: [PATCH] C++: fix-it hint for removing stray semicolons
On 04/24/2017 03:59 PM, David Malcolm wrote: Patch adds a fix-it hint to a pre-existing pedwarn to make it easier for IDEs to assist in fixing the mistake. Successfully bootstrapped®rtested on x86_64-pc-linux-gnu. OK for trunk? gcc/cp/ChangeLog: * parser.c (cp_parser_member_declaration): Add fix-it hint for removing stray semicolons. ok. -- Nathan Sidwell
Backport to GCC6
Hello.
There's a series of revisions I would like to install to GCC 6 branch.
When I did the same couple weeks ago, Richi told me to install regression
without asking for a permission. However the series also contains various
fixed for PRs that are present probably from the time a functionality
was added. Thus I'm sending the whole series to ML.
Thanks,
Martin
>From 6408f98d499ebaf8e4d72ffa43a8471aa2fad8b1 Mon Sep 17 00:00:00 2001
From: marxin
Date: Mon, 24 Apr 2017 13:16:34 +
Subject: [PATCH 13/13] Backport r247097
gcc/ChangeLog:
2017-04-24 Jan Hubicka
PR middle-end/79931
* ipa-devirt.c (dump_possible_polymorphic_call_targets): Fix ICE.
gcc/testsuite/ChangeLog:
2017-04-24 Martin Liska
PR middle-end/79931
* g++.dg/ipa/pr79931.C: New test.
---
gcc/ipa-devirt.c | 8 +++-
gcc/testsuite/g++.dg/ipa/pr79931.C | 24
2 files changed, 31 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/g++.dg/ipa/pr79931.C
diff --git a/gcc/ipa-devirt.c b/gcc/ipa-devirt.c
index 981fabf6dc6..0332b3ec616 100644
--- a/gcc/ipa-devirt.c
+++ b/gcc/ipa-devirt.c
@@ -3367,7 +3367,13 @@ dump_possible_polymorphic_call_targets (FILE *f,
fprintf (f, " Speculative targets:");
dump_targets (f, targets);
}
- gcc_assert (targets.length () <= len);
+ /* Ugly: during callgraph construction the target cache may get populated
+ before all targets are found. While this is harmless (because all local
+ types are discovered and only in those case we devirtualize fully and we
+ don't do speculative devirtualization before IPA stage) it triggers
+ assert here when dumping at that stage also populates the case with
+ speculative targets. Quietly ignore this. */
+ gcc_assert (symtab->state < IPA_SSA || targets.length () <= len);
fprintf (f, "\n");
}
diff --git a/gcc/testsuite/g++.dg/ipa/pr79931.C b/gcc/testsuite/g++.dg/ipa/pr79931.C
new file mode 100644
index 000..78f6e03c458
--- /dev/null
+++ b/gcc/testsuite/g++.dg/ipa/pr79931.C
@@ -0,0 +1,24 @@
+/* { dg-do compile } */
+/* { dg-options "-O2 -fdump-ipa-all" } */
+
+class DocumentImpl;
+struct NodeImpl
+{
+ virtual DocumentImpl * getOwnerDocument();
+ virtual NodeImpl * getParentNode();
+ virtual NodeImpl * removeChild(NodeImpl *oldChild);
+};
+struct AttrImpl : NodeImpl
+{
+ NodeImpl *insertBefore(NodeImpl *newChild, NodeImpl *refChild);
+};
+struct DocumentImpl : NodeImpl
+{
+ virtual NodeImpl *removeChild(NodeImpl *oldChild);
+ virtual int* getRanges();
+};
+NodeImpl *AttrImpl::insertBefore(NodeImpl *newChild, NodeImpl *refChild) {
+ NodeImpl *oldparent = newChild->getParentNode();
+ oldparent->removeChild(newChild);
+ this->getOwnerDocument()->getRanges();
+}
--
2.12.2
>From 052f030a600e1396b29f7f8c63bbe2628ca767e3 Mon Sep 17 00:00:00 2001
From: marxin
Date: Wed, 19 Apr 2017 12:06:35 +
Subject: [PATCH 12/13] Backport r246996
gcc/ChangeLog:
2017-04-19 Richard Biener
PR ipa/65972
* auto-profile.c (afdo_vpt_for_early_inline): Update SSA
when needed by AutoPGO.
---
gcc/auto-profile.c | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/gcc/auto-profile.c b/gcc/auto-profile.c
index cd82ab4932d..94afe6fd2d9 100644
--- a/gcc/auto-profile.c
+++ b/gcc/auto-profile.c
@@ -1437,7 +1437,9 @@ afdo_vpt_for_early_inline (stmt_set *promoted_stmts)
if (has_vpt)
{
- optimize_inline_calls (current_function_decl);
+ unsigned todo = optimize_inline_calls (current_function_decl);
+ if (todo & TODO_update_ssa_any)
+ update_ssa (TODO_update_ssa);
return true;
}
--
2.12.2
>From d6375474d7a4f091044b35cc17d5d603656c8ae2 Mon Sep 17 00:00:00 2001
From: marxin
Date: Wed, 19 Apr 2017 12:00:47 +
Subject: [PATCH 11/13] Backport r246995
gcc/ChangeLog:
2017-04-19 Paulo J. Matos
PR lto/50345
* doc/lto.texi: Remove an extra 'that'.
---
gcc/doc/lto.texi | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/doc/lto.texi b/gcc/doc/lto.texi
index 9269e55ca31..970a4d839af 100644
--- a/gcc/doc/lto.texi
+++ b/gcc/doc/lto.texi
@@ -43,7 +43,7 @@ existing build systems, as one can, for instance, produce archives of
the files. Additionally, one might be able to ship one set of fat
objects which could be used both for development and the production of
optimized builds. A, perhaps surprising, side effect of this feature
-is that any mistake in the toolchain that leads to LTO information not
+is that any mistake in the toolchain leads to LTO information not
being used (e.g.@: an older @code{libtool} calling @code{ld} directly).
This is both an advantage, as the system is more robust, and a
disadvantage, as the user is not informed that the optimization has
--
2.12.2
>From ea4c4aa982b45c0c97eced7521f7be83a12a0b83 Mon Sep 17 00:00:00 2001
From: marxin
Date: Tue, 18 Apr 2017 07:24:20 +
Subject: [PATCH 10/13] Backport r246961
gcc/ChangeLog:
2017-04-18 Martin Liska
PR gcov-pr
Re: [PATCH] C++: fix-it hints suggesting accessors for private fields
On 04/24/2017 04:06 PM, David Malcolm wrote:
test.cc:12:13: note: field ‘int foo::m_field’ can be accessed via ‘int
foo::get_field() const’
return f->m_field;
^~~
get_field()
Assuming that an IDE can offer to apply fix-it hints, this should
make it easier to handle refactorings where one makes a field
private and adds a getter.
It also helps by letting the user know that a getter exists, and
the name of the getter ("is it "field", "get_field", etc?").
Neat!
OK for trunk?
gcc/cp/ChangeLog:
* call.c (maybe_suggest_accessor): New function.
(enforce_access): Call maybe_suggest_accessor for inaccessible
decls.
* cp-tree.h (locate_field_accessor): New decl.
* search.c (matches_code_and_type_p): New function.
(field_access_p): New function.
(direct_accessor_p): New function.
(reference_accessor_p): New function.
(field_accessor_p): New function.
(dfs_locate_field_accessor_pre): New function.
(locate_field_accessor): New function.
ok.
--
Nathan Sidwell
[PATCH] Make __FUNCTION__ a mergeable string and do not generate symbol entry.
Hello.
This is patch that was originally installed by Jason and later reverted due to
PR70422.
In the later PR Richi suggested a fix for that and Segher verified that it
helped him
to survive regression tests. That's reason why I'm resending that.
Patch can bootstrap on ppc64le-redhat-linux and survives regression tests.
Ready to be installed?
Martin
>From a34ce0ef37ae00609c9f3ff98a9cb0b7db6a8bd0 Mon Sep 17 00:00:00 2001
From: marxin
Date: Thu, 20 Apr 2017 14:56:30 +0200
Subject: [PATCH] Make __FUNCTION__ a mergeable string and do not generate
symbol entry.
gcc/cp/ChangeLog:
2017-04-20 Jason Merrill
Martin Liska
Segher Boessenkool
PR c++/64266
PR c++/70353
PR bootstrap/70422
Core issue 1962
* decl.c (cp_fname_init): Decay the initializer to pointer.
(cp_make_fname_decl): Set DECL_DECLARED_CONSTEXPR_P,
* pt.c (tsubst_expr) [DECL_EXPR]: Set DECL_VALUE_EXPR,
DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P and
DECL_IGNORED_P. Don't call cp_finish_decl.
gcc/testsuite/ChangeLog:
2017-04-20 Jason Merrill
Segher Boessenkool
PR c++/64266
PR c++/70353
PR bootstrap/70422
Core issue 1962
* g++.dg/cpp0x/constexpr-__func__2.C: Add static assert test.
* g++.dg/ext/fnname5.C: New test.
* g++.old-deja/g++.ext/pretty4.C: Remove.
---
gcc/cp/decl.c| 20 --
gcc/cp/pt.c | 26 +---
gcc/testsuite/g++.dg/cpp0x/constexpr-__func__2.C | 7 +-
gcc/testsuite/g++.dg/ext/fnname5.C | 33 +
gcc/testsuite/g++.old-deja/g++.ext/pretty4.C | 85
5 files changed, 66 insertions(+), 105 deletions(-)
create mode 100644 gcc/testsuite/g++.dg/ext/fnname5.C
delete mode 100644 gcc/testsuite/g++.old-deja/g++.ext/pretty4.C
diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c
index 8e9a466afa0..c418fa4ce89 100644
--- a/gcc/cp/decl.c
+++ b/gcc/cp/decl.c
@@ -4348,13 +4348,15 @@ cp_fname_init (const char* name, tree *type_p)
type = cp_build_qualified_type (char_type_node, TYPE_QUAL_CONST);
type = build_cplus_array_type (type, domain);
- *type_p = type;
+ *type_p = type_decays_to (type);
if (init)
TREE_TYPE (init) = type;
else
init = error_mark_node;
+ init = decay_conversion (init, tf_warning_or_error);
+
return init;
}
@@ -4380,12 +4382,21 @@ cp_make_fname_decl (location_t loc, tree id, int type_dep)
/* As we're using pushdecl_with_scope, we must set the context. */
DECL_CONTEXT (decl) = current_function_decl;
- TREE_STATIC (decl) = 1;
TREE_READONLY (decl) = 1;
DECL_ARTIFICIAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
+ DECL_DECLARED_CONSTEXPR_P (decl) = 1;
TREE_USED (decl) = 1;
+ if (init)
+{
+ SET_DECL_VALUE_EXPR (decl, init);
+ DECL_HAS_VALUE_EXPR_P (decl) = 1;
+ /* For decl_constant_var_p. */
+ DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P (decl) = 1;
+}
+
if (current_function_decl)
{
cp_binding_level *b = current_binding_level;
@@ -4394,13 +4405,12 @@ cp_make_fname_decl (location_t loc, tree id, int type_dep)
while (b->level_chain->kind != sk_function_parms)
b = b->level_chain;
pushdecl_with_scope (decl, b, /*is_friend=*/false);
- cp_finish_decl (decl, init, /*init_const_expr_p=*/false, NULL_TREE,
- LOOKUP_ONLYCONVERTING);
+ add_decl_expr (decl);
}
else
{
DECL_THIS_STATIC (decl) = true;
- pushdecl_top_level_and_finish (decl, init);
+ pushdecl_top_level_and_finish (decl, NULL_TREE);
}
return decl;
diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c
index f8436b30b37..8d8cd0c5861 100644
--- a/gcc/cp/pt.c
+++ b/gcc/cp/pt.c
@@ -15808,21 +15808,25 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl,
DECL_CONTEXT (decl) = current_function_decl;
cp_check_omp_declare_reduction (decl);
}
+ else if (VAR_P (decl)
+ && DECL_PRETTY_FUNCTION_P (decl))
+ {
+ /* For __PRETTY_FUNCTION__ we have to adjust the
+ initializer. */
+ const char *const name
+ = cxx_printable_name (current_function_decl, 2);
+ init = cp_fname_init (name, &TREE_TYPE (decl));
+ SET_DECL_VALUE_EXPR (decl, init);
+ DECL_HAS_VALUE_EXPR_P (decl) = 1;
+ DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P (decl) = 1;
+ maybe_push_decl (decl);
+ }
else
{
int const_init = false;
maybe_push_decl (decl);
- if (VAR_P (decl)
- && DECL_PRETTY_FUNCTION_P (decl))
- {
- /* For __PRETTY_FUNCTION__ we have to adjust the
- initializer. */
- const char *const name
- = cxx_printable_name (current_function_decl, 2);
- init = cp_fname_init (name, &TREE_TYPE (decl));
- }
- else
- init = tsubst_init (init, decl, args, complain, in_decl);
+
+ init = tsubst_init (init, decl, args, complain, in_decl);
if (VAR_P (decl))
const_init = (DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P
diff --git a/gcc/testsuite/g++.dg/c
Re: [PATCH] C++: fix-it hints suggesting accessors for private fields
On 04/25/2017 07:46 AM, Nathan Sidwell wrote:
On 04/24/2017 04:06 PM, David Malcolm wrote:
test.cc:12:13: note: field ‘int foo::m_field’ can be accessed via ‘int
foo::get_field() const’
return f->m_field;
^~~
get_field()
Assuming that an IDE can offer to apply fix-it hints, this should
make it easier to handle refactorings where one makes a field
private and adds a getter.
It also helps by letting the user know that a getter exists, and
the name of the getter ("is it "field", "get_field", etc?").
Neat!
OK for trunk?
gcc/cp/ChangeLog:
* call.c (maybe_suggest_accessor): New function.
(enforce_access): Call maybe_suggest_accessor for inaccessible
decls.
* cp-tree.h (locate_field_accessor): New decl.
* search.c (matches_code_and_type_p): New function.
(field_access_p): New function.
(direct_accessor_p): New function.
(reference_accessor_p): New function.
(field_accessor_p): New function.
(dfs_locate_field_accessor_pre): New function.
(locate_field_accessor): New function.
ok.
Oh, what if the field is being accessed for modification or lvalueness?
Must the accessor return T, or can it return 'T cv &'? I.e. does it
need to look for setters too?
nathan
--
Nathan Sidwell
Re: [PATCH, C++] Fix-it info for invalid class/struct after enum
On 04/25/2017 03:39 AM, Volker Reichelt wrote: Hi, the following patch adds fix-it information for a pedwarn in the C++ parser about the invalid use of class/struct after enum. 2017-04-25 Volker Reichelt * parser.c (cp_parser_elaborated_type_specifier): Add fix-it to diagnostic of invalid class/struct keyword after enum. ok -- Nathan Sidwell
Re: [PATCH] Make __FUNCTION__ a mergeable string and do not generate symbol entry.
On Tue, Apr 25, 2017 at 01:48:05PM +0200, Martin Liška wrote:
> Hello.
>
> This is patch that was originally installed by Jason and later reverted due
> to PR70422.
> In the later PR Richi suggested a fix for that and Segher verified that it
> helped him
> to survive regression tests. That's reason why I'm resending that.
>
> Patch can bootstrap on ppc64le-redhat-linux and survives regression tests.
>
> Ready to be installed?
> Martin
> >From a34ce0ef37ae00609c9f3ff98a9cb0b7db6a8bd0 Mon Sep 17 00:00:00 2001
> From: marxin
> Date: Thu, 20 Apr 2017 14:56:30 +0200
> Subject: [PATCH] Make __FUNCTION__ a mergeable string and do not generate
> symbol entry.
>
> gcc/cp/ChangeLog:
>
> 2017-04-20 Jason Merrill
> Martin Liska
> Segher Boessenkool
>
> PR c++/64266
> PR c++/70353
> PR bootstrap/70422
> Core issue 1962
> * decl.c (cp_fname_init): Decay the initializer to pointer.
> (cp_make_fname_decl): Set DECL_DECLARED_CONSTEXPR_P,
> * pt.c (tsubst_expr) [DECL_EXPR]: Set DECL_VALUE_EXPR,
> DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P and
> DECL_IGNORED_P. Don't call cp_finish_decl.
If we don't emit those into the debug info, will the debugger be
able to handle __FUNCTION__ etc. properly?
Admittedly, right now we emit it into debug info only if those decls
are actually used, say on:
const char * foo () { return __FUNCTION__; }
const char * bar () { return ""; }
we'd emit foo::__FUNCTION__, but not bar::__FUNCTION__, so the debugger
has to have some handling of it anyway. But while in functions
that don't refer to __FUNCTION__ it is always the debugger that needs
to synthetize those and thus they will be always pointer-equal,
if there are some uses of it and for other uses the debugger would
synthetize it, there is the possibility that the debugger synthetized
string will not be the same object as actually used in the function.
Jakub
[Ada] Spurious warning on non-existend exception handler
This patch modifies the analysis of exception handlers to bypass restriction checks when the handler is internally generated and the verification mode is warnings. -- Source -- -- gen.ads generic type Ptr is private; package Gen is end Gen; -- types.ads with Gen; package Types is type T is private; type Ptr is access all T; package Inst is new Gen (Ptr); private type T is record Comp : Integer; end record; end Types; -- gnat.adc pragma Restriction_Warnings (No_Exception_Handlers); - -- Compilation -- - $ gcc -c types.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Hristian Kirtchev * exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Code cleanup. (Build_Adjust_Statements): Code cleanup. (Build_Finalizer): Update the initialization of Exceptions_OK. (Build_Finalize_Statements): Code cleanup. (Build_Initialize_Statements): Code cleanup. (Make_Deep_Array_Body): Update the initialization of Exceptions_OK. (Make_Deep_Record_Body): Update the initialization of Exceptions_OK. (Process_Object_Declaration): Generate a null exception handler only when exceptions are allowed. (Process_Transients_In_Scope): Update the initialization of Exceptions_OK. * exp_util.ads, exp_util.adb (Exceptions_In_Finalization_OK): New routine. * sem_ch11.adb (Analyze_Exception_Handlers): Do not check any restrictions when the handler is internally generated and the mode is warnings. Index: exp_ch7.adb === --- exp_ch7.adb (revision 247177) +++ exp_ch7.adb (working copy) @@ -1327,8 +1327,7 @@ or else (Present (Clean_Stmts) and then Is_Non_Empty_List (Clean_Stmts)); - Exceptions_OK: constant Boolean := - not Restriction_Active (No_Exception_Propagation); + Exceptions_OK: constant Boolean := Exceptions_In_Finalization_OK; For_Package_Body : constant Boolean := Nkind (N) = N_Package_Body; For_Package_Spec : constant Boolean := Nkind (N) = N_Package_Declaration; For_Package : constant Boolean := @@ -2844,7 +2843,7 @@ Body_Ins : Node_Id; Count_Ins : Node_Id; Fin_Call : Node_Id; - Fin_Stmts : List_Id; + Fin_Stmts : List_Id := No_List; Inc_Decl : Node_Id; Label : Node_Id; Label_Id : Entity_Id; @@ -3004,8 +3003,6 @@ -- manual finalization of their lock managers. if Is_Protected then -Fin_Stmts := No_List; - if Is_Simple_Protected_Type (Obj_Typ) then Fin_Call := Cleanup_Protected_Object (Decl, Obj_Ref); @@ -3031,8 +3028,8 @@ -- null; --end; -if Present (Fin_Stmts) then - Append_To (Finalizer_Stmts, +if Present (Fin_Stmts) and then Exceptions_OK then + Fin_Stmts := New_List ( Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, @@ -4866,8 +4863,7 @@ Last_Object : Node_Id; Related_Node : Node_Id) is - Exceptions_OK : constant Boolean := - not Restriction_Active (No_Exception_Propagation); + Exceptions_OK : constant Boolean := Exceptions_In_Finalization_OK; Must_Hook : Boolean := False; -- Flag denoting whether the context requires transient object @@ -5529,6 +5525,8 @@ (Prim : Final_Primitives; Typ : Entity_Id) return List_Id is + Exceptions_OK : constant Boolean := Exceptions_In_Finalization_OK; + function Build_Adjust_Or_Finalize_Statements (Typ : Entity_Id) return List_Id; -- Create the statements necessary to adjust or finalize an array of @@ -5645,12 +5643,10 @@ function Build_Adjust_Or_Finalize_Statements (Typ : Entity_Id) return List_Id is - Comp_Typ : constant Entity_Id := Component_Type (Typ); - Exceptions_OK : constant Boolean:= - not Restriction_Active (No_Exception_Propagation); - Index_List: constant List_Id:= New_List; - Loc : constant Source_Ptr := Sloc (Typ); - Num_Dims : constant Int:= Number_Dimensions (Typ); + Comp_Typ : constant Entity_Id := Component_Type (Typ); + Index_List : constant List_Id:= New_List; + Loc: constant Source_Ptr := Sloc (Typ); + Num_Dims : constant Int:= Number_Dimensions (Typ); procedure Build_Indexes; -- Generate the indexes used in the
RE: [PATCH 0/7] [ARC] Fix constraint letters and allow extra registers
> These all look good. > > Thanks, > Andrew Committed in r247201, r247200, r247199, r247198, r247196, r247195, and r247194 Thank you for your review, Claudiu
[Ada] Re-implement classwide invariants to evaluate statically
This patch corrects an issue outlined by AI12-0150-1 (text below) and changes class-wide type invariant procedures to avoid expensive dynamic dispatching. To accomplish this changes to most calls to Build_Invariant_Procedure_Body and Build_Invariant_Procedure_Declaration were made to handle the special case of interface types, and the replacement of parent to derived type for a type's current instance within the generated invariant procedure needed to be overhauled. Following this patch, external references within class-wide type invariants will function properly but there is no other user-facing change. AI12-0150-1: "For an invariant check on a value of type T1 based on a class-wide invariant expression inherited from an ancestor type T, any operations within the invariant expression that were resolved as primitive operations of the (notional) formal derived type NT, are in the evaluation of the invariant expression for the check on T1 bound to the corresponding operations of type T1." -- Source -- -- inv_aspects.ads with Parent_Reference; use Parent_Reference; package Inv_Aspects is -- Derivation without overriding -- type Par_1 is tagged private with Type_Invariant'Class => A (Par_1); -- own: A (Par_1) -- inheritable: A (Par_1) -- CHECKED: A (Par_1) function A (Obj : Par_1) return Boolean; type Deriv_1 is new Par_1 with private; -- inherited: A (Par_1) -- CHECKED: A (Par_1) -- Derivation with overriding -- type Par_2 is tagged private with Type_Invariant'Class => B (Par_2); -- own: B (Par_2) -- inheritable: B (Par_2) -- CHECKED: B (Par_2) function B (Obj : Par_2) return Boolean; type Deriv_2 is new Par_2 with private with Type_Invariant'Class => B (Deriv_2); -- inherited: B (Par_2) overridden by B (Deriv_2) -- CHECKED: B (Deriv_2) -- overriding function B (Obj : Deriv_2) return Boolean; -- Derivation with Inv overriding -- type Par_3 is tagged private with Type_Invariant'Class => C (Par_3); -- own: C (Par_3) -- inheritable: C (Par_3) -- CHECKED: C (Par_3) function C (Obj : Par_3) return Boolean; type Deriv_3 is new Par_3 with private with Type_Invariant'Class => D (Deriv_3); -- own: D (Deriv_3) -- inherited: C (Par_3) -- CHECKED: C (Par_3) -- D (Deriv_3) function D (Obj : Deriv_3) return Boolean; -- Derivation with overriding, Inv overriding -- type Par_4 is tagged private with Type_Invariant'Class => E (Par_4); -- own: E (Par_4) -- inheritable: E (Par_4) -- CHECKED: E (Par_4) function E (Obj : Par_4) return Boolean; type Deriv_4 is new Par_4 with private with Type_Invariant'Class => E (Deriv_4); -- own: E (Deriv_4) -- inherited: E (Par_4) overridden by E (Deriv_4) -- CHECKED: E (Deriv_4) x 2 (from derivation and component) overriding function E (Obj : Deriv_4) return Boolean; -- Derivation with partial overriding -- type Par_5 is tagged private with Type_Invariant'Class => F (Par_5) and G (Par_5); -- own: F (Par_5) -- G (Par_5) -- inheritable: F (Par_5) -- G (Par_5) function F (Obj : Par_5) return Boolean; function G (Obj : Par_5) return Boolean; type Deriv_5 is new Par_5 with private; -- inherited: F (Par_5) overridden by F (Deriv_5) -- G (Par_5) -- CHECKED: F (Deriv_5) -- G (Par_5) overriding function F (Obj : Deriv_5) return Boolean; --- -- Hidden derivation without overriding -- --- type Par_6 is tagged private with Type_Invariant'Class => H (Par_6); -- own: H (Par_6) -- inheritable: H (Par_6) -- CHECKED: H (Par_6) function H (Obj : Par_6) return Boolean; type Deriv_6 is tagged private; -- inherited: H (Par_6) -- CHECKED: H (Par_6) --- -- Hidden derivation with overriding -- --- type Par_7 is tagged private with Type_Invariant'Class => I (Par_7); -- own: I (Par_7) -- inheritable: I (Par_7) -- CHECKED: I (Par_7) function I (Obj : Par_7) return Boolean; type Deriv_7 is tagged private; -- inherited: I (Par_7) overridden by I (Deriv_7) -- CHECKED: I (Deriv_7) -
[Patch, testsuite] Fix failing attr-alloc_size-10.c for avr
Hi,
Integer promotion combined with equal sizes for short and int (16 bits)
causes overflow warnings when expanding the TEST macro for USHRT_MAX.
Fixed by explicitly disabling overflow warnings for targets with !int32plus.
Committed as obvious.
Regards
Senthil
gcc/testsuite/ChangeLog
2017-04-25 Senthil Kumar Selvaraj
* gcc.dg/attr-alloc_size-10.c: Ignore overflow warnings
for targets with int size less than 32 bits.
Index: gcc/testsuite/gcc.dg/attr-alloc_size-10.c
===
--- gcc/testsuite/gcc.dg/attr-alloc_size-10.c (revision 247191)
+++ gcc/testsuite/gcc.dg/attr-alloc_size-10.c (working copy)
@@ -4,7 +4,8 @@
range.
{ dg-do compile }
- { dg-options "-O2 -Walloc-size-larger-than=12" } */
+ { dg-options "-O2 -Walloc-size-larger-than=12" }
+ { dg-options "-Wno-overflow" { target { ! int32plus } } } */
#define SCHAR_MAX __SCHAR_MAX__
#define SCHAR_MIN (-SCHAR_MAX - 1)
Re: [AARCH64 ABI PATCH] Change AARCH64 ABI to match AAPCS, provide -Wpsabi notes (PR target/77728)
On 25/04/17 11:01, Jakub Jelinek wrote:
> Hi!
>
> Similarly to the previous patch, just hopefully triggers less often,
> because 128-bit alignment is more rare.
>
> Ok for trunk/7.1 if it passes testing?
>
> 2017-04-25 Ramana Radhakrishnan
> Jakub Jelinek
>
> PR target/77728
> * config/aarch64/aarch64.c (struct aarch64_fn_arg_alignment): New
> type.
> (aarch64_function_arg_alignment): Return aarch64_fn_arg_alignment
> struct. Ignore DECL_ALIGN of decls other than FIELD_DECL for
> the alignment computation, but return their maximum in warn_alignment.
> (aarch64_layout_arg): Adjust aarch64_function_arg_alignment caller.
> Emit a -Wpsabi note if warn_alignment is 16 bytes, but alignment
> is smaller.
> (aarch64_function_arg_boundary): Likewise. Simplify using MIN/MAX.
> (aarch64_gimplify_va_arg_expr): Adjust aarch64_function_arg_alignment
> caller.
> testsuite/
> * g++.dg/abi/pr77728-2.C: New test.
>
> --- gcc/config/aarch64/aarch64.c.jj 2017-04-24 19:28:02.518970890 +0200
> +++ gcc/config/aarch64/aarch64.c 2017-04-25 11:07:55.169532408 +0200
> @@ -2256,33 +2256,58 @@ aarch64_vfp_is_call_candidate (cumulativ
> NULL);
> }
>
> -/* Given MODE and TYPE of a function argument, return the alignment in
> +struct aarch64_fn_arg_alignment
> +{
> + /* Alignment for FIELD_DECLs in function arguments. */
> + unsigned int alignment;
> + /* Alignment for decls other than FIELD_DECLs in function arguments. */
> + unsigned int warn_alignment;
> +};
> +
> +/* Given MODE and TYPE of a function argument, return a pair of alignments in
> bits. The idea is to suppress any stronger alignment requested by
> the user and opt for the natural alignment (specified in AAPCS64 \S 4.1).
> This is a helper function for local use only. */
>
> -static unsigned int
> +static struct aarch64_fn_arg_alignment
> aarch64_function_arg_alignment (machine_mode mode, const_tree type)
> {
> + struct aarch64_fn_arg_alignment aa;
> + aa.alignment = 0;
> + aa.warn_alignment = 0;
> +
>if (!type)
> -return GET_MODE_ALIGNMENT (mode);
> +{
> + aa.alignment = GET_MODE_ALIGNMENT (mode);
> + return aa;
> +}
> +
>if (integer_zerop (TYPE_SIZE (type)))
> -return 0;
> +return aa;
>
>gcc_assert (TYPE_MODE (type) == mode);
>
>if (!AGGREGATE_TYPE_P (type))
> -return TYPE_ALIGN (TYPE_MAIN_VARIANT (type));
> +{
> + aa.alignment = TYPE_ALIGN (TYPE_MAIN_VARIANT (type));
> + return aa;
> +}
>
>if (TREE_CODE (type) == ARRAY_TYPE)
> -return TYPE_ALIGN (TREE_TYPE (type));
> -
> - unsigned int alignment = 0;
> +{
> + aa.alignment = TYPE_ALIGN (TREE_TYPE (type));
> + return aa;
> +}
>
>for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
> -alignment = std::max (alignment, DECL_ALIGN (field));
> +{
> + if (TREE_CODE (field) == FIELD_DECL)
> + aa.alignment = std::max (aa.alignment, DECL_ALIGN (field));
> + else
> + aa.warn_alignment = std::max (aa.warn_alignment, DECL_ALIGN (field));
> +}
>
> - return alignment;
> + return aa;
> }
>
> /* Layout a function argument according to the AAPCS64 rules. The rule
> @@ -2369,24 +2394,35 @@ aarch64_layout_arg (cumulative_args_t pc
> entirely general registers. */
>if (allocate_ncrn && (ncrn + nregs <= NUM_ARG_REGS))
> {
> - unsigned int alignment = aarch64_function_arg_alignment (mode, type);
>
>gcc_assert (nregs == 0 || nregs == 1 || nregs == 2);
>
>/* C.8 if the argument has an alignment of 16 then the NGRN is
> rounded up to the next even number. */
> - if (nregs == 2 && alignment == 16 * BITS_PER_UNIT && ncrn % 2)
> + if (nregs == 2 && ncrn % 2)
> {
> - ++ncrn;
> - gcc_assert (ncrn + nregs <= NUM_ARG_REGS);
> + struct aarch64_fn_arg_alignment aa
> + = aarch64_function_arg_alignment (mode, type);
> +
> + if (aa.warn_alignment == 16 * BITS_PER_UNIT
I was caught out (again) when reviewing this as to why the test was for
exactly 16 bytes and not >= 16. I'd forgotten that anything with higher
alignment would have a size larger than 16 and thus be passed by
reference to a copy. Could you please add a comment to that effect as
it's not obvious at this point.
OK with that change if testing passes.
> + && aa.alignment < aa.warn_alignment
> + && warn_psabi
> + && currently_expanding_gimple_stmt)
> + inform (input_location,
> + "parameter passing for argument of type %qT "
> + "changed in GCC 7.1", type);
> + else if (aa.alignment == 16 * BITS_PER_UNIT)
> + {
> + ++ncrn;
> + gcc_assert (ncrn + nregs <= NUM_ARG_REGS);
> + }
> }
> +
>/* NREGS can be 0 when e.g. an empty structur
Add LTO streaming support for sreal
Hi,
for inliner to use sreals we need to stream them into summaries. I added them
as member functions, becuase for streamer_write_sreal/streamer_read_sreal pair
we would need to access private variables. Does this seem sane?
Bootstrapped/regtested x86_64-linux, OK?
Honza
* sreal.c: Include backend.h, tree.h, gimple.h, cgraph.h and
data-streamer.h
(sreal::stream_out, sreal::stream_in): New.
* sreal.h (sreal::stream_out, sreal::stream_in): Declare.
Index: sreal.c
===
--- sreal.c (revision 246970)
+++ sreal.c (working copy)
@@ -53,6 +53,11 @@ along with GCC; see the file COPYING3.
#include "coretypes.h"
#include "sreal.h"
#include "selftest.h"
+#include "backend.h"
+#include "tree.h"
+#include "gimple.h"
+#include "cgraph.h"
+#include "data-streamer.h"
/* Print the content of struct sreal. */
@@ -236,6 +241,26 @@ sreal::operator/ (const sreal &other) co
return r;
}
+/* Stream sreal value to OB. */
+
+void
+sreal::stream_out (struct output_block *ob)
+{
+ streamer_write_hwi (ob, m_sig);
+ streamer_write_hwi (ob, m_exp);
+}
+
+/* Read sreal value from IB. */
+
+sreal
+sreal::stream_in (struct lto_input_block *ib)
+{
+ sreal val;
+ val.m_sig = streamer_read_hwi (ib);
+ val.m_exp = streamer_read_hwi (ib);
+ return val;
+}
+
#if CHECKING_P
namespace selftest {
Index: sreal.h
===
--- sreal.h (revision 246970)
+++ sreal.h (working copy)
@@ -34,6 +34,9 @@ along with GCC; see the file COPYING3.
#define SREAL_SIGN(v) (v < 0 ? -1: 1)
#define SREAL_ABS(v) (v < 0 ? -v: v)
+struct output_block;
+struct lto_input_block;
+
/* Structure for holding a simple real number. */
class sreal
{
@@ -50,6 +53,8 @@ public:
void dump (FILE *) const;
int64_t to_int () const;
double to_double () const;
+ void stream_out (struct output_block *);
+ static sreal stream_in (struct lto_input_block *);
sreal operator+ (const sreal &other) const;
sreal operator- (const sreal &other) const;
sreal operator* (const sreal &other) const;
Re: Add LTO streaming support for sreal
On Tue, 25 Apr 2017, Jan Hubicka wrote:
> Hi,
> for inliner to use sreals we need to stream them into summaries. I added them
> as member functions, becuase for streamer_write_sreal/streamer_read_sreal pair
> we would need to access private variables. Does this seem sane?
Bah - stupid C++ ;)
> Bootstrapped/regtested x86_64-linux, OK?
Ok.
Thanks,
Richard.
> Honza
>
> * sreal.c: Include backend.h, tree.h, gimple.h, cgraph.h and
> data-streamer.h
> (sreal::stream_out, sreal::stream_in): New.
> * sreal.h (sreal::stream_out, sreal::stream_in): Declare.
> Index: sreal.c
> ===
> --- sreal.c (revision 246970)
> +++ sreal.c (working copy)
> @@ -53,6 +53,11 @@ along with GCC; see the file COPYING3.
> #include "coretypes.h"
> #include "sreal.h"
> #include "selftest.h"
> +#include "backend.h"
> +#include "tree.h"
> +#include "gimple.h"
> +#include "cgraph.h"
> +#include "data-streamer.h"
>
> /* Print the content of struct sreal. */
>
> @@ -236,6 +241,26 @@ sreal::operator/ (const sreal &other) co
>return r;
> }
>
> +/* Stream sreal value to OB. */
> +
> +void
> +sreal::stream_out (struct output_block *ob)
> +{
> + streamer_write_hwi (ob, m_sig);
> + streamer_write_hwi (ob, m_exp);
> +}
> +
> +/* Read sreal value from IB. */
> +
> +sreal
> +sreal::stream_in (struct lto_input_block *ib)
> +{
> + sreal val;
> + val.m_sig = streamer_read_hwi (ib);
> + val.m_exp = streamer_read_hwi (ib);
> + return val;
> +}
> +
> #if CHECKING_P
>
> namespace selftest {
> Index: sreal.h
> ===
> --- sreal.h (revision 246970)
> +++ sreal.h (working copy)
> @@ -34,6 +34,9 @@ along with GCC; see the file COPYING3.
> #define SREAL_SIGN(v) (v < 0 ? -1: 1)
> #define SREAL_ABS(v) (v < 0 ? -v: v)
>
> +struct output_block;
> +struct lto_input_block;
> +
> /* Structure for holding a simple real number. */
> class sreal
> {
> @@ -50,6 +53,8 @@ public:
>void dump (FILE *) const;
>int64_t to_int () const;
>double to_double () const;
> + void stream_out (struct output_block *);
> + static sreal stream_in (struct lto_input_block *);
>sreal operator+ (const sreal &other) const;
>sreal operator- (const sreal &other) const;
>sreal operator* (const sreal &other) const;
>
>
--
Richard Biener
SUSE LINUX GmbH, GF: Felix Imendoerffer, Jane Smithard, Graham Norton, HRB
21284 (AG Nuernberg)
[C++] testsuite tweak
The G++ testsuite's main dg.exp file does a recursive glob for .C files
and then prunes out those in directories known to contain their own .exp
file. This is dumb.
This patch adds a recursive directory walker that stops when it
encounters a .exp file. In addition to not having to specify the same
thing twice, it keeps things nicely collated, (tcl's prune function can
scramble ordering).
committed to trunk.
nathan
--
Nathan Sidwell
2017-04-25 Nathan Sidwell
* g++.dg/dg.exp (find-cxx-tests): New function.
(main): Use it, remove explicit pruning
Index: testsuite/g++.dg/dg.exp
===
--- testsuite/g++.dg/dg.exp (revision 247214)
+++ testsuite/g++.dg/dg.exp (working copy)
@@ -29,35 +29,19 @@ if ![info exists DEFAULT_CXXFLAGS] then
# Initialize `dg'.
dg-init
-# Gather a list of all tests, with the exception of those in directories
-# that are handled specially.
-set tests [lsort [find $srcdir/$subdir *.C]]
-set tests [prune $tests $srcdir/$subdir/bprob/*]
-set tests [prune $tests $srcdir/$subdir/charset/*]
-set tests [prune $tests $srcdir/$subdir/cilk-plus/AN/*]
-set tests [prune $tests $srcdir/$subdir/compat/*]
-set tests [prune $tests $srcdir/$subdir/debug/*]
-set tests [prune $tests $srcdir/$subdir/dfp/*]
-set tests [prune $tests $srcdir/$subdir/gcov/*]
-set tests [prune $tests $srcdir/$subdir/lto/*]
-set tests [prune $tests $srcdir/$subdir/pch/*]
-set tests [prune $tests $srcdir/$subdir/plugin/*]
-set tests [prune $tests $srcdir/$subdir/special/*]
-set tests [prune $tests $srcdir/$subdir/tls/*]
-set tests [prune $tests $srcdir/$subdir/vect/*]
-set tests [prune $tests $srcdir/$subdir/goacc/*]
-set tests [prune $tests $srcdir/$subdir/goacc-gomp/*]
-set tests [prune $tests $srcdir/$subdir/gomp/*]
-set tests [prune $tests $srcdir/$subdir/tree-prof/*]
-set tests [prune $tests $srcdir/$subdir/torture/*]
-set tests [prune $tests $srcdir/$subdir/graphite/*]
-set tests [prune $tests $srcdir/$subdir/tm/*]
-set tests [prune $tests $srcdir/$subdir/cilk-plus/*]
-set tests [prune $tests $srcdir/$subdir/guality/*]
-set tests [prune $tests $srcdir/$subdir/simulate-thread/*]
-set tests [prune $tests $srcdir/$subdir/asan/*]
-set tests [prune $tests $srcdir/$subdir/ubsan/*]
-set tests [prune $tests $srcdir/$subdir/tsan/*]
+# Recursively find files in $dir and subdirs, do not walk into subdirs
+# that contain their own .exp file.
+proc find-cxx-tests { dir suffix } {
+set tests [lsort [glob -nocomplain -directory $dir "*.$suffix" ]]
+foreach subdir [lsort [glob -nocomplain -type d -directory $dir *]] {
+ if { [glob -nocomplain -directory $subdir *.exp] eq "" } {
+ lappend tests {*}[find-cxx-tests $subdir $suffix]
+ }
+}
+return $tests
+}
+
+set tests [find-cxx-tests $srcdir/$subdir {C}]
# Main loop.
g++-dg-runtest $tests "" $DEFAULT_CXXFLAGS
Re: std::vector move assign patch
On 24/04/17 22:10 +0200, Marc Glisse wrote:
It seems that this patch had 2 consequences that may or may not have
been planned. Consider this example (from PR64601)
#include
typedef std::vector V;
void f(V&v,V&w){ V(std::move(w)).swap(v); }
void g(V&v,V&w){ v=std::move(w); }
1) We generate shorter code for f than for g, probably since the fix
for PR59738. g ends up zeroing v, copying w to v, and finally zeroing
w, and for weird reasons (and because we swap the members one by one)
the standard prevents us from assuming that v and w do not overlap in
weird ways so we cannot optimize as much as one might expect.
f has an additional precondition (that the allocators of the vectors
being swapped must propagate on swap or be equal) and so the swap code
doesn't have to worry about non-equal allocators.
g has to be able to cope with the case where the allocator doesn't
propagate and isn't equal, and so is more complicated.
However, the propagation trait is known at compile-time, and for the
common case so is the equality condition, so it's unfortunate if that
can't be simplified (I'm sure you've analysed it carefully already
though!)
2) g(v,v) seems to turn v into a nice empty vector,
Yes.
while f(v,v) turns
it into an invalid vector pointing at released memory.
Does it?! I don't see that happening, and it's a bug if it does.
Since 2) is a nice side-effect, it may not be worth rewriting
operator= in a way that improves 1) but loses 2). Anyway, just
mentioning this here.
Re: [AARCH64 ABI PATCH] Change AARCH64 ABI to match AAPCS, provide -Wpsabi notes (PR target/77728)
On Tue, Apr 25, 2017 at 01:29:06PM +0100, Richard Earnshaw (lists) wrote:
> >/* C.8 if the argument has an alignment of 16 then the NGRN is
> > rounded up to the next even number. */
> > - if (nregs == 2 && alignment == 16 * BITS_PER_UNIT && ncrn % 2)
> > + if (nregs == 2 && ncrn % 2)
> > {
> > - ++ncrn;
> > - gcc_assert (ncrn + nregs <= NUM_ARG_REGS);
> > + struct aarch64_fn_arg_alignment aa
> > + = aarch64_function_arg_alignment (mode, type);
> > +
> > + if (aa.warn_alignment == 16 * BITS_PER_UNIT
>
> I was caught out (again) when reviewing this as to why the test was for
> exactly 16 bytes and not >= 16. I'd forgotten that anything with higher
> alignment would have a size larger than 16 and thus be passed by
I admit I didn't know why it has been written that way, I was just trying
to write something that would do the same as before if ignoring the
non-FIELD_DECL alignments and warn for the cases that changed ABI;
as there was originally alignment == 16 * BITS_PER_UNIT, I kept using that.
For structs/classes indeed I think alignment of any fields > 16
bytes implies struct size of > 16. The ARRAY_TYPE case is for some
languages I'm not familiar with, in C/C++/Fortran that doesn't happen, so I
can't guess what those languages can do. And otherwise it uses mode
alignment or alignment of main variant of scalar/vector/complex types and
I believe those should never be over-aligned.
> reference to a copy. Could you please add a comment to that effect as
> it's not obvious at this point.
Ok.
Jakub
Convert inliner's time to sreal
Hi,
this patch convers time in ipa-inline-analysis to sreals and removes the
ugly capping code. It is done in fully mechanical way --- sanitizing the code
to take advantage of sreals is comming as a followup.
Bootsrapped/regtested x86_64-linux, plan to commit it after the sreal streaming
is in.
Honza
* ipa-cp.c (estimate_local_effects): Convert sreal to int.
* ipa-inline-analysis.c (MAX_TIME): Remove.
(account_size_time): Use sreal for time.
(dump_inline_summary): Update.
(estimate_function_body_sizes): Update.
(estimate_edge_size_and_time): Update.
(estimate_calls_size_and_time): Update.
(estimate_node_size_and_time): Update.
(inline_merge_summary): Update.
(inline_update_overall_summary): Update.
(estimate_time_after_inlining): Update.
(inline_read_section): Update.
(inline_write_summary): Update.
* ipa-inline.c (compute_uninlined_call_time): Update.
(compute_inlined_call_time): Update.
(recursive_inlining): Update.
(inline_small_functions): Update.
(dump_overall_stats): Update.
* ipa-inline.h: Include sreal.h.
(size_time_entry): Turn time to sreal.
(inline_summary): Turn self_time nad time to sreal.
Index: ipa-cp.c
===
--- ipa-cp.c(revision 246970)
+++ ipa-cp.c(working copy)
@@ -2832,7 +2832,7 @@ estimate_local_effects (struct cgraph_no
vec known_aggs;
vec known_aggs_ptrs;
bool always_const;
- int base_time = inline_summaries->get (node)->time;
+ int base_time = inline_summaries->get (node)->time.to_int ();
int removable_params_cost;
if (!count || !ipcp_versionable_function_p (node))
Index: ipa-inline-analysis.c
===
--- ipa-inline-analysis.c (revision 246970)
+++ ipa-inline-analysis.c (working copy)
@@ -96,11 +96,6 @@ along with GCC; see the file COPYING3.
#include "cfgexpand.h"
#include "gimplify.h"
-/* Estimate runtime of function can easilly run into huge numbers with many
- nested loops. Be sure we can compute time * INLINE_SIZE_SCALE * 2 in an
- integer. For anything larger we use gcov_type. */
-#define MAX_TIME 50
-
/* Number of bits in integer, but we really want to be stable across different
hosts. */
#define NUM_CONDITIONS 32
@@ -668,7 +663,7 @@ dump_inline_hints (FILE *f, inline_hints
/* Record SIZE and TIME under condition PRED into the inline summary. */
static void
-account_size_time (struct inline_summary *summary, int size, int time,
+account_size_time (struct inline_summary *summary, int size, sreal time,
struct predicate *pred)
{
size_time_entry *e;
@@ -680,12 +675,9 @@ account_size_time (struct inline_summary
/* We need to create initial empty unconitional clause, but otherwie
we don't need to account empty times and sizes. */
- if (!size && !time && summary->entry)
+ if (!size && time == 0 && summary->entry)
return;
- /* Watch overflow that might result from insane profiles. */
- if (time > MAX_TIME * INLINE_TIME_SCALE)
-time = MAX_TIME * INLINE_TIME_SCALE;
gcc_assert (time >= 0);
for (i = 0; vec_safe_iterate (summary->entry, i, &e); i++)
@@ -705,12 +697,12 @@ account_size_time (struct inline_summary
"\t\tReached limit on number of entries, "
"ignoring the predicate.");
}
- if (dump_file && (dump_flags & TDF_DETAILS) && (time || size))
+ if (dump_file && (dump_flags & TDF_DETAILS) && (time != 0 || size))
{
fprintf (dump_file,
"\t\tAccounting size:%3.2f, time:%3.2f on %spredicate:",
((double) size) / INLINE_SIZE_SCALE,
- ((double) time) / INLINE_TIME_SCALE, found ? "" : "new ");
+ (time.to_double ()) / INLINE_TIME_SCALE, found ? "" : "new ");
dump_predicate (dump_file, summary->conds, pred);
}
if (!found)
@@ -725,8 +717,6 @@ account_size_time (struct inline_summary
{
e->size += size;
e->time += time;
- if (e->time > MAX_TIME * INLINE_TIME_SCALE)
- e->time = MAX_TIME * INLINE_TIME_SCALE;
}
}
@@ -1048,7 +1038,8 @@ reset_inline_summary (struct cgraph_node
{
struct cgraph_edge *e;
- info->self_size = info->self_time = 0;
+ info->self_size = 0;
+ info->self_time = 0;
info->estimated_stack_size = 0;
info->estimated_self_stack_size = 0;
info->stack_frame_offset = 0;
@@ -1434,8 +1425,8 @@ dump_inline_summary (FILE *f, struct cgr
fprintf (f, " contains_cilk_spawn");
if (s->fp_expressions)
fprintf (f, " fp_expression");
- fprintf (f, "\n self time: %i\n", s->self_time);
- fprintf (f, " global time: %i\n", s->time);
+ fprintf (f, "\n self time: %f\n", s->self_time.to_double ());
+ fprintf (f, " global time: %f\n", s->time.to_double ());
[Ada] Better diagnostics for illegal expression functions as completions.
This patch provides a better error message on expression functions that are
completions, when the expression has a reference to a type that cannot be
frozen yet.
Compiling try.ads must yield:
try.ads:10:49: premature usage of incomplete type "T2" defined at line 3
try.ads:10:49: type "T2" has private component
---
package try is
type T1 is private;
type T2 is record
Value : Integer;
Who_Knows : T1;
end record;
function Value (X : T2) return Integer;
Maybe : Boolean := True;
function Value (X : T2) return Integer is (X.Value);
private
type T1 is new Integer;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_ch6.adb (Analyze_Expression_Function): If expression function
is completion and return type is an access type do not freeze
designated type: this will be done in the process of freezing
the expression if needed.
(Freeze_Expr_Types): Check whether type is complete before
creating freeze node, to provide a better error message if
reference is premature.
* sem_ch13.adb (Check_Indexing_Functions): Ignore inherited
functions created by type derivations.
Index: sem_ch6.adb
===
--- sem_ch6.adb (revision 247212)
+++ sem_ch6.adb (working copy)
@@ -403,10 +403,6 @@
end if;
end if;
- if Is_Access_Type (Etype (Prev)) then
-Freeze_Before (N, Designated_Type (Etype (Prev)));
- end if;
-
-- For navigation purposes, indicate that the function is a body
Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True);
@@ -3089,7 +3085,27 @@
elsif Ekind_In (Entity (Node), E_Component,
E_Discriminant)
then
- Freeze_Before (N, Scope (Entity (Node)));
+ declare
+ Rec : constant Entity_Id := Scope (Entity (Node));
+ begin
+
+ -- Check that the enclosing record type can be frozen.
+ -- This provides a better error message than generating
+ -- primitives whose compilation fails much later.
+ -- Refine the error message if possible.
+
+ Check_Fully_Declared (Rec, Node);
+
+ if Error_Posted (Node) then
+if Has_Private_Component (Rec) then
+ Error_Msg_NE ("\type& has private component",
+ Node, Rec);
+end if;
+
+ else
+Freeze_Before (N, Rec);
+ end if;
+ end;
end if;
end if;
Index: sem_ch13.adb
===
--- sem_ch13.adb(revision 247216)
+++ sem_ch13.adb(working copy)
@@ -4374,7 +4374,15 @@
-- subprogram itself.
if Is_Overloadable (It.Nam) then
- Check_One_Function (It.Nam);
+
+ -- Ignore homonyms that may come from derived types
+ -- in the context.
+
+ if not Comes_From_Source (It.Nam) then
+null;
+ else
+Check_One_Function (It.Nam);
+ end if;
end if;
Get_Next_Interp (I, It);
[Ada] Crash processing comparison of composite objects
Comparisons of composite objects may be internally transformed by the frontend into a special kind of node that facilitates their internal management. If processing the comparison causes the internal declaration of a subtype declaration associated with some sub-expression, the backend may crash when generating the code. After this patch the following test compiles fine. package Q is type Rec (D : Positive) is record S : String (1 .. D); end record; type Field_T is (One); type Mask_T is array (Field_T) of Boolean; function F return Rec; end Q; with Q; use Q; procedure P (A : Rec) is M : Mask_T; use type Rec; begin M := (One => A /= F); end; Command: gcc -c p.adb Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Javier Miranda * sem_util.adb (New_Copy_Tree.Visit_Entity): Extend previous change to generate new entities for subtype declarations located in Expression_With_Action nodes. Index: sem_util.adb === --- sem_util.adb(revision 247212) +++ sem_util.adb(working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -17120,10 +17120,12 @@ pragma Assert (not Is_Itype (Old_Entity)); pragma Assert (Nkind (Old_Entity) in N_Entity); - -- Restrict entity creation to variable declarations. There is no - -- need to create variables declared in inner scopes. + -- Restrict entity creation to declarations of constants, variables + -- and subtypes. There is no need to duplicate entities declared in + -- inner scopes. - if not Ekind_In (Old_Entity, E_Constant, E_Variable) + if (not Ekind_In (Old_Entity, E_Constant, E_Variable) + and then Nkind (Parent (Old_Entity)) /= N_Subtype_Declaration) or else EWA_Inner_Scope_Level > 0 then return;
[Ada] Missing predicate functions for private types.
This patch fixes an omission in the generation of predicate functions for
private types whose full view derives from a subtype with predicates.
Executing the following:
gnatmake -gnata -q predicate_check
predicate_check
must yield;
OK derived subtype
OK original subtype
---
with Text_IO; use Text_IO;
with Ada.Assertions; use Ada.Assertions;
procedure Predicate_Check with SPARK_Mode is
type R is -- new Integer;
record
F : Integer := 42;
end record;
package Nested is
subtype S is R with Predicate => S.F = 42;
-- subtype S is R with Predicate => S = 42;
procedure P (X : in out S) is null;
type T is private;
procedure P (X : in out T);
private
type T is new S;
end Nested;
package body Nested is
procedure P (X : in out T) is
begin
X.F := X.F * 7;
end;
end Nested;
X : Nested.T;
Y : Nested.S;
begin
Y.F := Y.F * 3;
begin
Nested.P (X);
Put_Line ("should not be here");
exception
when Assertion_Error => Put_Line ("OK derived subtype");
end;
begin
Nested.P (Y);
Put_Line ("should not be here");
exception
when Assertion_Error => Put_Line ("OK original subtype");
end;
end Predicate_Check;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Ed Schonberg
* sem_aux.adb (Nearest_Ancestor): Use original node of type
declaration to locate nearest ancestor, because derived
type declarations for record types are rewritten as record
declarations.
* sem_ch13.adb (Add_Call): Use an unchecked conversion to handle
properly derivations that are completions of private types.
(Add_Predicates): If type is private, examine rep. items of full
view, which may include inherited predicates.
(Build_Predicate_Functions): Ditto.
Index: sem_aux.adb
===
--- sem_aux.adb (revision 247177)
+++ sem_aux.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, 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- --
@@ -1295,7 +1295,10 @@
--
function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id is
- D : constant Node_Id := Declaration_Node (Typ);
+ D : constant Node_Id := Original_Node (Declaration_Node (Typ));
+ -- We use the original node of the declaration, because derived
+ -- types from record subtypes are rewritten as record declarations,
+ -- and it is the original declaration that carries the ancestor.
begin
-- If we have a subtype declaration, get the ancestor subtype
Index: sem_ch13.adb
===
--- sem_ch13.adb(revision 247218)
+++ sem_ch13.adb(working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, 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- --
@@ -8309,11 +8309,15 @@
if Present (T) and then Present (Predicate_Function (T)) then
Set_Has_Predicates (Typ);
--- Build the call to the predicate function of T
+-- Build the call to the predicate function of T. The type may be
+-- derived, so use an unchecked conversion for the actual.
Exp :=
Make_Predicate_Call
-(T, Convert_To (T, Make_Identifier (Loc, Object_Name)));
+(Typ => T,
+ Expr =>
+ Unchecked_Convert_To (T,
+ Make_Identifier (Loc, Object_Name)));
-- "and"-in the call to evolving expression
@@ -8456,6 +8460,14 @@
begin
Ritem := First_Rep_Item (Typ);
+
+ -- If the type is private, check whether full view has inherited
+ -- predicates.
+
+ if Is_Private_Type (Typ) and t
[Ada] Compiler abort on nested instantions with pragma Ignore_Pragma.
This patch fixes a crash in a compilation involving nested generics when a generic subprogram carries an Inline_Always pragma, and a configuration file has a corresponding pragma Ignore_Pragma (Inline_Always). No small example available. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg * sem_ch12.adb (Load_Parent_Of_Generic); When retrieving the declaration of a subprogram instance within its wrapper package, skip over null statements that may result from the rewriting of ignored pragmas. Index: sem_ch12.adb === --- sem_ch12.adb(revision 247182) +++ sem_ch12.adb(working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -13217,8 +13217,8 @@ -- package, in which case the usual generic rule applies. declare - Exp_Status : Boolean := True; - Scop : Entity_Id; + Exp_Status : Boolean := True; + Scop : Entity_Id; begin -- Loop through scopes looking for generic package @@ -13292,8 +13292,7 @@ -- Package instance - if - Nkind (Node (Decl)) = N_Package_Instantiation + if Nkind (Node (Decl)) = N_Package_Instantiation then Instantiate_Package_Body (Info, Body_Optional => True); @@ -13308,8 +13307,9 @@ -- these result in the corresponding pragmas, -- inserted after the subprogram declaration. -- They must be skipped as well when retrieving - -- the desired spec. A direct link would be - -- more robust ??? + -- the desired spec. Some of them may have been + -- rewritten as null statements. + -- A direct link would be more robust ??? declare Decl : Node_Id := @@ -13317,7 +13317,9 @@ (Specification (Info.Act_Decl; begin while Nkind_In (Decl, - N_Subprogram_Renaming_Declaration, N_Pragma) + N_Null_Statement, + N_Pragma, + N_Subprogram_Renaming_Declaration) loop Decl := Prev (Decl); end loop;
[Ada] Compiler abort on components that are unchecked unions.
This patch fixes two errors in the handling of unchecked unions used as record components, in cases where such a use a potentially erroneous. The following must ocmpile quietly: gcc -c objects-base.adb --- package body Objects.Base is procedure setClass (self: in out SObject'Class; class : PtrClass) is begin self.class := class; end setClass; function getClass(self: in out SObject'Class) return PtrClass is begin return self.class; end getClass; function getSize(self: in out SObject'Class) return Integer is begin return getSize(self.size); end getSize; function isBinary (self: in out SObject'Class) return Boolean is begin return isBinary(self.size); end isBinary; function isRelocated (self: in out SObject'Class) return Boolean is begin return isRelocated(self.size); end isRelocated; procedure setField (self: in out SObject'Class; index: Positive; obj : PtrObject) is begin if index > self.fields'Last then null; else self.fields(index) := obj; end if; end setField; function getField (self: in out SObject'Class; index: Positive) return PtrObject is begin if index > self.fields'Last then raise Program_Error with "SObject:getField: field index is too high"; return self.fields(self.fields'Last); else return self.fields(index); end if; end getField; function getName (self: in out SDataObject) return String is begin raise Program_Error with "Abstract class SDataObject:getName"; return getName (self); end getName; function getName (self: in out SCharObject) return String is begin return "Char"; end getName; function getName (self: in out SFloatObject) return String is begin return "Float"; end getName; function getName (self: in out SLongIntObject) return String is begin return "LongInt"; end getName; function getName (self: in out SRawObject) return String is begin return "RawData"; end getName; function getName (self: in out SSymbolObject) return String is begin return "Symbol"; end getName; function getName (self: in out SMethod) return String is begin return "Method"; end getName; function getName (self: in out SContext) return String is begin return "Contex"; end getName; function getName (self: in out SBlock) return String is begin return "Block"; end getName; function getName (self: in out SDictionary) return String is begin return "Dict"; end getName; function getName (self: in out SClass) return String is begin return "Class"; end getName; function getName (self: in out SNode) return String is begin return "Node"; end getName; function getName (self: in out SProcess) return String is begin return "Process"; end getName; procedure setByte (self: in out SRawObject; index: Positive; value : Unsigned_8) is begin if index > self.data'Last then raise Program_Error with "SRawObject:setByte: index is too high"; else self.data(index) := value; end if; end setByte; function getByte (self: in out SRawObject; index: Positive) return Unsigned_8 is begin if index > self.data'Last then raise Program_Error with "SRawObject:getByte: index is too high"; else return self.data(index); end if; end getByte; function getAccessToBytes (self: in out SRawObject) return pArrayOfByte is begin return self.data; end getAccessToBytes; end Objects.Base; --- with Objects.Stack; use Objects.Stack; package Objects.Base is type SObject; type SClass; subtype PtrClass is PMClass; type SObject is new SMObject with record fields : pArrayOfObject; end record ; -- for SObject'Alignment use 8; --- SObject methods procedure setClass(self: in out SObject'Class; class : PtrClass); function getClass(self: in out SObject'Class) return PtrClass; function getSize(self: in out SObject'Class) return Integer; function isBinary(self: in out SObject'Class) return Boolean; function isRelocated(self: in out SObject'Class) return Boolean; procedure setField(self: in out SObject'Class; index: Positive; obj : PtrObject); function getField(self: in out SObject'Class; index: Positive) return PtrObject; type SDataObject is new SMObject with null record; function getName(self: in out SDataObject) return String; type PtrSDataObject is access all SDataObject'Class; type SCharObject is new SDataObject with record char : Wide_Character; end record; function getName(self: in out S
[Ada] Add GNAT_Ravenscar_EDF profile
This is an experimental profile to test EDF scheduling on bareboard platforms. No test as no runtime yet. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Tristan Gingold * exp_ch9.adb (Expand_N_Task_Type_Declaration): Add relative_deadline to task record on edf profile. (Make_Initialize_Protection): Pass deadline_floor value on edf profile. (Make_Task_Create_Call): Pass relative_deadline value. * par-prag.adb (Prag): Handle Pragma_Deadline_Floor. * s-rident.ads (Profile_Name): Add GNAT_Ravenscar_EDF. (Profile_Info): Add info for GNAT_Ravenscar_EDF. * sem_prag.adb (Set_Ravenscar_Profile): Handle GNAT_Ravenscar_EDF (set scheduling policy). (Analyze_Pragma): Handle GNAT_Ravenscar_EDF profile and Deadline_Floor pragma. (Sig_Flags): Add choice for Pragma_Deadline_Floor. * snames.ads-tmpl (Name_Deadline_Floor, Name_Gnat_Ravenscar_EDF): New names. (Pragma_Deadline_Floor): New pragma. * targparm.adb (Get_Target_Parameters): Recognize GNAT_Ravenscar_EDF profile. Index: exp_ch9.adb === --- exp_ch9.adb (revision 247177) +++ exp_ch9.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -12026,9 +12026,11 @@ -- Add the _Relative_Deadline component if a Relative_Deadline pragma is -- present. If we are using a restricted run time this component will - -- not be added (deadlines are not allowed by the Ravenscar profile). + -- not be added (deadlines are not allowed by the Ravenscar profile), + -- unless the task dispatching policy is EDF (for GNAT_Ravenscar_EDF + -- profile). - if not Restricted_Profile + if (not Restricted_Profile or else Task_Dispatching_Policy = 'E') and then Present (Taskdef) and then Has_Relative_Deadline_Pragma (Taskdef) then @@ -13822,6 +13824,46 @@ New_Occurrence_Of (RTE (RE_Unspecified_Priority), Loc)); end if; + -- Deadline_Floor parameter for GNAT_Ravenscar_EDF runtimes + + if Restricted_Profile and Task_Dispatching_Policy = 'E' then +Deadline_Floor : declare + Item : constant Node_Id := +Get_Rep_Item + (Ptyp, Name_Deadline_Floor, Check_Parents => False); + + Deadline : Node_Id; + +begin + if Present (Item) then + + -- Pragma Deadline_Floor + + if Nkind (Item) = N_Pragma then + Deadline := + Expression + (First (Pragma_Argument_Associations (Item))); + + -- Attribute definition clause Deadline_Floor + + else + pragma Assert + (Nkind (Item) = N_Attribute_Definition_Clause); + + Deadline := Expression (Item); + end if; + + Append_To (Args, Deadline); + + -- Unusual case: default deadline + + else + Append_To (Args, +New_Occurrence_Of (RTE (RE_Time_Span_Zero), Loc)); + end if; +end Deadline_Floor; + end if; + -- Test for Compiler_Info parameter. This parameter allows entry body -- procedures and barrier functions to be called from the runtime. It -- is a pointer to the record generated by the compiler to represent @@ -14127,15 +14169,18 @@ -- Priority parameter. Set to Unspecified_Priority unless there is a -- Priority rep item, in which case we take the value from the rep item. + -- Not used on Ravenscar_EDF profile. - if Has_Rep_Item (Ttyp, Name_Priority, Check_Parents => False) then - Append_To (Args, - Make_Selected_Component (Loc, - Prefix=> Make_Identifier (Loc, Name_uInit), - Selector_Name => Make_Identifier (Loc, Name_uPriority))); - else - Append_To (Args, - New_Occurrence_Of (RTE (RE_Unspecified_Priority), Loc)); + if not (Restricted_Profile and then Task_Dispatching_Policy = 'E') then + if Has_Rep_Item (Ttyp, Name_Priority, Check_Parents => Fal
