Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/sem_disp.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- S E M _ D I S P -- 5 -- S E M _ D I S P --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
209 while Present (Formal) loop 209 while Present (Formal) loop
210 Ctrl_Type := Check_Controlling_Type (Etype (Formal), Subp); 210 Ctrl_Type := Check_Controlling_Type (Etype (Formal), Subp);
211 211
212 if Present (Ctrl_Type) then 212 if Present (Ctrl_Type) then
213 213
214 -- Obtain the full type in case we are looking at an incomplete
215 -- view.
216
217 if Ekind (Ctrl_Type) = E_Incomplete_Type
218 and then Present (Full_View (Ctrl_Type))
219 then
220 Ctrl_Type := Full_View (Ctrl_Type);
221 end if;
222
214 -- When controlling type is concurrent and declared within a 223 -- When controlling type is concurrent and declared within a
215 -- generic or inside an instance use corresponding record type. 224 -- generic or inside an instance use corresponding record type.
216 225
217 if Is_Concurrent_Type (Ctrl_Type) 226 if Is_Concurrent_Type (Ctrl_Type)
218 and then Present (Corresponding_Record_Type (Ctrl_Type)) 227 and then Present (Corresponding_Record_Type (Ctrl_Type))
585 594
586 else 595 else
587 -- We need to determine whether the context of the call 596 -- We need to determine whether the context of the call
588 -- provides a tag to make the call dispatching. This requires 597 -- provides a tag to make the call dispatching. This requires
589 -- the call to be the actual in an enclosing call, and that 598 -- the call to be the actual in an enclosing call, and that
590 -- actual must be controlling. If the call is an operand of 599 -- actual must be controlling. If the call is an operand of
591 -- equality, the other operand must not ve abstract. 600 -- equality, the other operand must not ve abstract.
592 601
593 if not Is_Tagged_Type (Typ) 602 if not Is_Tagged_Type (Typ)
594 and then not 603 and then not
595 (Ekind (Typ) = E_Anonymous_Access_Type 604 (Ekind (Typ) = E_Anonymous_Access_Type
1133 -- primitives. 1142 -- primitives.
1134 1143
1135 -- 3. Subprograms associated with stream attributes (built by 1144 -- 3. Subprograms associated with stream attributes (built by
1136 -- New_Stream_Subprogram) 1145 -- New_Stream_Subprogram)
1137 1146
1138 -- 4. Wrapper built for inherited operations with inherited class- 1147 -- 4. Wrappers built for inherited operations with inherited class-
1139 -- wide conditions, where the conditions include calls to other 1148 -- wide conditions, where the conditions include calls to other
1140 -- overridden primitives. The wrappers include checks on these 1149 -- overridden primitives. The wrappers include checks on these
1141 -- modified conditions. (AI12-113). 1150 -- modified conditions. (AI12-113).
1151
1152 -- 5. Declarations built for subprograms without separate specs that
1153 -- are eligible for inlining in GNATprove (inside
1154 -- Sem_Ch6.Analyze_Subprogram_Body_Helper).
1142 1155
1143 if Present (Old_Subp) 1156 if Present (Old_Subp)
1144 and then Present (Overridden_Operation (Subp)) 1157 and then Present (Overridden_Operation (Subp))
1145 and then Is_Dispatching_Operation (Old_Subp) 1158 and then Is_Dispatching_Operation (Old_Subp)
1146 then 1159 then
1157 (Ultimate_Alias (Old_Subp))) 1170 (Ultimate_Alias (Old_Subp)))
1158 1171
1159 or else Get_TSS_Name (Subp) = TSS_Stream_Read 1172 or else Get_TSS_Name (Subp) = TSS_Stream_Read
1160 or else Get_TSS_Name (Subp) = TSS_Stream_Write 1173 or else Get_TSS_Name (Subp) = TSS_Stream_Write
1161 1174
1162 or else Present (Contract (Overridden_Operation (Subp)))); 1175 or else Present (Contract (Overridden_Operation (Subp)))
1176
1177 or else GNATprove_Mode);
1163 1178
1164 Check_Controlling_Formals (Tagged_Type, Subp); 1179 Check_Controlling_Formals (Tagged_Type, Subp);
1165 Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp); 1180 Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
1166 Set_Is_Dispatching_Operation (Subp); 1181 Set_Is_Dispatching_Operation (Subp);
1167 end if; 1182 end if;