Skip to content

R
riscv-gcc-1
Commit 3e65bfab by Arnaud Charlet
Options

[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
parent 0d305ef0
Showing with 108 additions and 62 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/checks.adb
......@@ -4118,26 +4118,37 @@ package body Checks is
-- Start of processing for Determine_Range
begin
-- Prevent junk warnings by initializing range variables
Lo := No_Uint;
Hi := No_Uint;
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.
-- 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
Determine_Range
(Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
return;
end if;
if Present (Expression (Parent (Entity (N)))) then
Determine_Range
(Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
-- Prevent junk warnings by initializing range variables
elsif Present (Full_View (Entity (N))) then
Determine_Range
(Expression (Parent (Full_View (Entity (N)))),
OK, Lo, Hi, Assume_Valid);
Lo := No_Uint;
Hi := No_Uint;
Lor := No_Uint;
Hir := No_Uint;
else
OK := False;
end if;
return;
end if;
-- If type is not defined, we can't determine its range
......
gcc/ada/debug.adb
......@@ -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 --
------------------------------------------
......
gcc/ada/freeze.ads
......@@ -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.
......
gcc/ada/layout.adb
......@@ -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;
......
gcc/ada/sem_ch13.adb
......@@ -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);
......
gcc/ada/sem_res.adb
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment