+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.
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,
Aspect_Invariant, -- GNAT
Aspect_Iterator_Element,
Aspect_Link_Name,
+ Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Output,
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,
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,
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,
-- SPARK_Pragma Node32
+ -- Linker_Section_Pragma Node33
-- SPARK_Aux_Pragma Node33
-- Contract Node34
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));
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);
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;
-- 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
-- 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
-- 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
-- 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
-- Related_Expression (Node24)
-- Current_Use_Clause (Node27)
-- Subprograms_For_Type (Node29)
+ -- Linker_Section_Pragma (Node33)
-- Depends_On_Private (Flag14)
-- Discard_Names (Flag88)
-- 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)
-- 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)
-- Last_Entity (Node20)
-- Overridden_Operation (Node26)
-- Subprograms_For_Type (Node29)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Invariants (Flag232)
-- Has_Postconditions (Flag240)
-- 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)
-- Last_Assignment (Node26)
-- Related_Type (Node27)
-- Initialization_Statements (Node28)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
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;
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);
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);
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);
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;
-- 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.
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
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
+* Aspect Linker_Section::
* Aspect Object_Size::
* Aspect Persistent_BSS::
* Aspect Predicate::
@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
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
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
+* Aspect Linker_Section::
* Aspect Lock_Free::
* Aspect Object_Size::
* Aspect Persistent_BSS::
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
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
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
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;
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;
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;
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.
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);
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);
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;
-- 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);
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 --
---------------------
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)))
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);
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
-- 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 (
Aspect_Value_Size =>
T := Any_Integer;
+ when Aspect_Linker_Section =>
+ T := Standard_String;
+
when Aspect_Synchronization =>
return;
-- [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);
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 --
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 --
------------------------------------
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 --
---------------------------------
projects / gcc.git / commitdiff