* switch-b.adb (Scan_Binder_Switches): Add missing guard.
2014-07-16 Ben Brosgol <brosgol@adacore.com>
* gnat_ugn.texi: Fix typo.
2014-07-16 Ed Schonberg <schonberg@adacore.com>
* 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 <quinot@adacore.com>
* 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 <quinot@adacore.com>
* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212657
138bc75d-0d04-0410-961f-
82ee72b054a4
+2014-07-16 Eric Botcazou <ebotcazou@adacore.com>
+
+ * switch-b.adb (Scan_Binder_Switches): Add missing guard.
+
+2014-07-16 Ben Brosgol <brosgol@adacore.com>
+
+ * gnat_ugn.texi: Fix typo.
+
+2014-07-16 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <quinot@adacore.com>
+
+ * 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 <quinot@adacore.com>
+
+ * 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 <dewar@adacore.com>
* sem_ch3.adb, sem_prag.adb, sem_util.adb, sem_res.adb, sem_ch13.adb:
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 ...
-- 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;
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;
-- 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 =>
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.
-- --
-- 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- --
--------------------------
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
-- 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
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;
-- In all cases, add location string
- Add_Str_To_Name_Buffer (Msg_Loc);
+ Add_Str_To_Name_Buffer (Loc_Str);
-- Build the message
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.
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;
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;
-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
"UNCHECKED_CONVERSIONS " &
"-gnatwz " &
"NOUNCHECKED_CONVERSIONS " &
- "-gnatwZ" &
+ "-gnatwZ " &
"SIZE_ALIGNMENT " &
- "-gnatw.z" &
+ "-gnatw.z " &
"NOSIZE_ALIGNMENT " &
"-gnatw.Z";