[Ada] Reject components in extensions overlapping with the parent

[Ada] Reject components in extensions overlapping with the parent

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 769 bytes --]

Such problematic components can be specified by means of a component clause 
but they cannot be fully supported by the type system.  They had initially 
been forbidden, then we decided to accept them by working around the type 
system, but this is very fragile and, for example, any static aggregate is 
guaranteed to trigger an ICE with the current implementation.

We now reject them again, except if the -gnatd.K switch is passed.

Tested on x86-64/Linux, applied on the mainline.


2020-07-02  Eric Botcazou  <ebotcazou@adacore.com>

	* debug.adb (d.K): Document new usage.
	* fe.h (Debug_Flag_Dot_KK): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_field): Give an error when the
	component overlaps with the parent subtype, except with -gnatd.K.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 3031 bytes --]

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 63b14b2bd6d..0f73c2a17ae 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -128,7 +128,7 @@ package body Debug is
    --  d.H
    --  d.I  Do not ignore enum representation clauses in CodePeer mode
    --  d.J  Relaxed rules for pragma No_Return
-   --  d.K
+   --  d.K  Do not reject components in extensions overlapping with parent
    --  d.L  Depend on back end for limited types in if and case expressions
    --  d.M  Relaxed RM semantics
    --  d.N  Add node to all entities
@@ -898,6 +898,11 @@ package body Debug is
    --       for that. If the procedure does in fact return normally, execution
    --       is erroneous, and therefore unpredictable.
 
+   --  d.K  Do not reject components in extensions overlapping with the parent
+   --       component. Such components can be specified by means of a component
+   --       clause but they cannot be fully supported by the GCC type system.
+   --       This switch nevertheless allows them for the sake of compatibility.
+
    --  d.L  Normally the front end generates special expansion for conditional
    --       expressions of a limited type. This debug flag removes this special
    --       case expansion, leaving it up to the back end to handle conditional
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 043300d42c9..463a89c5fdb 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -59,9 +59,11 @@ extern int Compiler_Abort (String_Pointer, String_Pointer, Boolean) ATTRIBUTE_NO
 
 /* debug: */
 
+#define Debug_Flag_Dot_KK	debug__debug_flag_dot_kk
 #define Debug_Flag_Dot_R	debug__debug_flag_dot_r
 #define Debug_Flag_NN		debug__debug_flag_nn
 
+extern Boolean Debug_Flag_Dot_KK;
 extern Boolean Debug_Flag_Dot_R;
 extern Boolean Debug_Flag_NN;
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index cad06a4dd06..025714bd339 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -7234,12 +7234,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     {
       Entity_Id gnat_parent = Parent_Subtype (gnat_record_type);
 
-      /* Ensure the position does not overlap with the parent subtype, if there
-	 is one.  This test is omitted if the parent of the tagged type has a
-	 full rep clause since, in this case, component clauses are allowed to
-	 overlay the space allocated for the parent type and the front-end has
-	 checked that there are no overlapping components.  */
-      if (Present (gnat_parent) && !Is_Fully_Repped_Tagged_Type (gnat_parent))
+      /* Ensure the position doesn't overlap with the parent subtype if there
+	 is one.  It would be impossible to build CONSTRUCTORs and accessing
+	 the parent could clobber the component in the extension if directly
+	 done.  We accept it with -gnatd.K for the sake of compatibility.  */
+      if (Present (gnat_parent)
+	  && !(Debug_Flag_Dot_KK && Is_Fully_Repped_Tagged_Type (gnat_parent)))
 	{
 	  tree gnu_parent = gnat_to_gnu_type (gnat_parent);