diff options
Diffstat (limited to 'gcc/ada/sem.adb')
| -rw-r--r-- | gcc/ada/sem.adb | 263 |
1 files changed, 163 insertions, 100 deletions
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 34e090761a9..7dab13496c1 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -53,6 +53,8 @@ with Sinfo; use Sinfo; with Stand; use Stand; with Uintp; use Uintp; +with Unchecked_Deallocation; + pragma Warnings (Off, Sem_Util); -- Suppress warnings of unused with for Sem_Util (used only in asserts) @@ -448,8 +450,8 @@ package body Sem is when N_Requeue_Statement => Analyze_Requeue (N); - when N_Return_Statement => - Analyze_Return_Statement (N); + when N_Simple_Return_Statement => + Analyze_Simple_Return_Statement (N); when N_Selected_Component => Find_Selected_Component (N); @@ -724,65 +726,73 @@ package body Sem is From : Entity_Id; To : Entity_Id) is + Found : Boolean; + + procedure Search_Stack + (Top : Suppress_Stack_Entry_Ptr; + Found : out Boolean); + -- Search given suppress stack for matching entry for entity. If found + -- then set Checks_May_Be_Suppressed on To, and push an appropriate + -- entry for To onto the local suppress stack. + + ------------------ + -- Search_Stack -- + ------------------ + + procedure Search_Stack + (Top : Suppress_Stack_Entry_Ptr; + Found : out Boolean) + is + Ptr : Suppress_Stack_Entry_Ptr; + + begin + Ptr := Top; + while Ptr /= null loop + if Ptr.Entity = From + and then (Ptr.Check = All_Checks or else Ptr.Check = C) + then + if Ptr.Suppress then + Set_Checks_May_Be_Suppressed (To, True); + Push_Local_Suppress_Stack_Entry + (Entity => To, + Check => C, + Suppress => True); + Found := True; + return; + end if; + end if; + + Ptr := Ptr.Prev; + end loop; + + Found := False; + return; + end Search_Stack; + + -- Start of processing for Copy_Suppress_Status + begin if not Checks_May_Be_Suppressed (From) then return; end if; - -- First search the local entity suppress table, we search this in + -- First search the local entity suppress stack, we search this in -- reverse order so that we get the innermost entry that applies to -- this case if there are nested entries. Note that for the purpose -- of this procedure we are ONLY looking for entries corresponding -- to a two-argument Suppress, where the second argument matches From. - for J in - reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last - loop - declare - R : Entity_Check_Suppress_Record - renames Local_Entity_Suppress.Table (J); + Search_Stack (Global_Suppress_Stack_Top, Found); - begin - if R.Entity = From - and then (R.Check = All_Checks or else R.Check = C) - then - if R.Suppress then - Set_Checks_May_Be_Suppressed (To, True); - Local_Entity_Suppress.Append - ((Entity => To, - Check => C, - Suppress => True)); - return; - end if; - end if; - end; - end loop; + if Found then + return; + end if; -- Now search the global entity suppress table for a matching entry -- We also search this in reverse order so that if there are multiple -- pragmas for the same entity, the last one applies. - for J in - reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last - loop - declare - R : Entity_Check_Suppress_Record - renames Global_Entity_Suppress.Table (J); - - begin - if R.Entity = From - and then (R.Check = All_Checks or else R.Check = C) - then - if R.Suppress then - Set_Checks_May_Be_Suppressed (To, True); - Local_Entity_Suppress.Append - ((Entity => To, - Check => C, - Suppress => True)); - end if; - end if; - end; - end loop; + Search_Stack (Local_Suppress_Stack_Top, Found); end Copy_Suppress_Status; ------------------------- @@ -812,29 +822,26 @@ package body Sem is ----------------------- function Explicit_Suppress (E : Entity_Id; C : Check_Id) return Boolean is + Ptr : Suppress_Stack_Entry_Ptr; + begin if not Checks_May_Be_Suppressed (E) then return False; else - for J in - reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last - loop - declare - R : Entity_Check_Suppress_Record - renames Global_Entity_Suppress.Table (J); - - begin - if R.Entity = E - and then (R.Check = All_Checks or else R.Check = C) - then - return R.Suppress; - end if; - end; - end loop; + Ptr := Global_Suppress_Stack_Top; + while Ptr /= null loop + if Ptr.Entity = E + and then (Ptr.Check = All_Checks or else Ptr.Check = C) + then + return Ptr.Suppress; + end if; - return False; + Ptr := Ptr.Prev; + end loop; end if; + + return False; end Explicit_Suppress; ----------------------------- @@ -880,9 +887,26 @@ package body Sem is ---------------- procedure Initialize is + Next : Suppress_Stack_Entry_Ptr; + + procedure Free is new Unchecked_Deallocation + (Suppress_Stack_Entry, Suppress_Stack_Entry_Ptr); + begin - Local_Entity_Suppress.Init; - Global_Entity_Suppress.Init; + -- Free any global suppress stack entries from a previous invocation + -- of the compiler (in the normal case this loop does nothing). + + while Suppress_Stack_Entries /= null loop + Next := Global_Suppress_Stack_Top.Next; + Free (Suppress_Stack_Entries); + Suppress_Stack_Entries := Next; + end loop; + + Local_Suppress_Stack_Top := null; + Global_Suppress_Stack_Top := null; + + -- Clear scope stack, and reset global variables + Scope_Stack.Init; Unloaded_Subunits := False; end Initialize; @@ -1136,53 +1160,52 @@ package body Sem is ------------------------- function Is_Check_Suppressed (E : Entity_Id; C : Check_Id) return Boolean is - begin - -- First search the local entity suppress table, we search this in - -- reverse order so that we get the innermost entry that applies to - -- this case if there are nested entries. - for J in - reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last - loop - declare - R : Entity_Check_Suppress_Record - renames Local_Entity_Suppress.Table (J); + Ptr : Suppress_Stack_Entry_Ptr; - begin - if (R.Entity = Empty or else R.Entity = E) - and then (R.Check = All_Checks or else R.Check = C) - then - return R.Suppress; - end if; - end; + begin + -- First search the local entity suppress stack, we search this from the + -- top of the stack down, so that we get the innermost entry that + -- applies to this case if there are nested entries. + + Ptr := Local_Suppress_Stack_Top; + while Ptr /= null loop + if (Ptr.Entity = Empty or else Ptr.Entity = E) + and then (Ptr.Check = All_Checks or else Ptr.Check = C) + then + return Ptr.Suppress; + end if; + + Ptr := Ptr.Prev; end loop; -- Now search the global entity suppress table for a matching entry - -- We also search this in reverse order so that if there are multiple + -- We also search this from the top down so that if there are multiple -- pragmas for the same entity, the last one applies (not clear what -- or whether the RM specifies this handling, but it seems reasonable). - for J in - reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last - loop - declare - R : Entity_Check_Suppress_Record - renames Global_Entity_Suppress.Table (J); + Ptr := Global_Suppress_Stack_Top; + while Ptr /= null loop + if (Ptr.Entity = Empty or else Ptr.Entity = E) + and then (Ptr.Check = All_Checks or else Ptr.Check = C) + then + return Ptr.Suppress; + end if; - begin - if R.Entity = E - and then (R.Check = All_Checks or else R.Check = C) - then - return R.Suppress; - end if; - end; + Ptr := Ptr.Prev; end loop; -- If we did not find a matching entry, then use the normal scope -- suppress value after all (actually this will be the global setting - -- since it clearly was not overridden at any point) + -- since it clearly was not overridden at any point). For a predefined + -- check, we test the specific flag. For a user defined check, we check + -- the All_Checks flag. - return Scope_Suppress (C); + if C in Predefined_Check_Id then + return Scope_Suppress (C); + else + return Scope_Suppress (All_Checks); + end if; end Is_Check_Suppressed; ---------- @@ -1191,14 +1214,54 @@ package body Sem is procedure Lock is begin - Local_Entity_Suppress.Locked := True; - Global_Entity_Suppress.Locked := True; Scope_Stack.Locked := True; - Local_Entity_Suppress.Release; - Global_Entity_Suppress.Release; Scope_Stack.Release; end Lock; + -------------------------------------- + -- Push_Global_Suppress_Stack_Entry -- + -------------------------------------- + + procedure Push_Global_Suppress_Stack_Entry + (Entity : Entity_Id; + Check : Check_Id; + Suppress : Boolean) + is + begin + Global_Suppress_Stack_Top := + new Suppress_Stack_Entry' + (Entity => Entity, + Check => Check, + Suppress => Suppress, + Prev => Global_Suppress_Stack_Top, + Next => Suppress_Stack_Entries); + Suppress_Stack_Entries := Global_Suppress_Stack_Top; + return; + + end Push_Global_Suppress_Stack_Entry; + + ------------------------------------- + -- Push_Local_Suppress_Stack_Entry -- + ------------------------------------- + + procedure Push_Local_Suppress_Stack_Entry + (Entity : Entity_Id; + Check : Check_Id; + Suppress : Boolean) + is + begin + Local_Suppress_Stack_Top := + new Suppress_Stack_Entry' + (Entity => Entity, + Check => Check, + Suppress => Suppress, + Prev => Local_Suppress_Stack_Top, + Next => Suppress_Stack_Entries); + Suppress_Stack_Entries := Local_Suppress_Stack_Top; + + return; + end Push_Local_Suppress_Stack_Entry; + --------------- -- Semantics -- --------------- |