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, 394 insertions, 187 deletions

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9e8687daad6..b9ef016a498 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -68,6 +68,7 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
+with Style;    use Style;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -395,9 +396,9 @@ package body Sem_Res is
       D    : Node_Id;
 
    begin
-      --  Any use in a default expression is legal
+      --  Any use in a a spec-expression is legal
 
-      if In_Default_Expression then
+      if In_Spec_Expression then
          null;
 
       elsif Nkind (PN) = N_Range then
@@ -434,10 +435,9 @@ package body Sem_Res is
               and then Scope (Disc) = Current_Scope
               and then not
                 (Nkind (Parent (P)) = N_Subtype_Indication
-                   and then
-                    (Nkind (Parent (Parent (P))) = N_Component_Definition
-                       or else
-                     Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
+                  and then
+                    Nkind_In (Parent (Parent (P)), N_Component_Definition,
+                                                   N_Subtype_Declaration)
                   and then Paren_Count (N) = 0)
             then
                Error_Msg_N
@@ -554,8 +554,8 @@ package body Sem_Res is
 
       --  Legal case is in index or discriminant constraint
 
-      elsif Nkind (PN) = N_Index_Or_Discriminant_Constraint
-        or else Nkind (PN) = N_Discriminant_Association
+      elsif Nkind_In (PN, N_Index_Or_Discriminant_Constraint,
+                          N_Discriminant_Association)
       then
          if Paren_Count (N) > 0 then
             Error_Msg_N
@@ -576,9 +576,9 @@ package body Sem_Res is
       else
          D := PN;
          P := Parent (PN);
-         while Nkind (P) /= N_Component_Declaration
-           and then Nkind (P) /= N_Subtype_Indication
-           and then Nkind (P) /= N_Entry_Declaration
+         while not Nkind_In (P, N_Component_Declaration,
+                                N_Subtype_Indication,
+                                N_Entry_Declaration)
          loop
             D := P;
             P := Parent (P);
@@ -591,10 +591,8 @@ package body Sem_Res is
          --  is of course a double fault.
 
          if (Nkind (P) = N_Subtype_Indication
-              and then
-                (Nkind (Parent (P)) = N_Component_Definition
-                   or else
-                 Nkind (Parent (P)) = N_Derived_Type_Definition)
+              and then Nkind_In (Parent (P), N_Component_Definition,
+                                             N_Derived_Type_Definition)
               and then D = Constraint (P))
 
          --  The constraint itself may be given by a subtype indication,
@@ -753,11 +751,10 @@ package body Sem_Res is
       loop
          P := Parent (C);
          exit when Nkind (P) = N_Subprogram_Body;
-
-         if Nkind (P) = N_Or_Else        or else
-            Nkind (P) = N_And_Then       or else
-            Nkind (P) = N_If_Statement   or else
-            Nkind (P) = N_Case_Statement
+         if Nkind_In (P, N_Or_Else,
+                         N_And_Then,
+                         N_If_Statement,
+                         N_Case_Statement)
          then
             return False;
 
@@ -963,25 +960,24 @@ package body Sem_Res is
          Require_Entity (N);
       end if;
 
-      --  If the context expects a value, and the name is a procedure,
-      --  this is most likely a missing 'Access. Do not try to resolve
-      --  the parameterless call, error will be caught when the outer
-      --  call is analyzed.
+      --  If the context expects a value, and the name is a procedure, this is
+      --  most likely a missing 'Access. Don't try to resolve the parameterless
+      --  call, error will be caught when the outer call is analyzed.
 
       if Is_Entity_Name (N)
         and then Ekind (Entity (N)) = E_Procedure
         and then not Is_Overloaded (N)
         and then
-         (Nkind (Parent (N)) = N_Parameter_Association
-            or else Nkind (Parent (N)) = N_Function_Call
-            or else Nkind (Parent (N)) = N_Procedure_Call_Statement)
+         Nkind_In (Parent (N), N_Parameter_Association,
+                               N_Function_Call,
+                               N_Procedure_Call_Statement)
       then
          return;
       end if;
 
-      --  Rewrite as call if overloadable entity that is (or could be, in
-      --  the overloaded case) a function call. If we know for sure that
-      --  the entity is an enumeration literal, we do not rewrite it.
+      --  Rewrite as call if overloadable entity that is (or could be, in the
+      --  overloaded case) a function call. If we know for sure that the entity
+      --  is an enumeration literal, we do not rewrite it.
 
       if (Is_Entity_Name (N)
             and then Is_Overloadable (Entity (N))
@@ -1386,7 +1382,19 @@ package body Sem_Res is
 
       Set_Entity (Op_Node, Op_Id);
       Generate_Reference (Op_Id, N, ' ');
-      Rewrite (N,  Op_Node);
+
+      --  Do rewrite setting Comes_From_Source on the result if the original
+      --  call came from source. Although it is not strictly the case that the
+      --  operator as such comes from the source, logically it corresponds
+      --  exactly to the function call in the source, so it should be marked
+      --  this way (e.g. to make sure that validity checks work fine).
+
+      declare
+         CS : constant Boolean := Comes_From_Source (N);
+      begin
+         Rewrite (N, Op_Node);
+         Set_Comes_From_Source (N, CS);
+      end;
 
       --  If this is an arithmetic operator and the result type is private,
       --  the operands and the result must be wrapped in conversion to
@@ -1487,11 +1495,11 @@ package body Sem_Res is
       return Kind;
    end Operator_Kind;
 
-   -----------------------------
-   -- Pre_Analyze_And_Resolve --
-   -----------------------------
+   ----------------------------
+   -- Preanalyze_And_Resolve --
+   ----------------------------
 
-   procedure Pre_Analyze_And_Resolve (N : Node_Id; T : Entity_Id) is
+   procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
       Save_Full_Analysis : constant Boolean := Full_Analysis;
 
    begin
@@ -1506,11 +1514,11 @@ package body Sem_Res is
 
       Expander_Mode_Restore;
       Full_Analysis := Save_Full_Analysis;
-   end Pre_Analyze_And_Resolve;
+   end Preanalyze_And_Resolve;
 
    --  Version without context type
 
-   procedure Pre_Analyze_And_Resolve (N : Node_Id) is
+   procedure Preanalyze_And_Resolve (N : Node_Id) is
       Save_Full_Analysis : constant Boolean := Full_Analysis;
 
    begin
@@ -1522,7 +1530,7 @@ package body Sem_Res is
 
       Expander_Mode_Restore;
       Full_Analysis := Save_Full_Analysis;
-   end Pre_Analyze_And_Resolve;
+   end Preanalyze_And_Resolve;
 
    ----------------------------------
    -- Replace_Actual_Discriminants --
@@ -1647,6 +1655,7 @@ package body Sem_Res is
                 Intval => UR_To_Uint (Realval (N))));
             Set_Etype (N, Universal_Integer);
             Set_Is_Static_Expression (N);
+
          elsif Nkind (N) = N_String_Literal
            and then Is_Character_Type (Typ)
          then
@@ -1909,8 +1918,8 @@ package body Sem_Res is
                      --  of the arguments is Any_Type, and if so, suppress
                      --  the message, since it is a cascaded error.
 
-                     if Nkind (N) = N_Function_Call
-                       or else Nkind (N) = N_Procedure_Call_Statement
+                     if Nkind_In (N, N_Function_Call,
+                                     N_Procedure_Call_Statement)
                      then
                         declare
                            A : Node_Id;
@@ -2079,14 +2088,14 @@ package body Sem_Res is
                --  with a name that is an explicit dereference, there is
                --  nothing to be done at this point.
 
-               elsif     Nkind (N) = N_Explicit_Dereference
-                 or else Nkind (N) = N_Attribute_Reference
-                 or else Nkind (N) = N_And_Then
-                 or else Nkind (N) = N_Indexed_Component
-                 or else Nkind (N) = N_Or_Else
-                 or else Nkind (N) = N_Range
-                 or else Nkind (N) = N_Selected_Component
-                 or else Nkind (N) = N_Slice
+               elsif Nkind_In (N, N_Explicit_Dereference,
+                                  N_Attribute_Reference,
+                                  N_And_Then,
+                                  N_Indexed_Component,
+                                  N_Or_Else,
+                                  N_Range,
+                                  N_Selected_Component,
+                                  N_Slice)
                  or else Nkind (Name (N)) = N_Explicit_Dereference
                then
                   null;
@@ -2094,8 +2103,7 @@ package body Sem_Res is
                --  For procedure or function calls, set the type of the name,
                --  and also the entity pointer for the prefix
 
-               elsif (Nkind (N) = N_Procedure_Call_Statement
-                       or else Nkind (N) = N_Function_Call)
+               elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
                  and then (Is_Entity_Name (Name (N))
                             or else Nkind (Name (N)) = N_Operator_Symbol)
                then
@@ -2398,8 +2406,8 @@ package body Sem_Res is
 
             elsif Present (Alias (Entity (N)))
               and then
-                Nkind (Parent (Parent (Entity (N))))
-                  = N_Subprogram_Renaming_Declaration
+                Nkind (Parent (Parent (Entity (N)))) =
+                                    N_Subprogram_Renaming_Declaration
             then
                Rewrite_Renamed_Operator (N, Alias (Entity (N)), Typ);
 
@@ -2613,6 +2621,11 @@ package body Sem_Res is
       Prev   : Node_Id := Empty;
       Orig_A : Node_Id;
 
+      procedure Check_Argument_Order;
+      --  Performs a check for the case where the actuals are all simple
+      --  identifiers that correspond to the formal names, but in the wrong
+      --  order, which is considered suspicious and cause for a warning.
+
       procedure Check_Prefixed_Call;
       --  If the original node is an overloaded call in prefix notation,
       --  insert an 'Access or a dereference as needed over the first actual.
@@ -2630,6 +2643,119 @@ package body Sem_Res is
       --  common type. Used to enforce the restrictions on array conversions
       --  of AI95-00246.
 
+      --------------------------
+      -- Check_Argument_Order --
+      --------------------------
+
+      procedure Check_Argument_Order is
+      begin
+         --  Nothing to do if no parameters, or original node is neither a
+         --  function call nor a procedure call statement (happens in the
+         --  operator-transformed-to-function call case), or the call does
+         --  not come from source, or this warning is off.
+
+         if not Warn_On_Parameter_Order
+           or else
+             No (Parameter_Associations (N))
+           or else
+             not Nkind_In (Original_Node (N), N_Procedure_Call_Statement,
+                                              N_Function_Call)
+           or else
+             not Comes_From_Source (N)
+         then
+            return;
+         end if;
+
+         declare
+            Nargs : constant Nat := List_Length (Parameter_Associations (N));
+
+         begin
+            --  Nothing to do if only one parameter
+
+            if Nargs < 2 then
+               return;
+            end if;
+
+            --  Here if at least two arguments
+
+            declare
+               Actuals : array (1 .. Nargs) of Node_Id;
+               Actual  : Node_Id;
+               Formal  : Node_Id;
+
+               Wrong_Order : Boolean := False;
+               --  Set True if an out of order case is found
+
+            begin
+               --  Collect identifier names of actuals, fail if any actual is
+               --  not a simple identifier, and record max length of name.
+
+               Actual := First (Parameter_Associations (N));
+               for J in Actuals'Range loop
+                  if Nkind (Actual) /= N_Identifier then
+                     return;
+                  else
+                     Actuals (J) := Actual;
+                     Next (Actual);
+                  end if;
+               end loop;
+
+               --  If we got this far, all actuals are identifiers and the list
+               --  of their names is stored in the Actuals array.
+
+               Formal := First_Formal (Nam);
+               for J in Actuals'Range loop
+
+                  --  If we ran out of formals, that's odd, probably an error
+                  --  which will be detected elsewhere, but abandon the search.
+
+                  if No (Formal) then
+                     return;
+                  end if;
+
+                  --  If name matches and is in order OK
+
+                  if Chars (Formal) = Chars (Actuals (J)) then
+                     null;
+
+                  else
+                     --  If no match, see if it is elsewhere in list and if so
+                     --  flag potential wrong order if type is compatible.
+
+                     for K in Actuals'Range loop
+                        if Chars (Formal) = Chars (Actuals (K))
+                          and then
+                            Has_Compatible_Type (Actuals (K), Etype (Formal))
+                        then
+                           Wrong_Order := True;
+                           goto Continue;
+                        end if;
+                     end loop;
+
+                     --  No match
+
+                     return;
+                  end if;
+
+                  <<Continue>> Next_Formal (Formal);
+               end loop;
+
+               --  If Formals left over, also probably an error, skip warning
+
+               if Present (Formal) then
+                  return;
+               end if;
+
+               --  Here we give the warning if something was out of order
+
+               if Wrong_Order then
+                  Error_Msg_N
+                    ("actuals for this call may be in wrong order?", N);
+               end if;
+            end;
+         end;
+      end Check_Argument_Order;
+
       -------------------------
       -- Check_Prefixed_Call --
       -------------------------
@@ -2866,6 +2992,8 @@ package body Sem_Res is
    --  Start of processing for Resolve_Actuals
 
    begin
+      Check_Argument_Order;
+
       if Present (First_Actual (N)) then
          Check_Prefixed_Call;
       end if;
@@ -2889,7 +3017,7 @@ package body Sem_Res is
 
          --  Case where actual is present
 
-         --  If the actual is an entity,  generate a reference to it now. We
+         --  If the actual is an entity, generate a reference to it now. We
          --  do this before the actual is resolved, because a formal of some
          --  protected subprogram, or a task discriminant, will be rewritten
          --  during expansion, and the reference to the source entity may
@@ -2906,7 +3034,6 @@ package body Sem_Res is
                  and then Ekind (F) /= E_In_Parameter
                then
                   Generate_Reference (Orig_A, A, 'm');
-
                elsif not Is_Overloaded (A) then
                   Generate_Reference (Orig_A, A);
                end if;
@@ -2918,6 +3045,14 @@ package body Sem_Res is
                        or else
                      Chars (Selector_Name (Parent (A))) = Chars (F))
          then
+            --  If style checking mode on, check match of formal name
+
+            if Style_Check then
+               if Nkind (Parent (A)) = N_Parameter_Association then
+                  Check_Identifier (Selector_Name (Parent (A)), F);
+               end if;
+            end if;
+
             --  If the formal is Out or In_Out, do not resolve and expand the
             --  conversion, because it is subsequently expanded into explicit
             --  temporaries and assignments. However, the object of the
@@ -2941,32 +3076,51 @@ package body Sem_Res is
                   if Has_Aliased_Components (Etype (Expression (A)))
                     /= Has_Aliased_Components (Etype (F))
                   then
-                     if Ada_Version < Ada_05 then
-                        Error_Msg_N
-                          ("both component types in a view conversion must be"
-                            & " aliased, or neither", A);
 
-                     --  Ada 2005: rule is relaxed (see AI-363)
+                     --  In a view conversion, the conversion must be legal in
+                     --  both directions, and thus both component types must be
+                     --  aliased, or neither (4.6 (8)).
 
-                     elsif Has_Aliased_Components (Etype (F))
-                       and then
-                         not Has_Aliased_Components (Etype (Expression (A)))
+                     --  The additional rule 4.6 (24.9.2) seems unduly
+                     --  restrictive: the privacy requirement should not
+                     --  apply to generic types, and should be checked in
+                     --  an instance. ARG query is in order.
+
+                     Error_Msg_N
+                       ("both component types in a view conversion must be"
+                         & " aliased, or neither", A);
+
+                  elsif
+                     not Same_Ancestor (Etype (F), Etype (Expression (A)))
+                  then
+                     if Is_By_Reference_Type (Etype (F))
+                        or else Is_By_Reference_Type (Etype (Expression (A)))
                      then
                         Error_Msg_N
-                          ("view conversion operand must have aliased " &
-                           "components", N);
-                        Error_Msg_N
-                          ("\since target type has aliased components", N);
+                          ("view conversion between unrelated by reference " &
+                           "array types not allowed (\'A'I-00246)", A);
+                     else
+                        declare
+                           Comp_Type : constant Entity_Id :=
+                                         Component_Type
+                                           (Etype (Expression (A)));
+                        begin
+                           if Comes_From_Source (A)
+                             and then Ada_Version >= Ada_05
+                             and then
+                               ((Is_Private_Type (Comp_Type)
+                                   and then not Is_Generic_Type (Comp_Type))
+                                 or else Is_Tagged_Type (Comp_Type)
+                                 or else Is_Volatile (Comp_Type))
+                           then
+                              Error_Msg_N
+                                ("component type of a view conversion cannot"
+                                   & " be private, tagged, or volatile"
+                                   & " (RM 4.6 (24))",
+                                   Expression (A));
+                           end if;
+                        end;
                      end if;
-
-                  elsif not Same_Ancestor (Etype (F), Etype (Expression (A)))
-                    and then
-                     (Is_By_Reference_Type (Etype (F))
-                        or else Is_By_Reference_Type (Etype (Expression (A))))
-                  then
-                     Error_Msg_N
-                       ("view conversion between unrelated by reference " &
-                        "array types not allowed (\'A'I-00246)", A);
                   end if;
                end if;
 
@@ -3024,14 +3178,15 @@ package body Sem_Res is
                   declare
                      DDT : constant Entity_Id :=
                              Directly_Designated_Type (Base_Type (Etype (F)));
+
                      New_Itype : Entity_Id;
+
                   begin
                      if Is_Class_Wide_Type (DDT)
                        and then Is_Interface (DDT)
                      then
                         New_Itype := Create_Itype (E_Anonymous_Access_Type, A);
-                        Set_Etype       (New_Itype, Etype (A));
-                        Init_Size_Align (New_Itype);
+                        Set_Etype (New_Itype, Etype (A));
                         Set_Directly_Designated_Type (New_Itype,
                           Directly_Designated_Type (Etype (A)));
                         Set_Etype (A, New_Itype);
@@ -3043,8 +3198,7 @@ package body Sem_Res is
                      --  enabled only, otherwise the transient scope will not
                      --  be removed in the expansion of the wrapped construct.
 
-                     if (Is_Controlled (DDT)
-                          or else Has_Task (DDT))
+                     if (Is_Controlled (DDT) or else Has_Task (DDT))
                        and then Expander_Active
                      then
                         Establish_Transient_Scope (A, False);
@@ -3056,9 +3210,13 @@ package body Sem_Res is
                --   a tagged synchronized type, declared outside of the type.
                --   In this case the controlling actual must be converted to
                --   its corresponding record type, which is the formal type.
+               --   The actual may be a subtype, either because of a constraint
+               --   or because it is a generic actual, so use base type to
+               --   locate concurrent type.
 
                if Is_Concurrent_Type (Etype (A))
-                 and then Etype (F) = Corresponding_Record_Type (Etype (A))
+                 and then Etype (F) =
+                            Corresponding_Record_Type (Base_Type (Etype (A)))
                then
                   Rewrite (A,
                     Unchecked_Convert_To
@@ -3130,14 +3288,14 @@ package body Sem_Res is
             if Ekind (F) /= E_In_Parameter then
 
                --  For an Out parameter, check for useless assignment. Note
-               --  that we can't set Last_Assignment this early, because we
-               --  may kill current values in Resolve_Call, and that call
-               --  would clobber the Last_Assignment field.
+               --  that we can't set Last_Assignment this early, because we may
+               --  kill current values in Resolve_Call, and that call would
+               --  clobber the Last_Assignment field.
 
-               --  Note: call Warn_On_Useless_Assignment before doing the
-               --  check below for Is_OK_Variable_For_Out_Formal so that the
-               --  setting of Referenced_As_LHS/Referenced_As_Out_Formal
-               --  properly reflects the last assignment, not this one!
+               --  Note: call Warn_On_Useless_Assignment before doing the check
+               --  below for Is_OK_Variable_For_Out_Formal so that the setting
+               --  of Referenced_As_LHS/Referenced_As_Out_Formal properly
+               --  reflects the last assignment, not this one!
 
                if Ekind (F) = E_Out_Parameter then
                   if Warn_On_Modified_As_Out_Parameter (F)
@@ -3258,8 +3416,8 @@ package body Sem_Res is
             end if;
 
             --  An actual associated with an access parameter is implicitly
-            --  converted to the anonymous access type of the formal and
-            --  must satisfy the legality checks for access conversions.
+            --  converted to the anonymous access type of the formal and must
+            --  satisfy the legality checks for access conversions.
 
             if Ekind (F_Typ) = E_Anonymous_Access_Type then
                if not Valid_Conversion (A, F_Typ, A) then
@@ -3500,8 +3658,7 @@ package body Sem_Res is
       function In_Dispatching_Context return Boolean is
          Par : constant Node_Id := Parent (N);
       begin
-         return (Nkind (Par) = N_Function_Call
-                   or else Nkind (Par) = N_Procedure_Call_Statement)
+         return Nkind_In (Par, N_Function_Call, N_Procedure_Call_Statement)
            and then Is_Entity_Name (Name (Par))
            and then Is_Dispatching_Operation (Entity (Name (Par)));
       end In_Dispatching_Context;
@@ -3691,10 +3848,7 @@ package body Sem_Res is
             Aggr := Original_Node (Expression (E));
 
             if Has_Discriminants (Subtyp)
-              and then
-                (Nkind (Aggr) = N_Aggregate
-                   or else
-                 Nkind (Aggr) = N_Extension_Aggregate)
+              and then Nkind_In (Aggr, N_Aggregate, N_Extension_Aggregate)
             then
                Discrim := First_Discriminant (Base_Type (Subtyp));
 
@@ -3938,18 +4092,18 @@ package body Sem_Res is
          --  N is the expression after "delta" in a fixed_point_definition;
          --  see RM-3.5.9(6):
 
-         return    Nkind (Parent (N)) = N_Ordinary_Fixed_Point_Definition
-           or else Nkind (Parent (N)) = N_Decimal_Fixed_Point_Definition
+         return Nkind_In (Parent (N), N_Ordinary_Fixed_Point_Definition,
+                                      N_Decimal_Fixed_Point_Definition,
 
          --  N is one of the bounds in a real_range_specification;
          --  see RM-3.5.7(5):
 
-           or else Nkind (Parent (N)) = N_Real_Range_Specification
+                                      N_Real_Range_Specification,
 
          --  N is the expression of a delta_constraint;
          --  see RM-J.3(3):
 
-           or else Nkind (Parent (N)) = N_Delta_Constraint;
+                                      N_Delta_Constraint);
       end Expected_Type_Is_Any_Real;
 
       -----------------------------
@@ -4143,8 +4297,7 @@ package body Sem_Res is
       --  conversion to a specific fixed-point type (instead the expander
       --  takes care of the case).
 
-      elsif (B_Typ = Universal_Integer
-           or else B_Typ = Universal_Real)
+      elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real)
         and then Present (Universal_Interpretation (L))
         and then Present (Universal_Interpretation (R))
       then
@@ -4153,15 +4306,14 @@ package body Sem_Res is
          Set_Etype (N, B_Typ);
 
       elsif (B_Typ = Universal_Real
-           or else Etype (N) = Universal_Fixed
-           or else (Etype (N) = Any_Fixed
-                     and then Is_Fixed_Point_Type (B_Typ))
-           or else (Is_Fixed_Point_Type (B_Typ)
-                     and then (Is_Integer_Or_Universal (L)
-                                 or else
-                               Is_Integer_Or_Universal (R))))
-        and then (Nkind (N) = N_Op_Multiply or else
-                  Nkind (N) = N_Op_Divide)
+              or else Etype (N) = Universal_Fixed
+              or else (Etype (N) = Any_Fixed
+                        and then Is_Fixed_Point_Type (B_Typ))
+              or else (Is_Fixed_Point_Type (B_Typ)
+                        and then (Is_Integer_Or_Universal (L)
+                                   or else
+                                  Is_Integer_Or_Universal (R))))
+        and then Nkind_In (N, N_Op_Multiply, N_Op_Divide)
       then
          if TL = Universal_Integer or else TR = Universal_Integer then
             Check_For_Visible_Operator (N, B_Typ);
@@ -4189,38 +4341,36 @@ package body Sem_Res is
             Set_Mixed_Mode_Operand (R, TL);
          end if;
 
-         --  Check the rule in RM05-4.5.5(19.1/2) disallowing the
-         --  universal_fixed multiplying operators from being used when the
-         --  expected type is also universal_fixed. Note that B_Typ will be
-         --  Universal_Fixed in some cases where the expected type is actually
-         --  Any_Real; Expected_Type_Is_Any_Real takes care of that case.
+         --  Check the rule in RM05-4.5.5(19.1/2) disallowing universal_fixed
+         --  multiplying operators from being used when the expected type is
+         --  also universal_fixed. Note that B_Typ will be Universal_Fixed in
+         --  some cases where the expected type is actually Any_Real;
+         --  Expected_Type_Is_Any_Real takes care of that case.
 
          if Etype (N) = Universal_Fixed
            or else Etype (N) = Any_Fixed
          then
             if B_Typ = Universal_Fixed
               and then not Expected_Type_Is_Any_Real (N)
-              and then Nkind (Parent (N)) /= N_Type_Conversion
-              and then Nkind (Parent (N)) /= N_Unchecked_Type_Conversion
+              and then not Nkind_In (Parent (N), N_Type_Conversion,
+                                                 N_Unchecked_Type_Conversion)
             then
-               Error_Msg_N
-                 ("type cannot be determined from context!", N);
-               Error_Msg_N
-                 ("\explicit conversion to result type required", N);
+               Error_Msg_N ("type cannot be determined from context!", N);
+               Error_Msg_N ("\explicit conversion to result type required", N);
 
                Set_Etype (L, Any_Type);
                Set_Etype (R, Any_Type);
 
             else
                if Ada_Version = Ada_83
-                  and then Etype (N) = Universal_Fixed
-                  and then Nkind (Parent (N)) /= N_Type_Conversion
-                  and then Nkind (Parent (N)) /= N_Unchecked_Type_Conversion
+                 and then Etype (N) = Universal_Fixed
+                 and then not
+                   Nkind_In (Parent (N), N_Type_Conversion,
+                                         N_Unchecked_Type_Conversion)
                then
                   Error_Msg_N
-                    ("(Ada 83) fixed-point operation " &
-                     "needs explicit conversion",
-                     N);
+                    ("(Ada 83) fixed-point operation "
+                     & "needs explicit conversion", N);
                end if;
 
                --  The expected type is "any real type" in contexts like
@@ -4239,8 +4389,7 @@ package body Sem_Res is
            and then (Is_Integer_Or_Universal (L)
                        or else Nkind (L) = N_Real_Literal
                        or else Nkind (R) = N_Real_Literal
-                       or else
-                     Is_Integer_Or_Universal (R))
+                       or else Is_Integer_Or_Universal (R))
          then
             Set_Etype (N, B_Typ);
 
@@ -4254,7 +4403,8 @@ package body Sem_Res is
 
       else
          if (TL = Universal_Integer or else TL = Universal_Real)
-           and then (TR = Universal_Integer or else TR = Universal_Real)
+              and then
+            (TR = Universal_Integer or else TR = Universal_Real)
          then
             Check_For_Visible_Operator (N, B_Typ);
          end if;
@@ -4263,9 +4413,7 @@ package body Sem_Res is
          --  universal fixed, this is an error, unless there is only one
          --  applicable fixed_point type (usually duration).
 
-         if B_Typ = Universal_Fixed
-           and then Etype (L) = Universal_Fixed
-         then
+         if B_Typ = Universal_Fixed and then Etype (L) = Universal_Fixed then
             T := Unique_Fixed_Point_Type (N);
 
             if T  = Any_Type then
@@ -4306,19 +4454,17 @@ package body Sem_Res is
 
          --  Give warning if explicit division by zero
 
-         if (Nkind (N) = N_Op_Divide
-             or else Nkind (N) = N_Op_Rem
-             or else Nkind (N) = N_Op_Mod)
+         if Nkind_In (N, N_Op_Divide, N_Op_Rem, N_Op_Mod)
            and then not Division_Checks_Suppressed (Etype (N))
          then
             Rop := Right_Opnd (N);
 
             if Compile_Time_Known_Value (Rop)
               and then ((Is_Integer_Type (Etype (Rop))
-                                and then Expr_Value (Rop) = Uint_0)
+                           and then Expr_Value (Rop) = Uint_0)
                           or else
                         (Is_Real_Type (Etype (Rop))
-                                and then Expr_Value_R (Rop) = Ureal_0))
+                           and then Expr_Value_R (Rop) = Ureal_0))
             then
                --  Specialize the warning message according to the operation
 
@@ -4351,6 +4497,38 @@ package body Sem_Res is
                Activate_Division_Check (N);
             end if;
          end if;
+
+         --  If Restriction No_Implicit_Conditionals is active, then it is
+         --  violated if either operand can be negative for mod, or for rem
+         --  if both operands can be negative.
+
+         if Restrictions.Set (No_Implicit_Conditionals)
+           and then Nkind_In (N, N_Op_Rem, N_Op_Mod)
+         then
+            declare
+               Lo : Uint;
+               Hi : Uint;
+               OK : Boolean;
+
+               LNeg : Boolean;
+               RNeg : Boolean;
+               --  Set if corresponding operand might be negative
+
+            begin
+               Determine_Range (Left_Opnd (N), OK, Lo, Hi);
+               LNeg := (not OK) or else Lo < 0;
+
+               Determine_Range (Right_Opnd (N), OK, Lo, Hi);
+               RNeg := (not OK) or else Lo < 0;
+
+               if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg))
+                    or else
+                  (Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
+               then
+                  Check_Restriction (No_Implicit_Conditionals, N);
+               end if;
+            end;
+         end if;
       end if;
 
       Check_Unset_Reference (L);
@@ -4426,8 +4604,7 @@ package body Sem_Res is
       --  operations use the same circuitry because the name in the call
       --  can be an arbitrary expression with special resolution rules.
 
-      elsif Nkind (Subp) = N_Selected_Component
-        or else Nkind (Subp) = N_Indexed_Component
+      elsif Nkind_In (Subp, N_Selected_Component, N_Indexed_Component)
         or else (Is_Entity_Name (Subp)
                   and then Ekind (Entity (Subp)) = E_Entry)
       then
@@ -4474,11 +4651,16 @@ package body Sem_Res is
             P := N;
             loop
                P := Parent (P);
-               exit when No (P);
+
+               --  Exclude calls that occur within the default of a formal
+               --  parameter of the entry, since those are evaluated outside
+               --  of the body.
+
+               exit when No (P) or else Nkind (P) = N_Parameter_Specification;
 
                if Nkind (P) = N_Entry_Body
                  or else (Nkind (P) = N_Subprogram_Body
-                            and then Is_Entry_Barrier_Function (P))
+                           and then Is_Entry_Barrier_Function (P))
                then
                   Rtype := Etype (N);
                   Error_Msg_NE
@@ -4540,7 +4722,7 @@ package body Sem_Res is
          Error_Msg_N ("\cannot call operation that may modify it", N);
       end if;
 
-      --  Freeze the subprogram name if not in default expression. Note that we
+      --  Freeze the subprogram name if not in a spec-expression. Note that we
       --  freeze procedure calls as well as function calls. Procedure calls are
       --  not frozen according to the rules (RM 13.14(14)) because it is
       --  impossible to have a procedure call to a non-frozen procedure in pure
@@ -4548,7 +4730,7 @@ package body Sem_Res is
       --  needs extending because we can generate procedure calls that need
       --  freezing.
 
-      if Is_Entity_Name (Subp) and then not In_Default_Expression then
+      if Is_Entity_Name (Subp) and then not In_Spec_Expression then
          Freeze_Expression (Subp);
       end if;
 
@@ -4803,12 +4985,14 @@ package body Sem_Res is
 
       --  If the subprogram is marked Inline_Always, then even if it returns
       --  an unconstrained type the call does not require use of the secondary
-      --  stack.
+      --  stack. However, inlining will only take place if the body to inline
+      --  is already present. It may not be available if e.g. the subprogram is
+      --  declared in a child instance.
 
       if Is_Inlined (Nam)
-        and then Present (First_Rep_Item (Nam))
-        and then Nkind (First_Rep_Item (Nam)) = N_Pragma
-        and then Pragma_Name (First_Rep_Item (Nam)) = Name_Inline_Always
+        and then Has_Pragma_Inline_Always (Nam)
+        and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
+        and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
       then
          null;
 
@@ -4883,8 +5067,14 @@ package body Sem_Res is
       --  way we still take advantage of the current value information while
       --  scanning the actuals.
 
-      if (not Is_Library_Level_Entity (Nam)
-            or else Suppress_Value_Tracking_On_Call (Current_Scope))
+      --  We suppress killing values if we are processing the nodes associated
+      --  with N_Freeze_Entity nodes. Otherwise the declaration of a tagged
+      --  type kills all the values as part of analyzing the code that
+      --  initializes the dispatch tables.
+
+      if Inside_Freezing_Actions = 0
+        and then (not Is_Library_Level_Entity (Nam)
+                   or else Suppress_Value_Tracking_On_Call (Current_Scope))
         and then (Comes_From_Source (Nam)
                    or else (Present (Alias (Nam))
                              and then Comes_From_Source (Alias (Nam))))
@@ -5291,7 +5481,7 @@ package body Sem_Res is
            and then Comes_From_Source (E)
            and then No (Constant_Value (E))
            and then Is_Frozen (Etype (E))
-           and then not In_Default_Expression
+           and then not In_Spec_Expression
            and then not Is_Imported (E)
          then
 
@@ -5852,6 +6042,7 @@ package body Sem_Res is
              (Corresponding_Equality (Entity (N)))
          then
             Eval_Relational_Op (N);
+
          elsif Nkind (N) = N_Op_Ne
            and then Is_Abstract_Subprogram (Entity (N))
          then
@@ -6382,9 +6573,8 @@ package body Sem_Res is
          --  In the common case of a call which uses an explicitly null
          --  value for an access parameter, give specialized error msg
 
-         if Nkind (Parent (N)) = N_Procedure_Call_Statement
-              or else
-            Nkind (Parent (N)) = N_Function_Call
+         if Nkind_In (Parent (N), N_Procedure_Call_Statement,
+                                  N_Function_Call)
          then
             Error_Msg_N
               ("null is not allowed as argument for an access parameter", N);
@@ -6999,7 +7189,7 @@ package body Sem_Res is
       --  sequences that otherwise fail to notice the modification.
 
       if Is_Entity_Name (P) and then Treat_As_Volatile (Entity (P)) then
-         Note_Possible_Modification (P);
+         Note_Possible_Modification (P, Sure => False);
       end if;
    end Resolve_Reference;
 
@@ -7223,8 +7413,8 @@ package body Sem_Res is
       Resolve (L, B_Typ);
       Resolve (R, B_Typ);
 
-      --  Check for issuing warning for always False assert, this happens
-      --  when assertions are turned off, in which case the pragma Assert
+      --  Check for issuing warning for always False assert/check, this happens
+      --  when assertions are turned off, in which case the pragma Assert/Check
       --  was transformed into:
 
       --     if False and then <condition> then ...
@@ -7241,6 +7431,7 @@ package body Sem_Res is
       then
          declare
             Orig : constant Node_Id := Original_Node (Parent (N));
+
          begin
             if Nkind (Orig) = N_Pragma
               and then Pragma_Name (Orig) = Name_Assert
@@ -7269,6 +7460,29 @@ package body Sem_Res is
                      Error_Msg_N ("?assertion would fail at run-time", Orig);
                   end if;
                end;
+
+            --  Similar processing for Check pragma
+
+            elsif Nkind (Orig) = N_Pragma
+              and then Pragma_Name (Orig) = Name_Check
+            then
+               --  Don't want to warn if original condition is explicit False
+
+               declare
+                  Expr : constant Node_Id :=
+                           Original_Node
+                             (Expression
+                                (Next (First
+                                  (Pragma_Argument_Associations (Orig)))));
+               begin
+                  if Is_Entity_Name (Expr)
+                    and then Entity (Expr) = Standard_False
+                  then
+                     null;
+                  else
+                     Error_Msg_N ("?check would fail at run-time", Orig);
+                  end if;
+               end;
             end if;
          end;
       end if;
@@ -7477,16 +7691,17 @@ package body Sem_Res is
 
       elsif Nkind (Parent (N)) = N_Op_Concat
         and then not Need_Check
-        and then Nkind (Original_Node (N)) /= N_Character_Literal
-        and then Nkind (Original_Node (N)) /= N_Attribute_Reference
-        and then Nkind (Original_Node (N)) /= N_Qualified_Expression
-        and then Nkind (Original_Node (N)) /= N_Type_Conversion
+        and then not Nkind_In (Original_Node (N), N_Character_Literal,
+                                                  N_Attribute_Reference,
+                                                  N_Qualified_Expression,
+                                                  N_Type_Conversion)
       then
          Subtype_Id := Typ;
 
       --  Otherwise we must create a string literal subtype. Note that the
       --  whole idea of string literal subtypes is simply to avoid the need
       --  for building a full fledged array subtype for each literal.
+
       else
          Set_String_Literal_Subtype (N, Typ);
          Subtype_Id := Etype (N);
@@ -7607,10 +7822,8 @@ package body Sem_Res is
          --  corresponding character aggregate and let the aggregate
          --  code do the checking.
 
-         if R_Typ = Standard_Character
-           or else R_Typ = Standard_Wide_Character
-           or else R_Typ = Standard_Wide_Wide_Character
-         then
+         if Is_Standard_Character_Type (R_Typ) then
+
             --  Check for the case of full range, where we are definitely OK
 
             if Component_Type (Typ) = Base_Type (Component_Type (Typ)) then
@@ -7730,10 +7943,10 @@ package body Sem_Res is
             Set_Etype (Operand, Universal_Real);
 
          elsif Is_Numeric_Type (Typ)
-           and then (Nkind (Operand) = N_Op_Multiply
-                      or else Nkind (Operand) = N_Op_Divide)
+           and then Nkind_In (Operand, N_Op_Multiply, N_Op_Divide)
            and then (Etype (Right_Opnd (Operand)) = Universal_Real
-                     or else Etype (Left_Opnd (Operand)) = Universal_Real)
+                       or else
+                     Etype (Left_Opnd  (Operand)) = Universal_Real)
          then
             --  Return if expression is ambiguous
 
@@ -8043,11 +8256,7 @@ package body Sem_Res is
             --  mod. These are the cases where the grouping can affect results.
 
             if Paren_Count (Rorig) = 0
-              and then (Nkind (Rorig) = N_Op_Mod
-                          or else
-                        Nkind (Rorig) = N_Op_Multiply
-                          or else
-                        Nkind (Rorig) = N_Op_Divide)
+              and then Nkind_In (Rorig, N_Op_Mod, N_Op_Multiply, N_Op_Divide)
             then
                --  For mod, we always give the warning, since the value is
                --  affected by the parenthesization (e.g. (-5) mod 315 /=
@@ -8129,9 +8338,7 @@ package body Sem_Res is
                --  overflow is impossible (divisor > 1) or we have a case of
                --  division by zero in any case.
 
-               if (Nkind (Rorig) = N_Op_Divide
-                    or else
-                   Nkind (Rorig) = N_Op_Rem)
+               if Nkind_In (Rorig, N_Op_Divide, N_Op_Rem)
                  and then Compile_Time_Known_Value (Right_Opnd (Rorig))
                  and then UI_Abs (Expr_Value (Right_Opnd (Rorig))) /= 1
                then
@@ -8334,7 +8541,6 @@ package body Sem_Res is
       Set_First_Index    (Slice_Subtype, Index);
       Set_Etype          (Slice_Subtype, Base_Type (Etype (N)));
       Set_Is_Constrained (Slice_Subtype, True);
-      Init_Size_Align    (Slice_Subtype);
 
       Check_Compile_Time_Size (Slice_Subtype);
 
@@ -8349,7 +8555,9 @@ package body Sem_Res is
       --  call to Check_Compile_Time_Size could be eliminated, which would
       --  be nice, because then that routine could be made private to Freeze.
 
-      if Is_Packed (Slice_Subtype) and not In_Default_Expression then
+      --  Why the test for In_Spec_Expression here ???
+
+      if Is_Packed (Slice_Subtype) and not In_Spec_Expression then
          Freeze_Itype (Slice_Subtype, N);
       end if;
 
@@ -8435,7 +8643,6 @@ package body Sem_Res is
             Set_First_Index    (Array_Subtype, Index);
             Set_Etype          (Array_Subtype, Base_Type (Typ));
             Set_Is_Constrained (Array_Subtype, True);
-            Init_Size_Align    (Array_Subtype);
 
             Rewrite (N,
               Make_Unchecked_Type_Conversion (Loc,
@@ -8573,7 +8780,6 @@ package body Sem_Res is
 
       if Nkind (N) = N_Real_Literal then
          Error_Msg_NE ("?real literal interpreted as }!", N, T1);
-
       else
          Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1);
       end if;
@@ -8736,11 +8942,12 @@ package body Sem_Res is
                return False;
             end if;
 
-            --  Check that component subtypes statically match
+            --  Check that component subtypes statically match. For numeric
+            --  types this means that both must be either constrained or
+            --  unconstrained. For enumeration types the bounds must match.
+            --  All of this is checked in Subtypes_Statically_Match.
 
-            if Is_Constrained (Target_Comp_Type) /=
-                 Is_Constrained (Opnd_Comp_Type)
-              or else not Subtypes_Statically_Match
+            if not Subtypes_Statically_Match
                             (Target_Comp_Type, Opnd_Comp_Type)
             then
                Error_Msg_N
@@ -8993,7 +9200,7 @@ package body Sem_Res is
 
                if Nkind (Operand) = N_Selected_Component
                  and then Object_Access_Level (Operand) >
-                            Type_Access_Level (Target_Type)
+                          Type_Access_Level (Target_Type)
                then
                   --  In an instance, this is a run-time check, but one we
                   --  know will fail, so generate an appropriate warning.
@@ -9102,8 +9309,8 @@ package body Sem_Res is
                --  handles checking the prefix of the operand for this case.)
 
                if Nkind (Operand) = N_Selected_Component
-                 and then Object_Access_Level (Operand)
-                   > Type_Access_Level (Target_Type)
+                 and then Object_Access_Level (Operand) >
+                          Type_Access_Level (Target_Type)
                then
                   --  In an instance, this is a run-time check, but one we
                   --  know will fail, so generate an appropriate warning.