From d9c59db4554b9fe827e2f262eafdd789b686a944 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 6 Jan 2017 12:10:13 +0100 Subject: [PATCH] [multiple changes] 2017-01-06 Ed Schonberg * sem_eval.adb (Check_Expression_Against_Static_Predicate): If expression is compile-time known and obeys a static predicate it must be labelled as static, to prevent spurious warnings and run-time errors, e.g. in case statements. This is relevant when the expression is the result of constant-folding a type conversion whose expression is a variable with a known static value. 2017-01-06 Hristian Kirtchev * exp_attr.adb, sem_attr.ads: Minor reformatting. From-SVN: r244135 --- gcc/ada/ChangeLog | 13 ++++++++++ gcc/ada/exp_attr.adb | 62 ++++++++++++++++++++++---------------------- gcc/ada/sem_attr.ads | 8 +++--- gcc/ada/sem_eval.adb | 9 ++++++- 4 files changed, 56 insertions(+), 36 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 25f1dfcdbaa..1dc59581701 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-01-06 Ed Schonberg + + * sem_eval.adb (Check_Expression_Against_Static_Predicate): + If expression is compile-time known and obeys a static predicate + it must be labelled as static, to prevent spurious warnings and + run-time errors, e.g. in case statements. This is relevant when + the expression is the result of constant-folding a type conversion + whose expression is a variable with a known static value. + +2017-01-06 Hristian Kirtchev + + * exp_attr.adb, sem_attr.ads: Minor reformatting. + 2017-01-06 Justin Squirek * exp_attr.adb (Expand_N_Attribute_Reference): Add entry for diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ddc48613e5b..57905df1459 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3141,11 +3141,10 @@ package body Exp_Attr is ----------------------- when Attribute_Finalization_Size => Finalization_Size : declare - function Calculate_Header_Size return Node_Id; - -- Generate a runtime call to calculate the size of the hidden - -- header along with any added padding which would precede a - -- heap-allocated object of the prefix type. + -- Generate a runtime call to calculate the size of the hidden header + -- along with any added padding which would precede a heap-allocated + -- object of the prefix type. --------------------------- -- Calculate_Header_Size -- @@ -3155,46 +3154,47 @@ package body Exp_Attr is begin -- Generate: -- Universal_Integer - -- (Header_Size_With_Padding (N'Alignment)) + -- (Header_Size_With_Padding (Pref'Alignment)) return Convert_To (Universal_Integer, Make_Function_Call (Loc, Name => - New_Occurrence_Of - (RTE (RE_Header_Size_With_Padding), Loc), + New_Occurrence_Of (RTE (RE_Header_Size_With_Padding), Loc), + Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => - New_Copy_Tree (Pref), + Prefix => New_Copy_Tree (Pref), Attribute_Name => Name_Alignment)))); end Calculate_Header_Size; - -- Local variables + -- Local variables - Size : constant Entity_Id := Make_Temporary (Loc, 'S'); + Size : Entity_Id; -- Start of Finalization_Size begin - -- An object of a class-wide type requires a runtime check to + -- An object of a class-wide type first requires a runtime check to -- determine whether it is actually controlled or not. Depending on -- the outcome of this check, the Finalization_Size of the object -- may be zero or some positive value. -- - -- In this scenario, Obj'Finalization_Size is expanded into + -- In this scenario, Pref'Finalization_Size is expanded into -- - -- Size : Integer := 0; + -- Size : Integer := 0; -- - -- if Needs_Finalization (Pref'Tag) then - -- Size := - -- Universal_Integer - -- (Header_Size_With_Padding (Pref'Alignment)); - -- end if; + -- if Needs_Finalization (Pref'Tag) then + -- Size := + -- Universal_Integer + -- (Header_Size_With_Padding (Pref'Alignment)); + -- end if; -- -- and the attribute reference is replaced with a reference to Size. if Is_Class_Wide_Type (Ptyp) then + Size := Make_Temporary (Loc, 'S'); + Insert_Actions (N, New_List ( -- Generate: @@ -3208,21 +3208,22 @@ package body Exp_Attr is -- Generate: -- if Needs_Finalization (Pref'Tag) then - -- Size := Universal_Integer - -- (Header_Size_With_Padding (Pref'Alignment)); + -- Size := + -- Universal_Integer + -- (Header_Size_With_Padding (Pref'Alignment)); -- end if; Make_If_Statement (Loc, Condition => Make_Function_Call (Loc, Name => - New_Occurrence_Of - (RTE (RE_Needs_Finalization), Loc), + New_Occurrence_Of (RTE (RE_Needs_Finalization), Loc), + Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Attribute_Name => Name_Tag, - Prefix => - New_Copy_Tree (Pref)))), + Prefix => New_Copy_Tree (Pref), + Attribute_Name => Name_Tag))), + Then_Statements => New_List ( Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Size, Loc), @@ -3230,15 +3231,14 @@ package body Exp_Attr is Rewrite (N, New_Occurrence_Of (Size, Loc)); - -- The the prefix is known to be controlled at compile time. - -- Calculate its Finalization_Size by calling runtime routine - -- Header_Size_With_Padding. + -- The prefix is known to be controlled at compile time. Calculate + -- Finalization_Size by calling function Header_Size_With_Padding. elsif Needs_Finalization (Ptyp) then Rewrite (N, Calculate_Header_Size); - -- The prefix is not a controlled object, its Finalization_Size - -- is zero. + -- The prefix is not an object with controlled parts, so its + -- Finalization_Size is zero. else Rewrite (N, Make_Integer_Literal (Loc, 0)); diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 2c480f5c9af..cd11b526e2c 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -247,10 +247,10 @@ package Sem_Attr is ----------------------- Attribute_Finalization_Size => True, - -- For every object, Finalization_Size will return the size of the - -- internal header required for finalization (including padding). If - -- the type is not controlled or contains no controlled components - -- then the result is always zero. + -- For every object, Finalization_Size returns the size of the hidden + -- header used for finalization purposes as if the object was allocated + -- on the heap. The size of the header does take into account any extra + -- padding due to alignment issues. ----------------- -- Fixed_Value -- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 314c110fb8d..fce4643dfbf 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -347,7 +347,11 @@ package body Sem_Eval is -- Here we have a static predicate (note that it could have arisen from -- an explicitly specified Dynamic_Predicate whose expression met the - -- rules for being predicate-static). + -- rules for being predicate-static). If the expression is known at + -- compile time and obeys the predicate, then it is static and must be + -- labeled as such, which matters e.g. for case statements. The original + -- expression may be a type conversion of a variable with a known value, + -- which might otherwise not be marked static. -- Case of real static predicate @@ -356,6 +360,7 @@ package body Sem_Eval is (Val => Make_Real_Literal (Sloc (Expr), Expr_Value_R (Expr)), Typ => Typ) then + Set_Is_Static_Expression (Expr); return; end if; @@ -365,6 +370,7 @@ package body Sem_Eval is if Real_Or_String_Static_Predicate_Matches (Val => Expr_Value_S (Expr), Typ => Typ) then + Set_Is_Static_Expression (Expr); return; end if; @@ -376,6 +382,7 @@ package body Sem_Eval is -- If static predicate matches, nothing to do if Choices_Match (Expr, Static_Discrete_Predicate (Typ)) = Match then + Set_Is_Static_Expression (Expr); return; end if; end if; -- 2.30.2