diff options
Diffstat (limited to 'gcc/ada/sem_ch5.adb')
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 122 |
1 files changed, 82 insertions, 40 deletions
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3f39aca..c569a28 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.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- -- @@ -118,31 +118,40 @@ package body Sem_Ch5 is -- Some special bad cases of entity names elsif Is_Entity_Name (N) then - if Ekind (Entity (N)) = E_In_Parameter then - Error_Msg_N - ("assignment to IN mode parameter not allowed", N); - - -- Private declarations in a protected object are turned into - -- constants when compiling a protected function. + declare + Ent : constant Entity_Id := Entity (N); - elsif Present (Scope (Entity (N))) - and then Is_Protected_Type (Scope (Entity (N))) - and then - (Ekind (Current_Scope) = E_Function - or else - Ekind (Enclosing_Dynamic_Scope (Current_Scope)) = E_Function) - then - Error_Msg_N - ("protected function cannot modify protected object", N); + begin + if Ekind (Ent) = E_In_Parameter then + Error_Msg_N + ("assignment to IN mode parameter not allowed", N); + + -- Renamings of protected private components are turned into + -- constants when compiling a protected function. In the case + -- of single protected types, the private component appears + -- directly. + + elsif (Is_Prival (Ent) + and then + (Ekind (Current_Scope) = E_Function + or else Ekind (Enclosing_Dynamic_Scope ( + Current_Scope)) = E_Function)) + or else + (Ekind (Ent) = E_Component + and then Is_Protected_Type (Scope (Ent))) + then + Error_Msg_N + ("protected function cannot modify protected object", N); - elsif Ekind (Entity (N)) = E_Loop_Parameter then - Error_Msg_N - ("assignment to loop parameter not allowed", N); + elsif Ekind (Ent) = E_Loop_Parameter then + Error_Msg_N + ("assignment to loop parameter not allowed", N); - else - Error_Msg_N - ("left hand side of assignment must be a variable", N); - end if; + else + Error_Msg_N + ("left hand side of assignment must be a variable", N); + end if; + end; -- For indexed components or selected components, test prefix @@ -430,6 +439,15 @@ package body Sem_Ch5 is ("left hand of assignment must not be limited type", Lhs); Explain_Limited_Type (T1, Lhs); return; + + -- Enforce RM 3.9.3 (8): left-hand side cannot be abstract + + elsif Is_Interface (T1) + and then not Is_Class_Wide_Type (T1) + then + Error_Msg_N + ("target of assignment operation may not be abstract", Lhs); + return; end if; -- Resolution may have updated the subtype, in case the left-hand @@ -469,6 +487,7 @@ package body Sem_Ch5 is -- This is the point at which we check for an unset reference Check_Unset_Reference (Rhs); + Check_Unprotected_Access (Lhs, Rhs); -- Remaining steps are skipped if Rhs was syntactically in error @@ -588,7 +607,7 @@ package body Sem_Ch5 is -- We still mark this as a possible modification, that's necessary -- to reset Is_True_Constant, and desirable for xref purposes. - Note_Possible_Modification (Lhs); + Note_Possible_Modification (Lhs, Sure => True); return; -- If we know the right hand side is non-null, then we convert to the @@ -635,7 +654,7 @@ package body Sem_Ch5 is -- Note: modifications of the Lhs may only be recorded after -- checks have been applied. - Note_Possible_Modification (Lhs); + Note_Possible_Modification (Lhs, Sure => True); -- ??? a real accessibility check is needed when ??? @@ -1901,20 +1920,36 @@ package body Sem_Ch5 is Analyze (Id); Ent := Entity (Id); - Generate_Reference (Ent, Loop_Statement, ' '); - Generate_Definition (Ent); - -- If we found a label, mark its type. If not, ignore it, since it - -- means we have a conflicting declaration, which would already have - -- been diagnosed at declaration time. Set Label_Construct of the - -- implicit label declaration, which is not created by the parser - -- for generic units. + -- Guard against serious error (typically, a scope mismatch when + -- semantic analysis is requested) by creating loop entity to + -- continue analysis. - if Ekind (Ent) = E_Label then - Set_Ekind (Ent, E_Loop); + if No (Ent) then + if Total_Errors_Detected /= 0 then + Ent := + New_Internal_Entity + (E_Loop, Current_Scope, Sloc (Loop_Statement), 'L'); + else + raise Program_Error; + end if; + + else + Generate_Reference (Ent, Loop_Statement, ' '); + Generate_Definition (Ent); - if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then - Set_Label_Construct (Parent (Ent), Loop_Statement); + -- If we found a label, mark its type. If not, ignore it, since it + -- means we have a conflicting declaration, which would already + -- have been diagnosed at declaration time. Set Label_Construct + -- of the implicit label declaration, which is not created by the + -- parser for generic units. + + if Ekind (Ent) = E_Label then + Set_Ekind (Ent, E_Loop); + + if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then + Set_Label_Construct (Parent (Ent), Loop_Statement); + end if; end if; end if; @@ -1928,10 +1963,10 @@ package body Sem_Ch5 is Set_Parent (Ent, Loop_Statement); end if; - -- Kill current values on entry to loop, since statements in body - -- of loop may have been executed before the loop is entered. - -- Similarly we kill values after the loop, since we do not know - -- that the body of the loop was executed. + -- Kill current values on entry to loop, since statements in body of + -- loop may have been executed before the loop is entered. Similarly we + -- kill values after the loop, since we do not know that the body of the + -- loop was executed. Kill_Current_Values; Push_Scope (Ent); @@ -1941,6 +1976,13 @@ package body Sem_Ch5 is End_Scope; Kill_Current_Values; Check_Infinite_Loop_Warning (N); + + -- Code after loop is unreachable if the loop has no WHILE or FOR + -- and contains no EXIT statements within the body of the loop. + + if No (Iter) and then not Has_Exit (Ent) then + Check_Unreachable_Code (N); + end if; end Analyze_Loop_Statement; ---------------------------- |