[PATCH] Fix LTO type mismatch warning on transparent union

[Eric Botcazou]

Hi,

Ada doesn't have an equivalent to transparent union types in GNU C so, when it 
needs to interface a C function that takes a parameter of a transparent union 
type, GNAT uses the type of the first member of the union on the Ada side 
(which is the type used to determine the passing mechanism of the parameter).  
This works fine, except that LTO may warn about it; for the attached testcase:

.> gcc -c t.c -O2 -flto -D_GNU_SOURCE
.> gnatmake -q p -O2 -flto -largs t.o

q.ads:6:12: warning: type of 'q__c_getpeername' does not match original 
declaration [-Wlto-type-mismatch]
    6 |   function C_Getpeername
      |            ^
/usr/include/sys/socket.h:130:12: note: type mismatch in parameter 2
  130 | extern int getpeername (int __fd, __SOCKADDR_ARG __addr,
      |            ^
/usr/include/sys/socket.h:130:12: note: 'getpeername' was previously declared 
here
/usr/include/sys/socket.h:130:12: note: code may be misoptimized unless '-fno-
strict-aliasing' is used


The attached patch recognizes the situation and checks the compatibility with 
the type of the first member of the union in this case.

Tested on x86-64/Linux, OK for the mainline?


2024-05-29  Eric Botcazou  <ebotca...@adacore.com>

        * lto/lto-symtab.cc (warn_type_compatibility_p): Deal with
        parameters whose type is a transparent union specially.

-- 
Eric Botcazou
diff --git a/gcc/lto/lto-symtab.cc b/gcc/lto/lto-symtab.cc
index a40218beac5..ca5a79610bb 100644
--- a/gcc/lto/lto-symtab.cc
+++ b/gcc/lto/lto-symtab.cc
@@ -233,8 +233,20 @@ warn_type_compatibility_p (tree prevailing_type, tree type,
 	       parm1 && parm2;
 	       parm1 = TREE_CHAIN (parm1),
 	       parm2 = TREE_CHAIN (parm2))
-	    lev |= warn_type_compatibility_p (TREE_VALUE (parm1),
-					      TREE_VALUE (parm2), false);
+	    /* If a function with a transparent union parameter is interfaced
+	       with another type, check that the latter is compatible with the
+	       type of the first field of the union, which is the type used to
+	       set the calling convention for the argument.  */
+	    if (TREE_CODE (TREE_VALUE (parm1)) == UNION_TYPE
+		&& TYPE_TRANSPARENT_AGGR (TREE_VALUE (parm1))
+		&& TREE_CODE (TREE_VALUE (parm2)) != UNION_TYPE
+		&& common_or_extern)
+	      lev |= warn_type_compatibility_p
+		       (TREE_TYPE (TYPE_FIELDS (TREE_VALUE (parm1))),
+			TREE_VALUE (parm2), false);
+	    else
+	      lev |= warn_type_compatibility_p (TREE_VALUE (parm1),
+						TREE_VALUE (parm2), false);
 	  if (parm1 || parm2)
 	    lev |= odr_p ? 3 : 1;
 	}

with Interfaces.C; use Interfaces.C;
with System;

with Q; use Q;

procedure P is
  L : aliased unsigned;
  I : int := C_Getpeername (0, System.Null_Address, L'Access);

begin
  null;
end;

with Interfaces.C;
with System;

package Q is

  function C_Getpeername
  (S       : Interfaces.C.int;
   Name    : System.Address;
   Namelen : not null access Interfaces.C.unsigned) return Interfaces.C.int;
  pragma Import (C, C_Getpeername, "getpeername");

  procedure Foo;
  pragma Import (C, Foo, "foo");

end Q;

#include <sys/socket.h>
#include <stddef.h>

void foo (void)
{
  int i = getpeername (0, NULL, NULL);
}