@@ -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);
@@ -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;
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; Tested on x86_64-pc-linux-gnu, committed on trunk 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.