[gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Spurious error on call to controlled primitive

[Martin Liska]

https://gcc.gnu.org/g:a689887372e80f748fedd95e98ce9a85e7b09c9b

commit a689887372e80f748fedd95e98ce9a85e7b09c9b
Author: Justin Squirek <squirek@adacore.com>
Date:   Fri Feb 21 16:12:35 2020 -0500

    [Ada] Spurious error on call to controlled primitive
    
    2020-06-08  Justin Squirek  <squirek@adacore.com>
    
    gcc/ada/
    
            * sem_ch4.adb (Analyze_One_Call): Add extra condition to the
            predicate for deciding when a given controlled call is visible.

Diff:
---
 gcc/ada/sem_ch4.adb | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 4a80ff085be..4ff08a523fb 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3697,15 +3697,15 @@ package body Sem_Ch4 is
 
          --  To avoid breaking privacy, Is_Hidden gets set elsewhere on such
          --  primitives, but we still need to verify that Nam is indeed a
-         --  controlled subprogram. So, we do that here and issue the
-         --  appropriate error.
+         --  non-visible controlled subprogram. So, we do that here and issue
+         --  the appropriate error.
 
          if Is_Hidden (Nam)
            and then not In_Instance
            and then not Comes_From_Source (Nam)
            and then Comes_From_Source (N)
 
-           --  Verify Nam is a controlled primitive
+           --  Verify Nam is a non-visible controlled primitive
 
            and then Nam_In (Chars (Nam), Name_Adjust,
                                          Name_Finalize,
@@ -3713,6 +3713,7 @@ package body Sem_Ch4 is
            and then Ekind (Nam) = E_Procedure
            and then Is_Controlled (Etype (First_Form))
            and then No (Next_Formal (First_Form))
+           and then not Is_Visibly_Controlled (Etype (First_Form))
          then
             Error_Msg_Node_2 := Etype (First_Form);
             Error_Msg_NE ("call to non-visible controlled primitive & on type"