From bb020a20147d1a840289a8aea0eff5847215f83d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 2 Aug 2011 08:06:18 +0000 Subject: [PATCH] 2011-08-02 Robert Dewar * sem_ch8.adb: Minor code reorganization, comment updates. 2011-08-02 Robert Dewar * sem_res.adb (Matching_Static_Array_Bounds): Moved to Sem_Util * sem_util.ads, sem_util.adb (Matching_Static_Array_Bounds): Moved here from Sem_Res. (Matching_Static_Array_Bounds): Use Is_Ok_Static_Expression (Matching_Static_Array_Bounds): Moved here from Sem_Res git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177091 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 12 +++++++ gcc/ada/sem_ch8.adb | 11 +++++-- gcc/ada/sem_res.adb | 89 ++++++++-------------------------------------------- gcc/ada/sem_util.adb | 56 +++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 7 +++++ 5 files changed, 97 insertions(+), 78 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fb77921..ae47e20 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-08-02 Robert Dewar + + * sem_ch8.adb: Minor code reorganization, comment updates. + +2011-08-02 Robert Dewar + + * sem_res.adb (Matching_Static_Array_Bounds): Moved to Sem_Util + * sem_util.ads, sem_util.adb (Matching_Static_Array_Bounds): Moved + here from Sem_Res. + (Matching_Static_Array_Bounds): Use Is_Ok_Static_Expression + (Matching_Static_Array_Bounds): Moved here from Sem_Res + 2011-08-02 Ed Schonberg * atree.h, atree.ads, atree.adb: New subprograms to manipulate Elist5. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ad87c6f..7f4e4b1 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2679,9 +2679,13 @@ package body Sem_Ch8 is Chain_Use_Clause (N); end if; - -- Commented needed??? + -- If the Used_Operations list is already initialized, the clause has + -- been analyzed previously, and it is begin reinstalled, for example + -- when the clause appears in a package spec and we are compiling the + -- corresponding package body. In that case, make the entities on the + -- existing list use-visible. - if Used_Operations (N) /= No_Elist then + if Present (Used_Operations (N)) then declare Elmt : Elmt_Id; begin @@ -2695,6 +2699,9 @@ package body Sem_Ch8 is return; end if; + -- Otherwise, create new list and attach to it the operations that + -- are made use-visible by the clause. + Set_Used_Operations (N, New_Elmt_List); Id := First (Subtype_Marks (N)); while Present (Id) loop diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 495b260..7f71d1b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -92,12 +92,6 @@ package body Sem_Res is -- Note that Resolve_Attribute is separated off in Sem_Attr - function Matching_Static_Array_Bounds - (L_Typ : Node_Id; - R_Typ : Node_Id) return Boolean; - -- L_Typ and R_Typ are two array types. Returns True when they have the - -- same dimension, and, for each index position, the same static bounds. - function Bad_Unordered_Enumeration_Reference (N : Node_Id; T : Entity_Id) return Boolean; @@ -1577,65 +1571,6 @@ package body Sem_Res is end if; end Make_Call_Into_Operator; - ---------------------------------- - -- Matching_Static_Array_Bounds -- - ---------------------------------- - - function Matching_Static_Array_Bounds - (L_Typ : Node_Id; - R_Typ : Node_Id) return Boolean - is - L_Ndims : constant Nat := Number_Dimensions (L_Typ); - R_Ndims : constant Nat := Number_Dimensions (R_Typ); - - L_Index : Node_Id; - R_Index : Node_Id; - L_Low : Node_Id; - L_High : Node_Id; - R_Low : Node_Id; - R_High : Node_Id; - - begin - if L_Ndims /= R_Ndims then - return False; - end if; - - -- Unconstrained types do not have static bounds - - if not Is_Constrained (L_Typ) or else not Is_Constrained (R_Typ) then - return False; - end if; - - L_Index := First_Index (L_Typ); - R_Index := First_Index (R_Typ); - - for Indx in 1 .. L_Ndims loop - Get_Index_Bounds (L_Index, L_Low, L_High); - Get_Index_Bounds (R_Index, R_Low, R_High); - - if True - and then Is_Static_Expression (L_Low) - and then Is_Static_Expression (L_High) - and then Is_Static_Expression (R_Low) - and then Is_Static_Expression (R_High) - and then Expr_Value (L_Low) = Expr_Value (R_Low) - and then Expr_Value (L_High) = Expr_Value (R_High) - then - -- Matching so far, continue with next index - - null; - - else - return False; - end if; - - Next (L_Index); - Next (R_Index); - end loop; - - return True; - end Matching_Static_Array_Bounds; - ------------------- -- Operator_Kind -- ------------------- @@ -3634,15 +3569,16 @@ package body Sem_Res is Operand : constant Node_Id := Expression (A); Operand_Typ : constant Entity_Id := Etype (Operand); Target_Typ : constant Entity_Id := A_Typ; + begin if not (Is_Tagged_Type (Target_Typ) - and then not Is_Class_Wide_Type (Target_Typ) - and then Is_Tagged_Type (Operand_Typ) - and then not Is_Class_Wide_Type (Operand_Typ) - and then Is_Ancestor (Target_Typ, Operand_Typ)) + and then not Is_Class_Wide_Type (Target_Typ) + and then Is_Tagged_Type (Operand_Typ) + and then not Is_Class_Wide_Type (Operand_Typ) + and then Is_Ancestor (Target_Typ, Operand_Typ)) then Error_Msg_F ("|~~ancestor conversion is the only " - & "view conversion", A); + & "permitted view conversion", A); end if; end; end if; @@ -4893,7 +4829,7 @@ package body Sem_Res is if Formal_Verification_Mode and then (Is_Fixed_Point_Type (Etype (L)) - or else Is_Fixed_Point_Type (Etype (R))) + or else Is_Fixed_Point_Type (Etype (R))) and then Nkind_In (N, N_Op_Multiply, N_Op_Divide) and then not Nkind_In (Parent (N), N_Qualified_Expression, N_Type_Conversion) @@ -4921,10 +4857,10 @@ package body Sem_Res is if Compile_Time_Known_Value (Rop) and then ((Is_Integer_Type (Etype (Rop)) - 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 (Rop) = Uint_0) + or else + (Is_Real_Type (Etype (Rop)) + and then Expr_Value_R (Rop) = Ureal_0)) then -- Specialize the warning message according to the operation @@ -5911,7 +5847,8 @@ package body Sem_Res is and then Base_Type (T) /= Standard_String then Error_Msg_F - ("|~~comparison is not defined on array type except String", N); + ("|~~comparison is not defined on array types " & + "other than String", N); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6645688..78348d4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7998,6 +7998,62 @@ package body Sem_Util is return N; end Last_Source_Statement; + ---------------------------------- + -- Matching_Static_Array_Bounds -- + ---------------------------------- + + function Matching_Static_Array_Bounds + (L_Typ : Node_Id; + R_Typ : Node_Id) return Boolean + is + L_Ndims : constant Nat := Number_Dimensions (L_Typ); + R_Ndims : constant Nat := Number_Dimensions (R_Typ); + + L_Index : Node_Id; + R_Index : Node_Id; + L_Low : Node_Id; + L_High : Node_Id; + R_Low : Node_Id; + R_High : Node_Id; + + begin + if L_Ndims /= R_Ndims then + return False; + end if; + + -- Unconstrained types do not have static bounds + + if not Is_Constrained (L_Typ) or else not Is_Constrained (R_Typ) then + return False; + end if; + + L_Index := First_Index (L_Typ); + R_Index := First_Index (R_Typ); + + for Indx in 1 .. L_Ndims loop + Get_Index_Bounds (L_Index, L_Low, L_High); + Get_Index_Bounds (R_Index, R_Low, R_High); + + if Is_OK_Static_Expression (L_Low) + and then Is_OK_Static_Expression (L_High) + and then Is_OK_Static_Expression (R_Low) + and then Is_OK_Static_Expression (R_High) + and then Expr_Value (L_Low) = Expr_Value (R_Low) + and then Expr_Value (L_High) = Expr_Value (R_High) + then + Next (L_Index); + Next (R_Index); + + else + return False; + end if; + end loop; + + -- If we fall through the loop, all indexes matched + + return True; + end Matching_Static_Array_Bounds; + ------------------- -- May_Be_Lvalue -- ------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index bb4e1c2..6410db4 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -939,6 +939,13 @@ package Sem_Util is -- See Sinfo. We rename Make_Return_Statement to the correct Ada 2005 -- terminology here. Clients should use Make_Simple_Return_Statement. + function Matching_Static_Array_Bounds + (L_Typ : Node_Id; + R_Typ : Node_Id) return Boolean; + -- L_Typ and R_Typ are two array types. Returns True when they have the + -- same number of dimensions, and the same static bounds for each index + -- position. + Make_Return_Statement : constant := -2 ** 33; -- Attempt to prevent accidental uses of Make_Return_Statement. If this -- and the one in Nmake are both potentially use-visible, it will cause -- 2.7.4