sem_ch13.adb (Check_Indexing_Functions): The return type of an indexing function can be the default element type...

2011-12-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_Indexing_Functions): The return type of an
	indexing function can be the default element type, and does not
	need to be a reference type.
	* sem_ch4.adb (Try_Container_Indexing): Ditto.

From-SVN: r182536
This commit is contained in:
Ed Schonberg 2011-12-20 13:53:42 +00:00 committed by Arnaud Charlet
parent a68d415b1d
commit 76d49f494a
3 changed files with 52 additions and 19 deletions

View File

@ -1,3 +1,10 @@
2011-12-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Check_Indexing_Functions): The return type of an
indexing function can be the default element type, and does not
need to be a reference type.
* sem_ch4.adb (Try_Container_Indexing): Ditto.
2011-12-20 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, sem_cat.adb, sem_ch10.adb: Minor reformatting.

View File

@ -1867,6 +1867,11 @@ package body Sem_Ch13 is
------------------------
procedure Check_One_Function (Subp : Entity_Id) is
Default_Element : constant Node_Id :=
Find_Aspect
(Etype (First_Formal (Subp)),
Aspect_Iterator_Element);
begin
if not Check_Primitive_Function (Subp) then
Error_Msg_NE
@ -1874,6 +1879,21 @@ package body Sem_Ch13 is
Subp, Ent);
end if;
-- An indexing function must return either the default element of
-- the container, or a reference type.
if Present (Default_Element) then
Analyze (Default_Element);
if Is_Entity_Name (Default_Element)
and then
Covers (Entity (Default_Element), Etype (Subp))
then
return;
end if;
end if;
-- Otherwise the return type must be a reference type.
if not Has_Implicit_Dereference (Etype (Subp)) then
Error_Msg_N
("function for indexing must return a reference type", Subp);

View File

@ -6491,18 +6491,22 @@ package body Sem_Ch4 is
Rewrite (N, Indexing);
Analyze (N);
-- The return type of the indexing function is a reference type, so
-- add the dereference as a possible interpretation.
-- If the return type of the indexing function is a reference type,
-- add the dereference as a possible interpretation. Note that the
-- indexing aspect may be a function that returns the element type
-- with no intervening implicit dereference.
Disc := First_Discriminant (Etype (Func));
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp (N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
if Has_Discriminants (Etype (Func)) then
Disc := First_Discriminant (Etype (Func));
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp (N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
Next_Discriminant (Disc);
end loop;
Next_Discriminant (Disc);
end loop;
end if;
else
Indexing := Make_Function_Call (Loc,
@ -6528,16 +6532,18 @@ package body Sem_Ch4 is
-- Add implicit dereference interpretation
Disc := First_Discriminant (Etype (It.Nam));
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp
(N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
if Has_Discriminants (Etype (It.Nam)) then
Disc := First_Discriminant (Etype (It.Nam));
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp
(N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
Next_Discriminant (Disc);
end loop;
Next_Discriminant (Disc);
end loop;
end if;
exit;
end if;