https://gcc.gnu.org/g:e10dc5147b6f35523c8357dae57ae519e7016693
commit r17-4954-ge10dc5147b6f35523c8357dae57ae519e7016693 Author: Eric Botcazou <[email protected]> Date: Wed Oct 7 13:05:14 2026 +0200 Ada: Fix missing internal finalization of protected object This occurs when the type of the protected object is a constrained subtype of an unconstrained protected type, and comes from an obsolete kludge. gcc/ada/ PR ada/127756 * exp_util.adb (Find_Protection_Type): Remove early return. gcc/testsuite/ * gnat.dg/protected_subtype2.adb: New test. Diff: --- gcc/ada/exp_util.adb | 9 ------- gcc/testsuite/gnat.dg/protected_subtype2.adb | 37 ++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 9 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d587fb16c8f4..24828e4a250e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7220,15 +7220,6 @@ package body Exp_Util is Typ := Corresponding_Record_Type (Typ); end if; - -- Since restriction violations are not considered serious errors, the - -- expander remains active, but may leave the corresponding record type - -- malformed. In such cases, component _object is not available so do - -- not look for it. - - if not Analyzed (Typ) then - return Empty; - end if; - Comp := First_Component (Typ); while Present (Comp) loop if Chars (Comp) = Name_uObject then diff --git a/gcc/testsuite/gnat.dg/protected_subtype2.adb b/gcc/testsuite/gnat.dg/protected_subtype2.adb new file mode 100644 index 000000000000..68fd096da583 --- /dev/null +++ b/gcc/testsuite/gnat.dg/protected_subtype2.adb @@ -0,0 +1,37 @@ +-- { dg-do compile } + +with Ada.Unchecked_Deallocation; + +procedure Protected_Subtype2 is + + protected type State (Capacity : Positive) with Lock_Free => False is + procedure Touch; + private + Value : Natural := 0; + end State; + + protected body State is + procedure Touch is + begin + Value := Value + 1; + end Touch; + end State; + + subtype Constrained_State is State (4); + type State_Access is access Constrained_State; + + procedure Free is + new Ada.Unchecked_Deallocation (Constrained_State, State_Access); + +begin + for I in 1 .. 100 loop + declare + P : State_Access := new Constrained_State; + begin + P.Touch; + Free (P); + end; + end loop; +end; + +-- { dg-final { scan-assembler "finalize_protection" } }
