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

2014-02-24 Sergey Rybin <rybin@adacore.com frybin>

Browse Source 
* gnat_ugn.texi: Misc updates.

2014-02-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_prag.adb (Expand_Old): Set the type of the generated temporary.

2014-02-24  Gary Dismukes  <dismukes@adacore.com>

	* layout.adb (Layout_Variant_Record): Instantiate
	Generic_Check_Choices and call Check_Choices before calling
	Build_Discr_Checking_Funcs, since we need Others_Discrete_Choices
	set to prevent generating incorrect discriminant-checking
	functions for 'others' variants (functions that unconditionally
	return True rather than accounting for the values covered by the
	'others' choice).
	* sem_eval.ads (Subtypes_Statically_Compatible): Add formal
	Formal_Derived_Matching.
	(Subtypes_Statically_Match): Add formal Formal_Derived_Matching.
	* sem_eval.adb (Subtypes_Statically_Compatible): Pass new
	Formal_Derived_Matching formal to Subtypes_Statically_Match.
	(Subtypes_Statically_Match): Suppress the Object_Size matching
	test in the case where Formal_Derived_Matching is True.
	* sem_ch12.adb (Validate_Derived_Type_Instance): Pass
	True for Formal_Derived_Matching_Formal on the call to
	Subtypes_Statically_Compatible.

From-SVN: r208068
This commit is contained in:
Arnaud Charlet 2014-02-24 16:07:09 +01:00
parent f3fec19fb8
commit c97d7285d9
7 changed files with 171 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2014-02-24 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi: Misc updates.
2014-02-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_prag.adb (Expand_Old): Set the type of the generated temporary.
2014-02-24 Gary Dismukes <dismukes@adacore.com>
* layout.adb (Layout_Variant_Record): Instantiate
Generic_Check_Choices and call Check_Choices before calling
Build_Discr_Checking_Funcs, since we need Others_Discrete_Choices
set to prevent generating incorrect discriminant-checking
functions for 'others' variants (functions that unconditionally
return True rather than accounting for the values covered by the
'others' choice).
* sem_eval.ads (Subtypes_Statically_Compatible): Add formal
Formal_Derived_Matching.
(Subtypes_Statically_Match): Add formal Formal_Derived_Matching.
* sem_eval.adb (Subtypes_Statically_Compatible): Pass new
Formal_Derived_Matching formal to Subtypes_Statically_Match.
(Subtypes_Statically_Match): Suppress the Object_Size matching
test in the case where Formal_Derived_Matching is True.
* sem_ch12.adb (Validate_Derived_Type_Instance): Pass
True for Formal_Derived_Matching_Formal on the call to
Subtypes_Statically_Compatible.
2014-02-23 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/Make-lang.in (ADA_TOOLS_FLAGS_TO_PASS): Robustify.

1
gcc/ada/exp_prag.adb
View File

@ -436,6 +436,7 @@ package body Exp_Prag is
then
Pref := Prefix (N);
Temp := Make_Temporary (Loc, 'T', Pref);
Set_Etype (Temp, Etype (Pref));
-- Generate a temporary to capture the value of the prefix:
-- Temp : <Pref type>;

65
gcc/ada/gnat_ugn.texi
View File

@ -14643,6 +14643,31 @@ Display Copyright and version, then exit disregarding all other options.
@cindex @option{--help} @command{gnatpp}
Display usage, then exit disregarding all other options.
@item -P @var{file}
@cindex @option{-P} @command{gnatpp}
Indicates the name of the project file that describes the set of sources
to be processed. The exact set of argument sources depends on other options
specified, see below.
@item -U
@cindex @option{-U} @command{gnatpp}
If a project file is specified and no argument source is explicitly
specified (either directly or by means of @option{-files} option), process
all the units of the closure of the argument project. Otherwise this option
has no effect.
@item -U @var{main_unit}
If a project file is specified and no argument source is explicitly
specified (either directly or by means of @option{-files} option), process
the closure of units rooted at @var{main_unit}. Otherwise this option
has no effect.
@item -X@var{name}=@var{value}
@cindex @option{-X} @command{gnatpp}
Indicates that external variable @var{name} in the argument project
has the @var{value} value. Has no effect if no project is specified as
tool argument.
@item --pp-off=@var{xxx}
@cindex @option{--pp-off} @command{gnatpp}
Use @code{--xxx} as the command to turn off pretty printing, instead
@ -14692,6 +14717,13 @@ Warning mode;
a required layout in the result source.
@end table
@noindent
If a project file is specified and no argument source is explicitly
specified (either directly or by means of @option{-files} option), and no
@option{-U} is specified, then the set of processed sources is
all the immediate units of the argument project.
@node Formatting Rules
@section Formatting Rules
@ -15318,6 +15350,23 @@ Options:
-h
--help -- generate usage information and quit, ignoring all other options
-P @file{file} -- indicates the name of the project file that describes
the set of sources to be processed. The exact set of argument
sources depends on other options specified, see below.
-U -- if a project file is specified and no argument source is explicitly
specified, process all the units of the closure of the argument project.
Otherwise this option has no effect.
-U @var{main_unit} -- if a project file is specified and no argument source
is explicitly specified (either directly or by means of @option{-files}
option), process the closure of units rooted at @var{main_unit}.
Otherwise this option has no effect.
-X@var{name}=@var{value} -- indicates that external variable @var{name} in
the argument project has the @var{value} value. Has no effect if no
project is specified as tool argument.
-mdir -- generate one .xml file for each Ada source file, in directory
@file{dir}. (Default is to generate the XML to standard output.)
@ -15340,6 +15389,11 @@ Options:
@end smallexample
@noindent
If a project file is specified and no argument source is explicitly
specified, and no @option{-U} is specified, then the set of processed
sources is all the immediate units of the argument project.
You can generate the ``tree files'' ahead of time using the -gnatct switch:
@smallexample
@ -16697,7 +16751,14 @@ tool argument.
Use the specified subdirectory of the project objects file (or of the
project file directory if the project does not specify an object directory)
for tool output files. Has no effect if no project is specified as
tool argument.
tool argument r if @option{--no_objects_dir} is specified.
@item --no_objects_dir
@cindex @option{--no_objects_dir} @command{gnatmetric}
Place all the result files into the current directory instead of
project objects directory. This corresponds to the @command{gnatcheck}
behavior when it is called with the project file from the
GNAT driver. Has no effect if no project is specified.
@item ^-files @var{filename}^/FILES=@var{filename}^
@cindex @option{^-files^/FILES^} (@code{gnatmetric})
@ -16729,13 +16790,11 @@ a trace of sources being processed.
Quiet mode.
@end table
@ignore
@noindent
If a project file is specified and no argument source is explicitly
specified (either directly or by means of @option{-files} option), and no
@option{-U} is specified, then the set of processed sources is
all the immediate units of the argument project.
@end ignore
@ignore

46
gcc/ada/layout.adb
View File

@ -37,6 +37,7 @@ with Opt; use Opt;
with Repinfo; use Repinfo;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
@ -2224,9 +2225,54 @@ package body Layout is
end if;
end Layout_Component_List;
Others_Present : Boolean;
pragma Warnings (Off, Others_Present);
-- Indicates others present, not used in this case
procedure Non_Static_Choice_Error (Choice : Node_Id);
-- Error routine invoked by the generic instantiation below when
-- the variant part has a nonstatic choice.
package Variant_Choices_Processing is new
Generic_Check_Choices
(Process_Empty_Choice => No_OP,
Process_Non_Static_Choice => Non_Static_Choice_Error,
Process_Associated_Node => No_OP);
use Variant_Choices_Processing;
-----------------------------
-- Non_Static_Choice_Error --
-----------------------------
procedure Non_Static_Choice_Error (Choice : Node_Id) is
begin
Flag_Non_Static_Expr
("choice given in case expression is not static!", Choice);
end Non_Static_Choice_Error;
-- Start of processing for Layout_Variant_Record
begin
-- Call Check_Choices here to ensure that Others_Discrete_Choices
-- gets set on any 'others' choice before the discriminant-checking
-- functions are generated. Otherwise the function for the 'others'
-- alternative will unconditionally return True, causing discriminant
-- checks to fail. However, Check_Choices is now normally delayed
-- until the type's freeze entity is processed, due to requirements
-- coming from subtype predicates, so doing it at this point is
-- probably not right in general, but it's not clear how else to deal
-- with this situation. Perhaps we should only generate declarations
-- for the checking functions here, and somehow delay generation of
-- their bodies, but that would be a nontrivial change. ???
declare
VP : constant Node_Id :=
Variant_Part (Component_List (Type_Definition (Decl)));
begin
Check_Choices
(VP, Variants (VP), Etype (Name (VP)), Others_Present);
end;
-- We need the discriminant checking functions, since we generate
-- calls to these functions for the RM_Size expression, so make
-- sure that these functions have been constructed in time.

4
gcc/ada/sem_ch12.adb
View File

@ -11124,7 +11124,9 @@ package body Sem_Ch12 is
Abandon_Instantiation (Actual);
end if;
if not Subtypes_Statically_Compatible (Act_T, Ancestor) then
if not Subtypes_Statically_Compatible
(Act_T, Ancestor, Formal_Derived_Matching => True)
then
Error_Msg_N
("constraint on actual is incompatible with formal", Actual);
Abandon_Instantiation (Actual);

26
gcc/ada/sem_eval.adb
View File

@ -4786,8 +4786,9 @@ package body Sem_Eval is
------------------------------------
function Subtypes_Statically_Compatible
(T1 : Entity_Id;
T2 : Entity_Id) return Boolean
(T1 : Entity_Id;
T2 : Entity_Id;
Formal_Derived_Matching : Boolean := False) return Boolean
is
begin
-- Scalar types
@ -4863,7 +4864,7 @@ package body Sem_Eval is
else
return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
or else Subtypes_Statically_Match (T1, T2);
or else Subtypes_Statically_Match (T1, T2, Formal_Derived_Matching);
end if;
end Subtypes_Statically_Compatible;
@ -4877,19 +4878,28 @@ package body Sem_Eval is
-- values match (RM 4.9.1(1)).
-- In addition, in GNAT, the object size (Esize) values of the types must
-- match if they are set. The use of 'Object_Size can cause this to be
-- false even if the types would otherwise match in the RM sense.
-- match if they are set (unless checking an actual for a formal derived
-- type). The use of 'Object_Size can cause this to be false even if the
-- types would otherwise match in the RM sense.
function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean is
function Subtypes_Statically_Match
(T1 : Entity_Id;
T2 : Entity_Id;
Formal_Derived_Matching : Boolean := False) return Boolean
is
begin
-- A type always statically matches itself
if T1 = T2 then
return True;
-- No match if sizes different (from use of 'Object_Size)
-- No match if sizes different (from use of 'Object_Size). This test
-- is excluded if Formal_Derived_Matching is True, as the base types
-- can be different in that case and typically have different sizes
-- (and Esizes can be set when Frontend_Layout_On_Target is True).
elsif Known_Static_Esize (T1) and then Known_Static_Esize (T2)
elsif not Formal_Derived_Matching
and then Known_Static_Esize (T1) and then Known_Static_Esize (T2)
and then Esize (T1) /= Esize (T2)
then
return False;

18
gcc/ada/sem_eval.ads
View File

@ -214,17 +214,25 @@ package Sem_Eval is
-- static, or because one or the other bound raises CE).
function Subtypes_Statically_Compatible
(T1 : Entity_Id;
T2 : Entity_Id) return Boolean;
(T1 : Entity_Id;
T2 : Entity_Id;
Formal_Derived_Matching : Boolean := False) return Boolean;
-- Returns true if the subtypes are unconstrained or the constraint on
-- on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
-- Otherwise returns false.
-- Otherwise returns false. Formal_Derived_Matching indicates whether
-- the type T1 is a generic actual being checked against ancestor T2
-- in a formal derived type association.
function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean;
function Subtypes_Statically_Match
(T1 : Entity_Id;
T2 : Entity_Id;
Formal_Derived_Matching : Boolean := False) return Boolean;
-- Determine whether two types T1, T2, which have the same base type,
-- are statically matching subtypes (RM 4.9.1(1-2)). Also includes the
-- extra GNAT rule that object sizes must match (this can be false for
-- types that match in the RM sense because of use of 'Object_Size).
-- types that match in the RM sense because of use of 'Object_Size),
-- except when testing a generic actual T1 against an ancestor T2 in a
-- formal derived type association (indicated by Formal_Derived_Matching).
function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
-- Returns true if Op is an expression not raising Constraint_Error whose