From ec9c3bd5d2d6d91a9967bf153ebf1411e6bb10c0 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 24 Nov 2021 22:06:01 +0100 Subject: [PATCH] [Ada] Cleanups related to expansion of dispatching primitives 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). --- .../standard_and_implementation_defined_restrictions.rst | 2 +- gcc/ada/exp_ch13.adb | 2 +- gcc/ada/exp_ch3.adb | 6 ++---- gcc/ada/gnat_rm.texi | 2 +- 4 files changed, 5 insertions(+), 7 deletions(-) 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 index cbd780b285e6..6d60e668e705 100644 --- 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 index 479decae9040..6665daaf42bc 100644 --- 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 index c75e98e796b2..9a0bbb45bb22 100644 --- 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 index 9f92812a6f36..70e8c36bff26 100644 --- 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 -- 2.47.2