Hi Gary,
Thanks for finding that! I have made the recommended change and attached the
revised patch, which is also rebased on trunk.
Additionally, I have added the “Signed-off-by” tag for legal compliance to the
patch, as well as the change log entry as follows:
-- Begin change log entry –
ada: TSS finalize address subprogram generation for constrained subtypes of
unconstrained synchronized private extensions should take care to designate the
corresponding record of the underlying concurrent type.
When generating TSS finalize address subprograms for class-wide types of
constrained root types, it follows the parent chain looking for the first
“non-constrained” type. It is possible that such a type is a private extension
with the “synchronized” keyword, in which case the underlying type is a
concurrent type. When that happens, the designated type of the finalize address
subprogram should be the corresponding record’s class-wide-type.
Gcc/ada/
* exp_ch3(Expand_Freeze_Class_Wide_Type): Expanded comments
explaining why TSS Finalize_Address is not generated for concurrent class-wide
types.
* exp_ch7(Make_Finalize_Address_Stmts): Handle cases where the
underlying non-constrained parent type is a concurrent type, and adjust the
designated type to be the corresponding record’s class-wide type.
Signed-off-by: Richard Wai <rich...@annexi-strayline.com
<mailto:rich...@annexi-strayline.com>>
-- End change log entry –
See you at the next meeting!
Cheers,
Richard

> On Sep 15, 2023, at 12:38, Gary Dismukes <dismu...@adacore.com> wrote:
>
> Richard,
>
> As a follow-on to my earlier message, additional testing has uncovered an
> issue
> with your patch. When run against a compiler built with assertions enabled,
> the test of "Present (Corresponding_Record_Type (Parent_Utyp))" can fail.
> An additional guard is needed prior to that test, as follows:
>
> if Ekind (Parent_Utyp) in Concurrent_Kind
> and then Present (Corresponding_Record_Type (Parent_Utyp))
> then
> Parent_Utyp := Corresponding_Record_Type (Parent_Utyp);
> end if;
>
> -- Gary
>
