Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/checks.adb @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
comparison
equal
deleted
inserted
replaced
111:04ced10e8804 | 131:84e7813d76e9 |
---|---|
4 -- -- | 4 -- -- |
5 -- C H E C K S -- | 5 -- C H E C K S -- |
6 -- -- | 6 -- -- |
7 -- B o d y -- | 7 -- B o d y -- |
8 -- -- | 8 -- -- |
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- | 9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- |
10 -- -- | 10 -- -- |
11 -- GNAT is free software; you can redistribute it and/or modify it under -- | 11 -- GNAT is free software; you can redistribute it and/or modify it under -- |
12 -- terms of the GNU General Public License as published by the Free Soft- -- | 12 -- terms of the GNU General Public License as published by the Free Soft- -- |
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- | 13 -- ware Foundation; either version 3, or (at your option) any later ver- -- |
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
1456 T_Typ := Designated_Type (Typ); | 1456 T_Typ := Designated_Type (Typ); |
1457 else | 1457 else |
1458 T_Typ := Typ; | 1458 T_Typ := Typ; |
1459 end if; | 1459 end if; |
1460 | 1460 |
1461 -- If the expression is a function call that returns a limited object | |
1462 -- it cannot be copied. It is not clear how to perform the proper | |
1463 -- discriminant check in this case because the discriminant value must | |
1464 -- be retrieved from the constructed object itself. | |
1465 | |
1466 if Nkind (N) = N_Function_Call | |
1467 and then Is_Limited_Type (Typ) | |
1468 and then Is_Entity_Name (Name (N)) | |
1469 and then Returns_By_Ref (Entity (Name (N))) | |
1470 then | |
1471 return; | |
1472 end if; | |
1473 | |
1461 -- Only apply checks when generating code and discriminant checks are | 1474 -- Only apply checks when generating code and discriminant checks are |
1462 -- not suppressed. In GNATprove mode, we do not apply the checks, but we | 1475 -- not suppressed. In GNATprove mode, we do not apply the checks, but we |
1463 -- still analyze the expression to possibly issue errors on SPARK code | 1476 -- still analyze the expression to possibly issue errors on SPARK code |
1464 -- when a run-time error can be detected at compile time. | 1477 -- when a run-time error can be detected at compile time. |
1465 | 1478 |
1858 ROK : Boolean) | 1871 ROK : Boolean) |
1859 is | 1872 is |
1860 pragma Assert (Do_Division_Check (N)); | 1873 pragma Assert (Do_Division_Check (N)); |
1861 | 1874 |
1862 Loc : constant Source_Ptr := Sloc (N); | 1875 Loc : constant Source_Ptr := Sloc (N); |
1863 Right : constant Node_Id := Right_Opnd (N); | 1876 Right : constant Node_Id := Right_Opnd (N); |
1877 Opnd : Node_Id; | |
1864 | 1878 |
1865 begin | 1879 begin |
1866 if Expander_Active | 1880 if Expander_Active |
1867 and then not Backend_Divide_Checks_On_Target | 1881 and then not Backend_Divide_Checks_On_Target |
1868 and then Check_Needed (Right, Division_Check) | 1882 and then Check_Needed (Right, Division_Check) |
1883 | |
1884 -- See if division by zero possible, and if so generate test. This | |
1885 -- part of the test is not controlled by the -gnato switch, since it | |
1886 -- is a Division_Check and not an Overflow_Check. | |
1887 | |
1888 and then Do_Division_Check (N) | |
1869 then | 1889 then |
1870 -- See if division by zero possible, and if so generate test. This | 1890 Set_Do_Division_Check (N, False); |
1871 -- part of the test is not controlled by the -gnato switch, since | 1891 |
1872 -- it is a Division_Check and not an Overflow_Check. | 1892 if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then |
1873 | 1893 if Is_Floating_Point_Type (Etype (N)) then |
1874 if Do_Division_Check (N) then | 1894 Opnd := Make_Real_Literal (Loc, Ureal_0); |
1875 Set_Do_Division_Check (N, False); | 1895 else |
1876 | 1896 Opnd := Make_Integer_Literal (Loc, 0); |
1877 if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then | |
1878 Insert_Action (N, | |
1879 Make_Raise_Constraint_Error (Loc, | |
1880 Condition => | |
1881 Make_Op_Eq (Loc, | |
1882 Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), | |
1883 Right_Opnd => Make_Integer_Literal (Loc, 0)), | |
1884 Reason => CE_Divide_By_Zero)); | |
1885 end if; | 1897 end if; |
1898 | |
1899 Insert_Action (N, | |
1900 Make_Raise_Constraint_Error (Loc, | |
1901 Condition => | |
1902 Make_Op_Eq (Loc, | |
1903 Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), | |
1904 Right_Opnd => Opnd), | |
1905 Reason => CE_Divide_By_Zero)); | |
1886 end if; | 1906 end if; |
1887 end if; | 1907 end if; |
1888 end Apply_Division_Check; | 1908 end Apply_Division_Check; |
1889 | 1909 |
1890 ---------------------------------- | 1910 ---------------------------------- |
2763 is | 2783 is |
2764 Parnt : constant Node_Id := Parent (Expr); | 2784 Parnt : constant Node_Id := Parent (Expr); |
2765 S_Typ : Entity_Id; | 2785 S_Typ : Entity_Id; |
2766 Arr : Node_Id := Empty; -- initialize to prevent warning | 2786 Arr : Node_Id := Empty; -- initialize to prevent warning |
2767 Arr_Typ : Entity_Id := Empty; -- initialize to prevent warning | 2787 Arr_Typ : Entity_Id := Empty; -- initialize to prevent warning |
2768 OK : Boolean := False; -- initialize to prevent warning | |
2769 | 2788 |
2770 Is_Subscr_Ref : Boolean; | 2789 Is_Subscr_Ref : Boolean; |
2771 -- Set true if Expr is a subscript | 2790 -- Set true if Expr is a subscript |
2772 | 2791 |
2773 Is_Unconstrained_Subscr_Ref : Boolean; | 2792 Is_Unconstrained_Subscr_Ref : Boolean; |
2993 begin | 3012 begin |
2994 if Compile_Time_Known_Value (Tlo) | 3013 if Compile_Time_Known_Value (Tlo) |
2995 and then Compile_Time_Known_Value (Thi) | 3014 and then Compile_Time_Known_Value (Thi) |
2996 then | 3015 then |
2997 declare | 3016 declare |
3017 OK : Boolean := False; -- initialize to prevent warning | |
2998 Hiv : constant Uint := Expr_Value (Thi); | 3018 Hiv : constant Uint := Expr_Value (Thi); |
2999 Lov : constant Uint := Expr_Value (Tlo); | 3019 Lov : constant Uint := Expr_Value (Tlo); |
3000 Hi : Uint; | 3020 Hi : Uint := No_Uint; |
3001 Lo : Uint; | 3021 Lo : Uint := No_Uint; |
3002 | 3022 |
3003 begin | 3023 begin |
3004 -- If range is null, we for sure have a constraint error (we | 3024 -- If range is null, we for sure have a constraint error (we |
3005 -- don't even need to look at the value involved, since all | 3025 -- don't even need to look at the value involved, since all |
3006 -- possible values will raise CE). | 3026 -- possible values will raise CE). |
3063 return; | 3083 return; |
3064 | 3084 |
3065 -- If definitely not in range, warn | 3085 -- If definitely not in range, warn |
3066 | 3086 |
3067 elsif Lov > Hi or else Hiv < Lo then | 3087 elsif Lov > Hi or else Hiv < Lo then |
3068 Bad_Value; | 3088 |
3089 -- Ignore out of range values for System.Priority in | |
3090 -- CodePeer mode since the actual target compiler may | |
3091 -- provide a wider range. | |
3092 | |
3093 if not CodePeer_Mode | |
3094 or else Target_Typ /= RTE (RE_Priority) | |
3095 then | |
3096 Bad_Value; | |
3097 end if; | |
3098 | |
3069 return; | 3099 return; |
3070 | 3100 |
3071 -- Otherwise we don't know | 3101 -- Otherwise we don't know |
3072 | 3102 |
3073 else | 3103 else |
3516 then | 3546 then |
3517 if Float_To_Int | 3547 if Float_To_Int |
3518 and then not GNATprove_Mode | 3548 and then not GNATprove_Mode |
3519 then | 3549 then |
3520 Apply_Float_Conversion_Check (Expr, Target_Type); | 3550 Apply_Float_Conversion_Check (Expr, Target_Type); |
3551 | |
3521 else | 3552 else |
3522 Apply_Scalar_Range_Check | 3553 -- Conversions involving fixed-point types are expanded |
3523 (Expr, Target_Type, Fixed_Int => Conv_OK); | 3554 -- separately, and do not need a Range_Check flag, except |
3555 -- in SPARK_Mode, where the explicit constraint check will | |
3556 -- not be generated. | |
3557 | |
3558 if GNATprove_Mode | |
3559 or else not Is_Fixed_Point_Type (Expr_Type) | |
3560 then | |
3561 Apply_Scalar_Range_Check | |
3562 (Expr, Target_Type, Fixed_Int => Conv_OK); | |
3563 | |
3564 else | |
3565 Set_Do_Range_Check (Expression (N), False); | |
3566 end if; | |
3524 | 3567 |
3525 -- If the target type has predicates, we need to indicate | 3568 -- If the target type has predicates, we need to indicate |
3526 -- the need for a check, even if Determine_Range finds that | 3569 -- the need for a check, even if Determine_Range finds that |
3527 -- the value is within bounds. This may be the case e.g for | 3570 -- the value is within bounds. This may be the case e.g for |
3528 -- a division with a constant denominator. | 3571 -- a division with a constant denominator. |
3745 Dref : Node_Id; | 3788 Dref : Node_Id; |
3746 Dval : Node_Id; | 3789 Dval : Node_Id; |
3747 | 3790 |
3748 function Aggregate_Discriminant_Val (Disc : Entity_Id) return Node_Id; | 3791 function Aggregate_Discriminant_Val (Disc : Entity_Id) return Node_Id; |
3749 | 3792 |
3750 ---------------------------------- | 3793 -------------------------------- |
3751 -- Aggregate_Discriminant_Value -- | 3794 -- Aggregate_Discriminant_Val -- |
3752 ---------------------------------- | 3795 -------------------------------- |
3753 | 3796 |
3754 function Aggregate_Discriminant_Val (Disc : Entity_Id) return Node_Id is | 3797 function Aggregate_Discriminant_Val (Disc : Entity_Id) return Node_Id is |
3755 Assoc : Node_Id; | 3798 Assoc : Node_Id; |
3756 | 3799 |
3757 begin | 3800 begin |
4368 | 4411 |
4369 Lo_Left : Uint; | 4412 Lo_Left : Uint; |
4370 Hi_Left : Uint; | 4413 Hi_Left : Uint; |
4371 -- Lo and Hi bounds of left operand | 4414 -- Lo and Hi bounds of left operand |
4372 | 4415 |
4373 Lo_Right : Uint; | 4416 Lo_Right : Uint := No_Uint; |
4374 Hi_Right : Uint; | 4417 Hi_Right : Uint := No_Uint; |
4375 -- Lo and Hi bounds of right (or only) operand | 4418 -- Lo and Hi bounds of right (or only) operand |
4376 | 4419 |
4377 Bound : Node_Id; | 4420 Bound : Node_Id; |
4378 -- Temp variable used to hold a bound node | 4421 -- Temp variable used to hold a bound node |
4379 | 4422 |
4456 if No (Typ) | 4499 if No (Typ) |
4457 | 4500 |
4458 -- We don't deal with anything except discrete types | 4501 -- We don't deal with anything except discrete types |
4459 | 4502 |
4460 or else not Is_Discrete_Type (Typ) | 4503 or else not Is_Discrete_Type (Typ) |
4504 | |
4505 -- Don't deal with enumerated types with non-standard representation | |
4506 | |
4507 or else (Is_Enumeration_Type (Typ) | |
4508 and then Present (Enum_Pos_To_Rep (Base_Type (Typ)))) | |
4461 | 4509 |
4462 -- Ignore type for which an error has been posted, since range in | 4510 -- Ignore type for which an error has been posted, since range in |
4463 -- this case may well be a bogosity deriving from the error. Also | 4511 -- this case may well be a bogosity deriving from the error. Also |
4464 -- ignore if error posted on the reference node. | 4512 -- ignore if error posted on the reference node. |
4465 | 4513 |
4907 | 4955 |
4908 Lo_Left : Ureal; | 4956 Lo_Left : Ureal; |
4909 Hi_Left : Ureal; | 4957 Hi_Left : Ureal; |
4910 -- Lo and Hi bounds of left operand | 4958 -- Lo and Hi bounds of left operand |
4911 | 4959 |
4912 Lo_Right : Ureal; | 4960 Lo_Right : Ureal := No_Ureal; |
4913 Hi_Right : Ureal; | 4961 Hi_Right : Ureal := No_Ureal; |
4914 -- Lo and Hi bounds of right (or only) operand | 4962 -- Lo and Hi bounds of right (or only) operand |
4915 | 4963 |
4916 Bound : Node_Id; | 4964 Bound : Node_Id; |
4917 -- Temp variable used to hold a bound node | 4965 -- Temp variable used to hold a bound node |
4918 | 4966 |
6725 ----------------------------- | 6773 ----------------------------- |
6726 -- Convert_And_Check_Range -- | 6774 -- Convert_And_Check_Range -- |
6727 ----------------------------- | 6775 ----------------------------- |
6728 | 6776 |
6729 procedure Convert_And_Check_Range is | 6777 procedure Convert_And_Check_Range is |
6730 Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N); | 6778 Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N); |
6779 Conv_Node : Node_Id; | |
6731 | 6780 |
6732 begin | 6781 begin |
6782 -- For enumeration types with non-standard representation this is a | |
6783 -- direct conversion from the enumeration type to the target integer | |
6784 -- type, which is treated by the back end as a normal integer type | |
6785 -- conversion, treating the enumeration type as an integer, which is | |
6786 -- exactly what we want. We set Conversion_OK to make sure that the | |
6787 -- analyzer does not complain about what otherwise might be an | |
6788 -- illegal conversion. | |
6789 | |
6790 if Is_Enumeration_Type (Source_Base_Type) | |
6791 and then Present (Enum_Pos_To_Rep (Source_Base_Type)) | |
6792 and then Is_Integer_Type (Target_Base_Type) | |
6793 then | |
6794 Conv_Node := | |
6795 OK_Convert_To | |
6796 (Typ => Target_Base_Type, | |
6797 Expr => Duplicate_Subexpr (N)); | |
6798 | |
6799 -- Common case | |
6800 | |
6801 else | |
6802 Conv_Node := | |
6803 Make_Type_Conversion (Loc, | |
6804 Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc), | |
6805 Expression => Duplicate_Subexpr (N)); | |
6806 end if; | |
6807 | |
6733 -- We make a temporary to hold the value of the converted value | 6808 -- We make a temporary to hold the value of the converted value |
6734 -- (converted to the base type), and then do the test against this | 6809 -- (converted to the base type), and then do the test against this |
6735 -- temporary. The conversion itself is replaced by an occurrence of | 6810 -- temporary. The conversion itself is replaced by an occurrence of |
6736 -- Tnn and followed by the explicit range check. Note that checks | 6811 -- Tnn and followed by the explicit range check. Note that checks |
6737 -- are suppressed for this code, since we don't want a recursive | 6812 -- are suppressed for this code, since we don't want a recursive |
6743 Insert_Actions (N, New_List ( | 6818 Insert_Actions (N, New_List ( |
6744 Make_Object_Declaration (Loc, | 6819 Make_Object_Declaration (Loc, |
6745 Defining_Identifier => Tnn, | 6820 Defining_Identifier => Tnn, |
6746 Object_Definition => New_Occurrence_Of (Target_Base_Type, Loc), | 6821 Object_Definition => New_Occurrence_Of (Target_Base_Type, Loc), |
6747 Constant_Present => True, | 6822 Constant_Present => True, |
6748 Expression => | 6823 Expression => Conv_Node), |
6749 Make_Type_Conversion (Loc, | |
6750 Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc), | |
6751 Expression => Duplicate_Subexpr (N))), | |
6752 | 6824 |
6753 Make_Raise_Constraint_Error (Loc, | 6825 Make_Raise_Constraint_Error (Loc, |
6754 Condition => | 6826 Condition => |
6755 Make_Not_In (Loc, | 6827 Make_Not_In (Loc, |
6756 Left_Opnd => New_Occurrence_Of (Tnn, Loc), | 6828 Left_Opnd => New_Occurrence_Of (Tnn, Loc), |
6810 -- Force evaluation of the node, so that it does not get evaluated twice | 6882 -- Force evaluation of the node, so that it does not get evaluated twice |
6811 -- (once for the check, once for the actual reference). Such a double | 6883 -- (once for the check, once for the actual reference). Such a double |
6812 -- evaluation is always a potential source of inefficiency, and is | 6884 -- evaluation is always a potential source of inefficiency, and is |
6813 -- functionally incorrect in the volatile case. | 6885 -- functionally incorrect in the volatile case. |
6814 | 6886 |
6815 if not Is_Entity_Name (N) or else Treat_As_Volatile (Entity (N)) then | 6887 -- We skip the evaluation of attribute references because, after these |
6816 Force_Evaluation (N); | 6888 -- runtime checks are generated, the expander may need to rewrite this |
6889 -- node (for example, see Attribute_Max_Size_In_Storage_Elements in | |
6890 -- Expand_N_Attribute_Reference). | |
6891 | |
6892 if Nkind (N) /= N_Attribute_Reference | |
6893 and then (not Is_Entity_Name (N) | |
6894 or else Treat_As_Volatile (Entity (N))) | |
6895 then | |
6896 Force_Evaluation (N, Mode => Strict); | |
6817 end if; | 6897 end if; |
6818 | 6898 |
6819 -- The easiest case is when Source_Base_Type and Target_Base_Type are | 6899 -- The easiest case is when Source_Base_Type and Target_Base_Type are |
6820 -- the same since in this case we can simply do a direct check of the | 6900 -- the same since in this case we can simply do a direct check of the |
6821 -- value of N against the bounds of Target_Type. | 6901 -- value of N against the bounds of Target_Type. |
7685 end Mark_Non_Null; | 7765 end Mark_Non_Null; |
7686 | 7766 |
7687 -- Start of processing for Install_Null_Excluding_Check | 7767 -- Start of processing for Install_Null_Excluding_Check |
7688 | 7768 |
7689 begin | 7769 begin |
7770 -- No need to add null-excluding checks when the tree may not be fully | |
7771 -- decorated. | |
7772 | |
7773 if Serious_Errors_Detected > 0 then | |
7774 return; | |
7775 end if; | |
7776 | |
7690 pragma Assert (Is_Access_Type (Typ)); | 7777 pragma Assert (Is_Access_Type (Typ)); |
7691 | 7778 |
7692 -- No check inside a generic, check will be emitted in instance | 7779 -- No check inside a generic, check will be emitted in instance |
7693 | 7780 |
7694 if Inside_A_Generic then | 7781 if Inside_A_Generic then |
7839 Context : constant Node_Id := Parent (Subp_Body); | 7926 Context : constant Node_Id := Parent (Subp_Body); |
7840 Loc : constant Source_Ptr := Sloc (Subp_Body); | 7927 Loc : constant Source_Ptr := Sloc (Subp_Body); |
7841 Subp_Id : constant Entity_Id := Unique_Defining_Entity (Subp_Body); | 7928 Subp_Id : constant Entity_Id := Unique_Defining_Entity (Subp_Body); |
7842 Subp_Decl : constant Node_Id := Unit_Declaration_Node (Subp_Id); | 7929 Subp_Decl : constant Node_Id := Unit_Declaration_Node (Subp_Id); |
7843 | 7930 |
7844 Decls : List_Id; | 7931 Decls : List_Id; |
7845 Flag_Id : Entity_Id; | 7932 Flag_Id : Entity_Id; |
7846 Set_Ins : Node_Id; | 7933 Set_Ins : Node_Id; |
7847 Tag_Typ : Entity_Id; | 7934 Set_Stmt : Node_Id; |
7935 Tag_Typ : Entity_Id; | |
7848 | 7936 |
7849 -- Start of processing for Install_Primitive_Elaboration_Check | 7937 -- Start of processing for Install_Primitive_Elaboration_Check |
7850 | 7938 |
7851 begin | 7939 begin |
7852 -- Do not generate an elaboration check in compilation modes where | 7940 -- Do not generate an elaboration check in compilation modes where |
7876 -- they cannot be the target of a dispatching call. | 7964 -- they cannot be the target of a dispatching call. |
7877 | 7965 |
7878 elsif Nkind (Context) = N_Compilation_Unit then | 7966 elsif Nkind (Context) = N_Compilation_Unit then |
7879 return; | 7967 return; |
7880 | 7968 |
7881 -- Only nonabstract library-level source primitives are considered for | 7969 -- Do not consider anything other than nonabstract library-level source |
7882 -- this check. | 7970 -- primitives. |
7883 | 7971 |
7884 elsif not | 7972 elsif not |
7885 (Comes_From_Source (Subp_Id) | 7973 (Comes_From_Source (Subp_Id) |
7886 and then Is_Library_Level_Entity (Subp_Id) | 7974 and then Is_Library_Level_Entity (Subp_Id) |
7887 and then Is_Primitive (Subp_Id) | 7975 and then Is_Primitive (Subp_Id) |
7994 end if; | 8082 end if; |
7995 | 8083 |
7996 -- Generate: | 8084 -- Generate: |
7997 -- E := True; | 8085 -- E := True; |
7998 | 8086 |
7999 Insert_After_And_Analyze (Set_Ins, | 8087 Set_Stmt := |
8000 Make_Assignment_Statement (Loc, | 8088 Make_Assignment_Statement (Loc, |
8001 Name => New_Occurrence_Of (Flag_Id, Loc), | 8089 Name => New_Occurrence_Of (Flag_Id, Loc), |
8002 Expression => New_Occurrence_Of (Standard_True, Loc))); | 8090 Expression => New_Occurrence_Of (Standard_True, Loc)); |
8091 | |
8092 -- Mark the assignment statement as elaboration code. This allows the | |
8093 -- early call region mechanism (see Sem_Elab) to properly ignore such | |
8094 -- assignments even though they are non-preelaborable code. | |
8095 | |
8096 Set_Is_Elaboration_Code (Set_Stmt); | |
8097 | |
8098 Insert_After_And_Analyze (Set_Ins, Set_Stmt); | |
8003 end Install_Primitive_Elaboration_Check; | 8099 end Install_Primitive_Elaboration_Check; |
8004 | 8100 |
8005 -------------------------- | 8101 -------------------------- |
8006 -- Install_Static_Check -- | 8102 -- Install_Static_Check -- |
8007 -------------------------- | 8103 -------------------------- |
8360 end Reexpand; | 8456 end Reexpand; |
8361 | 8457 |
8362 -- Start of processing for Minimize_Eliminate_Overflows | 8458 -- Start of processing for Minimize_Eliminate_Overflows |
8363 | 8459 |
8364 begin | 8460 begin |
8461 -- Default initialize Lo and Hi since these are not guaranteed to be | |
8462 -- set otherwise. | |
8463 | |
8464 Lo := No_Uint; | |
8465 Hi := No_Uint; | |
8466 | |
8365 -- Case where we do not have a signed integer arithmetic operation | 8467 -- Case where we do not have a signed integer arithmetic operation |
8366 | 8468 |
8367 if not Is_Signed_Integer_Arithmetic_Op (N) then | 8469 if not Is_Signed_Integer_Arithmetic_Op (N) then |
8368 | 8470 |
8369 -- Use the normal Determine_Range routine to get the range. We | 8471 -- Use the normal Determine_Range routine to get the range. We |
9812 Exptyp : Entity_Id; | 9914 Exptyp : Entity_Id; |
9813 Cond : Node_Id := Empty; | 9915 Cond : Node_Id := Empty; |
9814 Do_Access : Boolean := False; | 9916 Do_Access : Boolean := False; |
9815 Wnode : Node_Id := Warn_Node; | 9917 Wnode : Node_Id := Warn_Node; |
9816 Ret_Result : Check_Result := (Empty, Empty); | 9918 Ret_Result : Check_Result := (Empty, Empty); |
9817 Num_Checks : Integer := 0; | 9919 Num_Checks : Natural := 0; |
9818 | 9920 |
9819 procedure Add_Check (N : Node_Id); | 9921 procedure Add_Check (N : Node_Id); |
9820 -- Adds the action given to Ret_Result if N is non-Empty | 9922 -- Adds the action given to Ret_Result if N is non-Empty |
9821 | 9923 |
9822 function Discrete_Range_Cond | 9924 function Discrete_Range_Cond |