d: Return promoted types in d_type_promotes_to when linkage is not D

This enables warnings to be shown when a bad type is passed to va_arg
inside an extern(C) or extern(C++) function.

gcc/d/ChangeLog:

	PR d/97002
	* d-codegen.cc (d_build_call): Set input_location on CALL_EXPR.
	* d-lang.cc: Include function.h.
	(d_type_promotes_to): Do default conversions for C and C++ functions.
	* intrinsics.cc (expand_intrinsic_vaarg): Use build1_loc to build
	VA_ARG_EXPR.

gcc/testsuite/ChangeLog:

	PR d/97002
	* gdc.dg/pr97002.d: New test.

gcc/d/d-codegen.cc

@@ -2042,6 +2042,7 @@ d_build_call (TypeFunction *tf, tree callable, tree object,
     }
 
   tree result = build_call_vec (TREE_TYPE (ctype), callee, args);
+  SET_EXPR_LOCATION (result, input_location);
 
   /* Enforce left to right evaluation.  */
   if (tf->linkage == LINKd)

gcc/d/d-lang.cc

@@ -43,6 +43,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "langhooks.h"
 #include "langhooks-def.h"
 #include "target.h"
+#include "function.h"
 #include "stringpool.h"
 #include "stor-layout.h"
 #include "varasm.h"
@@ -1358,12 +1359,65 @@ d_type_for_size (unsigned bits, int unsignedp)
   return 0;
 }
 
-/* Implements the lang_hooks.types.type_promotes_to routine for language D.
-   All promotions for variable arguments are handled by the D frontend.  */
+/* Implements the lang_hooks.types.type_promotes_to routine for language D.  */
 
 static tree
 d_type_promotes_to (tree type)
 {
+  /* Promotions are only applied on unnamed function arguments for declarations
+     with `extern(C)' or `extern(C++)' linkage.  */
+  if (cfun && DECL_LANG_FRONTEND (cfun->decl)
+      && DECL_LANG_FRONTEND (cfun->decl)->linkage != LINKd)
+    {
+      /* In [type/integer-promotions], integer promotions are conversions of the
+	 following types:
+
+		bool	int
+		byte	int
+		ubyte	int
+		short	int
+		ushort	int
+		char	int
+		wchar	int
+		dchar	uint
+
+	 If an enum has as a base type one of the types in the left column, it
+	 is converted to the type in the right column.  */
+      if (TREE_CODE (type) == ENUMERAL_TYPE && ENUM_IS_SCOPED (type))
+	type = TREE_TYPE (type);
+
+      type = TYPE_MAIN_VARIANT (type);
+
+      /* Check for promotions of target-defined types first.  */
+      tree promoted_type = targetm.promoted_type (type);
+      if (promoted_type)
+	return promoted_type;
+
+      if (TREE_CODE (type) == BOOLEAN_TYPE)
+	return d_int_type;
+
+      if (INTEGRAL_TYPE_P (type))
+	{
+	  if (type == d_byte_type || type == d_ubyte_type
+	      || type == d_short_type || type == d_ushort_type
+	      || type == char8_type_node || type == char16_type_node)
+	    return d_int_type;
+
+	  if (type == char32_type_node)
+	    return d_uint_type;
+
+	  if (TYPE_PRECISION (type) < TYPE_PRECISION (d_int_type))
+	    return d_int_type;
+	}
+
+      /* Float arguments are converted to doubles.  */
+      if (type == float_type_node)
+	return double_type_node;
+
+      if (type == ifloat_type_node)
+	return idouble_type_node;
+    }
+
   return type;
 }
 

gcc/d/intrinsics.cc

@@ -562,7 +562,7 @@ expand_intrinsic_vaarg (tree callexp)
     }
 
   /* (T) VA_ARG_EXP<ap>;  */
-  tree exp = build1 (VA_ARG_EXPR, type, ap);
+  tree exp = build1_loc (EXPR_LOCATION (callexp), VA_ARG_EXPR, type, ap);
 
   /* parmn = (T) VA_ARG_EXP<ap>;  */
   if (parmn != NULL_TREE)

gcc/testsuite/gdc.dg/pr97002.d

@@ -0,0 +1,55 @@
+// https://gcc.gnu.org/bugzilla/show_bug.cgi?id=97002
+// { dg-do compile }
+
+import core.stdc.stdarg;
+
+enum E1 : bool { one, two }
+enum E2 : short { one, two }
+enum E3 : dchar { one, two }
+enum E4 : float { one, two }
+
+extern(C) void fun(void *p1, ...)
+{
+    va_arg!bool(_argptr);   // { dg-warning "'bool' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: .so you should pass .int. not .bool. to .va_arg.." "int not bool" { target *-*-* } .-1 }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-2 }
+
+    va_arg!byte(_argptr);   // { dg-warning "'byte' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!ubyte(_argptr);   // { dg-warning "'ubyte' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!short(_argptr);   // { dg-warning "'short' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!ushort(_argptr);   // { dg-warning "'ushort' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!char(_argptr);   // { dg-warning "'char' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!wchar(_argptr);   // { dg-warning "'wchar' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!dchar(_argptr);   // { dg-warning "'dchar' is promoted to 'uint' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!float(_argptr);   // { dg-warning "'float' is promoted to 'double' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!ifloat(_argptr);   // { dg-warning "'ifloat' is promoted to 'idouble' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!E1(_argptr);   // { dg-warning "'E1' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!E2(_argptr);   // { dg-warning "'E2' is promoted to 'int' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!E3(_argptr);   // { dg-warning "'E3' is promoted to 'uint' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+
+    va_arg!E4(_argptr);   // { dg-warning "'E4' is promoted to 'double' when passed through '...'" "promoted" }
+    // { dg-message "note: if this code is reached, the program will abort"  "will abort" { target *-*-* } .-1 }
+}