mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 09:50:42 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-02-24  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads, sem_ch12.adb, sem_res.adb, sem_ch4.adb, par-ch12.adb:
	Minor reformatting.
	* atree.ads, atree.adb (Node35): New function.
	(Set_Node35): New procedure.
	* debug.adb: Define new debug flag -gnatd.X.
	* einfo.ads, einfo.adb (Import_Pragma): New field.
	* freeze.adb (Wrap_Imported_Procedure): New procedure (not
	really active yet, has to be activated with -gnatd.X.
	* sem_prag.adb (Set_Imported): Set new Import_Pragma
	field (Set_Imported): Don't set Is_Public (see
	Freeze.Wrap_Imported_Subprogram)
	* par-ch3.adb (P_Component_List): Handle unexpected null component.

2014-02-24  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb: Correct reference to SPARK RM in error messages.
	* gnat_rm.texi: Correct documentation of attribute Update.

2014-02-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): Reject container
	iterator in older versions of Ada.

From-SVN: r208076
This commit is contained in:
Arnaud Charlet 2014-02-24 17:30:08 +01:00
parent 97027f64df
commit 32bba3c9d8
17 changed files with 349 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ada/ChangeLog
View File

@ -1,3 +1,28 @@
2014-02-24 Robert Dewar <dewar@adacore.com>
* sinfo.ads, sem_ch12.adb, sem_res.adb, sem_ch4.adb, par-ch12.adb:
Minor reformatting.
* atree.ads, atree.adb (Node35): New function.
(Set_Node35): New procedure.
* debug.adb: Define new debug flag -gnatd.X.
* einfo.ads, einfo.adb (Import_Pragma): New field.
* freeze.adb (Wrap_Imported_Procedure): New procedure (not
really active yet, has to be activated with -gnatd.X.
* sem_prag.adb (Set_Imported): Set new Import_Pragma
field (Set_Imported): Don't set Is_Public (see
Freeze.Wrap_Imported_Subprogram)
* par-ch3.adb (P_Component_List): Handle unexpected null component.
2014-02-24 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Correct reference to SPARK RM in error messages.
* gnat_rm.texi: Correct documentation of attribute Update.
2014-02-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): Reject container
iterator in older versions of Ada.
2014-02-24 Gary Dismukes <dismukes@adacore.com>
* sem_ch5.adb, sem_aux.ads, sem_ch12.adb, gnat_ugn.texi, par.adb,

12
gcc/ada/atree.adb
View File

@ -2643,6 +2643,12 @@ package body Atree is
return Node_Id (Nodes.Table (N + 5).Field10);
end Node34;
function Node35 (N : Node_Id) return Node_Id is
begin
pragma Assert (Nkind (N) in N_Entity);
return Node_Id (Nodes.Table (N + 5).Field11);
end Node35;
function List1 (N : Node_Id) return List_Id is
begin
pragma Assert (N <= Nodes.Last);
@ -5407,6 +5413,12 @@ package body Atree is
Nodes.Table (N + 5).Field10 := Union_Id (Val);
end Set_Node34;
procedure Set_Node35 (N : Node_Id; Val : Node_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 5).Field11 := Union_Id (Val);
end Set_Node35;
procedure Set_List1 (N : Node_Id; Val : List_Id) is
begin
pragma Assert (N <= Nodes.Last);

6
gcc/ada/atree.ads
View File

@ -1236,6 +1236,9 @@ package Atree is
function Node34 (N : Node_Id) return Node_Id;
pragma Inline (Node34);
function Node35 (N : Node_Id) return Node_Id;
pragma Inline (Node35);
function List1 (N : Node_Id) return List_Id;
pragma Inline (List1);
@ -2545,6 +2548,9 @@ package Atree is
procedure Set_Node34 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node34);
procedure Set_Node35 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node35);
procedure Set_List1 (N : Node_Id; Val : List_Id);
pragma Inline (Set_List1);

5
gcc/ada/debug.adb
View File

@ -141,7 +141,7 @@ package body Debug is
-- d.U Ignore indirect calls for static elaboration
-- d.V
-- d.W Print out debugging information for Walk_Library_Items
-- d.X
-- d.X Activate wrapping of imported subprograms with pre/post conditions
-- d.Y
-- d.Z
@ -664,6 +664,9 @@ package body Debug is
-- the order in which units are walked. This is primarily for use in
-- debugging CodePeer mode.
-- d.X Activates Wrap_Imported_Subprogram in Freeze (not yet working so
-- this allows checkin of partial implementation).
-- d1 Error messages have node numbers where possible. Normally error
-- messages have only source locations. This option is useful when
-- debugging errors caused by expanded code, where the source location

16
gcc/ada/einfo.adb
View File

@ -257,7 +257,7 @@ package body Einfo is
-- Contract Node34
-- (unused) Node35
-- Import_Pragma Node35
---------------------------------------------
-- Usage of Flags in Defining Entity Nodes --
@ -1785,6 +1785,12 @@ package body Einfo is
return Node4 (Id);
end Homonym;
function Import_Pragma (Id : E) return E is
begin
pragma Assert (Is_Subprogram (Id));
return Node35 (Id);
end Import_Pragma;
function Interface_Alias (Id : E) return E is
begin
pragma Assert (Is_Subprogram (Id));
@ -4483,6 +4489,12 @@ package body Einfo is
Set_Node4 (Id, V);
end Set_Homonym;
procedure Set_Import_Pragma (Id : E; V : E) is
begin
pragma Assert (Is_Subprogram (Id));
Set_Node35 (Id, V);
end Set_Import_Pragma;
procedure Set_Interface_Alias (Id : E; V : E) is
begin
pragma Assert
@ -9554,6 +9566,8 @@ package body Einfo is
procedure Write_Field35_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when Subprogram_Kind =>
Write_Str ("Import_Pragma");
when others =>
Write_Str ("Field35??");
end case;

11
gcc/ada/einfo.ads
View File

@ -1973,6 +1973,13 @@ package Einfo is
-- that we still have a concrete type. For entities other than types,
-- returns the entity unchanged.
-- Import_Pragma (Node35)
-- Defined in subprogram entities. Set if a valid pragma Import or pragma
-- Import_Function or pragma Import_Procedure aplies to the subprogram,
-- in which case this field points to the pragma (we can't use the normal
-- Rep_Item chain mechanism, because a single pragma Import can apply
-- to multiple subprogram entities.
-- In_Package_Body (Flag48)
-- Defined in package entities. Set on the entity that denotes the
-- package (the defining occurrence of the package declaration) while
@ -6478,6 +6485,7 @@ package Einfo is
function Has_Xref_Entry (Id : E) return B;
function Hiding_Loop_Variable (Id : E) return E;
function Homonym (Id : E) return E;
function Import_Pragma (Id : E) return E;
function In_Package_Body (Id : E) return B;
function In_Private_Part (Id : E) return B;
function In_Use (Id : E) return B;
@ -7100,6 +7108,7 @@ package Einfo is
procedure Set_Has_Xref_Entry (Id : E; V : B := True);
procedure Set_Hiding_Loop_Variable (Id : E; V : E);
procedure Set_Homonym (Id : E; V : E);
procedure Set_Import_Pragma (Id : E; V : E);
procedure Set_In_Package_Body (Id : E; V : B := True);
procedure Set_In_Private_Part (Id : E; V : B := True);
procedure Set_In_Use (Id : E; V : B := True);
@ -7836,6 +7845,7 @@ package Einfo is
pragma Inline (Has_Xref_Entry);
pragma Inline (Hiding_Loop_Variable);
pragma Inline (Homonym);
pragma Inline (Import_Pragma);
pragma Inline (In_Package_Body);
pragma Inline (In_Private_Part);
pragma Inline (In_Use);
@ -8306,6 +8316,7 @@ package Einfo is
pragma Inline (Set_Has_Xref_Entry);
pragma Inline (Set_Hiding_Loop_Variable);
pragma Inline (Set_Homonym);
pragma Inline (Set_Import_Pragma);
pragma Inline (Set_In_Package_Body);
pragma Inline (Set_In_Private_Part);
pragma Inline (Set_In_Use);

181
gcc/ada/freeze.adb
View File

@ -1742,6 +1742,11 @@ package body Freeze is
-- Freeze record type, including freezing component types, and freezing
-- primitive operations if this is a tagged type.
procedure Wrap_Imported_Subprogram (E : Entity_Id);
-- If E is an entity for an imported subprogram with pre/post-conditions
-- then this procedure will create a wrapper to ensure that proper run-
-- time checking of the pre/postconditions. See body for details.
-------------------
-- Add_To_Result --
-------------------
@ -3358,6 +3363,146 @@ package body Freeze is
end Check_Variant_Part;
end Freeze_Record_Type;
------------------------------
-- Wrap_Imported_Subprogram --
------------------------------
-- The issue here is that our normal approach of checking preconditions
-- and postconditions does not work for imported procedures, since we
-- are not generating code for the body. To get around this we create
-- a wrapper, as shown by the following example:
-- procedure K (A : Integer);
-- pragma Import (C, K);
-- The spec is rewritten by removing the effects of pragma Import, but
-- leaving the convention unchanged, as though the source had said:
-- procedure K (A : Integer);
-- pragma Convention (C, K);
-- and we create a body, added to the entity K freeze actions, which
-- looks like:
-- procedure K (A : Integer) is
-- procedure K (A : Integer);
-- pragma Import (C, K);
-- begin
-- K (A);
-- end K;
-- Now the contract applies in the normal way to the outer procedure,
-- and the inner procedure has no contracts, so there is no problem
-- in just calling it to get the original effect.
-- In the case of a function, we create an appropriate return statement
-- for the subprogram body that calls the inner procedure.
procedure Wrap_Imported_Subprogram (E : Entity_Id) is
Loc : constant Source_Ptr := Sloc (E);
Spec : Node_Id;
Parms : List_Id;
Stmt : Node_Id;
Iprag : Node_Id;
Bod : Node_Id;
Forml : Entity_Id;
begin
-- Nothing to do if not imported
if not Is_Imported (E) then
return;
end if;
-- Test enabling conditions for wrapping
if Is_Subprogram (E)
and then Present (Contract (E))
and then Present (Pre_Post_Conditions (Contract (E)))
and then not GNATprove_Mode
then
-- For now, activate this only if -gnatd.X is set, because there
-- are problems with this procedure, it is not working yet, but
-- we would like to be able to check it in ???
if not Debug_Flag_Dot_XX then
Error_Msg_NE
("pre/post conditions on imported subprogram are not "
& "enforced??", E, Pre_Post_Conditions (Contract (E)));
goto Not_Wrapped;
end if;
-- Fix up spec to be not imported any more
Iprag := Import_Pragma (E);
Set_Is_Imported (E, False);
Set_Interface_Name (E, Empty);
Set_Has_Completion (E, False);
Set_Import_Pragma (E, Empty);
-- Grab the subprogram declaration and specification
Spec := Declaration_Node (E);
-- Build parameter list that we need
Parms := New_List;
Forml := First_Formal (E);
while Present (Forml) loop
Append_To (Parms, New_Occurrence_Of (Forml, Loc));
Next_Formal (Forml);
end loop;
-- Build the call
if Ekind_In (E, E_Function, E_Generic_Function) then
Stmt :=
Make_Simple_Return_Statement (Loc,
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (E, Loc),
Parameter_Associations => Parms));
else
Stmt :=
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (E, Loc),
Parameter_Associations => Parms);
end if;
-- Now build the body
Bod :=
Make_Subprogram_Body (Loc,
Specification => Copy_Separate_Tree (Spec),
Declarations => New_List (
Make_Subprogram_Declaration (Loc,
Specification => Copy_Separate_Tree (Spec)),
Copy_Separate_Tree (Iprag)),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Stmt),
End_Label => New_Occurrence_Of (E, Loc)));
-- Append the body to freeze result
Add_To_Result (Bod);
return;
end if;
-- Case of imported subprogram that does not get wrapped
<<Not_Wrapped>>
-- Set Is_Public. All imported entities need an external symbol
-- created for them since they are always referenced from another
-- object file. Note this used to be set when we set Is_Imported
-- back in Sem_Prag, but now we delay it to this point, since we
-- don't want to set this flag if we wrap an imported subprogram.
Set_Is_Public (E);
end Wrap_Imported_Subprogram;
-- Start of processing for Freeze_Entity
begin
@ -3539,13 +3684,19 @@ package body Freeze is
null;
end if;
-- For a subprogram, freeze all parameter types and also the return
-- type (RM 13.14(14)). However skip this for internal subprograms.
-- This is also the point where any extra formal parameters are
-- created since we now know whether the subprogram will use a
-- foreign convention.
-- Subprogram case
if Is_Subprogram (E) then
-- Check for needing to wrap imported subprogram
Wrap_Imported_Subprogram (E);
-- Freeze all parameter types and the return type (RM 13.14(14)).
-- However skip this for internal subprograms. This is also where
-- any extra formal parameters are created since we now know
-- whether the subprogram will use a foreign convention.
if not Is_Internal (E) then
declare
F_Type : Entity_Id;
@ -3867,26 +4018,6 @@ package body Freeze is
end if;
end if;
end;
-- Pre/post conditions are implemented through a subprogram
-- in the corresponding body, and therefore are not checked on
-- an imported subprogram for which the body is not available.
-- This warning is not issued in GNATprove mode, as all these
-- contracts are handled in formal verification, so the warning
-- would be misleading in that case.
-- Could consider generating a wrapper to take care of this???
if Is_Subprogram (E)
and then Is_Imported (E)
and then Present (Contract (E))
and then Present (Pre_Post_Conditions (Contract (E)))
and then not GNATprove_Mode
then
Error_Msg_NE
("pre/post conditions on imported subprogram are not "
& "enforced??", E, Pre_Post_Conditions (Contract (E)));
end if;
end if;
-- Must freeze its parent first if it is a derived subprogram

23
gcc/ada/gnat_rm.texi
View File

@ -9286,14 +9286,21 @@ The @code{Update} attribute creates a copy of an array or record value
with one or more modified components. The syntax is:
@smallexample @c ada
PREFIX'Update (AGGREGATE)
PREFIX'Update ( RECORD_COMPONENT_ASSOCIATION_LIST )
PREFIX'Update ( ARRAY_COMPONENT_ASSOCIATION @{, ARRAY_COMPONENT_ASSOCIATION @} )
PREFIX'Update ( MULTIDIMENSIONAL_ARRAY_COMPONENT_ASSOCIATION
@{, MULTIDIMENSIONAL_ARRAY_COMPONENT_ASSOCIATION @} )
MULTIDIMENSIONAL_ARRAY_COMPONENT_ASSOCIATION ::= INDEX_EXPRESSION_LIST_LIST => EXPRESSION
INDEX_EXPRESSION_LIST_LIST ::= INDEX_EXPRESSION_LIST @{| INDEX_EXPRESSION_LIST @}
INDEX_EXPRESSION_LIST ::= ( EXPRESSION @{, EXPRESSION @} )
@end smallexample
@noindent
where @code{PREFIX} is the name of an array or record object, and
@code{AGGREGATE} is a named aggregate that does not contain an @code{others}
the association list in parentheses does not contain an @code{others}
choice. The effect is to yield a copy of the array or record value which
is unchanged apart from the components mentioned in the aggregate, which
is unchanged apart from the components mentioned in the association list, which
are changed to the indicated value. The original value of the array or
record value is not affected. For example:
@ -9301,7 +9308,7 @@ record value is not affected. For example:
type Arr is Array (1 .. 5) of Integer;
...
Avar1 : Arr := (1,2,3,4,5);
Avar2 : Arr := Avar1'Update ((2 => 10, 3 .. 4 => 20));
Avar2 : Arr := Avar1'Update (2 => 10, 3 .. 4 => 20);
@end smallexample
@noindent
@ -9312,7 +9319,7 @@ begin unmodified. Similarly:
type Rec is A, B, C : Integer;
...
Rvar1 : Rec := (A => 1, B => 2, C => 3);
Rvar2 : Rec := Rvar1'Update ((B => 20));
Rvar2 : Rec := Rvar1'Update (B => 20);
@end smallexample
@noindent
@ -9322,7 +9329,7 @@ Note that the value of the attribute reference is computed
completely before it is used. This means that if you write:
@smallexample @c ada
Avar1 := Avar1'Update ((1 => 10, 2 => Function_Call));
Avar1 := Avar1'Update (1 => 10, 2 => Function_Call);
@end smallexample
@noindent
@ -9338,7 +9345,7 @@ The accessibility level of an Update attribute result object is defined
as for an aggregate.
In the record case, no component can be mentioned more than once. In
the array case, two overlapping ranges can appear in the aggregate,
the array case, two overlapping ranges can appear in the association list,
in which case the modifications are processed left to right.
Multi-dimensional arrays can be modified, as shown by this example:
@ -9346,7 +9353,7 @@ Multi-dimensional arrays can be modified, as shown by this example:
@smallexample @c ada
A : array (1 .. 10, 1 .. 10) of Integer;
..
A := A'Update (1 => (2 => 20), 3 => (4 => 30));
A := A'Update ((1, 2) => 20, (3, 4) => 30);
@end smallexample
@noindent

4
gcc/ada/par-ch12.adb
View File

@ -350,8 +350,8 @@ package body Ch12 is
if Token = Tok_Others then
if Ada_Version < Ada_2005 then
Error_Msg_SP
("partial parameterization of formal packages" &
" is an Ada 2005 extension");
("partial parameterization of formal packages"
& " is an Ada 2005 extension");
Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
end if;

131
gcc/ada/par-ch3.adb
View File

@ -3270,88 +3270,101 @@ package body Ch3 is
Component_List_Node : Node_Id;
Decls_List : List_Id;
Scan_State : Saved_Scan_State;
Null_Loc : Source_Ptr;
begin
Component_List_Node := New_Node (N_Component_List, Token_Ptr);
Decls_List := New_List;
-- Handle null
if Token = Tok_Null then
Null_Loc := Token_Ptr;
Scan; -- past NULL
TF_Semicolon;
P_Pragmas_Opt (Decls_List);
Set_Null_Present (Component_List_Node, True);
return Component_List_Node;
else
P_Pragmas_Opt (Decls_List);
-- If we have an END or WHEN now, everything is fine, otherwise we
-- complain about the null, ignore it, and scan for more components.
if Token /= Tok_Case then
Component_Scan_Loop : loop
P_Component_Items (Decls_List);
P_Pragmas_Opt (Decls_List);
if Token = Tok_End or else Token = Tok_When then
Set_Null_Present (Component_List_Node, True);
return Component_List_Node;
else
Error_Msg ("NULL component only allowed in null record", Null_Loc);
end if;
end if;
exit Component_Scan_Loop when Token = Tok_End
or else Token = Tok_Case
or else Token = Tok_When;
-- Scan components for non-null record
-- We are done if we do not have an identifier. However, if
-- we have a misspelled reserved identifier that is in a column
-- to the right of the record definition, we will treat it as
-- an identifier. It turns out to be too dangerous in practice
-- to accept such a mis-spelled identifier which does not have
-- this additional clue that confirms the incorrect spelling.
P_Pragmas_Opt (Decls_List);
if Token /= Tok_Identifier then
if Start_Column > Scope.Table (Scope.Last).Ecol
and then Is_Reserved_Identifier
then
Save_Scan_State (Scan_State); -- at reserved id
Scan; -- possible reserved id
if Token /= Tok_Case then
Component_Scan_Loop : loop
P_Component_Items (Decls_List);
P_Pragmas_Opt (Decls_List);
if Token = Tok_Comma or else Token = Tok_Colon then
Restore_Scan_State (Scan_State);
Scan_Reserved_Identifier (Force_Msg => True);
exit Component_Scan_Loop when Token = Tok_End
or else Token = Tok_Case
or else Token = Tok_When;
-- Note reserved identifier used as field name after
-- all because not followed by colon or comma
-- We are done if we do not have an identifier. However, if we
-- have a misspelled reserved identifier that is in a column to
-- the right of the record definition, we will treat it as an
-- identifier. It turns out to be too dangerous in practice to
-- accept such a mis-spelled identifier which does not have this
-- additional clue that confirms the incorrect spelling.
else
Restore_Scan_State (Scan_State);
exit Component_Scan_Loop;
end if;
if Token /= Tok_Identifier then
if Start_Column > Scope.Table (Scope.Last).Ecol
and then Is_Reserved_Identifier
then
Save_Scan_State (Scan_State); -- at reserved id
Scan; -- possible reserved id
if Token = Tok_Comma or else Token = Tok_Colon then
Restore_Scan_State (Scan_State);
Scan_Reserved_Identifier (Force_Msg => True);
-- Note reserved identifier used as field name after all
-- because not followed by colon or comma.
else
Restore_Scan_State (Scan_State);
exit Component_Scan_Loop;
end if;
-- Non-identifier that definitely was not reserved id
else
exit Component_Scan_Loop;
end if;
end if;
end loop Component_Scan_Loop;
end if;
if Token = Tok_Case then
Set_Variant_Part (Component_List_Node, P_Variant_Part);
-- Check for junk after variant part
if Token = Tok_Identifier then
Save_Scan_State (Scan_State);
Scan; -- past identifier
if Token = Tok_Colon then
Restore_Scan_State (Scan_State);
Error_Msg_SC ("component may not follow variant part");
Discard_Junk_Node (P_Component_List);
elsif Token = Tok_Case then
Restore_Scan_State (Scan_State);
Error_Msg_SC ("only one variant part allowed in a record");
Discard_Junk_Node (P_Component_List);
else
Restore_Scan_State (Scan_State);
exit Component_Scan_Loop;
end if;
end if;
end loop Component_Scan_Loop;
end if;
if Token = Tok_Case then
Set_Variant_Part (Component_List_Node, P_Variant_Part);
-- Check for junk after variant part
if Token = Tok_Identifier then
Save_Scan_State (Scan_State);
Scan; -- past identifier
if Token = Tok_Colon then
Restore_Scan_State (Scan_State);
Error_Msg_SC ("component may not follow variant part");
Discard_Junk_Node (P_Component_List);
elsif Token = Tok_Case then
Restore_Scan_State (Scan_State);
Error_Msg_SC ("only one variant part allowed in a record");
Discard_Junk_Node (P_Component_List);
else
Restore_Scan_State (Scan_State);
end if;
end if;
end if;

4
gcc/ada/sem_ch12.adb
View File

@ -1505,8 +1505,8 @@ package body Sem_Ch12 is
Check_Overloaded_Formal_Subprogram (Formal);
end if;
-- If there is no corresponding actual, this may be case of
-- partial parameterization, or else the formal has a
-- If there is no corresponding actual, this may be case
-- of partial parameterization, or else the formal has a
-- default or a box.
if No (Match) and then Partial_Parameterization then

4
gcc/ada/sem_ch3.adb
View File

@ -2999,7 +2999,7 @@ package body Sem_Ch3 is
and then No (Corresponding_Generic_Association (Parent (Obj_Id)))
then
Error_Msg_N
("constant cannot be volatile (SPARK RM 7.1.3(4))", Obj_Id);
("constant cannot be volatile (SPARK RM 7.1.3(6))", Obj_Id);
end if;
else pragma Assert (Ekind (Obj_Id) = E_Variable);
@ -3016,7 +3016,7 @@ package body Sem_Ch3 is
then
Error_Msg_N
("non-volatile variable & cannot have volatile components "
& "(SPARK RM 7.1.3(6))", Obj_Id);
& "(SPARK RM 7.1.3(7))", Obj_Id);
-- The declaration of a volatile object must appear at the library
-- level.

12
gcc/ada/sem_ch4.adb
View File

@ -1094,13 +1094,13 @@ package body Sem_Ch4 is
-- indexed component and analyze as container indexing.
if not Is_Overloadable (Nam_Ent) then
if Present (
Find_Value_Of_Aspect
(Etype (Nam_Ent), Aspect_Constant_Indexing))
if Present
(Find_Value_Of_Aspect
(Etype (Nam_Ent), Aspect_Constant_Indexing))
then
Replace (N,
Make_Indexed_Component (Sloc (N),
Prefix => Nam,
Prefix => Nam,
Expressions => Parameter_Associations (N)));
if Try_Container_Indexing (N, Nam, Expressions (N)) then
@ -1112,6 +1112,7 @@ package body Sem_Ch4 is
else
No_Interpretation;
end if;
return;
end if;
end if;
@ -7065,7 +7066,6 @@ package body Sem_Ch4 is
while Present (Disc) loop
declare
Elmt_Type : Entity_Id;
begin
if Has_Implicit_Dereference (Disc) then
Elmt_Type := Designated_Type (Etype (Disc));
@ -7098,6 +7098,7 @@ package body Sem_Ch4 is
Set_Etype (Indexing, Any_Type);
while Present (It.Nam) loop
Analyze_One_Call (Indexing, It.Nam, False, Success);
if Success then
Set_Etype (Name (Indexing), It.Typ);
Set_Entity (Name (Indexing), It.Nam);
@ -7122,6 +7123,7 @@ package body Sem_Ch4 is
exit;
end if;
Get_Next_Interp (I, It);
end loop;
end;

3
gcc/ada/sem_ch5.adb
View File

@ -1855,6 +1855,9 @@ package body Sem_Ch5 is
else
Set_Ekind (Def_Id, E_Loop_Parameter);
if Ada_Version < Ada_2012 then
Error_Msg_N ("container iterators are an Ada 2012 feature", N);
end if;
-- OF present

12
gcc/ada/sem_prag.adb
View File

@ -7966,12 +7966,6 @@ package body Sem_Prag is
end if;
end if;
-- All interfaced procedures need an external symbol created
-- for them since they are always referenced from another
-- object file.
Set_Is_Public (Def_Id);
-- Verify that the subprogram does not have a completion
-- through a renaming declaration. For other completions the
-- pragma appears as a too late representation.
@ -9425,6 +9419,12 @@ package body Sem_Prag is
else
Set_Is_Imported (E);
-- For subprogram, set Import_Pragma field
if Is_Subprogram (E) then
Set_Import_Pragma (E, N);
end if;
-- If the entity is an object that is not at the library level,
-- then it is statically allocated. We do not worry about objects
-- with address clauses in this context since they are not really

5
gcc/ada/sem_res.adb
View File

@ -7540,7 +7540,6 @@ package body Sem_Res is
Pref : Node_Id;
begin
-- In ASIS mode, propagate the information about the indices back to
-- to the original indexing node. The generalized indexing is either
-- a function call, or a dereference of one. The actuals include the
@ -7550,9 +7549,9 @@ package body Sem_Res is
Resolve (Indexing, Typ);
Set_Etype (N, Etype (Indexing));
Set_Is_Overloaded (N, False);
Call := Indexing;
while Nkind_In (Call,
N_Explicit_Dereference, N_Selected_Component)
while Nkind_In (Call, N_Explicit_Dereference, N_Selected_Component)
loop
Call := Prefix (Call);
end loop;

17
gcc/ada/sinfo.ads
View File

@ -1278,13 +1278,13 @@ package Sinfo is
-- ali file.
-- Generalized_Indexing (Node4-Sem)
-- Generalized_Indexing is set in Indexed_Component nodes that are Ada 2012
-- container indexing operations. The value of the attribute is a function
-- call (possibly dereferenced) that corresponds to the proper expansion
-- of the source indexing operation. Before expansion, the source node
-- is rewritten as the resolved generalized indexing. In ASIS mode, the
-- expansion does not take place, so that the source is preserved and
-- properly annotated with types.
-- Present in N_Indexed_Component nodes. Set for Indexed_Component nodes
-- that are Ada 2012 container indexing operations. The value of the
-- attribute is a function call (possibly dereferenced) that corresponds
-- to the proper expansion of the source indexing operation. Before
-- expansion, the source node is rewritten as the resolved generalized
-- indexing. In ASIS mode, the expansion does not take place, so that
-- the source is preserved and properly annotated with types.
-- Generic_Parent (Node5-Sem)
-- Generic_Parent is defined on declaration nodes that are instances. The
@ -8924,6 +8924,7 @@ package Sinfo is
function Generalized_Indexing
(N : Node_Id) return Node_Id; -- Node4
function Generic_Associations
(N : Node_Id) return List_Id; -- List3
@ -10933,7 +10934,7 @@ package Sinfo is
(1 => True, -- Expressions (List1)
2 => False, -- unused
3 => True, -- Prefix (Node3)
4 => False, -- Generalized_Indexing (Node4-Sem)
4 => False, -- Generalized_Indexing (Node4-Sem)
5 => False), -- Etype (Node5-Sem)
N_Slice =>