From ff1f1705ffdb2a6d4e7682a3499e37fcaa1dfa18 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 16 Jul 2014 16:35:34 +0200 Subject: [PATCH] [multiple changes] 2014-07-16 Eric Botcazou * switch-b.adb (Scan_Binder_Switches): Add missing guard. 2014-07-16 Ben Brosgol * gnat_ugn.texi: Fix typo. 2014-07-16 Ed Schonberg * exp_ch4.adb (Expand_N_Case_Expression): Do not expand case expression if it is the specification of a subtype predicate: it will be expanded when the return statement is analyzed, or when a static predicate is transformed into a static expression for evaluation by the front-end. * sem_ch13.adb (Get_RList): If the expression for a static predicate is a case expression, extract the alternatives of the branches with a True value to create the required statically evaluable expression. 2014-07-16 Thomas Quinot * exp_prag.adb (Expand_Pragma_Check): Use the location of the expression, not the location of the aspect, for all generated code, so that in particular the call to raise_assert_failure gets the sloc of the associated condition. * exp_ch6.adb (Expand_Subprogram_Contract.Build_Postconditions_Procedure): Set an explicit End_Label on the handled sequence of statements for the _Postconditions procedure so that the implicit return statement does not erroneously get associated with code generated for the last condition in postconditions. 2014-07-16 Thomas Quinot * ug_words: Fix name of VMS synonym for -gnatw.z (SIZE_ALIGNMENT, not SIZE_ALIGN) and -gnatw.Z (NOSIZE_ALIGNMENT, not NOSIZE_ALIGN). * vms_data.ads: Add missing spaces in VMS synonyms for -gnatw.z / -gnatw.Z. From-SVN: r212657 --- gcc/ada/ChangeLog | 40 +++++++++++++++++++++++++++++++++++ gcc/ada/exp_ch4.adb | 10 +++++++++ gcc/ada/exp_ch6.adb | 19 ++++++++++++----- gcc/ada/exp_prag.adb | 49 +++++++++++++++++++------------------------ gcc/ada/gnat_ugn.texi | 2 +- gcc/ada/sem_ch13.adb | 37 +++++++++++++++++++++++++++++++- gcc/ada/switch-b.adb | 2 +- gcc/ada/ug_words | 4 ++-- gcc/ada/vms_data.ads | 4 ++-- 9 files changed, 128 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 82a6662ace1a..8c42df40d474 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2014-07-16 Eric Botcazou + + * switch-b.adb (Scan_Binder_Switches): Add missing guard. + +2014-07-16 Ben Brosgol + + * gnat_ugn.texi: Fix typo. + +2014-07-16 Ed Schonberg + + * exp_ch4.adb (Expand_N_Case_Expression): Do not expand case + expression if it is the specification of a subtype predicate: + it will be expanded when the return statement is analyzed, or + when a static predicate is transformed into a static expression + for evaluation by the front-end. + * sem_ch13.adb (Get_RList): If the expression for a static + predicate is a case expression, extract the alternatives of the + branches with a True value to create the required statically + evaluable expression. + +2014-07-16 Thomas Quinot + + * exp_prag.adb (Expand_Pragma_Check): Use the location of the + expression, not the location of the aspect, for all generated + code, so that in particular the call to raise_assert_failure + gets the sloc of the associated condition. + * exp_ch6.adb + (Expand_Subprogram_Contract.Build_Postconditions_Procedure): + Set an explicit End_Label on the handled sequence of statements + for the _Postconditions procedure so that the implicit return + statement does not erroneously get associated with code generated + for the last condition in postconditions. + +2014-07-16 Thomas Quinot + + * ug_words: Fix name of VMS synonym for -gnatw.z (SIZE_ALIGNMENT, + not SIZE_ALIGN) and -gnatw.Z (NOSIZE_ALIGNMENT, not NOSIZE_ALIGN). + * vms_data.ads: Add missing spaces in VMS synonyms for -gnatw.z / + -gnatw.Z. + 2014-07-16 Robert Dewar * sem_ch3.adb, sem_prag.adb, sem_util.adb, sem_res.adb, sem_ch13.adb: diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4f60b312c7c0..9a86fb48360f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4927,6 +4927,16 @@ package body Exp_Ch4 is return; end if; + -- If the case expression is a predicate specification, do not + -- expand, because it will be converted to the proper predicate + -- form when building the predicate function. + + if Ekind_In (Current_Scope, E_Function, E_Procedure) + and then Is_Predicate_Function (Current_Scope) + then + return; + end if; + -- We expand -- case X is when A => AX, when B => BX ... diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2aa9dc714b30..a63d23699920 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8405,7 +8405,9 @@ package body Exp_Ch6 is -- Local variables - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (N); + -- Source location of subprogram contract + Formal : Entity_Id; Typ : Entity_Id; @@ -8467,9 +8469,8 @@ package body Exp_Ch6 is if Predicate_Checks_OK (Typ) then Append_Enabled_Item - (Item => - Make_Predicate_Check - (Typ, New_Occurrence_Of (Formal, Loc)), + (Item => Make_Predicate_Check + (Typ, New_Occurrence_Of (Formal, Loc)), List => Stmts); end if; end if; @@ -8614,6 +8615,12 @@ package body Exp_Ch6 is -- order reference. The body of _Postconditions must be placed after -- the declaration of Temp to preserve correct visibility. + -- Note that we set an explicit End_Label in order to override the + -- sloc of the implicit RETURN statement, and prevent it from + -- inheriting the sloc of one of the postconditions: this would cause + -- confusing debug info to be produced, interfering with coverage + -- analysis tools. + Insert_Before_First_Source_Declaration ( Make_Subprogram_Body (Loc, Specification => @@ -8623,7 +8630,9 @@ package body Exp_Ch6 is Declarations => Empty_List, Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, Stmts))); + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stmts, + End_Label => Make_Identifier (Loc, Chars (Proc_Id))))); -- Set the attributes of the related subprogram to capture the -- generated procedure. diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 1925012b8459..fef09c4d12df 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -916,18 +916,24 @@ package body Exp_Prag is -------------------------- procedure Expand_Pragma_Check (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - -- Location of the pragma node. Note: it is important to use this - -- location (and not the location of the expression) for the generated - -- statements, otherwise the implicit return statement in the body - -- of a pre/postcondition subprogram may inherit the source location - -- of part of the expression, which causes confusing debug information - -- to be generated, which interferes with coverage analysis tools. - Cond : constant Node_Id := Arg2 (N); Nam : constant Name_Id := Chars (Arg1 (N)); Msg : Node_Id; + Loc : constant Source_Ptr := Sloc (First_Node (Cond)); + -- Source location used in the case of a failed assertion: point to the + -- failing condition, not Loc. Note that the source location of the + -- expression is not usually the best choice here, because it points to + -- the location of the topmost tree node, which may be an operator in + -- the middle of the source text of the expression. For example, it gets + -- located on the last AND keyword in a chain of boolean expressiond + -- AND'ed together. It is best to put the message on the first character + -- of the condition, which is the effect of the First_Node call here. + -- This source location is used to build the default exception message, + -- and also as the sloc of the call to the runtime subprogram raising + -- Assert_Failure, so that coverage analysis tools can relate the + -- call to the failed check. + begin -- Nothing to do if pragma is ignored @@ -984,20 +990,17 @@ package body Exp_Prag is -- Case where we generate a direct raise - if ((Debug_Flag_Dot_G - or else Restriction_Active (No_Exception_Propagation)) - and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N))) + if ((Debug_Flag_Dot_G or else + Restriction_Active (No_Exception_Propagation)) + and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N))) or else (Opt.Exception_Locations_Suppressed and then No (Arg3 (N))) then Rewrite (N, Make_If_Statement (Loc, - Condition => - Make_Op_Not (Loc, - Right_Opnd => Cond), + Condition => Make_Op_Not (Loc, Right_Opnd => Cond), Then_Statements => New_List ( Make_Raise_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Assert_Failure), Loc))))); + Name => New_Occurrence_Of (RTE (RE_Assert_Failure), Loc))))); -- Case where we call the procedure @@ -1011,15 +1014,7 @@ package body Exp_Prag is else declare - Msg_Loc : constant String := - Build_Location_String (Sloc (First_Node (Cond))); - -- Source location used in the case of a failed assertion: - -- point to the failing condition, not Loc. Note that the - -- source location of the expression is not usually the best - -- choice here. For example, it gets located on the last AND - -- keyword in a chain of boolean expressiond AND'ed together. - -- It is best to put the message on the first character of the - -- condition, which is the effect of the First_Node call here. + Loc_Str : constant String := Build_Location_String (Loc); begin Name_Len := 0; @@ -1066,7 +1061,7 @@ package body Exp_Prag is -- In all cases, add location string - Add_Str_To_Name_Buffer (Msg_Loc); + Add_Str_To_Name_Buffer (Loc_Str); -- Build the message diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 137175d9d337..72b781337137 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -20163,7 +20163,7 @@ The GNAT compiler now supports dimensionality checking. The user can specify physical units for objects, and the compiler will verify that uses of these objects are compatible with their dimensions, in a fashion that is familiar to engineering practice. The dimensions of algebraic expressions -(including powers with static exponents) are computed from their consistuents. +(including powers with static exponents) are computed from their constituents. This feature depends on Ada 2012 aspect specifications, and is available from version 7.0.1 of GNAT onwards. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 111e9a6078d7..a8f04731b939 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7584,12 +7584,47 @@ package body Sem_Ch13 is when N_Qualified_Expression => return Get_RList (Expression (Exp)); + when N_Case_Expression => + declare + Alt : Node_Id; + Choices : List_Id; + Dep : Node_Id; + + begin + if not Is_Entity_Name (Expression (Expr)) + or else Etype (Expression (Expr)) /= Typ + then + Error_Msg_N + ("expression must denaote subtype", Expression (Expr)); + return False_Range; + end if; + + -- Collect discrete choices in all True alternatives + + Choices := New_List; + Alt := First (Alternatives (Exp)); + while Present (Alt) loop + Dep := Expression (Alt); + + if not Is_Static_Expression (Dep) then + raise Non_Static; + + elsif Is_True (Expr_Value (Dep)) then + Append_List_To (Choices, + New_Copy_List (Discrete_Choices (Alt))); + end if; + + Next (Alt); + end loop; + + return Membership_Entries (First (Choices)); + end; + -- Expression with actions: if no actions, dig out expression when N_Expression_With_Actions => if Is_Empty_List (Actions (Exp)) then return Get_RList (Expression (Exp)); - else raise Non_Static; end if; diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 8253d41b267b..db6407abd72f 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -379,7 +379,7 @@ package body Switch.B is Ptr := Ptr + 1; List_Closure := True; - if Switch_Chars (Ptr) = 'a' then + if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then Ptr := Ptr + 1; List_Closure_All := True; end if; diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 053a5438b7dc..48a36b791c55 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -226,8 +226,8 @@ gcc -c ^ GNAT COMPILE -gnatw.Y ^ /WARNINGS=NOWHY_SPEC_NEEDS_BODY -gnatwz ^ /WARNINGS=UNCHECKED_CONVERSIONS -gnatwZ ^ /WARNINGS=NOUNCHECKED_CONVERSIONS --gnatw.z ^ /WARNINGS=SIZE_ALIGN --gnatw.Z ^ /WARNINGS=NOSIZE_ALIGN +-gnatw.z ^ /WARNINGS=SIZE_ALIGNMENT +-gnatw.Z ^ /WARNINGS=NOSIZE_ALIGNMENT -gnatW8 ^ /WIDE_CHARACTER_ENCODING=UTF8 -gnatW? ^ /WIDE_CHARACTER_ENCODING=? -gnaty ^ /STYLE_CHECKS diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 927bdfb1867e..e5e5059302c9 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -3270,9 +3270,9 @@ package VMS_Data is "UNCHECKED_CONVERSIONS " & "-gnatwz " & "NOUNCHECKED_CONVERSIONS " & - "-gnatwZ" & + "-gnatwZ " & "SIZE_ALIGNMENT " & - "-gnatw.z" & + "-gnatw.z " & "NOSIZE_ALIGNMENT " & "-gnatw.Z";