OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-01-23  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Make_Invqriant_Call): If type of expression is
	a private extension, get invariant from base type.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb, sem_attr.adb: Minor reformatting.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* opt.adb (Save_Opt_Config_Switches): Save SPARK_Mode_Pragma
	(Restore_Opt_Config_Switches): Restore SPARK_Mode_Pragma.
	* sem.adb (Semantics): Remove save/restore of
	SPARK_Mode[_Pragma]. Not needed since already done in
	Save/Restore_Opt_Config_Switches.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi, einfo.adb, einfo.ads, sem_prag.adb, gnat_ugn.texi,
	freeze.adb, repinfo.adb, aspects.adb, aspects.ads, sem_ch13.adb:
	Linker_Section enhancements.

From-SVN: r206992
This commit is contained in:
Arnaud Charlet 2014-01-23 18:03:41 +01:00
parent 40f14e9f10
commit 19992053df
16 changed files with 318 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2014-01-23 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Make_Invqriant_Call): If type of expression is
a private extension, get invariant from base type.
2014-01-23 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_attr.adb: Minor reformatting.
2014-01-23 Robert Dewar <dewar@adacore.com>
* opt.adb (Save_Opt_Config_Switches): Save SPARK_Mode_Pragma
(Restore_Opt_Config_Switches): Restore SPARK_Mode_Pragma.
* sem.adb (Semantics): Remove save/restore of
SPARK_Mode[_Pragma]. Not needed since already done in
Save/Restore_Opt_Config_Switches.
2014-01-23 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi, einfo.adb, einfo.ads, sem_prag.adb, gnat_ugn.texi,
freeze.adb, repinfo.adb, aspects.adb, aspects.ads, sem_ch13.adb:
Linker_Section enhancements.
2014-01-23 Tristan Gingold <gingold@adacore.com>
* gnat_rm.texi: Minor editing.

1
gcc/ada/aspects.adb
View File

@ -516,6 +516,7 @@ package body Aspects is
Aspect_Invariant => Aspect_Invariant,
Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_Link_Name => Aspect_Link_Name,
Aspect_Linker_Section => Aspect_Linker_Section,
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
Aspect_No_Return => Aspect_No_Return,

4
gcc/ada/aspects.ads
View File

@ -103,6 +103,7 @@ package Aspects is
Aspect_Invariant, -- GNAT
Aspect_Iterator_Element,
Aspect_Link_Name,
Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Output,
@ -325,6 +326,7 @@ package Aspects is
Aspect_Invariant => Expression,
Aspect_Iterator_Element => Name,
Aspect_Link_Name => Expression,
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Output => Name,
@ -420,6 +422,7 @@ package Aspects is
Aspect_Invariant => Name_Invariant,
Aspect_Iterator_Element => Name_Iterator_Element,
Aspect_Link_Name => Name_Link_Name,
Aspect_Linker_Section => Name_Linker_Section,
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_No_Return => Name_No_Return,
@ -624,6 +627,7 @@ package Aspects is
Aspect_Invariant => Always_Delay,
Aspect_Iterator_Element => Always_Delay,
Aspect_Link_Name => Always_Delay,
Aspect_Linker_Section => Always_Delay,
Aspect_Lock_Free => Always_Delay,
Aspect_No_Return => Always_Delay,
Aspect_Output => Always_Delay,

22
gcc/ada/einfo.adb
View File

@ -249,6 +249,7 @@ package body Einfo is
-- SPARK_Pragma Node32
-- Linker_Section_Pragma Node33
-- SPARK_Aux_Pragma Node33
-- Contract Node34
@ -2387,6 +2388,13 @@ package body Einfo is
return Node23 (Id);
end Limited_View;
function Linker_Section_Pragma (Id : E) return N is
begin
pragma Assert
(Is_Type (Id) or else Is_Object (Id) or else Is_Subprogram (Id));
return Node33 (Id);
end Linker_Section_Pragma;
function Lit_Indexes (Id : E) return E is
begin
pragma Assert (Is_Enumeration_Type (Id));
@ -5095,6 +5103,14 @@ package body Einfo is
Set_Node23 (Id, V);
end Set_Limited_View;
procedure Set_Linker_Section_Pragma (Id : E; V : N) is
begin
pragma Assert (Is_Type (Id)
or else Ekind_In (Id, E_Constant, E_Variable)
or else Is_Subprogram (Id));
Set_Node33 (Id, V);
end Set_Linker_Section_Pragma;
procedure Set_Lit_Indexes (Id : E; V : E) is
begin
pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
@ -9453,6 +9469,12 @@ package body Einfo is
E_Package_Body =>
Write_Str ("SPARK_Aux_Pragma");
when E_Constant |
E_Variable |
Subprogram_Kind |
Type_Kind =>
Write_Str ("Linker_Section_Pragma");
when others =>
Write_Str ("Field33??");
end case;

33
gcc/ada/einfo.ads
View File

@ -1299,6 +1299,10 @@ package Einfo is
-- If any of these items are present, then the flag Has_Gigi_Rep_Item is
-- set, indicating that Gigi should search the chain.
--
-- Note that in the case of Linker_Section, this is set only for objects,
-- and only for transitional use until the new Linker_Section_Pragma
-- field is properly processed by the back end.
--
-- Other representation items are included in the chain so that error
-- messages can easily locate the relevant nodes for posting errors.
-- Note in particular that size clauses are defined only for this
@ -1564,6 +1568,10 @@ package Einfo is
-- If this flag is set, then Gigi should scan the rep item chain to
-- process any of these items that appear. At least one such item will
-- be present.
--
-- Note that in the case of Linker_Section, this is set only for objects,
-- and only for transitional use until the new Linker_Section_Pragma
-- field is properly processed by the back end.
-- Has_Homonym (Flag56)
-- Defined in all entities. Set if an entity has a homonym in the same
@ -3055,7 +3063,14 @@ package Einfo is
-- fide package with the limited-view list through the first_entity and
-- first_private attributes. The elements of this list are the shadow
-- entities created for the types and local packages that are declared
-- in a package appearing in a limited_with clause (Ada 2005: AI-50217)
-- in a package appearing in a limited_with clause (Ada 2005: AI-50217).
-- Linker_Section_Pragma (Node33)
-- Present in constant, variable, type and subprogram entities. Points
-- to a linker section pragma that applies to the entity, or is Empty if
-- no such pragma applies. Note that for constants and variables, this
-- field may be set as a result of a linker section pragma applied to the
-- type of the object.
-- Lit_Indexes (Node15)
-- Defined in enumeration types and subtypes. Non-empty only for the
@ -3906,9 +3921,9 @@ package Einfo is
-- or a copy of the low bound of the index base type if not.
-- Subprograms_For_Type (Node29)
-- Defined in all type entities, and in subprogram entities. This is used
-- to hold a list of subprogram entities for subprograms associated with
-- the type, linked through the Subprogram_List field of the subprogram
-- Defined in all type and subprogram entities. This is used to hold
-- a list of subprogram entities for subprograms associated with the
-- type, linked through the Subprograms_For_Type field of the subprogram
-- entity. Basically this is a way of multiplexing the single field to
-- hold more than one entity (since we ran out of space in some type
-- entities). This is currently used for Invariant_Procedure and also
@ -5067,6 +5082,7 @@ package Einfo is
-- Related_Expression (Node24)
-- Current_Use_Clause (Node27)
-- Subprograms_For_Type (Node29)
-- Linker_Section_Pragma (Node33)
-- Depends_On_Private (Flag14)
-- Discard_Names (Flag88)
@ -5301,6 +5317,7 @@ package Einfo is
-- Interface_Name (Node21) (constants only)
-- Related_Type (Node27) (constants only)
-- Initialization_Statements (Node28)
-- Linker_Section_Pragma (Node33)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
@ -5480,6 +5497,7 @@ package Einfo is
-- Corresponding_Equality (Node30) (implicit /= only)
-- Thunk_Entity (Node31) (thunk case only)
-- SPARK_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Body_Needed_For_SAL (Flag40)
-- Elaboration_Entity_Required (Flag174)
@ -5633,6 +5651,7 @@ package Einfo is
-- Last_Entity (Node20)
-- Overridden_Operation (Node26)
-- Subprograms_For_Type (Node29)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Invariants (Flag232)
-- Has_Postconditions (Flag240)
@ -5767,6 +5786,7 @@ package Einfo is
-- Static_Initialization (Node30) (init_proc only)
-- Thunk_Entity (Node31) (thunk case only)
-- SPARK_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Body_Needed_For_SAL (Flag40)
-- Delay_Cleanups (Flag114)
@ -6001,6 +6021,7 @@ package Einfo is
-- Last_Assignment (Node26)
-- Related_Type (Node27)
-- Initialization_Statements (Node28)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
@ -6566,6 +6587,7 @@ package Einfo is
function Last_Assignment (Id : E) return N;
function Last_Entity (Id : E) return E;
function Limited_View (Id : E) return E;
function Linker_Section_Pragma (Id : E) return N;
function Lit_Indexes (Id : E) return E;
function Lit_Strings (Id : E) return E;
function Low_Bound_Tested (Id : E) return B;
@ -7192,6 +7214,7 @@ package Einfo is
procedure Set_Last_Assignment (Id : E; V : N);
procedure Set_Last_Entity (Id : E; V : E);
procedure Set_Limited_View (Id : E; V : E);
procedure Set_Linker_Section_Pragma (Id : E; V : N);
procedure Set_Lit_Indexes (Id : E; V : E);
procedure Set_Lit_Strings (Id : E; V : E);
procedure Set_Low_Bound_Tested (Id : E; V : B := True);
@ -7960,6 +7983,7 @@ package Einfo is
pragma Inline (Last_Assignment);
pragma Inline (Last_Entity);
pragma Inline (Limited_View);
pragma Inline (Linker_Section_Pragma);
pragma Inline (Lit_Indexes);
pragma Inline (Lit_Strings);
pragma Inline (Low_Bound_Tested);
@ -8386,6 +8410,7 @@ package Einfo is
pragma Inline (Set_Last_Assignment);
pragma Inline (Set_Last_Entity);
pragma Inline (Set_Limited_View);
pragma Inline (Set_Linker_Section_Pragma);
pragma Inline (Set_Lit_Indexes);
pragma Inline (Set_Lit_Strings);
pragma Inline (Set_Low_Bound_Tested);

5
gcc/ada/exp_util.adb
View File

@ -5566,11 +5566,12 @@ package body Exp_Util is
Typ := Etype (Expr);
-- Subtypes may be subject to invariants coming from their respective
-- base types.
-- base types. The subtype may be fully or partially private.
if Ekind_In (Typ, E_Array_Subtype,
E_Private_Subtype,
E_Record_Subtype)
E_Record_Subtype,
E_Record_Subtype_With_Private)
then
Typ := Base_Type (Typ);
end if;

14
gcc/ada/freeze.adb
View File

@ -2283,7 +2283,6 @@ package body Freeze is
-- Start of processing for Alias_Atomic_Check
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
@ -4046,6 +4045,19 @@ package body Freeze is
Set_Is_Public (E);
end if;
-- For source objects that are not Imported and are library
-- level, if no linker section pragma was given inherit the
-- appropriate linker section from the corresponding type.
if Comes_From_Source (E)
and then not Is_Imported (E)
and then Is_Library_Level_Entity (E)
and then No (Linker_Section_Pragma (E))
then
Set_Linker_Section_Pragma
(E, Linker_Section_Pragma (Etype (E)));
end if;
-- For convention C objects of an enumeration type, warn if
-- the size is not integer size and no explicit size given.
-- Skip warning for Boolean, and Character, assume programmer

34
gcc/ada/gnat_rm.texi
View File

@ -294,6 +294,7 @@ Implementation Defined Aspects
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
* Aspect Linker_Section::
* Aspect Object_Size::
* Aspect Persistent_BSS::
* Aspect Predicate::
@ -4249,12 +4250,30 @@ pragma Linker_Section (
@end smallexample
@noindent
@var{LOCAL_NAME} must refer to an object that is
@var{LOCAL_NAME} must refer to an object, type, or subprogram that is
declared at the library level. This pragma specifies the name of the
linker section for the given entity. It is equivalent to
@code{__attribute__((section))} in GNU C and causes @var{LOCAL_NAME} to
be placed in the @var{static_string_EXPRESSION} section of the
executable (assuming the linker doesn't rename the section).
GNAT also provides an implementation defined aspect of the same name.
In the case of specifying this aspect for a type, the effect is to
specify the corresponding for all library level objects of the type which
do not have an explicit linker section set. Note that this only applies to
whole objects, not to components of composite objects.
In the case of a subprogram, the linker section applies to all previously
declared matching overloaded subprograms in the current declarative part
which do not already have a linker section assigned. The linker section
aspect is useful in this case for specifying different linker sections
for different elements of such an overloaded set.
Note that an empty string specifies that no linker section is specified.
This is not quite the same as omitting the pragma or aspect, since it
can be used to specify that one element of an overloaded set of subprograms
has the default linker section, or that one object of a type for which a
linker section is specified should has the default linker section.
The compiler normally places library-level entities in standard sections
depending on the class: procedures and functions generally go in the
@ -4283,6 +4302,12 @@ package IO_Card is
Port_B : Integer;
pragma Volatile (Port_B);
pragma Linker_Section (Port_B, ".bss.port_b");
type Port_Type is new Integer with Linker_Section => ".bss";
PA : Port_Type with Linker_Section => ".bss.PA";
PB : Port_Type; -- ends up in linker section ".bss"
procedure Q with Linker_Section => "Qsection";
end IO_Card;
@end smallexample
@ -7631,6 +7656,7 @@ clause.
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
* Aspect Linker_Section::
* Aspect Lock_Free::
* Aspect Object_Size::
* Aspect Persistent_BSS::
@ -7824,6 +7850,12 @@ This aspect is equivalent to pragma @code{Invariant}. It is a
synonym for the language defined aspect @code{Type_Invariant} except
that it is separately controllable using pragma @code{Assertion_Policy}.
@node Aspect Linker_Section
@unnumberedsec Aspect Linker_Section
@findex Linker_Section
@noindent
This aspect is equivalent to an @code{Linker_Section} pragma.
@node Aspect Lock_Free
@unnumberedsec Aspect Lock_Free
@findex Lock_Free

7
gcc/ada/gnat_ugn.texi
View File

@ -7430,7 +7430,12 @@ the @option{-gnatR} switch). For @option{-gnatR1} (which is the default,
so @option{-gnatR} with no parameter has the same effect), size and alignment
information is listed for declared array and record types. For
@option{-gnatR2}, size and alignment information is listed for all
declared types and objects. Finally @option{-gnatR3} includes symbolic
declared types and objects. The @code{Linker_Section} is also listed for any
entity for which the @code{Linker_Section} is set explicitly or implicitly (the
latter case occurs for objects of a type for which a @code{Linker_Section}
is set).
Finally @option{-gnatR3} includes symbolic
expressions for values that are computed at run time for
variant records. These symbolic expressions have a mostly obvious
format with #n being used to represent the value of the n'th

2
gcc/ada/opt.adb
View File

@ -100,6 +100,7 @@ package body Opt is
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
SPARK_Mode := Save.SPARK_Mode;
SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
Use_VADS_Size := Save.Use_VADS_Size;
-- Update consistently the value of Init_Or_Norm_Scalars. The value of
@ -137,6 +138,7 @@ package body Opt is
Save.Polling_Required := Polling_Required;
Save.Short_Descriptors := Short_Descriptors;
Save.SPARK_Mode := SPARK_Mode;
Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
Save.Use_VADS_Size := Use_VADS_Size;
end Save_Opt_Config_Switches;

92
gcc/ada/repinfo.adb
View File

@ -36,6 +36,7 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
with Sem_Aux; use Sem_Aux;
@ -43,6 +44,7 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Table; use Table;
with Uname; use Uname;
with Urealp; use Urealp;
@ -147,6 +149,10 @@ package body Repinfo is
procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
-- List representation info for array type Ent
procedure List_Linker_Section (Ent : Entity_Id);
-- List linker section for Ent (caller has checked that Ent is an entity
-- for which the Linker_Section_Pragma field is defined).
procedure List_Mechanisms (Ent : Entity_Id);
-- List mechanism information for parameters of Ent, which is subprogram,
-- subprogram type, or an entry or entry family.
@ -352,8 +358,8 @@ package body Repinfo is
if List_Representation_Info_Mechanisms
and then (Is_Subprogram (Ent)
or else Ekind (Ent) = E_Entry
or else Ekind (Ent) = E_Entry_Family)
or else Ekind (Ent) = E_Entry
or else Ekind (Ent) = E_Entry_Family)
then
Need_Blank_Line := True;
List_Mechanisms (Ent);
@ -374,13 +380,16 @@ package body Repinfo is
and then Present (Full_View (E))))
or else Debug_Flag_AA
then
if Is_Subprogram (E)
or else
Ekind (E) = E_Entry
or else
Ekind (E) = E_Entry_Family
or else
Ekind (E) = E_Subprogram_Type
if Is_Subprogram (E) then
List_Linker_Section (E);
if List_Representation_Info_Mechanisms then
List_Mechanisms (E);
end if;
elsif Ekind_In (E, E_Entry,
E_Entry_Family,
E_Subprogram_Type)
then
if List_Representation_Info_Mechanisms then
List_Mechanisms (E);
@ -391,24 +400,28 @@ package body Repinfo is
List_Record_Info (E, Bytes_Big_Endian);
end if;
List_Linker_Section (E);
elsif Is_Array_Type (E) then
if List_Representation_Info >= 1 then
List_Array_Info (E, Bytes_Big_Endian);
end if;
List_Linker_Section (E);
elsif Is_Type (E) then
if List_Representation_Info >= 2 then
List_Type_Info (E);
List_Linker_Section (E);
end if;
elsif Ekind (E) = E_Variable
or else
Ekind (E) = E_Constant
or else
Ekind (E) = E_Loop_Parameter
or else
Is_Formal (E)
then
elsif Ekind_In (E, E_Variable, E_Constant) then
if List_Representation_Info >= 2 then
List_Object_Info (E);
List_Linker_Section (E);
end if;
elsif Ekind (E) = E_Loop_Parameter or else Is_Formal (E) then
if List_Representation_Info >= 2 then
List_Object_Info (E);
end if;
@ -425,17 +438,12 @@ package body Repinfo is
-- Recurse into bodies
elsif Ekind (E) = E_Protected_Type
or else
Ekind (E) = E_Task_Type
or else
Ekind (E) = E_Subprogram_Body
or else
Ekind (E) = E_Package_Body
or else
Ekind (E) = E_Task_Body
or else
Ekind (E) = E_Protected_Body
elsif Ekind_In (E, E_Protected_Type,
E_Task_Type,
E_Subprogram_Body,
E_Package_Body,
E_Task_Body,
E_Protected_Body)
then
List_Entities (E, Bytes_Big_Endian);
@ -633,6 +641,34 @@ package body Repinfo is
end if;
end List_GCC_Expression;
-------------------------
-- List_Linker_Section --
-------------------------
procedure List_Linker_Section (Ent : Entity_Id) is
Arg : Node_Id;
begin
if Present (Linker_Section_Pragma (Ent)) then
Write_Str ("pragma Linker_Section (");
List_Name (Ent);
Write_Str (", """);
Arg :=
Last (Pragma_Argument_Associations (Linker_Section_Pragma (Ent)));
if Nkind (Arg) = N_Pragma_Argument_Association then
Arg := Expression (Arg);
end if;
pragma Assert (Nkind (Arg) = N_String_Literal);
String_To_Name_Buffer (Strval (Arg));
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Str (""");");
Write_Eol;
end if;
end List_Linker_Section;
---------------------
-- List_Mechanisms --
---------------------

4
gcc/ada/sem.adb
View File

@ -1311,8 +1311,6 @@ package body Sem is
S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
S_Style_Check : constant Boolean := Style_Check;
S_SPARK_Mode : constant SPARK_Mode_Type := SPARK_Mode;
S_SPARK_Mode_Pragma : constant Node_Id := SPARK_Mode_Pragma;
Generic_Main : constant Boolean :=
Nkind (Unit (Cunit (Main_Unit)))
@ -1512,8 +1510,6 @@ package body Sem is
Inside_A_Generic := S_Inside_A_Generic;
Outer_Generic_Scope := S_Outer_Gen_Scope;
Style_Check := S_Style_Check;
SPARK_Mode := S_SPARK_Mode;
SPARK_Mode_Pragma := S_SPARK_Mode_Pragma;
Restore_Opt_Config_Switches (Save_Config_Switches);

5
gcc/ada/sem_attr.adb
View File

@ -4525,8 +4525,9 @@ package body Sem_Attr is
and then Is_Potentially_Unevaluated (N)
and then not Is_Entity_Name (P)
then
Error_Msg_N ("prefix that is potentially unevaluated must "
& "denote an entity", N);
Error_Msg_N
("prefix that is potentially unevaluated must denote an entity",
N);
end if;
-- The attribute appears within a pre/postcondition, but refers to

10
gcc/ada/sem_ch13.adb
View File

@ -1633,10 +1633,11 @@ package body Sem_Ch13 is
-- referring to the entity, and the second argument is the
-- aspect definition expression.
-- Suppress/Unsuppress
-- Linker_Section/Suppress/Unsuppress
when Aspect_Suppress |
Aspect_Unsuppress =>
when Aspect_Linker_Section |
Aspect_Suppress |
Aspect_Unsuppress =>
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
@ -7941,6 +7942,9 @@ package body Sem_Ch13 is
Aspect_Value_Size =>
T := Any_Integer;
when Aspect_Linker_Section =>
T := Standard_String;
when Aspect_Synchronization =>
return;

82
gcc/ada/sem_prag.adb
View File

@ -15545,7 +15545,11 @@ package body Sem_Prag is
-- [Entity =>] LOCAL_NAME
-- [Section =>] static_string_EXPRESSION);
when Pragma_Linker_Section =>
when Pragma_Linker_Section => Linker_Section : declare
Arg : Node_Id;
Ent : Entity_Id;
begin
GNAT_Pragma;
Check_Arg_Order ((Name_Entity, Name_Section));
Check_Arg_Count (2);
@ -15554,25 +15558,69 @@ package body Sem_Prag is
Check_Arg_Is_Library_Level_Local_Name (Arg1);
Check_Arg_Is_Static_Expression (Arg2, Standard_String);
-- This pragma applies to objects and types
-- Check kind of entity
if not Is_Object (Entity (Get_Pragma_Arg (Arg1)))
and then not Is_Type (Entity (Get_Pragma_Arg (Arg1)))
then
Error_Pragma_Arg
("pragma% applies only to objects and types", Arg1);
end if;
Arg := Get_Pragma_Arg (Arg1);
Ent := Entity (Arg);
-- The only processing required is to link this item on to the
-- list of rep items for the given entity. This is accomplished
-- by the call to Rep_Item_Too_Late (when no error is detected
-- and False is returned).
case Ekind (Ent) is
if Rep_Item_Too_Late (Entity (Get_Pragma_Arg (Arg1)), N) then
return;
else
Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
end if;
-- Objects (constants and variables)
when E_Constant | E_Variable =>
Set_Linker_Section_Pragma (Ent, N);
-- For now, for objects, we also link onto the rep item
-- chain and set the gigi rep item flag. This is here for
-- transition purposes only. When the processing for the
-- Linker_Section_Pragma field is completed, this can be
-- removed, since it will no longer be used.
-- This is accomplished by the call to Rep_Item_Too_Late
-- (when no error is detected and False is returned).
if not Rep_Item_Too_Late (Ent, N) then
Set_Has_Gigi_Rep_Item (Ent);
end if;
-- Types
when Type_Kind =>
Set_Linker_Section_Pragma (Ent, N);
-- Subprograms
when Subprogram_Kind =>
-- Aspect case, entity already set
if From_Aspect_Specification (N) then
Set_Linker_Section_Pragma
(Entity (Corresponding_Aspect (N)), N);
-- Pragma case, we must climb the homonym chain, but skip
-- any for which the linker section is already set.
else
loop
if No (Linker_Section_Pragma (Ent)) then
Set_Linker_Section_Pragma (Ent, N);
end if;
Ent := Homonym (Ent);
exit when No (Ent)
or else Scope (Ent) /= Current_Scope;
end loop;
end if;
-- All other cases are illegal
when others =>
Error_Pragma_Arg
("pragma% applies only to objects, subprograms, and types",
Arg1);
end case;
end Linker_Section;
----------
-- List --

85
gcc/ada/sem_util.adb
View File

@ -10249,48 +10249,6 @@ package body Sem_Util is
end if;
end Is_Partially_Initialized_Type;
--------------------------------
-- Is_Potentially_Unevaluated --
--------------------------------
function Is_Potentially_Unevaluated (N : Node_Id) return Boolean is
Par : Node_Id;
Expr : Node_Id;
begin
Expr := N;
Par := Parent (N);
while not Nkind_In (Par, N_If_Expression,
N_Case_Expression,
N_And_Then,
N_Or_Else,
N_In,
N_Not_In)
loop
Expr := Par;
Par := Parent (Par);
if Nkind (Par) not in N_Subexpr then
return False;
end if;
end loop;
if Nkind (Par) = N_If_Expression then
return Is_Elsif (Par) or else Expr /= First (Expressions (Par));
elsif Nkind (Par) = N_Case_Expression then
return Expr /= Expression (Par);
elsif Nkind_In (Par, N_And_Then, N_Or_Else) then
return Expr = Right_Opnd (Par);
elsif Nkind_In (Par, N_In, N_Not_In) then
return Expr /= Left_Opnd (Par);
else
return False;
end if;
end Is_Potentially_Unevaluated;
------------------------------------
-- Is_Potentially_Persistent_Type --
------------------------------------
@ -10355,6 +10313,49 @@ package body Sem_Util is
end if;
end Is_Potentially_Persistent_Type;
--------------------------------
-- Is_Potentially_Unevaluated --
--------------------------------
function Is_Potentially_Unevaluated (N : Node_Id) return Boolean is
Par : Node_Id;
Expr : Node_Id;
begin
Expr := N;
Par := Parent (N);
while not Nkind_In (Par, N_If_Expression,
N_Case_Expression,
N_And_Then,
N_Or_Else,
N_In,
N_Not_In)
loop
Expr := Par;
Par := Parent (Par);
if Nkind (Par) not in N_Subexpr then
return False;
end if;
end loop;
if Nkind (Par) = N_If_Expression then
return Is_Elsif (Par) or else Expr /= First (Expressions (Par));
elsif Nkind (Par) = N_Case_Expression then
return Expr /= Expression (Par);
elsif Nkind_In (Par, N_And_Then, N_Or_Else) then
return Expr = Right_Opnd (Par);
elsif Nkind_In (Par, N_In, N_Not_In) then
return Expr /= Left_Opnd (Par);
else
return False;
end if;
end Is_Potentially_Unevaluated;
---------------------------------
-- Is_Protected_Self_Reference --
---------------------------------