diff mbox series

[Ada] Cleanups related to expansion of dispatching primitives

Message ID 20211202162858.GA2159594@adacore.com
State New
Headers show
Series [Ada] Cleanups related to expansion of dispatching primitives | expand

Commit Message

Pierre-Marie de Rodat Dec. 2, 2021, 4:28 p.m. UTC 
Assorted cleanups related to expansion of dispatching primitives on
derived types for GNATprove; semantics of the compiler is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
	(No_Dispatching_Calls): Fix whitespace in example code.
	* gnat_rm.texi: Regenerate.
	* exp_ch13.adb (Expand_N_Freeze_Entity): Replace low-level
	membership test with a high-level wrapper.
	* exp_ch3.adb (Expand_Freeze_Record_Type): Remove unnecessary
	initialization of list of wrapper declarations and unnecessary
	guard for list of their bodies (if no bodies are created then
	Append_Freeze_Actions is a no-op).
diff mbox series

Patch

diff --git a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
--- a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
+++ b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
@@ -239,7 +239,7 @@  The following example indicates constructs that violate this restriction.
   with Pkg; use Pkg;
   procedure Example is
     procedure Test (O : T'Class) is
-      N : Natural  := O'Size;--  Error: Dispatching call
+      N : Natural := O'Size; --  Error: Dispatching call
       C : T'Class := O;      --  Error: implicit Dispatching Call
     begin
       if O in DT'Class then  --  OK   : Membership test


diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -491,7 +491,7 @@  package body Exp_Ch13 is
       --  a constrained type extension with inherited discriminants.
 
       if Is_Type (E_Scope)
-        and then Ekind (E_Scope) not in Concurrent_Kind
+        and then not Is_Concurrent_Type (E_Scope)
       then
          E_Scope := Scope (E_Scope);
 


diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5495,7 +5495,7 @@  package body Exp_Ch3 is
       Comp_Typ    : Entity_Id;
       Predef_List : List_Id;
 
-      Wrapper_Decl_List : List_Id := No_List;
+      Wrapper_Decl_List : List_Id;
       Wrapper_Body_List : List_Id := No_List;
 
       Renamed_Eq : Node_Id := Empty;
@@ -5906,9 +5906,7 @@  package body Exp_Ch3 is
          --  Ada 2005 (AI-391): If any wrappers were created for nonoverridden
          --  inherited functions, then add their bodies to the freeze actions.
 
-         if Present (Wrapper_Body_List) then
-            Append_Freeze_Actions (Typ, Wrapper_Body_List);
-         end if;
+         Append_Freeze_Actions (Typ, Wrapper_Body_List);
 
          --  Create extra formals for the primitive operations of the type.
          --  This must be done before analyzing the body of the initialization


diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -12621,7 +12621,7 @@  end Pkg;
 with Pkg; use Pkg;
 procedure Example is
   procedure Test (O : T'Class) is
-    N : Natural  := O'Size;--  Error: Dispatching call
+    N : Natural := O'Size; --  Error: Dispatching call
     C : T'Class := O;      --  Error: implicit Dispatching Call
   begin
     if O in DT'Class then  --  OK   : Membership test