Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/exp_ch4.adb @ 131:84e7813d76e9
gcc-8.2
| author | mir3636 |
|---|---|
| date | Thu, 25 Oct 2018 07:37:49 +0900 |
| parents | 04ced10e8804 |
| children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/ada/exp_ch4.adb Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/ada/exp_ch4.adb Thu Oct 25 07:37:49 2018 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2018, 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- -- @@ -630,7 +630,9 @@ -- [Deep_]Finalize (Obj_Ref.all); - if Needs_Finalization (DesigT) then + if Needs_Finalization (DesigT) + and then not No_Heap_Finalization (PtrT) + then Fin_Call := Make_Final_Call (Obj_Ref => @@ -2333,7 +2335,6 @@ is Loc : constant Source_Ptr := Sloc (Nod); Full_Type : Entity_Id; - Prim : Elmt_Id; Eq_Op : Entity_Id; function Find_Primitive_Eq return Node_Id; @@ -2426,51 +2427,61 @@ -- For composite component types, and floating-point types, use the -- expansion. This deals with tagged component types (where we use - -- the applicable equality routine) and floating-point, (where we + -- the applicable equality routine) and floating-point (where we -- need to worry about negative zeroes), and also the case of any -- composite type recursively containing such fields. else - return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Full_Type); + declare + Comp_Typ : Entity_Id; + Hi : Node_Id; + Indx : Node_Id; + Ityp : Entity_Id; + Lo : Node_Id; + + begin + -- Do the comparison in the type (or its full view) and not in + -- its unconstrained base type, because the latter operation is + -- more complex and would also require an unchecked conversion. + + if Is_Private_Type (Typ) then + Comp_Typ := Underlying_Type (Typ); + else + Comp_Typ := Typ; + end if; + + -- Except for the case where the bounds of the type depend on a + -- discriminant, or else we would run into scoping issues. + + Indx := First_Index (Comp_Typ); + while Present (Indx) loop + Ityp := Etype (Indx); + + Lo := Type_Low_Bound (Ityp); + Hi := Type_High_Bound (Ityp); + + if (Nkind (Lo) = N_Identifier + and then Ekind (Entity (Lo)) = E_Discriminant) + or else + (Nkind (Hi) = N_Identifier + and then Ekind (Entity (Hi)) = E_Discriminant) + then + Comp_Typ := Full_Type; + exit; + end if; + + Next_Index (Indx); + end loop; + + return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Comp_Typ); + end; end if; -- Case of tagged record types elsif Is_Tagged_Type (Full_Type) then - - -- Call the primitive operation "=" of this type - - if Is_Class_Wide_Type (Full_Type) then - Full_Type := Root_Type (Full_Type); - end if; - - -- If this is derived from an untagged private type completed with a - -- tagged type, it does not have a full view, so we use the primitive - -- operations of the private type. This check should no longer be - -- necessary when these types receive their full views ??? - - if Is_Private_Type (Typ) - and then not Is_Tagged_Type (Typ) - and then not Is_Controlled (Typ) - and then Is_Derived_Type (Typ) - and then No (Full_View (Typ)) - then - Prim := First_Elmt (Collect_Primitive_Operations (Typ)); - else - Prim := First_Elmt (Primitive_Operations (Full_Type)); - end if; - - loop - Eq_Op := Node (Prim); - exit when Chars (Eq_Op) = Name_Op_Eq - and then Etype (First_Formal (Eq_Op)) = - Etype (Next_Formal (First_Formal (Eq_Op))) - and then Base_Type (Etype (Eq_Op)) = Standard_Boolean; - Next_Elmt (Prim); - pragma Assert (Present (Prim)); - end loop; - - Eq_Op := Node (Prim); + Eq_Op := Find_Primitive_Eq (Typ); + pragma Assert (Present (Eq_Op)); return Make_Function_Call (Loc, @@ -2764,7 +2775,7 @@ -- special case of setting the right high bound for a null result. -- This is of type Ityp. - High_Bound : Node_Id; + High_Bound : Node_Id := Empty; -- A tree node representing the high bound of the result (of type Ityp) Result : Node_Id; @@ -4017,8 +4028,12 @@ Else_Expr : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc); begin + -- To prevent spurious visibility issues, convert all + -- operands to Standard.Unsigned. + Set_Left_Opnd (Cond_Expr, - New_Copy_Tree (Left_Opnd (N))); + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N)))); Set_Right_Opnd (Cond_Expr, Make_Integer_Literal (Loc, Mod_Minus_Right)); Append_To (Exprs, Cond_Expr); @@ -4052,12 +4067,14 @@ Op_Expr : constant Node_Id := New_Op_Node (Nkind (N), Loc); Mod_Expr : constant Node_Id := New_Op_Node (N_Op_Mod, Loc); + Target_Type : Entity_Id; + begin -- Convert nonbinary modular type operands into integer values. Thus -- we avoid never-ending loops expanding them, and we also ensure -- the back end never receives nonbinary modular type expressions. - if Nkind_In (Nkind (N), N_Op_And, N_Op_Or) then + if Nkind_In (Nkind (N), N_Op_And, N_Op_Or, N_Op_Xor) then Set_Left_Opnd (Op_Expr, Unchecked_Convert_To (Standard_Unsigned, New_Copy_Tree (Left_Opnd (N)))); @@ -4068,11 +4085,21 @@ Unchecked_Convert_To (Standard_Integer, Op_Expr)); else + -- If the modulus of the type is larger than Integer'Last + -- use a larger type for the operands, to prevent spurious + -- constraint errors on large legal literals of the type. + + if Modulus (Etype (N)) > UI_From_Int (Int (Integer'Last)) then + Target_Type := Standard_Long_Integer; + else + Target_Type := Standard_Integer; + end if; + Set_Left_Opnd (Op_Expr, - Unchecked_Convert_To (Standard_Integer, + Unchecked_Convert_To (Target_Type, New_Copy_Tree (Left_Opnd (N)))); Set_Right_Opnd (Op_Expr, - Unchecked_Convert_To (Standard_Integer, + Unchecked_Convert_To (Target_Type, New_Copy_Tree (Right_Opnd (N)))); -- Link this node to the tree to analyze it @@ -4140,7 +4167,8 @@ Loc); begin Set_Left_Opnd (Cond_Expr, - New_Copy_Tree (Left_Opnd (N))); + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N)))); Set_Right_Opnd (Cond_Expr, Make_Integer_Literal (Loc, Intval (Right_Opnd (N)))); Append_To (Exprs, Cond_Expr); @@ -4170,10 +4198,10 @@ -- Start of processing for Expand_Nonbinary_Modular_Op begin - -- No action needed if we are not generating C code for a nonbinary - -- modular operand. - - if not Modify_Tree_For_C + -- No action needed if front-end expansion is not required or if we + -- have a binary modular operand. + + if not Expand_Nonbinary_Modular_Ops or else not Non_Binary_Modulus (Typ) then return; @@ -4401,6 +4429,7 @@ Set_Storage_Pool (N, Pool); if Is_RTE (Pool, RE_SS_Pool) then + Check_Restriction (No_Secondary_Stack, N); Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); -- In the case of an allocator for a simple storage pool, locate @@ -4545,12 +4574,14 @@ end if; end if; - -- If no storage pool has been specified and we have the restriction + -- If no storage pool has been specified, or the storage pool + -- is System.Pool_Global.Global_Pool_Object, and the restriction -- No_Standard_Allocators_After_Elaboration is present, then generate -- a call to Elaboration_Allocators.Check_Standard_Allocator. if Nkind (N) = N_Allocator - and then No (Storage_Pool (N)) + and then (No (Storage_Pool (N)) + or else Is_RTE (Storage_Pool (N), RE_Global_Pool_Object)) and then Restriction_Active (No_Standard_Allocators_After_Elaboration) then Insert_Action (N, @@ -4593,7 +4624,7 @@ -- first argument to Init must be converted to the task record type. declare - T : constant Entity_Id := Entity (Expression (N)); + T : constant Entity_Id := Etype (Expression (N)); Args : List_Id; Decls : List_Id; Decl : Node_Id; @@ -4616,6 +4647,81 @@ Is_Allocate => True); end if; + -- Optimize the default allocation of an array object when pragma + -- Initialize_Scalars or Normalize_Scalars is in effect. Construct an + -- in-place initialization aggregate which may be convert into a fast + -- memset by the backend. + + elsif Init_Or_Norm_Scalars + and then Is_Array_Type (T) + + -- The array must lack atomic components because they are treated + -- as non-static, and as a result the backend will not initialize + -- the memory in one go. + + and then not Has_Atomic_Components (T) + + -- The array must not be packed because the invalid values in + -- System.Scalar_Values are multiples of Storage_Unit. + + and then not Is_Packed (T) + + -- The array must have static non-empty ranges, otherwise the + -- backend cannot initialize the memory in one go. + + and then Has_Static_Non_Empty_Array_Bounds (T) + + -- The optimization is only relevant for arrays of scalar types + + and then Is_Scalar_Type (Component_Type (T)) + + -- Similar to regular array initialization using a type init proc, + -- predicate checks are not performed because the initialization + -- values are intentionally invalid, and may violate the predicate. + + and then not Has_Predicates (Component_Type (T)) + + -- The component type must have a single initialization value + + and then Needs_Simple_Initialization + (Typ => Component_Type (T), + Consider_IS => True) + then + Set_Analyzed (N); + Temp := Make_Temporary (Loc, 'P'); + + -- Generate: + -- Temp : Ptr_Typ := new ...; + + Insert_Action + (Assoc_Node => N, + Ins_Action => + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Object_Definition => New_Occurrence_Of (PtrT, Loc), + Expression => Relocate_Node (N)), + Suppress => All_Checks); + + -- Generate: + -- Temp.all := (others => ...); + + Insert_Action + (Assoc_Node => N, + Ins_Action => + Make_Assignment_Statement (Loc, + Name => + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Temp, Loc)), + Expression => + Get_Simple_Init_Val + (Typ => T, + N => N, + Size => Esize (Component_Type (T)))), + Suppress => All_Checks); + + Rewrite (N, New_Occurrence_Of (Temp, Loc)); + Analyze_And_Resolve (N, PtrT); + -- Case of no initialization procedure present elsif not Has_Non_Null_Base_Init_Proc (T) then @@ -4798,7 +4904,7 @@ declare Dis : Boolean := False; - Typ : Entity_Id; + Typ : Entity_Id := Empty; begin if Has_Discriminants (T) then @@ -5338,7 +5444,7 @@ and then Is_Finalizable_Transient (Act, N) then Process_Transient_In_Expression (Act, N, Acts); - return Abandon; + return Skip; -- Avoid processing temporary function results multiple times when -- dealing with nested expression_with_actions. @@ -6013,10 +6119,20 @@ -- have a test in the generic that makes sense with some types -- and not with other types. - and then not In_Instance + -- Similarly, do not rewrite membership as a validity check if + -- within the predicate function for the type. + then - Substitute_Valid_Check; - goto Leave; + if In_Instance + or else (Ekind (Current_Scope) = E_Function + and then Is_Predicate_Function (Current_Scope)) + then + null; + + else + Substitute_Valid_Check; + goto Leave; + end if; end if; -- If we have an explicit range, do a bit of optimization based on @@ -6827,8 +6943,7 @@ -- Deal with software overflow checking - if not Backend_Overflow_Checks_On_Target - and then Is_Signed_Integer_Type (Etype (N)) + if Is_Signed_Integer_Type (Etype (N)) and then Do_Overflow_Check (N) then -- The only case to worry about is when the argument is equal to the @@ -6849,6 +6964,8 @@ New_Occurrence_Of (Base_Type (Etype (Expr)), Loc), Attribute_Name => Name_First)), Reason => CE_Overflow_Check_Failed)); + + Set_Do_Overflow_Check (N, False); end if; end Expand_N_Op_Abs; @@ -6897,12 +7014,7 @@ Check_Float_Op_Overflow (N); - -- When generating C code, convert nonbinary modular additions into code - -- that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Add; --------------------- @@ -6928,12 +7040,7 @@ Expand_Intrinsic_Call (N, Entity (N)); end if; - -- When generating C code, convert nonbinary modular operators into code - -- that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_And; ------------------------ @@ -7176,12 +7283,7 @@ Check_Float_Op_Overflow (N); - -- When generating C code, convert nonbinary modular divisions into code - -- that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Divide; -------------------- @@ -7742,16 +7844,14 @@ return; end if; - -- If this is derived from an untagged private type completed with - -- a tagged type, it does not have a full view, so we use the - -- primitive operations of the private type. This check should no - -- longer be necessary when these types get their full views??? - - if Is_Private_Type (A_Typ) - and then not Is_Tagged_Type (A_Typ) - and then Is_Derived_Type (A_Typ) - and then No (Full_View (A_Typ)) - then + -- If this is an untagged private type completed with a derivation + -- of an untagged private type whose full view is a tagged type, + -- we use the primitive operations of the private type (since it + -- does not have a full view, and also because its equality + -- primitive may have been overridden in its untagged full view). + + if Inherits_From_Tagged_Full_View (A_Typ) then + -- Search for equality operation, checking that the operands -- have the same type. Note that we must find a matching entry, -- or something is very wrong. @@ -8685,12 +8785,7 @@ Analyze_And_Resolve (N, Typ); end if; - -- When generating C code, convert nonbinary modular minus into code - -- that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Minus; --------------------- @@ -9168,12 +9263,7 @@ Check_Float_Op_Overflow (N); - -- When generating C code, convert nonbinary modular multiplications - -- into code that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Multiply; -------------------- @@ -9485,12 +9575,7 @@ Expand_Intrinsic_Call (N, Entity (N)); end if; - -- When generating C code, convert nonbinary modular operators into code - -- that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Or; ---------------------- @@ -9924,12 +10009,7 @@ Check_Float_Op_Overflow (N); - -- When generating C code, convert nonbinary modular subtractions into - -- code that relies on the front-end expansion of operator Mod. - - if Modify_Tree_For_C then - Expand_Nonbinary_Modular_Op (N); - end if; + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Subtract; --------------------- @@ -9953,8 +10033,9 @@ elsif Is_Intrinsic_Subprogram (Entity (N)) then Expand_Intrinsic_Call (N, Entity (N)); - - end if; + end if; + + Expand_Nonbinary_Modular_Op (N); end Expand_N_Op_Xor; ---------------------- @@ -10747,6 +10828,8 @@ if Present (Stored) then Elmt := First_Elmt (Stored); + else + Elmt := No_Elmt; -- init to avoid warning end if; Cons := New_List; @@ -10884,8 +10967,13 @@ Lo : constant Node_Id := Type_Low_Bound (Target_Type); Hi : constant Node_Id := Type_High_Bound (Target_Type); Xtyp : constant Entity_Id := Etype (Operand); - Conv : Node_Id; - Tnn : Entity_Id; + + Conv : Node_Id; + Hi_Arg : Node_Id; + Hi_Val : Node_Id; + Lo_Arg : Node_Id; + Lo_Val : Node_Id; + Tnn : Entity_Id; begin -- Nothing to do if conversion was rewritten @@ -10988,6 +11076,108 @@ Tnn := Make_Temporary (Loc, 'T', Conv); + -- For a conversion from Float to Fixed where the bounds of the + -- fixed-point type are static, we can obtain a more accurate + -- fixed-point value by converting the result of the floating- + -- point expression to an appropriate integer type, and then + -- performing an unchecked conversion to the target fixed-point + -- type. The range check can then use the corresponding integer + -- value of the bounds instead of requiring further conversions. + -- This preserves the identity: + + -- Fix_Val = Fixed_Type (Float_Type (Fix_Val)) + + -- which used to fail when Fix_Val was a bound of the type and + -- the 'Small was not a representable number. + -- This transformation requires an integer type large enough to + -- accommodate a fixed-point value. This will not be the case + -- in systems where Duration is larger than Long_Integer. + + if Is_Ordinary_Fixed_Point_Type (Target_Type) + and then Is_Floating_Point_Type (Operand_Type) + and then RM_Size (Base_Type (Target_Type)) <= + RM_Size (Standard_Long_Integer) + and then Nkind (Lo) = N_Real_Literal + and then Nkind (Hi) = N_Real_Literal + then + -- Find the integer type of the right size to perform an unchecked + -- conversion to the target fixed-point type. + + declare + Bfx_Type : constant Entity_Id := Base_Type (Target_Type); + Expr_Id : constant Entity_Id := + Make_Temporary (Loc, 'T', Conv); + Int_Type : Entity_Id; + + begin + if RM_Size (Bfx_Type) > RM_Size (Standard_Integer) then + Int_Type := Standard_Long_Integer; + + elsif RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer) then + Int_Type := Standard_Integer; + + else + Int_Type := Standard_Short_Integer; + end if; + + -- Generate a temporary with the integer value. Required in the + -- CCG compiler to ensure that runtime checks reference this + -- integer expression (instead of the resulting fixed-point + -- value) because fixed-point values are handled by means of + -- unsigned integer types). + + Insert_Action (N, + Make_Object_Declaration (Loc, + Defining_Identifier => Expr_Id, + Object_Definition => New_Occurrence_Of (Int_Type, Loc), + Constant_Present => True, + Expression => + Convert_To (Int_Type, Expression (Conv)))); + + -- Create integer objects for range checking of result. + + Lo_Arg := + Unchecked_Convert_To + (Int_Type, New_Occurrence_Of (Expr_Id, Loc)); + + Lo_Val := + Make_Integer_Literal (Loc, Corresponding_Integer_Value (Lo)); + + Hi_Arg := + Unchecked_Convert_To + (Int_Type, New_Occurrence_Of (Expr_Id, Loc)); + + Hi_Val := + Make_Integer_Literal (Loc, Corresponding_Integer_Value (Hi)); + + -- Rewrite conversion as an integer conversion of the + -- original floating-point expression, followed by an + -- unchecked conversion to the target fixed-point type. + + Conv := + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => New_Occurrence_Of (Target_Type, Loc), + Expression => New_Occurrence_Of (Expr_Id, Loc)); + end; + + -- All other conversions + + else + Lo_Arg := New_Occurrence_Of (Tnn, Loc); + Lo_Val := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Target_Type, Loc), + Attribute_Name => Name_First); + + Hi_Arg := New_Occurrence_Of (Tnn, Loc); + Hi_Val := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Target_Type, Loc), + Attribute_Name => Name_Last); + end if; + + -- Build code for range checking + Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, Defining_Identifier => Tnn, @@ -10997,25 +11187,17 @@ Make_Raise_Constraint_Error (Loc, Condition => - Make_Or_Else (Loc, - Left_Opnd => - Make_Op_Lt (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_First, - Prefix => - New_Occurrence_Of (Target_Type, Loc))), + Make_Or_Else (Loc, + Left_Opnd => + Make_Op_Lt (Loc, + Left_Opnd => Lo_Arg, + Right_Opnd => Lo_Val), Right_Opnd => Make_Op_Gt (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Last, - Prefix => - New_Occurrence_Of (Target_Type, Loc)))), - Reason => CE_Range_Check_Failed))); + Left_Opnd => Hi_Arg, + Right_Opnd => Hi_Val)), + Reason => CE_Range_Check_Failed))); Rewrite (N, New_Occurrence_Of (Tnn, Loc)); Analyze_And_Resolve (N, Btyp); @@ -11025,8 +11207,8 @@ -- Has_Extra_Accessibility -- ----------------------------- - -- Returns true for a formal of an anonymous access type or for - -- an Ada 2012-style stand-alone object of an anonymous access type. + -- Returns true for a formal of an anonymous access type or for an Ada + -- 2012-style stand-alone object of an anonymous access type. function Has_Extra_Accessibility (Id : Entity_Id) return Boolean is begin @@ -11277,6 +11459,7 @@ elsif In_Instance_Body and then Ekind (Operand_Type) = E_Anonymous_Access_Type and then Nkind (Operand) = N_Selected_Component + and then Ekind (Entity (Selector_Name (Operand))) = E_Discriminant and then Object_Access_Level (Operand) > Type_Access_Level (Target_Type) then @@ -11523,6 +11706,11 @@ elsif Is_Integer_Type (Etype (N)) then Expand_Convert_Fixed_To_Integer (N); + -- The result of the conversion might need a range check, + -- so do not assume that the result is in bounds. + + Set_Etype (N, Base_Type (Target_Type)); + else pragma Assert (Is_Floating_Point_Type (Etype (N))); Expand_Convert_Fixed_To_Float (N); @@ -11988,12 +12176,11 @@ -- Generates the following code: (assuming that Typ has one Discr and -- component C2 is also a record) - -- True - -- and then Lhs.Discr1 = Rhs.Discr1 - -- and then Lhs.C1 = Rhs.C1 - -- and then Lhs.C2.C1=Rhs.C2.C1 and then ... Lhs.C2.Cn=Rhs.C2.Cn - -- and then ... - -- and then Lhs.Cmpn = Rhs.Cmpn + -- Lhs.Discr1 = Rhs.Discr1 + -- and then Lhs.C1 = Rhs.C1 + -- and then Lhs.C2.C1=Rhs.C2.C1 and then ... Lhs.C2.Cn=Rhs.C2.Cn + -- and then ... + -- and then Lhs.Cmpn = Rhs.Cmpn Result := New_Occurrence_Of (Standard_True, Loc); C := Element_To_Compare (First_Entity (Typ)); @@ -12005,7 +12192,6 @@ begin if First_Time then - First_Time := False; New_Lhs := Lhs; New_Rhs := Rhs; else @@ -12033,13 +12219,28 @@ Set_Etype (Result, Standard_Boolean); exit; else - Result := - Make_And_Then (Loc, - Left_Opnd => Result, - Right_Opnd => Check); + if First_Time then + Result := Check; + + -- Generate logical "and" for CodePeer to simplify the + -- generated code and analysis. + + elsif CodePeer_Mode then + Result := + Make_Op_And (Loc, + Left_Opnd => Result, + Right_Opnd => Check); + + else + Result := + Make_And_Then (Loc, + Left_Opnd => Result, + Right_Opnd => Check); + end if; end if; end; + First_Time := False; C := Element_To_Compare (Next_Entity (C)); end loop; @@ -12065,7 +12266,7 @@ function Make_Cond (Alt : Node_Id) return Node_Id is Cond : Node_Id; - L : constant Node_Id := New_Copy (Lop); + L : constant Node_Id := New_Copy_Tree (Lop); R : constant Node_Id := Relocate_Node (Alt); begin @@ -12364,7 +12565,7 @@ Sel_Comp := Parent (Sel_Comp); end loop; - return Ekind (Entity (Prefix (Sel_Comp))) in Formal_Kind; + return Is_Formal (Entity (Prefix (Sel_Comp))); end Prefix_Is_Formal_Parameter; -- Start of processing for Has_Inferable_Discriminants @@ -13109,10 +13310,10 @@ Comp : Node_Id; -- Comparison operand, set only if Is_Zero is false - Ent : Entity_Id; + Ent : Entity_Id := Empty; -- Entity whose length is being compared - Index : Node_Id; + Index : Node_Id := Empty; -- Integer_Literal node for length attribute expression, or Empty -- if there is no such expression present. @@ -13837,7 +14038,7 @@ Selector_Name => New_Occurrence_Of (First_Tag_Component (Left_Type), Loc)); - if Is_Class_Wide_Type (Right_Type) then + if Is_Class_Wide_Type (Right_Type) or else Is_Interface (Left_Type) then -- No need to issue a run-time check if we statically know that the -- result of this membership test is always true. For example,