diff options
author | Robert Dewar <dewar@adacore.com> | 2008-04-08 08:50:21 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2008-04-08 08:50:21 +0200 |
commit | 70f9118087173b00e6aed0bcd14a5e901955ddf0 (patch) | |
tree | e4dc71d176952be31d0565bf2722e563d06d5207 /gcc/ada/exp_tss.adb | |
parent | 45fc7ddb495d04c3170109f9717e927d73f18e2b (diff) | |
download | gcc-70f9118087173b00e6aed0bcd14a5e901955ddf0.zip gcc-70f9118087173b00e6aed0bcd14a5e901955ddf0.tar.gz gcc-70f9118087173b00e6aed0bcd14a5e901955ddf0.tar.bz2 |
s-rident.ads: Add No_Default_Initialization restriction
2008-04-08 Robert Dewar <dewar@adacore.com>
Gary Dismukes <dismukes@adacore.com>
* s-rident.ads: Add No_Default_Initialization restriction
* exp_tss.adb:
(Has_Non_Null_Base_Init_Proc): Handle No_Default_Initialization case
(Set_TSS): Handle No_Default_Initialization case
* exp_ch6.adb (Expand_N_Subprogram_Body): Handle restriction
No_Default_Initialization
(Expand_N_Subprogram_Body): Remove redundant initialization of out
parameters when Normalize_Scalars is active.
(Add_Final_List_Actual_To_Build_In_Place_Call): Add formal Sel_Comp
Fix casing error in formal parameter name in call
(Register_Predefined_DT_Entry): Replace occurrences of RE_Address by
(Expand_Call, Propagate_Tag): Call Kill_Current_Values when processing a
dispatching call on VM targets.
From-SVN: r134028
Diffstat (limited to 'gcc/ada/exp_tss.adb')
-rw-r--r-- | gcc/ada/exp_tss.adb | 38 |
1 files changed, 28 insertions, 10 deletions
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index e3a7c29..f9b9e33 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -28,6 +28,8 @@ with Einfo; use Einfo; with Elists; use Elists; with Exp_Util; use Exp_Util; with Lib; use Lib; +with Restrict; use Restrict; +with Rident; use Rident; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -159,11 +161,16 @@ package body Exp_Tss is -- Has_Non_Null_Base_Init_Proc -- --------------------------------- + -- Note: if a base Init_Proc is present, and No_Default_Initialization is + -- present, then we must avoid testing for a null init proc, since there + -- is no init proc present in this case. + function Has_Non_Null_Base_Init_Proc (Typ : Entity_Id) return Boolean is BIP : constant Entity_Id := Base_Init_Proc (Typ); - begin - return Present (BIP) and then not Is_Null_Init_Proc (BIP); + return Present (BIP) + and then (Restriction_Active (No_Default_Initialization) + or else not Is_Null_Init_Proc (BIP)); end Has_Non_Null_Base_Init_Proc; --------------- @@ -306,20 +313,31 @@ package body Exp_Tss is ------------- procedure Set_TSS (Typ : Entity_Id; TSS : Entity_Id) is - Subprog_Body : constant Node_Id := Unit_Declaration_Node (TSS); - begin - -- Case of insertion location is in unit defining the type + -- Make sure body of subprogram is frozen - if In_Same_Code_Unit (Typ, TSS) then - Append_Freeze_Action (Typ, Subprog_Body); + -- Skip this for Init_Proc with No_Default_Initialization, since the + -- Init proc is a dummy void entity in this case to be ignored. - -- Otherwise, we are using an already existing TSS in another unit + if Is_Init_Proc (TSS) + and then Restriction_Active (No_Default_Initialization) + then + null; - else + -- Skip this if not in the same code unit (since it means we are using + -- an already existing TSS in another unit) + + elsif not In_Same_Code_Unit (Typ, TSS) then null; + + -- Otherwise make sure body is frozen + + else + Append_Freeze_Action (Typ, Unit_Declaration_Node (TSS)); end if; + -- Set TSS entry + Copy_TSS (TSS, Typ); end Set_TSS; |