[multiple changes]
2010-10-08 Robert Dewar <dewar@adacore.com> * sem_ch6.adb: Minor reformatting. 2010-10-08 Robert Dewar <dewar@adacore.com> * gnat1drv.adb: Add call to Validate_Independence. * par-prag.adb: Add dummy entries for Independent, Independent_Componentsa. * sem_ch13.adb (Validate_Independence): New procedure (Initialize): Initialize address clause and independence check tables * sem_ch13.ads (Independence_Checks): New table (Validate_Independence): New procedure * sem_prag.adb: Add processing for pragma Independent[_Components] * snames.ads-tmpl: Add entries for pragma Independent[_Components] 2010-10-08 Ed Schonberg <schonberg@adacore.com> * sem_aggr.adb (Propagate_Discriminants): When expanding an aggregate component with box initialization, if the component is a variant record use the values of the discriminants to select the proper variant for further box initialization. From-SVN: r165162
This commit is contained in:
parent
fd02e833d8
commit
105b5e659a
@ -1,3 +1,26 @@
|
||||
2010-10-08 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch6.adb: Minor reformatting.
|
||||
|
||||
2010-10-08 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* gnat1drv.adb: Add call to Validate_Independence.
|
||||
* par-prag.adb: Add dummy entries for Independent,
|
||||
Independent_Componentsa.
|
||||
* sem_ch13.adb (Validate_Independence): New procedure
|
||||
(Initialize): Initialize address clause and independence check tables
|
||||
* sem_ch13.ads (Independence_Checks): New table
|
||||
(Validate_Independence): New procedure
|
||||
* sem_prag.adb: Add processing for pragma Independent[_Components]
|
||||
* snames.ads-tmpl: Add entries for pragma Independent[_Components]
|
||||
|
||||
2010-10-08 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_aggr.adb (Propagate_Discriminants): When expanding an aggregate
|
||||
component with box initialization, if the component is a variant record
|
||||
use the values of the discriminants to select the proper variant for
|
||||
further box initialization.
|
||||
|
||||
2010-10-08 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* xsnames.adb: Remove obsolete file.
|
||||
|
@ -704,6 +704,7 @@ begin
|
||||
Treepr.Tree_Dump;
|
||||
Sem_Ch13.Validate_Unchecked_Conversions;
|
||||
Sem_Ch13.Validate_Address_Clauses;
|
||||
Sem_Ch13.Validate_Independence;
|
||||
Errout.Output_Messages;
|
||||
Namet.Finalize;
|
||||
|
||||
@ -880,6 +881,7 @@ begin
|
||||
|
||||
Sem_Ch13.Validate_Unchecked_Conversions;
|
||||
Sem_Ch13.Validate_Address_Clauses;
|
||||
Sem_Ch13.Validate_Independence;
|
||||
Errout.Finalize (Last_Call => True);
|
||||
Errout.Output_Messages;
|
||||
Treepr.Tree_Dump;
|
||||
@ -913,6 +915,7 @@ begin
|
||||
then
|
||||
Sem_Ch13.Validate_Unchecked_Conversions;
|
||||
Sem_Ch13.Validate_Address_Clauses;
|
||||
Sem_Ch13.Validate_Independence;
|
||||
Errout.Finalize (Last_Call => True);
|
||||
Errout.Output_Messages;
|
||||
Write_ALI (Object => False);
|
||||
@ -980,6 +983,11 @@ begin
|
||||
|
||||
Sem_Ch13.Validate_Address_Clauses;
|
||||
|
||||
-- Validate independence pragmas (again using values annotated by
|
||||
-- the back end for component layout etc.)
|
||||
|
||||
Sem_Ch13.Validate_Independence;
|
||||
|
||||
-- Now we complete output of errors, rep info and the tree info. These
|
||||
-- are delayed till now, since it is perfectly possible for gigi to
|
||||
-- generate errors, modify the tree (in particular by setting flags
|
||||
|
@ -1131,6 +1131,8 @@ begin
|
||||
Pragma_Import_Object |
|
||||
Pragma_Import_Procedure |
|
||||
Pragma_Import_Valued_Procedure |
|
||||
Pragma_Independent |
|
||||
Pragma_Independent_Components |
|
||||
Pragma_Initialize_Scalars |
|
||||
Pragma_Inline |
|
||||
Pragma_Inline_Always |
|
||||
|
@ -3570,8 +3570,7 @@ package body Sem_Aggr is
|
||||
|
||||
procedure Propagate_Discriminants
|
||||
(Aggr : Node_Id;
|
||||
Assoc_List : List_Id;
|
||||
Comp : Entity_Id);
|
||||
Assoc_List : List_Id);
|
||||
-- Nested components may themselves be discriminated
|
||||
-- types constrained by outer discriminants, whose
|
||||
-- values must be captured before the aggregate is
|
||||
@ -3653,42 +3652,95 @@ package body Sem_Aggr is
|
||||
|
||||
procedure Propagate_Discriminants
|
||||
(Aggr : Node_Id;
|
||||
Assoc_List : List_Id;
|
||||
Comp : Entity_Id)
|
||||
Assoc_List : List_Id)
|
||||
is
|
||||
Inner_Comp : Entity_Id;
|
||||
Comp_Type : Entity_Id;
|
||||
Aggr_Type : constant Entity_Id :=
|
||||
Base_Type (Etype (Aggr));
|
||||
Def_Node : constant Node_Id :=
|
||||
Type_Definition (Declaration_Node (Aggr_Type));
|
||||
|
||||
Comp : Node_Id;
|
||||
Comp_Elmt : Elmt_Id;
|
||||
Components : constant Elist_Id := New_Elmt_List;
|
||||
Needs_Box : Boolean := False;
|
||||
New_Aggr : Node_Id;
|
||||
Errors : Boolean;
|
||||
|
||||
begin
|
||||
Inner_Comp := First_Component (Etype (Comp));
|
||||
while Present (Inner_Comp) loop
|
||||
Comp_Type := Etype (Inner_Comp);
|
||||
procedure Process_Component (Comp : Entity_Id);
|
||||
-- Add one component with a box association to the
|
||||
-- inner aggregate, and recurse if component is
|
||||
-- itself composite.
|
||||
|
||||
if Is_Record_Type (Comp_Type)
|
||||
and then Has_Discriminants (Comp_Type)
|
||||
------------------------
|
||||
-- Process_Component --
|
||||
------------------------
|
||||
|
||||
procedure Process_Component (Comp : Entity_Id) is
|
||||
T : constant Entity_Id := Etype (Comp);
|
||||
New_Aggr : Node_Id;
|
||||
|
||||
begin
|
||||
if Is_Record_Type (T)
|
||||
and then Has_Discriminants (T)
|
||||
then
|
||||
New_Aggr :=
|
||||
Make_Aggregate (Loc, New_List, New_List);
|
||||
Set_Etype (New_Aggr, Comp_Type);
|
||||
Set_Etype (New_Aggr, T);
|
||||
Add_Association
|
||||
(Inner_Comp, New_Aggr,
|
||||
Component_Associations (Aggr));
|
||||
(Comp, New_Aggr,
|
||||
Component_Associations (Aggr));
|
||||
|
||||
-- Collect discriminant values and recurse
|
||||
|
||||
Add_Discriminant_Values
|
||||
(New_Aggr, Assoc_List);
|
||||
Propagate_Discriminants
|
||||
(New_Aggr, Assoc_List, Inner_Comp);
|
||||
(New_Aggr, Assoc_List);
|
||||
|
||||
else
|
||||
Needs_Box := True;
|
||||
end if;
|
||||
end Process_Component;
|
||||
|
||||
Next_Component (Inner_Comp);
|
||||
end loop;
|
||||
begin
|
||||
|
||||
-- The component type may be a variant type, so
|
||||
-- collect the components that are ruled by the
|
||||
-- known values of the discriminants.
|
||||
|
||||
if Nkind (Def_Node) = N_Record_Definition
|
||||
and then
|
||||
Present (Component_List (Def_Node))
|
||||
and then
|
||||
Present
|
||||
(Variant_Part (Component_List (Def_Node)))
|
||||
then
|
||||
Gather_Components (Aggr_Type,
|
||||
Component_List (Def_Node),
|
||||
Governed_By => Assoc_List,
|
||||
Into => Components,
|
||||
Report_Errors => Errors);
|
||||
|
||||
Comp_Elmt := First_Elmt (Components);
|
||||
while Present (Comp_Elmt) loop
|
||||
if
|
||||
Ekind (Node (Comp_Elmt)) /= E_Discriminant
|
||||
then
|
||||
Process_Component (Node (Comp_Elmt));
|
||||
end if;
|
||||
|
||||
Next_Elmt (Comp_Elmt);
|
||||
end loop;
|
||||
|
||||
-- No variant part, iterate over all components
|
||||
|
||||
else
|
||||
|
||||
Comp := First_Component (Etype (Aggr));
|
||||
while Present (Comp) loop
|
||||
Process_Component (Comp);
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if Needs_Box then
|
||||
Append
|
||||
@ -3701,6 +3753,8 @@ package body Sem_Aggr is
|
||||
end if;
|
||||
end Propagate_Discriminants;
|
||||
|
||||
-- Start of processing for Capture_Discriminants
|
||||
|
||||
begin
|
||||
Expr := Make_Aggregate (Loc, New_List, New_List);
|
||||
Set_Etype (Expr, Ctyp);
|
||||
@ -3713,14 +3767,13 @@ package body Sem_Aggr is
|
||||
|
||||
if Has_Discriminants (Typ) then
|
||||
Add_Discriminant_Values (Expr, New_Assoc_List);
|
||||
Propagate_Discriminants
|
||||
(Expr, New_Assoc_List, Component);
|
||||
Propagate_Discriminants (Expr, New_Assoc_List);
|
||||
|
||||
elsif Has_Discriminants (Ctyp) then
|
||||
Add_Discriminant_Values
|
||||
(Expr, Component_Associations (Expr));
|
||||
Propagate_Discriminants
|
||||
(Expr, Component_Associations (Expr), Component);
|
||||
(Expr, Component_Associations (Expr));
|
||||
|
||||
else
|
||||
declare
|
||||
|
@ -52,7 +52,6 @@ with Sem_Warn; use Sem_Warn;
|
||||
with Snames; use Snames;
|
||||
with Stand; use Stand;
|
||||
with Sinfo; use Sinfo;
|
||||
with Table;
|
||||
with Targparm; use Targparm;
|
||||
with Ttypes; use Ttypes;
|
||||
with Tbuild; use Tbuild;
|
||||
@ -4174,6 +4173,8 @@ package body Sem_Ch13 is
|
||||
|
||||
procedure Initialize is
|
||||
begin
|
||||
Address_Clause_Checks.Init;
|
||||
Independence_Checks.Init;
|
||||
Unchecked_Conversions.Init;
|
||||
end Initialize;
|
||||
|
||||
@ -5069,6 +5070,292 @@ package body Sem_Ch13 is
|
||||
end loop;
|
||||
end Validate_Address_Clauses;
|
||||
|
||||
---------------------------
|
||||
-- Validate_Independence --
|
||||
---------------------------
|
||||
|
||||
procedure Validate_Independence is
|
||||
SU : constant Uint := UI_From_Int (System_Storage_Unit);
|
||||
N : Node_Id;
|
||||
E : Entity_Id;
|
||||
IC : Boolean;
|
||||
Comp : Entity_Id;
|
||||
Addr : Node_Id;
|
||||
P : Node_Id;
|
||||
|
||||
procedure Check_Array_Type (Atyp : Entity_Id);
|
||||
-- Checks if the array type Atyp has independent components, and
|
||||
-- if not, outputs an appropriate set of error messages.
|
||||
|
||||
procedure No_Independence;
|
||||
-- Output message that independence cannot be guaranteed
|
||||
|
||||
function OK_Component (C : Entity_Id) return Boolean;
|
||||
-- Checks one component to see if it is independently accessible, and
|
||||
-- if so yields True, otherwise yields False if independent access
|
||||
-- cannot be guaranteed. This is a conservative routine, it only
|
||||
-- returns True if it knows for sure, it returns False if it knows
|
||||
-- there is a problem, or it cannot be sure there is no problem.
|
||||
|
||||
procedure Reason_Bad_Component (C : Entity_Id);
|
||||
-- Outputs continuation message if a reason can be determined for
|
||||
-- the component C being bad.
|
||||
|
||||
----------------------
|
||||
-- Check_Array_Type --
|
||||
----------------------
|
||||
|
||||
procedure Check_Array_Type (Atyp : Entity_Id) is
|
||||
Ctyp : constant Entity_Id := Component_Type (Atyp);
|
||||
|
||||
begin
|
||||
-- OK if no alignment clause, no pack, and no component size
|
||||
|
||||
if not Has_Component_Size_Clause (Atyp)
|
||||
and then not Has_Alignment_Clause (Atyp)
|
||||
and then not Is_Packed (Atyp)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Check actual component size
|
||||
|
||||
if not Known_Component_Size (Atyp)
|
||||
or else not (Addressable (Component_Size (Atyp))
|
||||
and then Component_Size (Atyp) < 64)
|
||||
or else Component_Size (Atyp) mod Esize (Ctyp) /= 0
|
||||
then
|
||||
No_Independence;
|
||||
|
||||
-- Bad component size, check reason
|
||||
|
||||
if Has_Component_Size_Clause (Atyp) then
|
||||
P :=
|
||||
Get_Attribute_Definition_Clause
|
||||
(Atyp, Attribute_Component_Size);
|
||||
|
||||
if Present (P) then
|
||||
Error_Msg_Sloc := Sloc (P);
|
||||
Error_Msg_N ("\because of Component_Size clause#", N);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Is_Packed (Atyp) then
|
||||
P := Get_Rep_Pragma (Atyp, Name_Pack);
|
||||
|
||||
if Present (P) then
|
||||
Error_Msg_Sloc := Sloc (P);
|
||||
Error_Msg_N ("\because of pragma Pack#", N);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- No reason found, just return
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Array type is OK independence-wise
|
||||
|
||||
return;
|
||||
end Check_Array_Type;
|
||||
|
||||
---------------------
|
||||
-- No_Independence --
|
||||
---------------------
|
||||
|
||||
procedure No_Independence is
|
||||
begin
|
||||
if Pragma_Name (N) = Name_Independent then
|
||||
Error_Msg_NE
|
||||
("independence cannot be guaranteed for&", N, E);
|
||||
else
|
||||
Error_Msg_NE
|
||||
("independent components cannot be guaranteed for&", N, E);
|
||||
end if;
|
||||
end No_Independence;
|
||||
|
||||
------------------
|
||||
-- OK_Component --
|
||||
------------------
|
||||
|
||||
function OK_Component (C : Entity_Id) return Boolean is
|
||||
Rec : constant Entity_Id := Scope (C);
|
||||
Ctyp : constant Entity_Id := Etype (C);
|
||||
|
||||
begin
|
||||
-- OK if no component clause, no Pack, and no alignment clause
|
||||
|
||||
if No (Component_Clause (C))
|
||||
and then not Is_Packed (Rec)
|
||||
and then not Has_Alignment_Clause (Rec)
|
||||
then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
-- Here we look at the actual component layout. A component is
|
||||
-- addressable if its size is a multiple of the Esize of the
|
||||
-- component type, and its starting position in the record has
|
||||
-- appropriate alignment, and the record itself has appropriate
|
||||
-- alignment to guarantee the component alignment.
|
||||
|
||||
-- Make sure sizes are static, always assume the worst for any
|
||||
-- cases where we cannot check static values.
|
||||
|
||||
if not (Known_Static_Esize (C)
|
||||
and then Known_Static_Esize (Ctyp))
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Size of component must be addressable or greater than 64 bits
|
||||
-- and a multiple of bytes.
|
||||
|
||||
if not Addressable (Esize (C))
|
||||
and then Esize (C) < Uint_64
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Check size is proper multiple
|
||||
|
||||
if Esize (C) mod Esize (Ctyp) /= 0 then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Check alignment of component is OK
|
||||
|
||||
if not Known_Component_Bit_Offset (C)
|
||||
or else Component_Bit_Offset (C) < Uint_0
|
||||
or else Component_Bit_Offset (C) mod Esize (Ctyp) /= 0
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Check alignment of record type is OK
|
||||
|
||||
if not Known_Alignment (Rec)
|
||||
or else (Alignment (Rec) * SU) mod Esize (Ctyp) /= 0
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- All tests passed, component is addressable
|
||||
|
||||
return True;
|
||||
end OK_Component;
|
||||
|
||||
--------------------------
|
||||
-- Reason_Bad_Component --
|
||||
--------------------------
|
||||
|
||||
procedure Reason_Bad_Component (C : Entity_Id) is
|
||||
Rec : constant Entity_Id := Scope (C);
|
||||
Ctyp : constant Entity_Id := Etype (C);
|
||||
|
||||
begin
|
||||
-- If component clause present assume that's the problem
|
||||
|
||||
if Present (Component_Clause (C)) then
|
||||
Error_Msg_Sloc := Sloc (Component_Clause (C));
|
||||
Error_Msg_N ("\because of Component_Clause#", N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If pragma Pack clause present, assume that's the problem
|
||||
|
||||
if Is_Packed (Rec) then
|
||||
P := Get_Rep_Pragma (Rec, Name_Pack);
|
||||
|
||||
if Present (P) then
|
||||
Error_Msg_Sloc := Sloc (P);
|
||||
Error_Msg_N ("\because of pragma Pack#", N);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- See if record has bad alignment clause
|
||||
|
||||
if Has_Alignment_Clause (Rec)
|
||||
and then Known_Alignment (Rec)
|
||||
and then (Alignment (Rec) * SU) mod Esize (Ctyp) /= 0
|
||||
then
|
||||
P := Get_Attribute_Definition_Clause (Rec, Attribute_Alignment);
|
||||
|
||||
if Present (P) then
|
||||
Error_Msg_Sloc := Sloc (P);
|
||||
Error_Msg_N ("\because of Alignment clause#", N);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Couldn't find a reason, so return without a message
|
||||
|
||||
return;
|
||||
end Reason_Bad_Component;
|
||||
|
||||
-- Start of processing for Validate_Independence
|
||||
|
||||
begin
|
||||
for J in Independence_Checks.First .. Independence_Checks.Last loop
|
||||
N := Independence_Checks.Table (J).N;
|
||||
E := Independence_Checks.Table (J).E;
|
||||
IC := Pragma_Name (N) = Name_Independent_Components;
|
||||
|
||||
-- Deal with component case
|
||||
|
||||
if Ekind (E) = E_Discriminant or else Ekind (E) = E_Component then
|
||||
if not OK_Component (E) then
|
||||
No_Independence;
|
||||
Reason_Bad_Component (E);
|
||||
goto Continue;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with record with Independent_Components
|
||||
|
||||
if IC and then Is_Record_Type (E) then
|
||||
Comp := First_Component_Or_Discriminant (E);
|
||||
while Present (Comp) loop
|
||||
if not OK_Component (Comp) then
|
||||
No_Independence;
|
||||
Reason_Bad_Component (Comp);
|
||||
goto Continue;
|
||||
end if;
|
||||
|
||||
Next_Component_Or_Discriminant (Comp);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Deal with address clause case
|
||||
|
||||
if Is_Object (E) then
|
||||
Addr := Address_Clause (E);
|
||||
|
||||
if Present (Addr) then
|
||||
No_Independence;
|
||||
Error_Msg_Sloc := Sloc (Addr);
|
||||
Error_Msg_N ("\because of Address clause#", N);
|
||||
goto Continue;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with independent components for array type
|
||||
|
||||
if IC and then Is_Array_Type (E) then
|
||||
Check_Array_Type (E);
|
||||
end if;
|
||||
|
||||
-- Deal with independent components for array object
|
||||
|
||||
if IC and then Is_Object (E) and then Is_Array_Type (Etype (E)) then
|
||||
Check_Array_Type (Etype (E));
|
||||
end if;
|
||||
|
||||
<<Continue>> null;
|
||||
end loop;
|
||||
end Validate_Independence;
|
||||
|
||||
-----------------------------------
|
||||
-- Validate_Unchecked_Conversion --
|
||||
-----------------------------------
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
@ -23,6 +23,7 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Table;
|
||||
with Types; use Types;
|
||||
with Uintp; use Uintp;
|
||||
|
||||
@ -167,10 +168,10 @@ package Sem_Ch13 is
|
||||
-- back end as required.
|
||||
|
||||
procedure Validate_Unchecked_Conversions;
|
||||
-- This routine is called after calling the backend to validate
|
||||
-- unchecked conversions for size and alignment appropriateness.
|
||||
-- The reason it is called that late is to take advantage of any
|
||||
-- back-annotation of size and alignment performed by the backend.
|
||||
-- This routine is called after calling the backend to validate unchecked
|
||||
-- conversions for size and alignment appropriateness. The reason it is
|
||||
-- called that late is to take advantage of any back-annotation of size
|
||||
-- and alignment performed by the backend.
|
||||
|
||||
procedure Validate_Address_Clauses;
|
||||
-- This is called after the back end has been called (and thus after the
|
||||
@ -178,4 +179,34 @@ package Sem_Ch13 is
|
||||
-- table of saved address clauses checking for suspicious alignments and
|
||||
-- if necessary issuing warnings.
|
||||
|
||||
procedure Validate_Independence;
|
||||
-- This is called after the back end has been called (and thus after the
|
||||
-- layout of components has been back annotated). It goes through the
|
||||
-- table of saved pragma Independent[_Component] entries, checking that
|
||||
-- independence can be achieved, and if necessary issuing error mssags.
|
||||
|
||||
-------------------------------------
|
||||
-- Table for Validate_Independence --
|
||||
-------------------------------------
|
||||
|
||||
-- If a legal pragma Independent or Independent_Components is given for
|
||||
-- an entity, then an entry is made in this table, to be checked by a
|
||||
-- call to Validate_Independence after back annotation of layout is done.
|
||||
|
||||
type Independence_Check_Record is record
|
||||
N : Node_Id;
|
||||
-- The pragma Independent or Independent_Components
|
||||
|
||||
E : Entity_Id;
|
||||
-- The entity to which it applies
|
||||
end record;
|
||||
|
||||
package Independence_Checks is new Table.Table (
|
||||
Table_Component_Type => Independence_Check_Record,
|
||||
Table_Index_Type => Int,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 20,
|
||||
Table_Increment => 200,
|
||||
Table_Name => "Independence_Checks");
|
||||
|
||||
end Sem_Ch13;
|
||||
|
@ -620,8 +620,7 @@ package body Sem_Ch6 is
|
||||
Subtype_Ind);
|
||||
end if;
|
||||
|
||||
-- AI05-103 : for elementary types, subtypes must statically
|
||||
-- match.
|
||||
-- AI05-103: for elementary types, subtypes must statically match
|
||||
|
||||
if Is_Constrained (R_Type)
|
||||
or else Is_Access_Type (R_Type)
|
||||
|
@ -8378,6 +8378,113 @@ package body Sem_Prag is
|
||||
Arg_First_Optional_Parameter => First_Optional_Parameter);
|
||||
end Import_Valued_Procedure;
|
||||
|
||||
-----------------
|
||||
-- Independent --
|
||||
-----------------
|
||||
|
||||
-- pragma Independent (LOCAL_NAME);
|
||||
|
||||
when Pragma_Independent => Independent : declare
|
||||
E_Id : Node_Id;
|
||||
E : Entity_Id;
|
||||
D : Node_Id;
|
||||
K : Node_Kind;
|
||||
|
||||
begin
|
||||
Check_Ada_83_Warning;
|
||||
Ada_2012_Pragma;
|
||||
Check_No_Identifiers;
|
||||
Check_Arg_Count (1);
|
||||
Check_Arg_Is_Local_Name (Arg1);
|
||||
E_Id := Expression (Arg1);
|
||||
|
||||
if Etype (E_Id) = Any_Type then
|
||||
return;
|
||||
end if;
|
||||
|
||||
E := Entity (E_Id);
|
||||
D := Declaration_Node (E);
|
||||
K := Nkind (D);
|
||||
|
||||
if Is_Type (E) then
|
||||
if Rep_Item_Too_Early (E, N)
|
||||
or else
|
||||
Rep_Item_Too_Late (E, N)
|
||||
then
|
||||
return;
|
||||
else
|
||||
Check_First_Subtype (Arg1);
|
||||
end if;
|
||||
|
||||
elsif K = N_Object_Declaration
|
||||
or else (K = N_Component_Declaration
|
||||
and then Original_Record_Component (E) = E)
|
||||
then
|
||||
if Rep_Item_Too_Late (E, N) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
else
|
||||
Error_Pragma_Arg
|
||||
("inappropriate entity for pragma%", Arg1);
|
||||
end if;
|
||||
|
||||
Independence_Checks.Append ((N, E));
|
||||
end Independent;
|
||||
|
||||
----------------------------
|
||||
-- Independent_Components --
|
||||
----------------------------
|
||||
|
||||
-- pragma Atomic_Components (array_LOCAL_NAME);
|
||||
|
||||
-- This processing is shared by Volatile_Components
|
||||
|
||||
when Pragma_Independent_Components => Independent_Components : declare
|
||||
E_Id : Node_Id;
|
||||
E : Entity_Id;
|
||||
D : Node_Id;
|
||||
K : Node_Kind;
|
||||
|
||||
begin
|
||||
Check_Ada_83_Warning;
|
||||
Ada_2012_Pragma;
|
||||
Check_No_Identifiers;
|
||||
Check_Arg_Count (1);
|
||||
Check_Arg_Is_Local_Name (Arg1);
|
||||
E_Id := Expression (Arg1);
|
||||
|
||||
if Etype (E_Id) = Any_Type then
|
||||
return;
|
||||
end if;
|
||||
|
||||
E := Entity (E_Id);
|
||||
|
||||
if Rep_Item_Too_Early (E, N)
|
||||
or else
|
||||
Rep_Item_Too_Late (E, N)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
D := Declaration_Node (E);
|
||||
K := Nkind (D);
|
||||
|
||||
if (K = N_Full_Type_Declaration
|
||||
and then (Is_Array_Type (E) or else Is_Record_Type (E)))
|
||||
or else
|
||||
((Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
|
||||
and then Nkind (D) = N_Object_Declaration
|
||||
and then Nkind (Object_Definition (D)) =
|
||||
N_Constrained_Array_Definition)
|
||||
then
|
||||
Independence_Checks.Append ((N, E));
|
||||
|
||||
else
|
||||
Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
|
||||
end if;
|
||||
end Independent_Components;
|
||||
|
||||
------------------------
|
||||
-- Initialize_Scalars --
|
||||
------------------------
|
||||
@ -12971,6 +13078,8 @@ package body Sem_Prag is
|
||||
Pragma_Import_Object => 0,
|
||||
Pragma_Import_Procedure => 0,
|
||||
Pragma_Import_Valued_Procedure => 0,
|
||||
Pragma_Independent => 0,
|
||||
Pragma_Independent_Components => 0,
|
||||
Pragma_Initialize_Scalars => -1,
|
||||
Pragma_Inline => 0,
|
||||
Pragma_Inline_Always => 0,
|
||||
|
@ -312,9 +312,13 @@ package Snames is
|
||||
-- may be found in the appropriate section in unit Sem_Prag in file
|
||||
-- sem-prag.adb, and they are documented in the GNAT reference manual.
|
||||
|
||||
-- The entries marked Ada05 are Ada 2005 pragmas. They are implemented in
|
||||
-- Ada 83 and Ada 95 mode as well, where they are technically considered to
|
||||
-- be implementation dependent pragmas.
|
||||
-- The entries marked Ada 05 are Ada 2005 pragmas. They are implemented
|
||||
-- in Ada 83 and Ada 95 mode as well, where they are technically considered
|
||||
-- to be implementation dependent pragmas.
|
||||
|
||||
-- The entries marked Ada 12 are Ada 2012 pragmas. They are implemented
|
||||
-- in Ada 83, Ada 95, and Ada 2005 mode as well, where they are technically
|
||||
-- considered to be implementation dependent pragmas.
|
||||
|
||||
-- The entries marked VMS are VMS specific pragmas that are recognized
|
||||
-- only in OpenVMS versions of GNAT. They are ignored in other versions
|
||||
@ -407,7 +411,7 @@ package Snames is
|
||||
Name_All_Calls_Remote : constant Name_Id := N + $;
|
||||
Name_Annotate : constant Name_Id := N + $; -- GNAT
|
||||
|
||||
-- Note: AST_Entry is not in this list because its name matches -- VMS
|
||||
-- Note: AST_Entry is not in this list because its name matches -- VMS
|
||||
-- the name of the corresponding attribute. However, it is
|
||||
-- included in the definition of the type Pragma_Id, and the
|
||||
-- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize
|
||||
@ -452,13 +456,15 @@ package Snames is
|
||||
Name_Import_Object : constant Name_Id := N + $; -- GNAT
|
||||
Name_Import_Procedure : constant Name_Id := N + $; -- GNAT
|
||||
Name_Import_Valued_Procedure : constant Name_Id := N + $; -- GNAT
|
||||
Name_Independent : constant Name_Id := N + $; -- Ada 12
|
||||
Name_Independent_Components : constant Name_Id := N + $; -- Ada 12
|
||||
Name_Inline : constant Name_Id := N + $;
|
||||
Name_Inline_Always : constant Name_Id := N + $; -- GNAT
|
||||
Name_Inline_Generic : constant Name_Id := N + $; -- GNAT
|
||||
Name_Inspection_Point : constant Name_Id := N + $;
|
||||
|
||||
-- Note: Interface is not in this list because its name -- GNAT
|
||||
-- matches an Ada 2005 keyword. However it is included in
|
||||
-- matches an Ada 05 keyword. However it is included in
|
||||
-- the definition of the type Attribute_Id, and the functions
|
||||
-- Get_Pragma_Id and Is_Pragma_Id correctly recognize and
|
||||
-- process Name_Storage_Size.
|
||||
@ -1172,7 +1178,7 @@ package Snames is
|
||||
|
||||
Name_Unaligned_Valid : constant Name_Id := N + $;
|
||||
|
||||
-- Ada 2005 reserved words
|
||||
-- Ada 05 reserved words
|
||||
|
||||
First_2005_Reserved_Word : constant Name_Id := N + $;
|
||||
Name_Interface : constant Name_Id := N + $;
|
||||
@ -1531,6 +1537,8 @@ package Snames is
|
||||
Pragma_Import_Object,
|
||||
Pragma_Import_Procedure,
|
||||
Pragma_Import_Valued_Procedure,
|
||||
Pragma_Independent,
|
||||
Pragma_Independent_Components,
|
||||
Pragma_Inline,
|
||||
Pragma_Inline_Always,
|
||||
Pragma_Inline_Generic,
|
||||
|
Loading…
Reference in New Issue
Block a user