mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2014-06-11 Thomas Quinot <quinot@adacore.com> * freeze.ads: Minor reformatting. * checks.adb (Determine_Range): Do not attempt to determine the range of a deferred constant whose full view has not been seen yet. * sem_res.adb (Resolve): Remove undesirable guard against resolving expressions from expression functions. 2014-06-11 Robert Dewar <dewar@adacore.com> * debug.adb (Debug_Flag_Dot_1): Set to enable fix for anonymous access types. * layout.adb (Layout_Type): Make anonymous access types for subprogram formal types and return types always thin. For now only enabled if -gnatd.1 set. 2014-06-11 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality rule for stream attributes of interface types (RM 13.13.2 (38/3)): subprogram must be a null procedure. From-SVN: r211464
This commit is contained in:
Arnaud Charlet
parent
0d305ef004
commit
3e65bfab4a
|
|
@ -1,3 +1,26 @@
|
|||
2014-06-11 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* freeze.ads: Minor reformatting.
|
||||
* checks.adb (Determine_Range): Do not attempt to determine
|
||||
the range of a deferred constant whose full view has not been
|
||||
seen yet.
|
||||
* sem_res.adb (Resolve): Remove undesirable guard against
|
||||
resolving expressions from expression functions.
|
||||
|
||||
2014-06-11 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* debug.adb (Debug_Flag_Dot_1): Set to enable fix for anonymous
|
||||
access types.
|
||||
* layout.adb (Layout_Type): Make anonymous access types for
|
||||
subprogram formal types and return types always thin. For now
|
||||
only enabled if -gnatd.1 set.
|
||||
|
||||
2014-06-11 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
|
||||
rule for stream attributes of interface types (RM 13.13.2 (38/3)):
|
||||
subprogram must be a null procedure.
|
||||
|
||||
2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Input_Item): Allow formal
|
||||
|
|
|
|||
|
|
@ -4118,20 +4118,6 @@ package body Checks is
|
|||
-- Start of processing for Determine_Range
|
||||
|
||||
begin
|
||||
-- For temporary constants internally generated to remove side effects
|
||||
-- we must use the corresponding expression to determine the range of
|
||||
-- the expression.
|
||||
|
||||
if Is_Entity_Name (N)
|
||||
and then Nkind (Parent (Entity (N))) = N_Object_Declaration
|
||||
and then Ekind (Entity (N)) = E_Constant
|
||||
and then Is_Internal_Name (Chars (Entity (N)))
|
||||
then
|
||||
Determine_Range
|
||||
(Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Prevent junk warnings by initializing range variables
|
||||
|
||||
Lo := No_Uint;
|
||||
|
|
@ -4139,6 +4125,31 @@ package body Checks is
|
|||
Lor := No_Uint;
|
||||
Hir := No_Uint;
|
||||
|
||||
-- For temporary constants internally generated to remove side effects
|
||||
-- we must use the corresponding expression to determine the range of
|
||||
-- the expression. But note that the expander can also generate
|
||||
-- constants in other cases, including deferred constants.
|
||||
|
||||
if Is_Entity_Name (N)
|
||||
and then Nkind (Parent (Entity (N))) = N_Object_Declaration
|
||||
and then Ekind (Entity (N)) = E_Constant
|
||||
and then Is_Internal_Name (Chars (Entity (N)))
|
||||
then
|
||||
if Present (Expression (Parent (Entity (N)))) then
|
||||
Determine_Range
|
||||
(Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
|
||||
|
||||
elsif Present (Full_View (Entity (N))) then
|
||||
Determine_Range
|
||||
(Expression (Parent (Full_View (Entity (N)))),
|
||||
OK, Lo, Hi, Assume_Valid);
|
||||
|
||||
else
|
||||
OK := False;
|
||||
end if;
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If type is not defined, we can't determine its range
|
||||
|
||||
if No (Typ)
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ package body Debug is
|
|||
-- d8 Force opposite endianness in packed stuff
|
||||
-- d9 Allow lock free implementation
|
||||
|
||||
-- d.1
|
||||
-- d.1 Activate thin-as-default for subprogram anonymous access types
|
||||
-- d.2
|
||||
-- d.3
|
||||
-- d.4
|
||||
|
|
@ -733,6 +733,15 @@ package body Debug is
|
|||
-- d9 This allows lock free implementation for protected objects
|
||||
-- (see Exp_Ch9).
|
||||
|
||||
-- d.1 Right now, we have a problem with anonymous access types in the
|
||||
-- context of subprogram formal parameter types and return types. The
|
||||
-- problem occurs when in one place (e.g. the subprogram spec), the
|
||||
-- designated type is unknown (e.g. private) and we choose to use a
|
||||
-- thin pointer representation. Then in another place, we can see the
|
||||
-- full declaration of the type, and choose a fat pointer. The fix is
|
||||
-- to always use thin pointers, but this is causing some other issues,
|
||||
-- so for now, this fix is under control of this debug flag.
|
||||
|
||||
------------------------------------------
|
||||
-- Documentation for Binder Debug Flags --
|
||||
------------------------------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2011, 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- --
|
||||
|
|
@ -195,7 +195,7 @@ package Freeze is
|
|||
-- Returns No_List if no freeze nodes needed.
|
||||
|
||||
procedure Freeze_All (From : Entity_Id; After : in out Node_Id);
|
||||
-- Before a non-instance body, or at the end of a declarative part
|
||||
-- Before a non-instance body, or at the end of a declarative part,
|
||||
-- freeze all entities therein that are not yet frozen. Calls itself
|
||||
-- recursively to catch types in inner packages that were not frozen
|
||||
-- at the inner level because they were not yet completely defined.
|
||||
|
|
|
|||
|
|
@ -1200,8 +1200,7 @@ package body Layout is
|
|||
|
||||
Len := Convert_To (Standard_Unsigned, Len);
|
||||
|
||||
-- If range definitely flat or superflat,
|
||||
-- result size is zero
|
||||
-- If range definitely flat or superflat, result size is 0
|
||||
|
||||
if OK and then LHi <= 0 then
|
||||
Set_Esize (E, Uint_0);
|
||||
|
|
@ -2432,7 +2431,6 @@ package body Layout is
|
|||
-- represents them the same way.
|
||||
|
||||
if Is_Access_Type (E) then
|
||||
|
||||
Desig_Type := Underlying_Type (Designated_Type (E));
|
||||
|
||||
-- If we only have a limited view of the type, see whether the
|
||||
|
|
@ -2464,15 +2462,34 @@ package body Layout is
|
|||
Set_Size_Info (E, Base_Type (E));
|
||||
Set_RM_Size (E, RM_Size (Base_Type (E)));
|
||||
|
||||
-- Anonymous access types in subprogram specifications are always
|
||||
-- thin. In the unconstrained case we always use thin pointers for
|
||||
-- anonymous access types, because otherwise we get into strange
|
||||
-- conformance problems between two types, one of which can see
|
||||
-- that something is unconstrained and one of which cannot. The
|
||||
-- object of an extended return is treated similarly.
|
||||
|
||||
elsif Ekind (E) = E_Anonymous_Access_Type
|
||||
and then (Nkind_In (Associated_Node_For_Itype (E),
|
||||
N_Function_Specification,
|
||||
N_Procedure_Specification)
|
||||
or else Ekind (Scope (E)) = E_Return_Statement)
|
||||
|
||||
-- For now, debug flag -gnatd.1 must be set to enable this fix
|
||||
|
||||
and then Debug_Flag_Dot_1
|
||||
then
|
||||
Init_Size (E, System_Address_Size);
|
||||
|
||||
-- For other access types, we use either address size, or, if a fat
|
||||
-- pointer is used (pointer-to-unconstrained array case), twice the
|
||||
-- address size to accommodate a fat pointer.
|
||||
|
||||
elsif Present (Desig_Type)
|
||||
and then Is_Array_Type (Desig_Type)
|
||||
and then not Is_Constrained (Desig_Type)
|
||||
and then not Has_Completion_In_Body (Desig_Type)
|
||||
and then not Debug_Flag_6
|
||||
and then Is_Array_Type (Desig_Type)
|
||||
and then not Is_Constrained (Desig_Type)
|
||||
and then not Has_Completion_In_Body (Desig_Type)
|
||||
and then not Debug_Flag_6
|
||||
then
|
||||
Init_Size (E, 2 * System_Address_Size);
|
||||
|
||||
|
|
@ -2493,12 +2510,11 @@ package body Layout is
|
|||
-- fat pointer.
|
||||
|
||||
elsif Present (Desig_Type)
|
||||
and then Present (Parent (Desig_Type))
|
||||
and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
|
||||
and then
|
||||
Nkind (Type_Definition (Parent (Desig_Type)))
|
||||
= N_Unconstrained_Array_Definition
|
||||
and then not Debug_Flag_6
|
||||
and then Present (Parent (Desig_Type))
|
||||
and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
|
||||
and then Nkind (Type_Definition (Parent (Desig_Type))) =
|
||||
N_Unconstrained_Array_Definition
|
||||
and then not Debug_Flag_6
|
||||
then
|
||||
Init_Size (E, 2 * System_Address_Size);
|
||||
|
||||
|
|
@ -2519,6 +2535,9 @@ package body Layout is
|
|||
or else Present (Enclosing_Subprogram (E)))))
|
||||
then
|
||||
Init_Size (E, 2 * System_Address_Size);
|
||||
|
||||
-- Normal case of thin pointer
|
||||
|
||||
else
|
||||
Init_Size (E, System_Address_Size);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -3213,6 +3213,21 @@ package body Sem_Ch13 is
|
|||
if Is_Abstract_Subprogram (Subp) then
|
||||
Error_Msg_N ("stream subprogram must not be abstract", Expr);
|
||||
return;
|
||||
|
||||
-- Disable the following for now, until Polyorb issue is fixed.
|
||||
|
||||
elsif Is_Interface (U_Ent)
|
||||
and then not Inside_A_Generic
|
||||
and then Ekind (Subp) = E_Procedure
|
||||
and then
|
||||
not Null_Present
|
||||
(Specification
|
||||
(Unit_Declaration_Node (Ultimate_Alias (Subp))))
|
||||
and then False
|
||||
then
|
||||
Error_Msg_N
|
||||
("stream subprogram for interface type "
|
||||
& "must be null procedure", Expr);
|
||||
end if;
|
||||
|
||||
Set_Entity (Expr, Subp);
|
||||
|
|
|
|||
|
|
@ -1790,10 +1790,6 @@ package body Sem_Res is
|
|||
-- Try and fix up a literal so that it matches its expected type. New
|
||||
-- literals are manufactured if necessary to avoid cascaded errors.
|
||||
|
||||
function Proper_Current_Scope return Entity_Id;
|
||||
-- Return the current scope. Skip loop scopes created for the purpose of
|
||||
-- quantified expression analysis since those do not appear in the tree.
|
||||
|
||||
procedure Report_Ambiguous_Argument;
|
||||
-- Additional diagnostics when an ambiguous call has an ambiguous
|
||||
-- argument (typically a controlling actual).
|
||||
|
|
@ -1856,30 +1852,6 @@ package body Sem_Res is
|
|||
end if;
|
||||
end Patch_Up_Value;
|
||||
|
||||
--------------------------
|
||||
-- Proper_Current_Scope --
|
||||
--------------------------
|
||||
|
||||
function Proper_Current_Scope return Entity_Id is
|
||||
S : Entity_Id := Current_Scope;
|
||||
|
||||
begin
|
||||
while Present (S) loop
|
||||
|
||||
-- Skip a loop scope created for quantified expression analysis
|
||||
|
||||
if Ekind (S) = E_Loop
|
||||
and then Nkind (Parent (S)) = N_Quantified_Expression
|
||||
then
|
||||
S := Scope (S);
|
||||
else
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
return S;
|
||||
end Proper_Current_Scope;
|
||||
|
||||
-------------------------------
|
||||
-- Report_Ambiguous_Argument --
|
||||
-------------------------------
|
||||
|
|
@ -2933,15 +2905,12 @@ package body Sem_Res is
|
|||
-- default expression mode (the Freeze_Expression routine tests this
|
||||
-- flag and only freezes static types if it is set).
|
||||
|
||||
-- Ada 2012 (AI05-177): Expression functions do not freeze. Only
|
||||
-- their use (in an expanded call) freezes.
|
||||
-- Ada 2012 (AI05-177): The declaration of an expression function
|
||||
-- does not cause freezing, but we never reach here in that case.
|
||||
-- Here we are resolving the corresponding expanded body, so we do
|
||||
-- need to perform normal freezing.
|
||||
|
||||
if Ekind (Proper_Current_Scope) /= E_Function
|
||||
or else Nkind (Original_Node (Unit_Declaration_Node
|
||||
(Proper_Current_Scope))) /= N_Expression_Function
|
||||
then
|
||||
Freeze_Expression (N);
|
||||
end if;
|
||||
Freeze_Expression (N);
|
||||
|
||||
-- Now we can do the expansion
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue