ada: Cleanup detection of type support subprogram entities

Avoid repeated calls to Get_TSS_Name. Code cleanup related to handling
of dispatching operations in GNATprove; semantics is unaffected.

gcc/ada/

	* exp_aggr.adb (Convert_Aggr_In_Allocator): Replace Get_TSS_Name
	with a high-level Is_TSS.
	* sem_ch6.adb (Check_Conformance): Replace DECLARE block and
	nested IF with a call to Get_TSS_Name and a membership test.
	(Has_Reliable_Extra_Formals): Refactor repeated calls to
	Get_TSS_Name.
	* sem_disp.adb (Check_Dispatching_Operation): Replace repeated
	calls to Get_TSS_Name with a membership test.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c4a016ed3d4f50182eda52354be7b2890a3ea33f..93fcac5439e7f0f8bf63674f1383f200b1baa25c 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4487,8 +4487,7 @@ package body Exp_Aggr is
 
             while Present (Stmt) loop
                if Nkind (Stmt) = N_Procedure_Call_Statement
-                 and then Get_TSS_Name (Entity (Name (Stmt)))
-                            = TSS_Slice_Assign
+                 and then Is_TSS (Entity (Name (Stmt)), TSS_Slice_Assign)
                then
                   Param := First (Parameter_Associations (Stmt));
                   Insert_Actions

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 495e8b1c5382edd0f18d411bd86c1b4e4d5ede86..17c50f6e676c8982a273ee127a73f261b804e442 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6005,41 +6005,35 @@ package body Sem_Ch6 is
               --  avoids some redundant error messages.
 
               and then not Error_Posted (New_Formal)
-            then
-               --  It is allowed to omit the null-exclusion in case of stream
-               --  attribute subprograms. We recognize stream subprograms
-               --  through their TSS-generated suffix.
 
-               declare
-                  TSS_Name : constant TSS_Name_Type := Get_TSS_Name (New_Id);
+              --  It is allowed to omit the null-exclusion in case of stream
+              --  attribute subprograms. We recognize stream subprograms
+              --  through their TSS-generated suffix.
 
-               begin
-                  if TSS_Name /= TSS_Stream_Read
-                    and then TSS_Name /= TSS_Stream_Write
-                    and then TSS_Name /= TSS_Stream_Input
-                    and then TSS_Name /= TSS_Stream_Output
-                  then
-                     --  Here we have a definite conformance error. It is worth
-                     --  special casing the error message for the case of a
-                     --  controlling formal (which excludes null).
+              and then Get_TSS_Name (New_Id) not in TSS_Stream_Read
+                                                  | TSS_Stream_Write
+                                                  | TSS_Stream_Input
+                                                  | TSS_Stream_Output
+            then
+               --  Here we have a definite conformance error. It is worth
+               --  special casing the error message for the case of a
+               --  controlling formal (which excludes null).
 
-                     if Is_Controlling_Formal (New_Formal) then
-                        Error_Msg_Node_2 := Scope (New_Formal);
-                        Conformance_Error
-                         ("\controlling formal & of & excludes null, "
-                          & "declaration must exclude null as well",
-                          New_Formal);
+               if Is_Controlling_Formal (New_Formal) then
+                  Error_Msg_Node_2 := Scope (New_Formal);
+                  Conformance_Error
+                    ("\controlling formal & of & excludes null, "
+                     & "declaration must exclude null as well",
+                     New_Formal);
 
-                     --  Normal case (couldn't we give more detail here???)
+                  --  Normal case (couldn't we give more detail here???)
 
-                     else
-                        Conformance_Error
-                          ("\type of & does not match!", New_Formal);
-                     end if;
+               else
+                  Conformance_Error
+                    ("\type of & does not match!", New_Formal);
+               end if;
 
-                     return;
-                  end if;
-               end;
+               return;
             end if;
          end if;
 
@@ -10650,21 +10644,16 @@ package body Sem_Ch6 is
 
       else
          declare
-            Typ : constant Entity_Id :=
-                    Underlying_Type (Find_Dispatching_Type (Alias_E));
+            TSS_Name : constant TSS_Name_Type := Get_TSS_Name (E);
+            Typ      : constant Entity_Id :=
+              Underlying_Type (Find_Dispatching_Type (Alias_E));
 
          begin
-            if (Get_TSS_Name (E) = TSS_Stream_Input
-                  and then not Stream_Operation_OK (Typ, TSS_Stream_Input))
-              or else
-                (Get_TSS_Name (E) = TSS_Stream_Output
-                   and then not Stream_Operation_OK (Typ, TSS_Stream_Output))
-              or else
-                (Get_TSS_Name (E) = TSS_Stream_Read
-                   and then not Stream_Operation_OK (Typ, TSS_Stream_Read))
-              or else
-                (Get_TSS_Name (E) = TSS_Stream_Write
-                   and then not Stream_Operation_OK (Typ, TSS_Stream_Write))
+            if TSS_Name in TSS_Stream_Input
+                         | TSS_Stream_Output
+                         | TSS_Stream_Read
+                         | TSS_Stream_Write
+              and then not Stream_Operation_OK (Typ, TSS_Name)
             then
                return False;
             end if;

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index ab409d3a4e4bd8d5644470cb52670aede8a606ae..6c8212c3cb32b6b2e36860183fb593eb922c8374 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1414,9 +1414,9 @@ package body Sem_Disp is
                  and then Is_Null_Interface_Primitive
                              (Ultimate_Alias (Old_Subp)))
 
-              or else Get_TSS_Name (Subp) = TSS_Stream_Read
-              or else Get_TSS_Name (Subp) = TSS_Stream_Write
-              or else Get_TSS_Name (Subp) = TSS_Put_Image
+              or else Get_TSS_Name (Subp) in TSS_Stream_Read
+                                           | TSS_Stream_Write
+                                           | TSS_Put_Image
 
               or else
                (Is_Wrapper (Subp)