diff options
author | Javier Miranda <miranda@adacore.com> | 2020-04-04 14:21:40 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-16 09:07:12 -0400 |
commit | 55153b7b4d19bbafadacd23e2b8cd1f21f1dcee1 (patch) | |
tree | 22f4440e7c4f1cc9e1ae7df438d5be23182a45bc /gcc | |
parent | fa75faedb19f0e7a4487a7ed1eeb080b590a0e73 (diff) | |
download | gcc-55153b7b4d19bbafadacd23e2b8cd1f21f1dcee1.zip gcc-55153b7b4d19bbafadacd23e2b8cd1f21f1dcee1.tar.gz gcc-55153b7b4d19bbafadacd23e2b8cd1f21f1dcee1.tar.bz2 |
[Ada] Crash in tagged type constructor with task components
2020-06-16 Javier Miranda <miranda@adacore.com>
gcc/ada/
* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Code cleanup.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_prag.adb | 51 |
1 files changed, 4 insertions, 47 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 673954a..f3f0aff 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10694,54 +10694,11 @@ package body Sem_Prag is Add_To_Config_Boolean_Restrictions (No_Elaboration_Code); end if; - -- Special processing for No_Tasking restriction + -- Special processing for No_Tasking restriction placed in + -- a configuration pragmas file. - elsif R_Id = No_Tasking then - - -- Handle global configuration pragmas - - if No (Cunit (Main_Unit)) then - Set_Global_No_Tasking; - - -- Handle package System, which may be loaded by rtsfind as - -- a consequence of loading some other run-time unit. - - else - declare - C_Node : constant Entity_Id := - Cunit (Current_Sem_Unit); - C_Ent : constant Entity_Id := - Cunit_Entity (Current_Sem_Unit); - Loc_Str : constant String := - Build_Location_String (Sloc (C_Ent)); - Ref_Str : constant String := "system.ads"; - Ref_Len : constant Positive := Ref_Str'Length; - - begin - pragma Assert (Loc_Str'First = 1); - pragma Assert (Loc_Str'First = Ref_Str'First); - - if Nkind (Unit (C_Node)) = N_Package_Declaration - and then Chars (C_Ent) = Name_System - - -- Handle child packages named foo-system.ads - - and then Loc_Str'Length > Ref_Str'Length - and then Loc_Str (Loc_Str'First .. Ref_Len) - = Ref_Str (Ref_Str'First .. Ref_Len) - - -- ... and ensure that package System has not - -- been previously loaded. Done to ensure that - -- the above checks do not have any corner case - -- (since they are performed without semantic - -- information). - - and then not RTU_Loaded (Rtsfind.System) - then - Set_Global_No_Tasking; - end if; - end; - end if; + elsif R_Id = No_Tasking and then No (Cunit (Main_Unit)) then + Set_Global_No_Tasking; end if; -- If this is a warning, then set the warning unless we already |