+2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch11.adb (Find_Local_Handler): Guard the
+ search over individual exception choices in case the list of
+ handlers contains other (possibly illegal) constructs.
+
+2011-12-20 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch8.adb (Find_Type): Test taggedness
+ of the Available_Type when checking for an illegal use of an
+ incomplete type, when the incomplete view is a limited view of
+ a type. Remove redundant Is_Tagged test.
+
+2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.adb: Add with and use clause for Aspects.
+ (Is_Finalizable_Transient): Objects which denote Ada containers
+ in the context of iterators are not considered transients. Such
+ object must live for as long as the loop is around.
+ (Is_Iterated_Container): New routine.
+
+2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_imgv.adb (Expand_Width_Attribute): Add a
+ type conversion from the enumeration subtype to its base subtype.
+
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch4.adb (Operator_Check): Update the call to
H := First (Exception_Handlers (P));
while Present (H) loop
- -- Loop through choices in one handler
+ -- Guard against other constructs appearing in the list of
+ -- exception handlers.
- C := First (Exception_Choices (H));
- while Present (C) loop
+ if Nkind (H) = N_Exception_Handler then
- -- Deal with others case
+ -- Loop through choices in one handler
- if Nkind (C) = N_Others_Choice then
+ C := First (Exception_Choices (H));
+ while Present (C) loop
- -- Matching others handler, but we need to ensure
- -- there is no choice parameter. If there is, then we
- -- don't have a local handler after all (since we do
- -- not allow choice parameters for local handlers).
+ -- Deal with others case
- if No (Choice_Parameter (H)) then
- return H;
- else
- return Empty;
- end if;
-
- -- If not others must be entity name
-
- elsif Nkind (C) /= N_Others_Choice then
- pragma Assert (Is_Entity_Name (C));
- pragma Assert (Present (Entity (C)));
-
- -- Get exception being handled, dealing with renaming
+ if Nkind (C) = N_Others_Choice then
- EHandle := Get_Renamed_Entity (Entity (C));
+ -- Matching others handler, but we need to ensure
+ -- there is no choice parameter. If there is, then
+ -- we don't have a local handler after all (since
+ -- we do not allow choice parameters for local
+ -- handlers).
- -- If match, then check choice parameter
-
- if ERaise = EHandle then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
+
+ -- If not others must be entity name
+
+ elsif Nkind (C) /= N_Others_Choice then
+ pragma Assert (Is_Entity_Name (C));
+ pragma Assert (Present (Entity (C)));
+
+ -- Get exception being handled, dealing with
+ -- renaming.
+
+ EHandle := Get_Renamed_Entity (Entity (C));
+
+ -- If match, then check choice parameter
+
+ if ERaise = EHandle then
+ if No (Choice_Parameter (H)) then
+ return H;
+ else
+ return Empty;
+ end if;
+ end if;
end if;
- end if;
- Next (C);
- end loop;
+ Next (C);
+ end loop;
+ end if;
Next (H);
end loop;
-- ...
-- else n)))...
- -- where n is equal to Rtyp'Pos (Rtyp'Last) + 1
+ -- where n is equal to Rtyp'Pos (Ptyp'Last) + 1
-- Note: The above processing is in accordance with the intent of
-- the RM, which is that Width should be related to the impl-defined
New_Occurrence_Of (Standard_Integer, Loc),
Expression =>
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Rtyp, Loc),
- Attribute_Name => Name_Pos,
- Expressions => New_List (
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ptyp, Loc),
- Attribute_Name => Name_Last)))));
+ Prefix => New_Occurrence_Of (Rtyp, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Convert_To (Rtyp,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ptyp, Loc),
+ Attribute_Name => Name_Last))))));
-- OK, now we need to build the conditional expression. First
-- get the value of M, the largest possible value needed.
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
with Checks; use Checks;
function Is_Allocated (Trans_Id : Entity_Id) return Boolean;
-- Determine whether transient object Trans_Id is allocated on the heap
+ function Is_Iterated_Container
+ (Trans_Id : Entity_Id;
+ First_Stmt : Node_Id) return Boolean;
+ -- Determine whether transient object Trans_Id denotes a container which
+ -- is in the process of being iterated in the statement list starting
+ -- from First_Stmt.
+
---------------------------
-- Initialized_By_Access --
---------------------------
and then Nkind (Expr) = N_Allocator;
end Is_Allocated;
+ ---------------------------
+ -- Is_Iterated_Container --
+ ---------------------------
+
+ function Is_Iterated_Container
+ (Trans_Id : Entity_Id;
+ First_Stmt : Node_Id) return Boolean
+ is
+ Aspect : Node_Id;
+ Call : Node_Id;
+ Iter : Entity_Id;
+ Param : Node_Id;
+ Stmt : Node_Id;
+ Typ : Entity_Id;
+
+ begin
+ -- It is not possible to iterate over containers in non-Ada 2012 code
+
+ if Ada_Version < Ada_2012 then
+ return False;
+ end if;
+
+ Typ := Etype (Trans_Id);
+
+ -- Handle access type created for secondary stack use
+
+ if Is_Access_Type (Typ) then
+ Typ := Designated_Type (Typ);
+ end if;
+
+ -- Look for aspect Default_Iterator
+
+ if Has_Aspects (Parent (Typ)) then
+ Aspect := Find_Aspect (Typ, Aspect_Default_Iterator);
+
+ if Present (Aspect) then
+ Iter := Entity (Aspect);
+
+ -- Examine the statements following the container object and
+ -- look for a call to the default iterate routine where the
+ -- first parameter is the transient. Such a call appears as:
+
+ -- It : Access_To_CW_Iterator :=
+ -- Iterate (Tran_Id.all, ...)'reference;
+
+ Stmt := First_Stmt;
+ while Present (Stmt) loop
+
+ -- Detect an object declaration which is initialized by a
+ -- secondary stack function call.
+
+ if Nkind (Stmt) = N_Object_Declaration
+ and then Present (Expression (Stmt))
+ and then Nkind (Expression (Stmt)) = N_Reference
+ and then Nkind (Prefix (Expression (Stmt))) =
+ N_Function_Call
+ then
+ Call := Prefix (Expression (Stmt));
+
+ -- The call must invoke the default iterate routine of
+ -- the container and the transient object must appear as
+ -- the first actual parameter.
+
+ if Entity (Name (Call)) = Iter
+ and then Present (Parameter_Associations (Call))
+ then
+ Param := First (Parameter_Associations (Call));
+
+ if Nkind (Param) = N_Explicit_Dereference
+ and then Entity (Prefix (Param)) = Trans_Id
+ then
+ return True;
+ end if;
+ end if;
+ end if;
+
+ Next (Stmt);
+ end loop;
+ end if;
+ end if;
+
+ return False;
+ end Is_Iterated_Container;
+
-- Start of processing for Is_Finalizable_Transient
begin
-- Do not consider conversions of tags to class-wide types
- and then not Is_Tag_To_CW_Conversion (Obj_Id);
+ and then not Is_Tag_To_CW_Conversion (Obj_Id)
+
+ -- Do not consider containers in the context of iterator loops. Such
+ -- transient objects must exist for as long as the loop is around,
+ -- otherwise any operation carried out by the iterator will fail.
+
+ and then not Is_Iterated_Container (Obj_Id, Decl);
end Is_Finalizable_Transient;
---------------------------------
-- is completed in the current scope, and not for a limited
-- view of a type.
- if not Is_Tagged_Type (T)
- and then Ada_Version >= Ada_2005
- then
- if From_With_Type (T) then
+ if Ada_Version >= Ada_2005 then
+
+ -- Test whether the Available_View of a limited type view
+ -- is tagged, since the limited view may not be marked as
+ -- tagged if the type itself has an untagged incomplete
+ -- type view in its package.
+
+ if From_With_Type (T)
+ and then not Is_Tagged_Type (Available_View (T))
+ then
Error_Msg_N
("prefix of Class attribute must be tagged", N);
Set_Etype (N, Any_Type);
projects / gcc.git / commitdiff