diff options
Diffstat (limited to 'gcc/ada/sem_ch6.adb')
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 82 |
1 files changed, 35 insertions, 47 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index e97afda..43aa2e6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6916,13 +6916,11 @@ package body Sem_Ch6 is -- operation is the inherited primitive (which is available -- through the attribute alias) - if (Is_Dispatching_Operation (Subp) - or else Is_Dispatching_Operation (Overridden_Subp)) + if Is_Dispatching_Operation (Subp) and then not Comes_From_Source (Overridden_Subp) and then Find_Dispatching_Type (Overridden_Subp) = Find_Dispatching_Type (Subp) and then Present (Alias (Overridden_Subp)) - and then Comes_From_Source (Alias (Overridden_Subp)) then Set_Overridden_Operation (Subp, Alias (Overridden_Subp)); Inherit_Subprogram_Contract (Subp, Alias (Overridden_Subp)); @@ -12565,16 +12563,25 @@ package body Sem_Ch6 is Enter_Overloaded_Entity (S); + -- LSP wrappers must override the ultimate alias of their + -- wrapped dispatching primitive E; required to traverse the + -- chain of ancestor primitives (see Map_Primitives). They + -- don't inherit contracts. + + if Is_Wrapper (S) + and then Present (LSP_Subprogram (S)) + then + Set_Overridden_Operation (S, Ultimate_Alias (E)); + -- For entities generated by Derive_Subprograms the -- overridden operation is the inherited primitive -- (which is available through the attribute alias). - if not (Comes_From_Source (E)) + elsif not (Comes_From_Source (E)) and then Is_Dispatching_Operation (E) and then Find_Dispatching_Type (E) = Find_Dispatching_Type (S) and then Present (Alias (E)) - and then Comes_From_Source (Alias (E)) then Set_Overridden_Operation (S, Alias (E)); Inherit_Subprogram_Contract (S, Alias (E)); @@ -12591,20 +12598,8 @@ package body Sem_Ch6 is -- must check whether the target is an init_proc. elsif not Is_Init_Proc (S) then - - -- LSP wrappers must override the ultimate alias of their - -- wrapped dispatching primitive E; required to traverse - -- the chain of ancestor primitives (c.f. Map_Primitives) - -- They don't inherit contracts. - - if Is_Wrapper (S) - and then Present (LSP_Subprogram (S)) - then - Set_Overridden_Operation (S, Ultimate_Alias (E)); - else - Set_Overridden_Operation (S, E); - Inherit_Subprogram_Contract (S, E); - end if; + Set_Overridden_Operation (S, E); + Inherit_Subprogram_Contract (S, E); Set_Is_Ada_2022_Only (S, Is_Ada_2022_Only (E)); end if; @@ -12619,37 +12614,30 @@ package body Sem_Ch6 is -- If S is a user-defined subprogram or a null procedure -- expanded to override an inherited null procedure, or a - -- predefined dispatching primitive then indicate that E - -- overrides the operation from which S is inherited. + -- predefined dispatching primitive, or a function wrapper + -- expanded to override an inherited function with + -- dispatching result, then indicate that S overrides the + -- operation from which E is inherited. - if Comes_From_Source (S) - or else - (Present (Parent (S)) - and then Nkind (Parent (S)) = N_Procedure_Specification - and then Null_Present (Parent (S))) - or else - (Present (Alias (E)) - and then - Is_Predefined_Dispatching_Operation (Alias (E))) + if (not Is_Wrapper (S) or else No (LSP_Subprogram (S))) + and then Present (Alias (E)) + and then + (Comes_From_Source (S) + or else + (Nkind (Parent (S)) = N_Procedure_Specification + and then Null_Present (Parent (S))) + or else Is_Predefined_Dispatching_Operation (Alias (E)) + or else + (E in E_Function_Id + and then Is_Dispatching_Operation (E) + and then Has_Controlling_Result (E) + and then Is_Wrapper (S) + and then not Is_Dispatch_Table_Wrapper (S))) then - if Present (Alias (E)) then - - -- LSP wrappers must override the ultimate alias of - -- their wrapped dispatching primitive E; required to - -- traverse the chain of ancestor primitives (see - -- Map_Primitives). They don't inherit contracts. - - if Is_Wrapper (S) - and then Present (LSP_Subprogram (S)) - then - Set_Overridden_Operation (S, Ultimate_Alias (E)); - else - Set_Overridden_Operation (S, Alias (E)); - Inherit_Subprogram_Contract (S, Alias (E)); - end if; + Set_Overridden_Operation (S, Alias (E)); + Inherit_Subprogram_Contract (S, Alias (E)); - Set_Is_Ada_2022_Only (S, Is_Ada_2022_Only (Alias (E))); - end if; + Set_Is_Ada_2022_Only (S, Is_Ada_2022_Only (Alias (E))); end if; if Is_Dispatching_Operation (E) then |