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. From-SVN: r208068
This commit is contained in:
parent
f3fec19fb8
commit
c97d7285d9
@ -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>
|
2014-02-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gcc-interface/Make-lang.in (ADA_TOOLS_FLAGS_TO_PASS): Robustify.
|
* gcc-interface/Make-lang.in (ADA_TOOLS_FLAGS_TO_PASS): Robustify.
|
||||||
|
@ -436,6 +436,7 @@ package body Exp_Prag is
|
|||||||
then
|
then
|
||||||
Pref := Prefix (N);
|
Pref := Prefix (N);
|
||||||
Temp := Make_Temporary (Loc, 'T', Pref);
|
Temp := Make_Temporary (Loc, 'T', Pref);
|
||||||
|
Set_Etype (Temp, Etype (Pref));
|
||||||
|
|
||||||
-- Generate a temporary to capture the value of the prefix:
|
-- Generate a temporary to capture the value of the prefix:
|
||||||
-- Temp : <Pref type>;
|
-- Temp : <Pref type>;
|
||||||
|
@ -14643,6 +14643,31 @@ Display Copyright and version, then exit disregarding all other options.
|
|||||||
@cindex @option{--help} @command{gnatpp}
|
@cindex @option{--help} @command{gnatpp}
|
||||||
Display usage, then exit disregarding all other options.
|
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}
|
@item --pp-off=@var{xxx}
|
||||||
@cindex @option{--pp-off} @command{gnatpp}
|
@cindex @option{--pp-off} @command{gnatpp}
|
||||||
Use @code{--xxx} as the command to turn off pretty printing, instead
|
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.
|
a required layout in the result source.
|
||||||
@end table
|
@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
|
@node Formatting Rules
|
||||||
@section Formatting Rules
|
@section Formatting Rules
|
||||||
|
|
||||||
@ -15318,6 +15350,23 @@ Options:
|
|||||||
-h
|
-h
|
||||||
--help -- generate usage information and quit, ignoring all other options
|
--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
|
-mdir -- generate one .xml file for each Ada source file, in directory
|
||||||
@file{dir}. (Default is to generate the XML to standard output.)
|
@file{dir}. (Default is to generate the XML to standard output.)
|
||||||
|
|
||||||
@ -15340,6 +15389,11 @@ Options:
|
|||||||
@end smallexample
|
@end smallexample
|
||||||
|
|
||||||
@noindent
|
@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:
|
You can generate the ``tree files'' ahead of time using the -gnatct switch:
|
||||||
|
|
||||||
@smallexample
|
@smallexample
|
||||||
@ -16697,7 +16751,14 @@ tool argument.
|
|||||||
Use the specified subdirectory of the project objects file (or of the
|
Use the specified subdirectory of the project objects file (or of the
|
||||||
project file directory if the project does not specify an object directory)
|
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
|
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}^
|
@item ^-files @var{filename}^/FILES=@var{filename}^
|
||||||
@cindex @option{^-files^/FILES^} (@code{gnatmetric})
|
@cindex @option{^-files^/FILES^} (@code{gnatmetric})
|
||||||
@ -16729,13 +16790,11 @@ a trace of sources being processed.
|
|||||||
Quiet mode.
|
Quiet mode.
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
@ignore
|
|
||||||
@noindent
|
@noindent
|
||||||
If a project file is specified and no argument source is explicitly
|
If a project file is specified and no argument source is explicitly
|
||||||
specified (either directly or by means of @option{-files} option), and no
|
specified (either directly or by means of @option{-files} option), and no
|
||||||
@option{-U} is specified, then the set of processed sources is
|
@option{-U} is specified, then the set of processed sources is
|
||||||
all the immediate units of the argument project.
|
all the immediate units of the argument project.
|
||||||
@end ignore
|
|
||||||
|
|
||||||
|
|
||||||
@ignore
|
@ignore
|
||||||
|
@ -37,6 +37,7 @@ with Opt; use Opt;
|
|||||||
with Repinfo; use Repinfo;
|
with Repinfo; use Repinfo;
|
||||||
with Sem; use Sem;
|
with Sem; use Sem;
|
||||||
with Sem_Aux; use Sem_Aux;
|
with Sem_Aux; use Sem_Aux;
|
||||||
|
with Sem_Case; use Sem_Case;
|
||||||
with Sem_Ch13; use Sem_Ch13;
|
with Sem_Ch13; use Sem_Ch13;
|
||||||
with Sem_Eval; use Sem_Eval;
|
with Sem_Eval; use Sem_Eval;
|
||||||
with Sem_Util; use Sem_Util;
|
with Sem_Util; use Sem_Util;
|
||||||
@ -2224,9 +2225,54 @@ package body Layout is
|
|||||||
end if;
|
end if;
|
||||||
end Layout_Component_List;
|
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
|
-- Start of processing for Layout_Variant_Record
|
||||||
|
|
||||||
begin
|
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
|
-- We need the discriminant checking functions, since we generate
|
||||||
-- calls to these functions for the RM_Size expression, so make
|
-- calls to these functions for the RM_Size expression, so make
|
||||||
-- sure that these functions have been constructed in time.
|
-- sure that these functions have been constructed in time.
|
||||||
|
@ -11124,7 +11124,9 @@ package body Sem_Ch12 is
|
|||||||
Abandon_Instantiation (Actual);
|
Abandon_Instantiation (Actual);
|
||||||
end if;
|
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
|
Error_Msg_N
|
||||||
("constraint on actual is incompatible with formal", Actual);
|
("constraint on actual is incompatible with formal", Actual);
|
||||||
Abandon_Instantiation (Actual);
|
Abandon_Instantiation (Actual);
|
||||||
|
@ -4786,8 +4786,9 @@ package body Sem_Eval is
|
|||||||
------------------------------------
|
------------------------------------
|
||||||
|
|
||||||
function Subtypes_Statically_Compatible
|
function Subtypes_Statically_Compatible
|
||||||
(T1 : Entity_Id;
|
(T1 : Entity_Id;
|
||||||
T2 : Entity_Id) return Boolean
|
T2 : Entity_Id;
|
||||||
|
Formal_Derived_Matching : Boolean := False) return Boolean
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
-- Scalar types
|
-- Scalar types
|
||||||
@ -4863,7 +4864,7 @@ package body Sem_Eval is
|
|||||||
|
|
||||||
else
|
else
|
||||||
return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
|
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 if;
|
||||||
end Subtypes_Statically_Compatible;
|
end Subtypes_Statically_Compatible;
|
||||||
|
|
||||||
@ -4877,19 +4878,28 @@ package body Sem_Eval is
|
|||||||
-- values match (RM 4.9.1(1)).
|
-- values match (RM 4.9.1(1)).
|
||||||
|
|
||||||
-- In addition, in GNAT, the object size (Esize) values of the types must
|
-- 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
|
-- match if they are set (unless checking an actual for a formal derived
|
||||||
-- false even if the types would otherwise match in the RM sense.
|
-- 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
|
begin
|
||||||
-- A type always statically matches itself
|
-- A type always statically matches itself
|
||||||
|
|
||||||
if T1 = T2 then
|
if T1 = T2 then
|
||||||
return True;
|
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)
|
and then Esize (T1) /= Esize (T2)
|
||||||
then
|
then
|
||||||
return False;
|
return False;
|
||||||
|
@ -214,17 +214,25 @@ package Sem_Eval is
|
|||||||
-- static, or because one or the other bound raises CE).
|
-- static, or because one or the other bound raises CE).
|
||||||
|
|
||||||
function Subtypes_Statically_Compatible
|
function Subtypes_Statically_Compatible
|
||||||
(T1 : Entity_Id;
|
(T1 : Entity_Id;
|
||||||
T2 : Entity_Id) return Boolean;
|
T2 : Entity_Id;
|
||||||
|
Formal_Derived_Matching : Boolean := False) return Boolean;
|
||||||
-- Returns true if the subtypes are unconstrained or the constraint on
|
-- 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)).
|
-- 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,
|
-- 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
|
-- 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
|
-- 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;
|
function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
|
||||||
-- Returns true if Op is an expression not raising Constraint_Error whose
|
-- Returns true if Op is an expression not raising Constraint_Error whose
|
||||||
|
Loading…
Reference in New Issue
Block a user