diff options
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 51 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 120 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.ads | 3 |
3 files changed, 106 insertions, 68 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index fb53bbd..36baf6f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -53,6 +53,7 @@ with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch9; use Sem_Ch9; with Sem_Ch11; use Sem_Ch11; +with Sem_Ch13; use Sem_Ch13; with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; @@ -6236,28 +6237,37 @@ package body Exp_Ch9 is when N_Expanded_Name | N_Identifier => + + -- Because of N_Expanded_Name case, return Skip instead of OK. + if No (Entity (N)) then return Abandon; elsif Is_Universal_Numeric_Type (Entity (N)) then - return OK; + return Skip; end if; case Ekind (Entity (N)) is when E_Constant | E_Discriminant - | E_Enumeration_Literal + => + return Skip; + + when E_Enumeration_Literal | E_Named_Integer | E_Named_Real => - return OK; + if not Is_OK_Static_Expression (N) then + return Abandon; + end if; + return Skip; when E_Component => - return OK; + return Skip; when E_Variable => if Is_Simple_Barrier_Name (N) then - return OK; + return Skip; end if; when E_Function => @@ -6268,7 +6278,7 @@ package body Exp_Ch9 is if Is_RTE (Entity (N), RE_Protected_Count) or else Is_RTE (Entity (N), RE_Protected_Count_Entry) then - return OK; + return Skip; end if; when others => @@ -6295,14 +6305,31 @@ package body Exp_Ch9 is return OK; end if; - when N_Short_Circuit => + when N_Short_Circuit + | N_If_Expression + | N_Case_Expression + => return OK; - when N_Indexed_Component - | N_Selected_Component - => - if not Is_Access_Type (Etype (Prefix (N))) then - return OK; + when N_Case_Expression_Alternative => + -- do not traverse Discrete_Choices subtree + if Is_Pure_Barrier (Expression (N)) /= Abandon then + return Skip; + end if; + + when N_Expression_With_Actions => + -- this may occur in the case of a Count attribute reference + if Original_Node (N) /= N + and then Is_Pure_Barrier (Original_Node (N)) /= Abandon + then + return Skip; + end if; + + when N_Membership_Test => + if Is_Pure_Barrier (Left_Opnd (N)) /= Abandon + and then All_Membership_Choices_Static (N) + then + return Skip; end if; when N_Type_Conversion => diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index b0b673f..0fc8d0e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -91,6 +91,13 @@ package body Sem_Ch13 is -- type whose inherited alignment is no longer appropriate for the new -- size value. In this case, we reset the Alignment to unknown. + function All_Static_Choices (L : List_Id) return Boolean; + -- Returns true if all elements of the list are OK static choices + -- as defined below for Is_Static_Choice. Used for case expression + -- alternatives and for the right operand of a membership test. An + -- others_choice is static if the corresponding expression is static. + -- The staticness of the bounds is checked separately. + procedure Build_Discrete_Static_Predicate (Typ : Entity_Id; Expr : Node_Id; @@ -154,6 +161,15 @@ package body Sem_Ch13 is -- that do not specify a representation characteristic are operational -- attributes. + function Is_Static_Choice (N : Node_Id) return Boolean; + -- Returns True if N represents a static choice (static subtype, or + -- static subtype indication, or static expression, or static range). + -- + -- Note that this is a bit more inclusive than we actually need + -- (in particular membership tests do not allow the use of subtype + -- indications). But that doesn't matter, we have already checked + -- that the construct is legal to get this far. + function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean; -- Returns True for a representation clause/pragma that specifies a -- type-related representation (as opposed to operational) aspect. @@ -820,6 +836,38 @@ package body Sem_Ch13 is end if; end Alignment_Check_For_Size_Change; + function All_Membership_Choices_Static (Expr : Node_Id) + return Boolean + is + pragma Assert (Nkind (Expr) in N_Membership_Test); + begin + return ((Present (Right_Opnd (Expr)) + and then Is_Static_Choice (Right_Opnd (Expr))) + or else + (Present (Alternatives (Expr)) + and then All_Static_Choices (Alternatives (Expr)))); + end All_Membership_Choices_Static; + + ------------------------ + -- All_Static_Choices -- + ------------------------ + + function All_Static_Choices (L : List_Id) return Boolean is + N : Node_Id; + + begin + N := First (L); + while Present (N) loop + if not Is_Static_Choice (N) then + return False; + end if; + + Next (N); + end loop; + + return True; + end All_Static_Choices; + ------------------------------------- -- Analyze_Aspects_At_Freeze_Point -- ------------------------------------- @@ -12163,22 +12211,6 @@ package body Sem_Ch13 is -- the alternatives are static (have all static choices, and a static -- expression). - function All_Static_Choices (L : List_Id) return Boolean; - -- Returns true if all elements of the list are OK static choices - -- as defined below for Is_Static_Choice. Used for case expression - -- alternatives and for the right operand of a membership test. An - -- others_choice is static if the corresponding expression is static. - -- The staticness of the bounds is checked separately. - - function Is_Static_Choice (N : Node_Id) return Boolean; - -- Returns True if N represents a static choice (static subtype, or - -- static subtype indication, or static expression, or static range). - -- - -- Note that this is a bit more inclusive than we actually need - -- (in particular membership tests do not allow the use of subtype - -- indications). But that doesn't matter, we have already checked - -- that the construct is legal to get this far. - function Is_Type_Ref (N : Node_Id) return Boolean; pragma Inline (Is_Type_Ref); -- Returns True if N is a reference to the type for the predicate in the @@ -12214,41 +12246,6 @@ package body Sem_Ch13 is return True; end All_Static_Case_Alternatives; - ------------------------ - -- All_Static_Choices -- - ------------------------ - - function All_Static_Choices (L : List_Id) return Boolean is - N : Node_Id; - - begin - N := First (L); - while Present (N) loop - if not Is_Static_Choice (N) then - return False; - end if; - - Next (N); - end loop; - - return True; - end All_Static_Choices; - - ---------------------- - -- Is_Static_Choice -- - ---------------------- - - function Is_Static_Choice (N : Node_Id) return Boolean is - begin - return Nkind (N) = N_Others_Choice - or else Is_OK_Static_Expression (N) - or else (Is_Entity_Name (N) and then Is_Type (Entity (N)) - and then Is_OK_Static_Subtype (Entity (N))) - or else (Nkind (N) = N_Subtype_Indication - and then Is_OK_Static_Subtype (Entity (N))) - or else (Nkind (N) = N_Range and then Is_OK_Static_Range (N)); - end Is_Static_Choice; - ----------------- -- Is_Type_Ref -- ----------------- @@ -12277,11 +12274,7 @@ package body Sem_Ch13 is -- for a static membership test. elsif Nkind (Expr) in N_Membership_Test - and then ((Present (Right_Opnd (Expr)) - and then Is_Static_Choice (Right_Opnd (Expr))) - or else - (Present (Alternatives (Expr)) - and then All_Static_Choices (Alternatives (Expr)))) + and then All_Membership_Choices_Static (Expr) then return True; @@ -12384,6 +12377,21 @@ package body Sem_Ch13 is end if; end Is_Predicate_Static; + ---------------------- + -- Is_Static_Choice -- + ---------------------- + + function Is_Static_Choice (N : Node_Id) return Boolean is + begin + return Nkind (N) = N_Others_Choice + or else Is_OK_Static_Expression (N) + or else (Is_Entity_Name (N) and then Is_Type (Entity (N)) + and then Is_OK_Static_Subtype (Entity (N))) + or else (Nkind (N) = N_Subtype_Indication + and then Is_OK_Static_Subtype (Entity (N))) + or else (Nkind (N) = N_Range and then Is_OK_Static_Range (N)); + end Is_Static_Choice; + ------------------------------ -- Is_Type_Related_Rep_Item -- ------------------------------ diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 9a922ea..4c26473 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -28,6 +28,9 @@ with Types; use Types; with Uintp; use Uintp; package Sem_Ch13 is + function All_Membership_Choices_Static (Expr : Node_Id) return Boolean; + -- Given a membership test, returns True iff all choices are static. + procedure Analyze_At_Clause (N : Node_Id); procedure Analyze_Attribute_Definition_Clause (N : Node_Id); procedure Analyze_Enumeration_Representation_Clause (N : Node_Id); |