2008-04-08 Hristian Kirtchev <kirtchev@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* exp_ch2.adb: Minor reformatting.
	(Expand_Entry_Index_Parameter): Set the type of the identifier.
	(Expand_Entry_Reference): Add call to Expand_Protected_Component.
	(Expand_Protected_Component): New routine.
	(Expand_Protected_Private): Removed.
	Add Sure parameter to Note_Possible_Modification calls

	* sem_ch12.ads, sem_ch12.adb (Analyze_Subprogram_Instantiation): The
	generated subprogram declaration must inherit the overriding indicator
	from the instantiation node.
	(Validate_Access_Type_Instance): If the designated type of the actual is
	a limited view, use the available view in all cases, not only if the
	type is an incomplete type.
	(Instantiate_Object):  Actual is illegal if the formal is null-excluding
	and the actual subtype does not exclude null.
	(Process_Default): Handle properly abstract formal subprograms.
	(Check_Formal_Package_Instance): Handle properly defaulted formal
	subprograms in a partially parameterized formal package.
	Add Sure parameter to Note_Possible_Modification calls
	(Validate_Derived_Type_Instance): if the formal is non-limited, the
	actual cannot be limited.
	(Collect_Previous_Instances): Generate instance bodies for subprograms
	as well.

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case Small): Don't
	try to set RM_Size.
	Add Sure parameter to Note_Possible_Modification calls
	(Analyze_At_Clause): Preserve Comes_From_Source on Rewrite call
	(Analyze_Attribute_Definition_Clause, case Attribute_Address): Check for
	constant overlaid by variable and issue warning.
	Use new Is_Standard_Character_Type predicate
	(Analyze_Record_Representation_Clause): Check that the specified
	Last_Bit is not less than First_Bit - 1.
	(Analyze_Attribute_Definition_Clause, case Address): Check for
	self-referential address clause

	* sem_ch5.ads, sem_ch5.adb (Diagnose_Non_Variable_Lhs): Rewrite the
	detection mechanism when the lhs is a prival.
	(Analyze_Assignment): Call Check_Unprotected_Access to detect
	assignment of a pointer to protected data, to an object declared
	outside of the protected object.
	(Analyze_Loop_Statement): Check for unreachable code after loop
	Add Sure parameter to Note_Possible_Modication calls
	Protect analysis from previous syntax error such as a scope mismatch
	or a missing begin.
	(Analyze_Assignment_Statement): The assignment is illegal if the
	left-hand is an interface.

	* sem_res.adb (Resolve_Arithmetic_Op): For mod/rem check violation of
	restriction No_Implicit_Conditionals
	Add Sure parameter to Note_Possible_Modication calls
	Use new Is_Standard_Character_Type predicate
	(Make_Call_Into_Operator): Preserve Comes_From_Source when rewriting
	call as operator. Fixes problems (e.g. validity checking) which
	come from the result looking as though it does not come from source).
	(Resolve_Call): Check case of name in named parameter if style checks
	are enabled.
	(Resolve_Call): Exclude calls to Current_Task as entry formal defaults
	from the checking that such calls should not occur from an entry body.
	(Resolve_Call): If the return type of an Inline_Always function
	requires the secondary stack, create a transient scope for the call
	if the body of the function is not available for inlining.
	(Resolve_Actuals): Apply Ada2005 checks to view conversions of arrays
	that are actuals for in-out formals.
	(Try_Object_Operation): If prefix is a tagged protected object,retrieve
	primitive operations from base type.
	(Analyze_Selected_Component): If the context is a call to a protected
	operation the parent may be an indexed component prior to expansion.
	(Resolve_Actuals): If an actual is of a protected subtype, use its
	base type to determine whether a conversion to the corresponding record
	is needed.
	(Resolve_Short_Circuit): Handle pragma Check

	* sem_eval.adb: Minor code reorganization (usea Is_Constant_Object)
	Use new Is_Standard_Character_Type predicate
	(Eval_Relational_Op): Catch more cases of string comparison



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134027 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 82 insertions, 40 deletions

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 3f39aca1307..c569a281845 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;
 
    ----------------------------