This is a regression present on mainline and 4.7 branch. The error message is:
p.adb: In function 'P.Proc':
p.adb:3:4: error: non-trivial conversion at assignment
system__address
void (*<T590>) (void)
r.callback.callback.address = q__proc;
+===========================GNAT BUG DETECTED==============================+
| 4.8.0 20120716 (experimental) [trunk revision 189525] (x86_64-suse-linux) GCC
error:|
| verify_gimple failed |
| Error detected around p.adb:3:4
We lose a cast in an initializer before gimplification, hence type mismatch.
This happens as follows: a CONSTRUCTOR used as the initializer of a global
constant and whose only value contains the cast is embedded (shared) in a
CONSTRUCTOR used as the initializer of a second global constant, which is in
turn embedded (shared) in a CONSTRUCTOR used as the initializer of a local
variable.
The sharing is fine, since we have an unsharing pass running right before
gimplification. The problem is that, since:
r171903 | matz | 2011-04-03 13:13:09 +0200 (Sun, 03 Apr 2011) | 7 lines
* cgraphbuild.c (record_reference): Canonicalize constructor
values.
* gimple-fold.c (canonicalize_constructor_val): Accept being called
without function context.
* cgraphunit.c (cgraph_finalize_compilation_unit): Clear
current_function_decl and cfun.
record_reference can modify the contents of CONSTRUCTORs _before_ the unsharing
pass is run and yield invalid GENERIC and later invalid GIMPLE.
Tested on x86_64-suse-linux, OK for the mainline and 4.7 branch?
2012-07-18 Eric Botcazou <ebotca...@adacore.com>
* gimple-fold.c (canonicalize_constructor_val): Strip only useless type
conversions.
2012-07-18 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/aggr20.ad[sb]: New test.
* gnat.dg/aggr20_pkg.ads: New helper.
--
Eric Botcazou
Index: gimple-fold.c
===================================================================
--- gimple-fold.c (revision 189525)
+++ gimple-fold.c (working copy)
@@ -139,7 +139,7 @@ can_refer_decl_in_current_unit_p (tree d
tree
canonicalize_constructor_val (tree cval, tree from_decl)
{
- STRIP_NOPS (cval);
+ STRIP_USELESS_TYPE_CONVERSION (cval);
if (TREE_CODE (cval) == POINTER_PLUS_EXPR
&& TREE_CODE (TREE_OPERAND (cval, 1)) == INTEGER_CST)
{
-- { dg-do compile }
package body Aggr20 is
procedure Proc (R : out Rec3) is
begin
R := (Callback => Nil_Rec2);
end;
end Aggr20;
with Aggr20_Pkg; use Aggr20_Pkg;
with System;
package Aggr20 is
type Rec1 is record
Address : System.Address;
end record;
Nil_Rec1 : constant Rec1 := (Address => Default_Nil_Address);
type Rec2 is record
Callback : Rec1;
end record;
Nil_Rec2 : constant Rec2 := (Callback => Nil_Rec1);
type Rec3 is record
Callback : Rec2;
end record;
procedure Proc (R : out Rec3);
end Aggr20;
with System;
package Aggr20_Pkg is
procedure Proc;
Default_Nil_Address : constant System.Address := Proc'Address;
end Aggr20_Pkg;
