+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
-- 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
-- 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
-- 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 --
------------------------------------------
-- --
-- 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- --
-- 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.
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);
-- 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
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);
-- 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);
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;
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);
-- 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).
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 --
-------------------------------
-- 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
projects / gcc.git / commitdiff