Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/exp_intr.adb @ 131:84e7813d76e9
gcc-8.2
| author | mir3636 |
|---|---|
| date | Thu, 25 Oct 2018 07:37:49 +0900 |
| parents | 04ced10e8804 |
| children | 1830386684a0 |
comparison
equal
deleted
inserted
replaced
| 111:04ced10e8804 | 131:84e7813d76e9 |
|---|---|
| 4 -- -- | 4 -- -- |
| 5 -- E X P _ I N T R -- | 5 -- E X P _ I N T R -- |
| 6 -- -- | 6 -- -- |
| 7 -- B o d y -- | 7 -- B o d y -- |
| 8 -- -- | 8 -- -- |
| 9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- | 9 -- Copyright (C) 1992-2018, 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- -- |
| 400 Set_Controlling_Argument (Cnstr_Call, | 400 Set_Controlling_Argument (Cnstr_Call, |
| 401 Relocate_Node (Tag_Arg)); | 401 Relocate_Node (Tag_Arg)); |
| 402 end if; | 402 end if; |
| 403 | 403 |
| 404 -- Rewrite and analyze the call to the instance as a class-wide | 404 -- Rewrite and analyze the call to the instance as a class-wide |
| 405 -- conversion of the call to the actual constructor. | 405 -- conversion of the call to the actual constructor. When the result |
| 406 -- type is a class-wide interface type this conversion is required to | |
| 407 -- force the displacement of the pointer to the object to reference the | |
| 408 -- corresponding dispatch table. | |
| 406 | 409 |
| 407 Rewrite (N, Convert_To (Result_Typ, Cnstr_Call)); | 410 Rewrite (N, Convert_To (Result_Typ, Cnstr_Call)); |
| 408 | 411 |
| 409 -- Do not generate a run-time check on the built object if tag | 412 -- Do not generate a run-time check on the built object if tag |
| 410 -- checks are suppressed for the result type or tagged type expansion | 413 -- checks are suppressed for the result type or tagged type expansion |
| 922 | 925 |
| 923 procedure Expand_Unc_Deallocation (N : Node_Id) is | 926 procedure Expand_Unc_Deallocation (N : Node_Id) is |
| 924 Arg : constant Node_Id := First_Actual (N); | 927 Arg : constant Node_Id := First_Actual (N); |
| 925 Loc : constant Source_Ptr := Sloc (N); | 928 Loc : constant Source_Ptr := Sloc (N); |
| 926 Typ : constant Entity_Id := Etype (Arg); | 929 Typ : constant Entity_Id := Etype (Arg); |
| 927 Desig_Typ : constant Entity_Id := Designated_Type (Typ); | 930 Desig_Typ : constant Entity_Id := |
| 931 Available_View (Designated_Type (Typ)); | |
| 928 Needs_Fin : constant Boolean := Needs_Finalization (Desig_Typ); | 932 Needs_Fin : constant Boolean := Needs_Finalization (Desig_Typ); |
| 929 Root_Typ : constant Entity_Id := Underlying_Type (Root_Type (Typ)); | 933 Root_Typ : constant Entity_Id := Underlying_Type (Root_Type (Typ)); |
| 930 Pool : constant Entity_Id := Associated_Storage_Pool (Root_Typ); | 934 Pool : constant Entity_Id := Associated_Storage_Pool (Root_Typ); |
| 931 Stmts : constant List_Id := New_List; | 935 Stmts : constant List_Id := New_List; |
| 932 | 936 |