OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-08-04  Vincent Celier  <celier@adacore.com>

	* prj-dect.adb (Parse_Case_Construction): It is no longer
	an error if the variable for a case construction is not
	typed, only if the variable value is not a single string. Call
	Parse_Choice_List and End_Case_Construction with the new parameter
	to indicate that the variable is typed.
	* prj-strt.adb (End_Case_Construction): Only check the labels
	if the variable is typed.  If the variable is not typed,
	issue a warning when there is no "when others" allternative.
	(Parse_Choice_List): Manage the labels only if the variable
	is typed.
	* prj-strt.ads (End_Case_Construction): New Boolean parameter
	String_Type.
	(Parse_Choice_List): Ditto.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: Additional fix to Check_Predicate_Use.

2014-08-04  Vincent Celier  <celier@adacore.com>

	* projects.texi: Update documentation of case constructions with
	variables that are not typed.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Build_Class_Wide_Wrapper): If the operator carries
	an Eliminated pragma, indicate that the wrapper is also to be
	eliminated, to prevent spurious errors when using gnatelim on
	programs that include box-initialization of equality operators
	(consequence of AI05-071)..

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Activate_Overflow_Check): Handle floating-point
	case correctly.
	* checks.ads (Activate_Overflow_Check): Clarify handling of
	floating-point cases.
	* exp_util.adb (Check_Float_Op_Overflow): Reset Do_Overflow_Check
	flag if we generate an explicit overflow check (for
	Check_Float_Overflow mode).

From-SVN: r213550
This commit is contained in:
Arnaud Charlet 2014-08-04 11:57:00 +02:00
parent 7ed571892e
commit bb30428734
10 changed files with 201 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
gcc/ada/ChangeLog
View File

@ -1,3 +1,46 @@
2014-08-04 Vincent Celier <celier@adacore.com>
* prj-dect.adb (Parse_Case_Construction): It is no longer
an error if the variable for a case construction is not
typed, only if the variable value is not a single string. Call
Parse_Choice_List and End_Case_Construction with the new parameter
to indicate that the variable is typed.
* prj-strt.adb (End_Case_Construction): Only check the labels
if the variable is typed. If the variable is not typed,
issue a warning when there is no "when others" allternative.
(Parse_Choice_List): Manage the labels only if the variable
is typed.
* prj-strt.ads (End_Case_Construction): New Boolean parameter
String_Type.
(Parse_Choice_List): Ditto.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb: Additional fix to Check_Predicate_Use.
2014-08-04 Vincent Celier <celier@adacore.com>
* projects.texi: Update documentation of case constructions with
variables that are not typed.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Build_Class_Wide_Wrapper): If the operator carries
an Eliminated pragma, indicate that the wrapper is also to be
eliminated, to prevent spurious errors when using gnatelim on
programs that include box-initialization of equality operators
(consequence of AI05-071)..
2014-08-04 Robert Dewar <dewar@adacore.com>
* checks.adb (Activate_Overflow_Check): Handle floating-point
case correctly.
* checks.ads (Activate_Overflow_Check): Clarify handling of
floating-point cases.
* exp_util.adb (Check_Float_Op_Overflow): Reset Do_Overflow_Check
flag if we generate an explicit overflow check (for
Check_Float_Overflow mode).
2014-08-04 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, prj-part.adb, prj-strt.adb, prj.adb, prj.ads,

53
gcc/ada/checks.adb
View File

@ -388,27 +388,46 @@ package body Checks is
-----------------------------
procedure Activate_Overflow_Check (N : Node_Id) is
Typ : constant Entity_Id := Etype (N);
begin
-- Nothing to do for unconstrained floating-point types (the test for
-- Etype (N) being present seems necessary in some cases, should be
-- tracked down, but for now just ignore the check in this case ???),
-- except if Check_Float_Overflow is set.
-- Floating-point case. If Etype is not set (this can happen when we
-- activate a check on a node that has not yet been analyzed), then
-- we assume we do not have a floating-point type (as per our spec).
if Present (Etype (N))
and then Is_Floating_Point_Type (Etype (N))
and then not Is_Constrained (Etype (N))
and then not Check_Float_Overflow
then
return;
if Present (Typ) and then Is_Floating_Point_Type (Typ) then
-- Ignore call if we have no automatic overflow checks on the target
-- and Check_Float_Overflow mode is not set. These are the cases in
-- which we expect to generate infinities and NaN's with no check.
if not (Machine_Overflows_On_Target or Check_Float_Overflow) then
return;
-- Ignore for unary operations ("+", "-", abs) since these can never
-- result in overflow for floating-point cases.
elsif Nkind (N) in N_Unary_Op then
return;
-- Otherwise we will set the flag
else
null;
end if;
-- Discrete case
else
-- Nothing to do for Rem/Mod/Plus (overflow not possible, the check
-- for zero-divide is a divide check, not an overflow check).
if Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
return;
end if;
end if;
-- Nothing to do for Rem/Mod/Plus (overflow not possible)
if Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
return;
end if;
-- Otherwise set the flag
-- Fall through for cases where we do set the flag
Set_Do_Overflow_Check (N, True);
Possible_Local_Raise (N, Standard_Constraint_Error);

17
gcc/ada/checks.ads
View File

@ -145,10 +145,19 @@ package Checks is
-- Sets Do_Overflow_Check flag in node N, and handles possible local raise.
-- Always call this routine rather than calling Set_Do_Overflow_Check to
-- set an explicit value of True, to ensure handling the local raise case.
-- Note that this call has no effect for MOD, REM, and unary "+" for which
-- overflow is never possible in any case. In addition, we do not set the
-- flag for unconstrained floating-point type operations, since we want to
-- allow for the generation of IEEE infinities in such cases.
-- Note that for discrete types, this call has no effect for MOD, REM, and
-- unary "+" for which overflow is never possible in any case.
--
-- Note: for the discrete-type case, it is legitimate to call this routine
-- on an unanalyzed node where the Etype field is not set. However, for the
-- floating-point case, Etype must be set (to a floating-point type).
--
-- For floating-point, we set the flag if we have automatic overflow checks
-- on the target, or if Check_Float_Overflow mode is set. For the floating-
-- point case, we ignore all the unary operators ("+", "-", and abs) since
-- none of these can result in overflow. If there are no overflow checks on
-- the target, and Check_Float_Overflow mode is not set, then the call has
-- no effect, since in such cases we want to generate NaN's and infinities.
procedure Activate_Range_Check (N : Node_Id);
pragma Inline (Activate_Range_Check);

12
gcc/ada/exp_util.adb
View File

@ -1641,10 +1641,11 @@ package body Exp_Util is
begin
-- Return if no check needed
if not Check_Float_Overflow
or else not Is_Floating_Point_Type (Etype (N))
if not Is_Floating_Point_Type (Etype (N))
or else not (Do_Overflow_Check (N) and then Check_Float_Overflow)
-- In CodePeer_Mode, rely on the overflow check flag being set instead
-- and do not expand the code for float overflow checking.
or else CodePeer_Mode
then
@ -1663,9 +1664,12 @@ package body Exp_Util is
Typ : constant Entity_Id := Etype (N);
begin
-- Prevent recursion
-- Turn off the Do_Overflow_Check flag, since we are doing that work
-- right here. We also set the node as analyzed to prevent infinite
-- recursion from repeating the operation in the expansion.
Set_Analyzed (N);
Set_Do_Overflow_Check (N, False);
Set_Analyzed (N, True);
-- Do the rewrite to include the check

10
gcc/ada/prj-dect.adb
View File

@ -827,11 +827,11 @@ package body Prj.Dect is
if Present (Case_Variable) then
String_Type := String_Type_Of (Case_Variable, In_Tree);
if No (String_Type) then
if Expression_Kind_Of (Case_Variable, In_Tree) /= Single then
Error_Msg (Flags,
"variable """ &
Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
""" is not typed",
""" is not a single string",
Variable_Location);
end if;
end if;
@ -914,7 +914,8 @@ package body Prj.Dect is
Parse_Choice_List
(In_Tree => In_Tree,
First_Choice => First_Choice,
Flags => Flags);
Flags => Flags,
String_Type => Present (String_Type));
Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
Expect (Tok_Arrow, "`=>`");
@ -941,7 +942,8 @@ package body Prj.Dect is
End_Case_Construction
(Check_All_Labels => not When_Others and not Quiet_Output,
Case_Location => Location_Of (Case_Construction, In_Tree),
Flags => Flags);
Flags => Flags,
String_Type => Present (String_Type));
Expect (Tok_End, "`END CASE`");
Remove_Next_End_Node;

103
gcc/ada/prj-strt.adb
View File

@ -297,7 +297,8 @@ package body Prj.Strt is
procedure End_Case_Construction
(Check_All_Labels : Boolean;
Case_Location : Source_Ptr;
Flags : Processing_Flags)
Flags : Processing_Flags;
String_Type : Boolean)
is
Non_Used : Natural := 0;
First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
@ -306,7 +307,8 @@ package body Prj.Strt is
-- of the string type have been used.
if Check_All_Labels then
for Choice in Choice_First .. Choices.Last loop
if String_Type then
for Choice in Choice_First .. Choices.Last loop
if not Choices.Table (Choice).Already_Used then
Non_Used := Non_Used + 1;
@ -314,27 +316,35 @@ package body Prj.Strt is
First_Non_Used := Choice;
end if;
end if;
end loop;
-- If only one is not used, report a single warning for this value
if Non_Used = 1 then
Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
Error_Msg (Flags, "?value %% is not used as label", Case_Location);
-- If several are not used, report a warning for each one of them
elsif Non_Used > 1 then
Error_Msg
(Flags, "?the following values are not used as labels:",
Case_Location);
for Choice in First_Non_Used .. Choices.Last loop
if not Choices.Table (Choice).Already_Used then
Error_Msg_Name_1 := Choices.Table (Choice).The_String;
Error_Msg (Flags, "\?%%", Case_Location);
end if;
end loop;
-- If only one is not used, report a single warning for this value
if Non_Used = 1 then
Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
Error_Msg
(Flags, "?value %% is not used as label", Case_Location);
-- If several are not used, report a warning for each one of
-- them.
elsif Non_Used > 1 then
Error_Msg
(Flags, "?the following values are not used as labels:",
Case_Location);
for Choice in First_Non_Used .. Choices.Last loop
if not Choices.Table (Choice).Already_Used then
Error_Msg_Name_1 := Choices.Table (Choice).The_String;
Error_Msg (Flags, "\?%%", Case_Location);
end if;
end loop;
end if;
else
Error_Msg
(Flags,
"?no when others for this case construction",
Case_Location);
end if;
end if;
@ -487,7 +497,8 @@ package body Prj.Strt is
procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id;
Flags : Processing_Flags)
Flags : Processing_Flags;
String_Type : Boolean := True)
is
Current_Choice : Project_Node_Id := Empty_Node;
Next_Choice : Project_Node_Id := Empty_Node;
@ -517,38 +528,40 @@ package body Prj.Strt is
Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String);
-- Check if the label is part of the string type and if it has not
-- been already used.
if String_Type then
-- Check if the label is part of the string type and if it has not
-- been already used.
Found := False;
for Choice in Choice_First .. Choices.Last loop
if Choices.Table (Choice).The_String = Choice_String then
Found := False;
for Choice in Choice_First .. Choices.Last loop
if Choices.Table (Choice).The_String = Choice_String then
-- This label is part of the string type
-- This label is part of the string type
Found := True;
Found := True;
if Choices.Table (Choice).Already_Used then
if Choices.Table (Choice).Already_Used then
-- But it has already appeared in a choice list for this
-- case construction so report an error.
-- But it has already appeared in a choice list for this
-- case construction so report an error.
Error_Msg_Name_1 := Choice_String;
Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
Error_Msg_Name_1 := Choice_String;
Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
else
Choices.Table (Choice).Already_Used := True;
else
Choices.Table (Choice).Already_Used := True;
end if;
exit;
end if;
end loop;
exit;
-- If the label is not part of the string list, report an error
if not Found then
Error_Msg_Name_1 := Choice_String;
Error_Msg (Flags, "illegal case label %%", Token_Ptr);
end if;
end loop;
-- If the label is not part of the string list, report an error
if not Found then
Error_Msg_Name_1 := Choice_String;
Error_Msg (Flags, "illegal case label %%", Token_Ptr);
end if;
-- Scan past the label

8
gcc/ada/prj-strt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -59,7 +59,8 @@ private package Prj.Strt is
procedure End_Case_Construction
(Check_All_Labels : Boolean;
Case_Location : Source_Ptr;
Flags : Processing_Flags);
Flags : Processing_Flags;
String_Type : Boolean);
-- This procedure is called at the end of a case construction to remove the
-- case labels and to restore the previous state. In particular, in the
-- case of nested case constructions, the case labels of the enclosing case
@ -70,7 +71,8 @@ private package Prj.Strt is
procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id;
Flags : Processing_Flags);
Flags : Processing_Flags;
String_Type : Boolean := True);
-- Get the label for a choice list.
-- Report an error if
-- - a case label is not a literal string

38
gcc/ada/projects.texi
View File

@ -2403,7 +2403,7 @@ The environment variables at the time you launch @command{gprbuild}
will influence the view these tools have of the project
(PATH to find the compiler, ADA_PROJECT_PATH or GPR_PROJECT_PATH to find the
projects, environment variables that are referenced in project files
through the "external" statement,...). Several command line switches
through the "external" built-in function, ...). Several command line switches
can be used to override those (-X or -aP), but on some systems and
with some projects, this might make the command line too long, and on
all systems often make it hard to read.
@ -2427,7 +2427,7 @@ building. The syntax looks like
@end smallexample
One of the often requested features in projects is to be able to
reference external variables in @code{with} statements, as in
reference external variables in @code{with} declarations, as in
@smallexample @c projectfile
@b{with} @b{external}("SETUP") & "path/prj.gpr"; --@i{ ILLEGAL}
@ -2566,7 +2566,7 @@ Here are a few valid examples:
@cindex @code{Project_Path}
This attribute can be used to specify a list of directories in
which to look for project files in @code{with} statements.
which to look for project files in @code{with} declarations.
When you specify a project in Project_Files (say @code{x/y/a.gpr}), and
@code{a.gpr} imports a project @code{b.gpr}, only @code{b.gpr} is searched in
@ -2637,7 +2637,7 @@ Example:
@cindex @code{External}
This attribute can be used to set the value of environment
variables as retrieved through the @code{external} statement
variables as retrieved through the @code{external} function
in projects. It does not affect the environment variables
themselves (so for instance you cannot use it to change the value
of your PATH as seen from the spawned compiler).
@ -3403,7 +3403,7 @@ list expression, and can therefore appear in a variable declaration or
an attribute declaration.
Most of the time, this construct is used to initialize typed variables, which
are then used in @b{case} statements to control the value assigned to
are then used in @b{case} constructions to control the value assigned to
attributes in various scenarios. Thus such variables are often called
@b{scenario variables}.
@ -3565,8 +3565,8 @@ A @b{context} may be one of the following:
@c ---------------------------------------------
@noindent
A @b{case} statement is used in a project file to effect conditional
behavior. Through this statement, you can set the value of attributes
A @b{case} construction is used in a project file to effect conditional
behavior. Through this construction, you can set the value of attributes
and variables depending on the value previously assigned to a typed
variable.
@ -3574,30 +3574,30 @@ All choices in a choice list must be distinct. Unlike Ada, the choice
lists of all alternatives do not need to include all values of the type.
An @code{others} choice must appear last in the list of alternatives.
The syntax of a @code{case} construction is based on the Ada case statement
(although the @code{null} statement for empty alternatives is optional).
The syntax of a @code{case} construction is based on the Ada case construction
(although the @code{null} declaration for empty alternatives is optional).
The case expression must be a typed string variable, whose value is often
given by an external reference (@pxref{External Values}).
The case expression must be a string variable, either typed or not, whose value
is often given by an external reference (@pxref{External Values}).
Each alternative starts with the reserved word @code{when}, either a list of
literal strings separated by the @code{"|"} character or the reserved word
@code{others}, and the @code{"=>"} token.
Each literal string must belong to the string type that is the type of the
case variable.
After each @code{=>}, there are zero or more statements. The only
statements allowed in a case construction are other case constructions,
When the case expression is a typed string variable, each literal string must
belong to the string type that is the type of the case variable.
After each @code{=>}, there are zero or more declarations. The only
declarations allowed in a case construction are other case constructions,
attribute declarations and variable declarations. String type declarations and
package declarations are not allowed. Variable declarations are restricted to
variables that have already been declared before the case construction.
@smallexample
case_statement ::=
@i{case} @i{<typed_variable_>}name @i{is} @{case_item@} @i{end case} ;
case_construction ::=
@i{case} @i{<variable_>}name @i{is} @{case_item@} @i{end case} ;
case_item ::=
@i{when} discrete_choice_list =>
@{case_statement
@{case_declaration
| attribute_declaration
| variable_declaration
| empty_declaration@}
@ -3606,7 +3606,7 @@ discrete_choice_list ::= string_literal @{| string_literal@} | @i{others}
@end smallexample
@noindent
Here is a typical example:
Here is a typical example, with a typed string variable:
@smallexample @c projectfile
@group

6
gcc/ada/sem_ch5.adb
View File

@ -2204,9 +2204,15 @@ package body Sem_Ch5 is
procedure Check_Predicate_Use (T : Entity_Id) is
begin
-- A predicated subtype is illegal in loops and related constructs
-- if the predicate is not static, or else if it is a non-static
-- subtype of a statically predicated subtype.
if Is_Discrete_Type (T)
and then Has_Predicates (T)
and then (not Has_Static_Predicate (T)
or else not Is_Static_Subtype (T)
or else Has_Dynamic_Predicate_Aspect (T))
then
Bad_Predicated_Subtype_Use

7
gcc/ada/sem_ch8.adb
View File

@ -2321,6 +2321,13 @@ package body Sem_Ch8 is
Insert_Before_And_Analyze (N, Spec_Decl);
Wrap_Id := Defining_Entity (Spec_Decl);
-- If the operator carries an Eliminated pragma, indicate that the
-- wrapper is also to be eliminated, to prevent spurious error when
-- using gnatelim on programs that include box-initialization of
-- equality operators.
Set_Is_Eliminated (Wrap_Id, Is_Eliminated (Prim_Op));
-- The generated body does not freeze and must be analyzed when the
-- class-wide wrapper is frozen. The body is only needed if expansion
-- is enabled.