[Ada] Crash on classwide precondition on subprogram with stub

This patch allows the compiler to handle properly a classwide precondition
on a primitive operation whose body is a stub and a separate subunit.

Executing:

   gnatmake -gnata -q check
   ./check

must yield:

   precondition violated

----
with Text_IO;
with Msg_Data_Block_Decoder; use Msg_Data_Block_Decoder;
procedure Check is
   Thing : T_Msg_Data_Block_Decoder;
   Value : Integer;
begin
   begin
      Value := Get_Long_Term_Corrections (Thing);
   exception
      when others => Text_IO.Put_Line ("precondition violated");
   end;
end Check;
----
package Msg_Data_Block_Decoder is
   pragma Preelaborate;
   type T_Msg_Data_Block_Decoder is Tagged Limited null record;

   type T_Msg_Data_Block_Decoder_Class_Access is
       access all T_Msg_Data_Block_Decoder'Class;

   function Get_Decoded_Data (This : in T_Msg_Data_Block_Decoder)
      return Integer;

   function Get_Long_Term_Corrections
     (This : in T_Msg_Data_Block_Decoder) return Integer  with
       Pre'
        Class => Get_Decoded_Data (T_Msg_Data_Block_Decoder'Class (This)) = 2;

end Msg_Data_Block_Decoder;
----
package body Msg_Data_Block_Decoder is

   function Get_Long_Term_Corrections (This : in T_Msg_Data_Block_Decoder)
   return Integer is separate;

   function Get_Decoded_Data (This : in T_Msg_Data_Block_Decoder)
     return Integer is
   begin
     return 0;
   end Get_Decoded_Data;

end Msg_Data_Block_Decoder;
----
separate (Msg_Data_Block_Decoder)
function Get_Long_Term_Corrections (This : in T_Msg_Data_Block_Decoder)
   return Integer is
begin
  return 0;
end Get_Long_Term_Corrections;

2018-05-25  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not create
	Class_Wide_Clone_Body when analyzing a subprogram_body_stub: the clone
	is created when the proper body of the stub is analyzed.
	* sem_util.adb (ZBuild_Class_Wide_Clone_Body): If the subprogram body
	is the proper body of a subunit, the cloned body must be inserted in
	the declarative list that contains the stub.

From-SVN: r260734

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2e5fd67e46bc887e5629eaa7fd00583b1bdd370d..904194e5ebb6d6592fdce98f05021d587001ee65 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-05-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not create
+       Class_Wide_Clone_Body when analyzing a subprogram_body_stub: the clone
+       is created when the proper body of the stub is analyzed.
+       * sem_util.adb (ZBuild_Class_Wide_Clone_Body): If the subprogram body
+       is the proper body of a subunit, the cloned body must be inserted in
+       the declarative list that contains the stub.
+
 2018-05-25  Justin Squirek  <squirek@adacore.com>
 
        * exp_ch6.adb (Expand_Simple_Function_Return): Add guard in check to

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5eab1e0394d2c0e738bec947e99bb56c5e7fedfb..3d8849a0491e34c08299df0f91922735890a9cd8 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3844,10 +3844,13 @@ package body Sem_Ch6 is
       --  If the subprogram has a class-wide clone, build its body as a copy
       --  of the original body, and rewrite body of original subprogram as a
       --  wrapper that calls the clone.
+      --  If N is a stub, this construction will take place when the proper
+      --  body is analyzed.
 
       if Present (Spec_Id)
         and then Present (Class_Wide_Clone (Spec_Id))
         and then (Comes_From_Source (N) or else Was_Expression_Function (N))
+        and then Nkind (N) /= N_Subprogram_Body_Stub
       then
          Build_Class_Wide_Clone_Body (Spec_Id, N);
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 00b7cfba891342d6e1284170e1c59c21f01c51f2..033903c09eadd0e83f3b08865092f2957628726e 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1365,7 +1365,18 @@ package body Sem_Util is
       --  (the original primitive may have carried one).
 
       Set_Must_Override (Specification (Clone_Body), False);
-      Insert_Before (Bod, Clone_Body);
+
+      --  If the subprogram body is the proper body of a stub, insert the
+      --  subprogram after the stub, i.e. the same declarative region as
+      --  the original sugprogram.
+
+      if Nkind (Parent (Bod)) = N_Subunit then
+         Insert_After (Corresponding_Stub (Parent (Bod)), Clone_Body);
+
+      else
+         Insert_Before (Bod, Clone_Body);
+      end if;
+
       Analyze (Clone_Body);
    end Build_Class_Wide_Clone_Body;