+2009-06-25 Vincent Celier <celier@adacore.com>
+
+ * vms_data.ads: Minor comment change
+
+2009-06-25 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch5.adb (Expand_N_Extended_Return_Statement): Don't build an
+ assignment statement to targeting a caller-provided object when the
+ result type is an interface type.
+
+ * exp_ch6.adb (Expand_Call): Remove redundant test of
+ Is_Limited_Interface (Is_Inherently_Limited is sufficient).
+ (Is_Build_In_Place_Function): Remove test for Is_Limited_Interface.
+
+ * sem_aggr.adb (Check_Expr_OK_In_Limited_Aggregate): Add type in call
+ to OK_For_Limited_Init.
+
+ * sem_aux.adb (Is_Inherently_Limited_Type): Revise limited type
+ condition so that True is returned for all limited interfaces, not
+ just synchronized ones. Ignore components of an interface type when
+ checking for limited components (such a component can be a parent
+ component).
+
+ * sem_ch3.ads (OK_For_Limited_Init_In_05): Add type parameter.
+ (OK_For_Limited_Init): Add type parameter.
+
+ * sem_ch3.adb (Check_Initialization): Add type in call to
+ OK_For_Limited_Init.
+ (OK_For_Limited_Init): Add new type param in call to
+ OK_For_Limited_Init_In_05.
+ (OK_For_Limited_Init_In_05): Permit arbitrary expressions of a
+ nonlimited type when the context type is a limited interface. Add type
+ on recursive calls.
+
+ * sem_ch4.adb (Analyze_Allocator): Add type in call to
+ OK_For_Limited_Init.
+
+ * sem_ch6.adb (Check_Limited_Return): Add type in call to
+ OK_For_Limited_Init.
+
+ * sem_ch12.adb (Analyze_Formal_Object_Declaration): Add type in call to
+ OK_For_Limited_Init.
+ (Instantiate_Object): Add type in call to OK_For_Limited_Init.
+
+ * sem_type.adb (Interface_Present_In_Ancestor): In the case of a
+ class-wide interface, get the base type before applying Etype, in order
+ to account for class-wide subtypes.
+
2009-06-25 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, make.adb, prj.adb, prj.ads, prj-nmsc.adb,
-- and the declaration isn't marked as No_Initialization, then
-- we need to generate an assignment to the object and insert
-- it after the declaration before rewriting it as a renaming
- -- (otherwise we'll lose the initialization).
+ -- (otherwise we'll lose the initialization). The case where
+ -- the result type is an interface (or class-wide interface)
+ -- is also excluded because the context of the function call
+ -- must be unconstrained, so the initialization will always
+ -- be done as part of an allocator evaluation (storage pool
+ -- or secondary stack), never to a constrained target object
+ -- passed in by the caller. Besides the assignment being
+ -- unneeded in this case, it avoids problems with trying to
+ -- generate a dispatching assignment when the return expression
+ -- is a nonlimited descendant of a limited interface (the
+ -- interface has no assignment operation).
if Present (Return_Obj_Expr)
and then not No_Initialization (Return_Object_Decl)
+ and then not Is_Interface (Return_Obj_Typ)
then
Init_Assignment :=
Make_Assignment_Statement (Loc,
if Present (Return_Obj_Expr)
and then not No_Initialization (Return_Object_Decl)
then
+ -- Always use the type of the expression for the
+ -- qualified expression, rather than the result type.
+ -- In general we cannot always use the result type
+ -- for the allocator, because the expression might be
+ -- of a specific type, such as in the case of an
+ -- aggregate or even a nonlimited object when the
+ -- result type is a limited class-wide interface type.
+
Heap_Allocator :=
Make_Allocator (Loc,
Expression =>
Make_Qualified_Expression (Loc,
Subtype_Mark =>
- New_Reference_To (Return_Obj_Typ, Loc),
+ New_Reference_To
+ (Etype (Return_Obj_Expr), Loc),
Expression =>
New_Copy_Tree (Return_Obj_Expr)));
if Needs_Finalization (Etype (Subp))
and then not Is_Inherently_Limited_Type (Etype (Subp))
- and then not Is_Limited_Interface (Etype (Subp))
then
Expand_Ctrl_Function_Call (N);
end if;
then
return False;
- -- If the return type is a limited interface it has to be treated
- -- as a return in place, even if the actual object is some non-
- -- limited descendant.
-
- elsif Is_Limited_Interface (Etype (E)) then
- return True;
+ -- In Ada 2005 all functions with an inherently limited return type
+ -- must be handled using a build-in-place profile, including the case
+ -- of a function with a limited interface result, where the function
+ -- may return objects of nonlimited descendants.
else
return Is_Inherently_Limited_Type (Etype (E))
and then Comes_From_Source (Expr)
and then not In_Instance_Body
then
- if not OK_For_Limited_Init (Expr) then
+ if not OK_For_Limited_Init (Etype (Expr), Expr) then
Error_Msg_N ("initialization not allowed for limited types", Expr);
Explain_Limited_Type (Etype (Expr), Expr);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
return True;
elsif Is_Record_Type (Btype) then
+
+ -- Note that we return True for all limited interfaces, even though
+ -- (unsynchronized) limited interfaces can have descendants that are
+ -- nonlimited, because this is a predicate on the type itself, and
+ -- things like functions with limited interface results need to be
+ -- handled as build in place even though they might return objects
+ -- of a type that is not inherently limited.
+
if Is_Limited_Record (Btype) then
- return not Is_Interface (Btype)
- or else Is_Protected_Interface (Btype)
- or else Is_Synchronized_Interface (Btype)
- or else Is_Task_Interface (Btype);
+ return True;
elsif Is_Class_Wide_Type (Btype) then
return Is_Inherently_Limited_Type (Root_Type (Btype));
begin
C := First_Component (Btype);
while Present (C) loop
- if Is_Inherently_Limited_Type (Etype (C)) then
+
+ -- Don't consider components with interface types (which can
+ -- only occur in the case of a _parent component anyway).
+ -- They don't have any components, plus it would cause this
+ -- function to return true for nonlimited types derived from
+ -- limited intefaces.
+
+ if not Is_Interface (Etype (C))
+ and then Is_Inherently_Limited_Type (Etype (C))
+ then
return True;
end if;
if Present (E) then
Preanalyze_Spec_Expression (E, T);
- if Is_Limited_Type (T) and then not OK_For_Limited_Init (E) then
+ if Is_Limited_Type (T) and then not OK_For_Limited_Init (T, E) then
Error_Msg_N
("initialization not allowed for limited types", E);
Explain_Limited_Type (T, E);
end if;
if Is_Limited_Type (Typ)
- and then not OK_For_Limited_Init (Actual)
+ and then not OK_For_Limited_Init (Typ, Actual)
then
Error_Msg_N
("initialization not allowed for limited types", Actual);
and then not In_Instance
and then not In_Inlined_Body
then
- if not OK_For_Limited_Init (Exp) then
+ if not OK_For_Limited_Init (T, Exp) then
-- In GNAT mode, this is just a warning, to allow it to be evilly
-- turned off. Otherwise it is a real error.
-- ???Check all calls of this, and compare the conditions under which it's
-- called.
- function OK_For_Limited_Init (Exp : Node_Id) return Boolean is
+ function OK_For_Limited_Init
+ (Typ : Entity_Id;
+ Exp : Node_Id) return Boolean
+ is
begin
return Is_CPP_Constructor_Call (Exp)
or else (Ada_Version >= Ada_05
and then not Debug_Flag_Dot_L
- and then OK_For_Limited_Init_In_05 (Exp));
+ and then OK_For_Limited_Init_In_05 (Typ, Exp));
end OK_For_Limited_Init;
-------------------------------
-- OK_For_Limited_Init_In_05 --
-------------------------------
- function OK_For_Limited_Init_In_05 (Exp : Node_Id) return Boolean is
+ function OK_For_Limited_Init_In_05
+ (Typ : Entity_Id;
+ Exp : Node_Id) return Boolean
+ is
begin
+ -- An object of a limited interface type can be initialized with any
+ -- expression of a nonlimited descendant type.
+
+ if Is_Class_Wide_Type (Typ)
+ and then Is_Limited_Interface (Typ)
+ and then not Is_Limited_Type (Etype (Exp))
+ then
+ return True;
+ end if;
+
-- Ada 2005 (AI-287, AI-318): Relax the strictness of the front end in
-- case of limited aggregates (including extension aggregates), and
-- function calls. The function call may have been give in prefixed
when N_Qualified_Expression =>
return
- OK_For_Limited_Init_In_05 (Expression (Original_Node (Exp)));
+ OK_For_Limited_Init_In_05
+ (Typ, Expression (Original_Node (Exp)));
-- Ada 2005 (AI-251): If a class-wide interface object is initialized
-- with a function call, the expander has rewritten the call into an
when N_Type_Conversion | N_Unchecked_Type_Conversion =>
return not Comes_From_Source (Exp)
and then
- OK_For_Limited_Init_In_05 (Expression (Original_Node (Exp)));
+ OK_For_Limited_Init_In_05
+ (Typ, Expression (Original_Node (Exp)));
when N_Indexed_Component | N_Selected_Component =>
return Nkind (Exp) = N_Function_Call;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- wide type is created at the same time, and therefore there is a private
-- and a full declaration for the class-wide type as well.
- function OK_For_Limited_Init_In_05 (Exp : Node_Id) return Boolean;
- -- Presuming Exp is an expression of an inherently limited type, returns
- -- True if the expression is allowed in an initialization context by the
- -- rules of Ada 2005. We use the rule in RM-7.5(2.1/2), "...it is an
- -- aggregate, a function_call, or a parenthesized expression or
- -- qualified_expression whose operand is permitted...". Note that in Ada
- -- 95 mode, we sometimes wish to give warnings based on whether the
- -- program _would_ be legal in Ada 2005. Note that Exp must already have
- -- been resolved, so we can know whether it's a function call (as opposed
- -- to an indexed component, for example).
-
- function OK_For_Limited_Init (Exp : Node_Id) return Boolean;
+ function OK_For_Limited_Init_In_05
+ (Typ : Entity_Id;
+ Exp : Node_Id) return Boolean;
+ -- Presuming Exp is an expression of an inherently limited type Typ,
+ -- returns True if the expression is allowed in an initialization context
+ -- by the rules of Ada 2005. We use the rule in RM-7.5(2.1/2), "...it is an
+ -- aggregate, a function_call, or a parenthesized expression or qualified
+ -- expression whose operand is permitted...". Note that in Ada 95 mode,
+ -- we sometimes wish to give warnings based on whether the program _would_
+ -- be legal in Ada 2005. Note that Exp must already have been resolved,
+ -- so we can know whether it's a function call (as opposed to an indexed
+ -- component, for example). In the case where Typ is a limited interface's
+ -- class-wide type, then the expression is allowed to be of any kind if its
+ -- type is a nonlimited descendant of the interface.
+
+ function OK_For_Limited_Init
+ (Typ : Entity_Id;
+ Exp : Node_Id) return Boolean;
-- Always False in Ada 95 mode. Equivalent to OK_For_Limited_Init_In_05 in
-- Ada 2005 mode.
and then Comes_From_Source (N)
and then not In_Instance_Body
then
- if not OK_For_Limited_Init (Expression (E)) then
+ if not OK_For_Limited_Init (Type_Id, Expression (E)) then
Error_Msg_N ("initialization not allowed for limited types", N);
Explain_Limited_Type (Type_Id, N);
end if;
if Is_Limited_Type (R_Type)
and then Comes_From_Source (N)
and then not In_Instance_Body
- and then not OK_For_Limited_Init_In_05 (Expr)
+ and then not OK_For_Limited_Init_In_05 (R_Type, Expr)
then
-- Error in Ada 2005
-- Start of processing for Interface_Present_In_Ancestor
begin
+ -- Iface might be a class-wide subtype, so we have to apply Base_Type
+
if Is_Class_Wide_Type (Iface) then
- Iface_Typ := Etype (Iface);
+ Iface_Typ := Etype (Base_Type (Iface));
else
Iface_Typ := Iface;
end if;
--
-- Work quietly, only output warnings and errors.
- S_Check_Time : aliased constant S := "/TIME " &
- "-t";
+ S_Check_Time : aliased constant S := "/TIME " &
+ "-t";
-- /NOTIME (D)
- -- /QUIET
+ -- /TIME
+ --
+ -- Print out execution time
+
+ S_Check_Log : aliased constant S := "/LOG " &
+ "-log";
+ -- /NOLOG (D)
+ -- /LOG
--
- -- Print out execution time
+ -- Duplicate all the output sent to Stderr into a log file.
S_Check_Sections : aliased constant S := "/SECTIONS=" &
"DEFAULT " &
S_Check_Project 'Access,
S_Check_Quiet 'Access,
S_Check_Time 'Access,
+ S_Check_Log 'Access,
S_Check_Sections 'Access,
S_Check_Short 'Access,
S_Check_Subdirs 'Access,
git://gcc.gnu.org / gcc.git / commitdiff