* sem_util.adb (Note_Possible_Modification): In Alfa mode,
generate a reference for a modification even when the modification
does not come from source.
2011-11-07 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form,
use the indexing attributes rather than the Element function,
to obtain variable references.
* sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use
Find_Aspect rather than iterating over representation
items. Improve error message.
* a-cohama.adb, a-cohama.ads Update to latest RM, with two versions
of Reference functions.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181093
138bc75d-0d04-0410-961f-
82ee72b054a4
2011-11-07 Yannick Moy <moy@adacore.com>
+ * sem_util.adb (Note_Possible_Modification): In Alfa mode,
+ generate a reference for a modification even when the modification
+ does not come from source.
+
+2011-11-07 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form,
+ use the indexing attributes rather than the Element function,
+ to obtain variable references.
+ * sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use
+ Find_Aspect rather than iterating over representation
+ items. Improve error message.
+ * a-cohama.adb, a-cohama.ads Update to latest RM, with two versions
+ of Reference functions.
+
+2011-11-07 Yannick Moy <moy@adacore.com>
+
* sem_util.adb (Unique_Entity): For a parameter on a subprogram
body that has a corresponding parameter on the subprogram
declaration, define the unique entity as being the declaration
-- Reference --
---------------
- function Constant_Reference (Container : Map; Key : Key_Type)
- return Constant_Reference_Type is
+ function Constant_Reference
+ (Container : aliased Map; Position : Cursor)
+ return Constant_Reference_Type
+ is
+ pragma Unreferenced (Container);
+ begin
+ return (Element => Element (Position)'Unrestricted_Access);
+ end Constant_Reference;
+
+ function Reference
+ (Container : aliased in out Map; Position : Cursor)
+ return Reference_Type
+ is
+ pragma Unreferenced (Container);
+ begin
+ return (Element => Element (Position)'Unrestricted_Access);
+ end Reference;
+
+ function Constant_Reference
+ (Container : aliased Map; Key : Key_Type)
+ return Constant_Reference_Type
+ is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
- function Reference (Container : Map; Key : Key_Type)
- return Reference_Type is
+ function Reference
+ (Container : aliased in out Map; Key : Key_Type)
+ return Reference_Type
+ is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Reference;
for Reference_Type'Read use Read;
function Constant_Reference
- (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
+ (Container : aliased Map; Position : Cursor)
return Constant_Reference_Type;
- function Reference (Container : Map; Key : Key_Type)
+ function Reference
+ (Container : aliased in out Map; Position : Cursor)
+ return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map; Key : Key_Type)
+ return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map; Key : Key_Type)
return Reference_Type;
procedure Iterate
end loop;
-- Generate:
- -- Id : Element_Type renames Pack.Element (Cursor);
+ -- Id : Element_Type renames Container (Cursor);
+ -- This assumes that the container type has an indexing
+ -- operation with Cursor. The check that this operation
+ -- exists is performed in Check_Container_Indexing.
Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
- Subtype_Mark =>
+ Subtype_Mark =>
New_Reference_To (Element_Type, Loc),
- Name =>
+ Name =>
Make_Indexed_Component (Loc,
- Prefix => Make_Selected_Component (Loc,
- Prefix => New_Reference_To (Pack, Loc),
- Selector_Name =>
- Make_Identifier (Loc, Chars => Name_Element)),
+ Prefix => Relocate_Node (Container_Arg),
Expressions =>
New_List (New_Occurrence_Of (Cursor, Loc))));
-- If the container holds controlled objects, wrap the loop
-- statements and element renaming declaration with a block.
- -- This ensures that the result of Element (Iterator) is
+ -- This ensures that the result of Element (Cusor) is
-- cleaned up after each iteration of the loop.
if Needs_Finalization (Element_Type) then
-- Generate:
-- declare
- -- Id : Element_Type := Pack.Element (Iterator);
+ -- Id : Element_Type := Pack.Element (curosr);
-- begin
-- <original loop statements>
-- end;
-- The Iterator is not modified in the source, but of course will
-- be updated in the generated code. Indicate that it is actually
- -- set to prevent spurious warnings.
+ -- set to prevent spurious warnings. Ditto for the Cursor, which
+ -- is modified indirectly in generated code.
Set_Never_Set_In_Source (Iterator, False);
+ Set_Never_Set_In_Source (Cursor, False);
-- If the range of iteration is given by a function call that
-- returns a container, the finalization actions have been saved
Func : Entity_Id;
Func_Name : Node_Id;
Indexing : Node_Id;
- Is_Var : Boolean;
- Ritem : Node_Id;
begin
-- Check whether type has a specified indexing aspect
Func_Name := Empty;
- Is_Var := False;
- Ritem := First_Rep_Item (Etype (Prefix));
- while Present (Ritem) loop
- if Nkind (Ritem) = N_Aspect_Specification then
-
- -- Prefer Variable_Indexing, but will settle for Constant
-
- if Get_Aspect_Id (Chars (Identifier (Ritem))) =
- Aspect_Constant_Indexing
- then
- Func_Name := Expression (Ritem);
-
- elsif Get_Aspect_Id (Chars (Identifier (Ritem))) =
- Aspect_Variable_Indexing
- then
- Func_Name := Expression (Ritem);
- Is_Var := True;
- exit;
- end if;
- end if;
+ if Is_Variable (Prefix) then
+ Func_Name := Find_Aspect (Etype (Prefix), Aspect_Variable_Indexing);
+ end if;
- Next_Rep_Item (Ritem);
- end loop;
+ if No (Func_Name) then
+ Func_Name := Find_Aspect (Etype (Prefix), Aspect_Constant_Indexing);
+ end if;
-- If aspect does not exist the expression is illegal. Error is
-- diagnosed in caller.
end if;
end if;
- if Is_Var
- and then not Is_Variable (Prefix)
- then
- Error_Msg_N ("Variable indexing cannot be applied to a constant", N);
- end if;
-
if not Is_Overloaded (Func_Name) then
Func := Entity (Func_Name);
Indexing := Make_Function_Call (Loc,
Analyze_One_Call (N, It.Nam, False, Success);
if Success then
Set_Etype (Name (N), It.Typ);
+ Set_Entity (Name (N), It.Nam);
-- Add implicit dereference interpretation
Next_Discriminant (Disc);
end loop;
+ exit;
end if;
Get_Next_Interp (I, It);
end loop;
end;
end if;
+ if Etype (N) = Any_Type then
+ Error_Msg_NE ("container cannot be indexed with&", N, Etype (Expr));
+ Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
+ else
+ Analyze (N);
+ end if;
+
return True;
end Try_Container_Indexing;
-- source. This excludes, for example, calls to a dispatching
-- assignment operation when the left-hand side is tagged.
- if Modification_Comes_From_Source then
+ if Modification_Comes_From_Source
+ or else Alfa_Mode
+ then
Generate_Reference (Ent, Exp, 'm');
-- If the target of the assignment is the bound variable
projects / platform / upstream / linaro-gcc.git / commitdiff