+2011-08-31 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch4.adb (Try_Object_Operation): When a dispatching primitive is
+ found check if there is a class-wide subprogram covering the primitive.
+
+2011-08-31 Yannick Moy <moy@adacore.com>
+
+ * sem_res.adb: Further cases where full expansion test is needed,
+ rather than expansion test.
+
+2011-08-31 Pascal Obry <obry@adacore.com>
+
+ * prj-attr.adb: Fix Source_File_Switches attribute kind (must be a list)
+
+2011-08-31 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch5.adb: Handle iterators over derived container types.
+
+2011-08-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.ads, einfo.adb: Add new flag Has_Anonymous_Master.
+ (Has_Anonymous_Master): New routine.
+ (Set_Has_Anonymous_Master): New routine.
+ (Write_Entity_Flags): Add an entry for Has_Anonymous_Master.
+ * exp_ch4.adb: Add with and use clause for Sem_Ch8.
+ (Current_Anonymous_Master): New routine.
+ (Current_Unit_First_Declaration): Removed.
+ (Current_Unit_Scope): Removed.
+ (Expand_N_Allocator): Anonymous access-to-controlled types now chain
+ their objects on a per-unit heterogeneous finalization master.
+
+2011-08-31 Matthew Heaney <heaney@adacore.com>
+
+ * a-cbhama.adb, a-cbhase.adb (Insert): Check for zero-length buckets
+ array.
+
+2011-08-31 Jose Ruiz <ruiz@adacore.com>
+
+ * s-taprop-linux.adb (Create_Task): Avoid changing the affinity mask
+ when not needed.
+
+2011-08-31 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_disp.adb (Propagate_Tag): Return without propagating in the case
+ where the actual is an unexpanded call to 'Input.
+
2011-08-31 Yannick Moy <moy@adacore.com>
* sem_ch4.adb: Code clean up.
procedure Assign_Key (Node : in out Node_Type) is
begin
Node.Key := Key;
+
+ -- Note that we do not also assign the element component of the node
+ -- here, because this version of Insert does not accept an element
+ -- parameter.
+
-- Node.Element := New_Item;
end Assign_Key;
-- Start of processing for Insert
begin
- -- ???
- -- if HT_Ops.Capacity (HT) = 0 then
- -- HT_Ops.Reserve_Capacity (HT, 1);
- -- end if;
+ -- The buckets array length is specified by the user as a discriminant
+ -- of the container type, so it is possible for the buckets array to
+ -- have a length of zero. We must check for this case specifically, in
+ -- order to prevent divide-by-zero errors later, when we compute the
+ -- buckets array index value for a key, given its hash value.
+
+ if Container.Buckets'Length = 0 then
+ raise Capacity_Error with "No capacity for insertion";
+ end if;
Local_Insert (Container, Key, Position.Node, Inserted);
-
- -- ???
- -- if Inserted
- -- and then HT.Length > HT_Ops.Capacity (HT)
- -- then
- -- HT_Ops.Reserve_Capacity (HT, HT.Length);
- -- end if;
-
Position.Container := Container'Unchecked_Access;
end Insert;
-- Start of processing for Insert
begin
- -- ??
- -- if HT_Ops.Capacity (HT) = 0 then
- -- HT_Ops.Reserve_Capacity (HT, 1);
- -- end if;
+ -- The buckets array length is specified by the user as a discriminant
+ -- of the container type, so it is possible for the buckets array to
+ -- have a length of zero. We must check for this case specifically, in
+ -- order to prevent divide-by-zero errors later, when we compute the
+ -- buckets array index value for a key, given its hash value.
+
+ if Container.Buckets'Length = 0 then
+ raise Capacity_Error with "No capacity for insertion";
+ end if;
Local_Insert (Container, Key, Position.Node, Inserted);
-
- -- ???
- -- if Inserted
- -- and then HT.Length > HT_Ops.Capacity (HT)
- -- then
- -- HT_Ops.Reserve_Capacity (HT, HT.Length);
- -- end if;
-
Position.Container := Container'Unchecked_Access;
end Insert;
-- Start of processing for Insert
begin
- -- ???
- -- if HT_Ops.Capacity (HT) = 0 then
- -- HT_Ops.Reserve_Capacity (HT, 1);
- -- end if;
+ -- The buckets array length is specified by the user as a discriminant
+ -- of the container type, so it is possible for the buckets array to
+ -- have a length of zero. We must check for this case specifically, in
+ -- order to prevent divide-by-zero errors later, when we compute the
+ -- buckets array index value for an element, given its hash value.
+
+ if Container.Buckets'Length = 0 then
+ raise Capacity_Error with "No capacity for insertion";
+ end if;
Local_Insert (Container, New_Item, Node, Inserted);
-
- -- ???
- -- if Inserted
- -- and then HT.Length > HT_Ops.Capacity (HT)
- -- then
- -- HT_Ops.Reserve_Capacity (HT, HT.Length);
- -- end if;
end Insert;
------------------
-- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252
+ -- Has_Anonymous_Master Flag253
- -- (unused) Flag253
-- (unused) Flag254
-----------------------
return Flag201 (Id);
end Has_Anon_Block_Suffix;
+ function Has_Anonymous_Master (Id : E) return B is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
+ return Flag253 (Id);
+ end Has_Anonymous_Master;
+
function Has_Atomic_Components (Id : E) return B is
begin
return Flag86 (Implementation_Base_Type (Id));
Set_Flag201 (Id, V);
end Set_Has_Anon_Block_Suffix;
+ procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
+ Set_Flag253 (Id, V);
+ end Set_Has_Anonymous_Master;
+
procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
begin
pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
W ("Has_Alignment_Clause", Flag46 (Id));
W ("Has_All_Calls_Remote", Flag79 (Id));
W ("Has_Anon_Block_Suffix", Flag201 (Id));
+ W ("Has_Anonymous_Master", Flag253 (Id));
W ("Has_Atomic_Components", Flag86 (Id));
W ("Has_Biased_Representation", Flag139 (Id));
W ("Has_Completion", Flag26 (Id));
-- more anonymous blocks and the Chars field contains a name with an
-- anonymous block suffix (see Exp_Dbug for further details).
+-- Has_Anonymous_Master (Flag253)
+-- Present in units (top-level functions and procedures, library-level
+-- packages). Set to True if the associated unit contains a heterogeneous
+-- finalization master. The master's name is of the form <unit>AM and it
+-- services anonymous access-to-controlled types with an undetermined
+-- lifetime.
+
-- Has_Atomic_Components (Flag86) [implementation base type only]
-- Present in all types and objects. Set only for an array type or
-- an array object if a valid pragma Atomic_Components applies to the
-- Delay_Cleanups (Flag114)
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
+ -- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Controlling_Result (Flag98)
-- Has_Invariants (Flag232)
-- Elaborate_Body_Desirable (Flag210) (non-generic case only)
-- From_With_Type (Flag159)
-- Has_All_Calls_Remote (Flag79)
+ -- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Forward_Instantiation (Flag175)
-- Has_Master_Entity (Flag21)
-- Is_Instantiated (Flag126)
-- Is_Private_Descendant (Flag53)
-- Is_Visible_Child_Unit (Flag116)
- -- Is_Wrapper_Package (synth) (non-generic case only)
-- Renamed_In_Spec (Flag231) (non-generic case only)
- -- Scope_Depth (synth)
-- Static_Elaboration_Desired (Flag77) (non-generic case only)
+ -- Is_Wrapper_Package (synth) (non-generic case only)
+ -- Scope_Depth (synth)
-- E_Package_Body
-- Handler_Records (List10) (non-generic case only)
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
-- Finalizer (Node24) (non-generic case only)
- -- Scope_Depth (synth)
-- Delay_Subprogram_Descriptors (Flag50)
+ -- Has_Anonymous_Master (Flag253)
-- Has_Subprogram_Descriptor (Flag93)
+ -- Scope_Depth (synth)
-- E_Private_Type
-- E_Private_Subtype
-- Delay_Cleanups (Flag114)
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
+ -- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Invariants (Flag232)
-- Has_Master_Entity (Flag21)
function Has_Alignment_Clause (Id : E) return B;
function Has_All_Calls_Remote (Id : E) return B;
function Has_Anon_Block_Suffix (Id : E) return B;
+ function Has_Anonymous_Master (Id : E) return B;
function Has_Atomic_Components (Id : E) return B;
function Has_Biased_Representation (Id : E) return B;
function Has_Completion (Id : E) return B;
procedure Set_Has_Alignment_Clause (Id : E; V : B := True);
procedure Set_Has_All_Calls_Remote (Id : E; V : B := True);
procedure Set_Has_Anon_Block_Suffix (Id : E; V : B := True);
+ procedure Set_Has_Anonymous_Master (Id : E; V : B := True);
procedure Set_Has_Atomic_Components (Id : E; V : B := True);
procedure Set_Has_Biased_Representation (Id : E; V : B := True);
procedure Set_Has_Completion (Id : E; V : B := True);
pragma Inline (Has_Alignment_Clause);
pragma Inline (Has_All_Calls_Remote);
pragma Inline (Has_Anon_Block_Suffix);
+ pragma Inline (Has_Anonymous_Master);
pragma Inline (Has_Atomic_Components);
pragma Inline (Has_Biased_Representation);
pragma Inline (Has_Completion);
pragma Inline (Set_Has_Alignment_Clause);
pragma Inline (Set_Has_All_Calls_Remote);
pragma Inline (Set_Has_Anon_Block_Suffix);
+ pragma Inline (Set_Has_Anonymous_Master);
pragma Inline (Set_Has_Atomic_Components);
pragma Inline (Set_Has_Biased_Representation);
pragma Inline (Set_Has_Completion);
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
+with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
-- If a boolean array assignment can be done in place, build call to
-- corresponding library procedure.
- function Current_Unit_First_Declaration return Node_Id;
- -- Return the current unit's first declaration. If the declaration list is
- -- empty, the routine generates a null statement and returns it.
-
- function Current_Unit_Scope return Entity_Id;
- -- Return the scope of the current unit. If the current unit is a body,
- -- return the scope of the spec.
+ function Current_Anonymous_Master return Entity_Id;
+ -- Return the entity of the heterogeneous finalization master belonging to
+ -- the current unit (either function, package or procedure). This master
+ -- services all anonymous access-to-controlled types. If the current unit
+ -- does not have such master, create one.
procedure Displace_Allocator_Pointer (N : Node_Id);
-- Ada 2005 (AI-251): Subsidiary procedure to Expand_N_Allocator and
return;
end Build_Boolean_Array_Proc_Call;
- ------------------------------------
- -- Current_Unit_First_Declaration --
- ------------------------------------
+ ------------------------------
+ -- Current_Anonymous_Master --
+ ------------------------------
- function Current_Unit_First_Declaration return Node_Id is
- Sem_U : Node_Id := Unit (Cunit (Current_Sem_Unit));
- Decl : Node_Id;
- Decls : List_Id;
+ function Current_Anonymous_Master return Entity_Id is
+ Decls : List_Id;
+ Fin_Mas_Id : Entity_Id;
+ Loc : Source_Ptr;
+ Subp_Body : Node_Id;
+ Unit_Decl : Node_Id;
+ Unit_Id : Entity_Id;
begin
- if Nkind (Sem_U) = N_Package_Declaration then
- Sem_U := Specification (Sem_U);
- Decls := Visible_Declarations (Sem_U);
+ Unit_Id := Cunit_Entity (Current_Sem_Unit);
+
+ -- Find the entity of the current unit
+
+ if Ekind (Unit_Id) = E_Subprogram_Body then
+
+ -- When processing subprogram bodies, the proper scope is always that
+ -- of the spec.
+
+ Subp_Body := Unit_Id;
+ while Present (Subp_Body)
+ and then Nkind (Subp_Body) /= N_Subprogram_Body
+ loop
+ Subp_Body := Parent (Subp_Body);
+ end loop;
+
+ Unit_Id := Corresponding_Spec (Subp_Body);
+ end if;
+
+ Loc := Sloc (Unit_Id);
+ Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+
+ -- Find the declarations list of the current unit
+
+ if Nkind (Unit_Decl) = N_Package_Declaration then
+ Unit_Decl := Specification (Unit_Decl);
+ Decls := Visible_Declarations (Unit_Decl);
if No (Decls) then
- Decl := Make_Null_Statement (Sloc (Sem_U));
- Decls := New_List (Decl);
- Set_Visible_Declarations (Sem_U, Decls);
+ Decls := New_List (Make_Null_Statement (Loc));
+ Set_Visible_Declarations (Unit_Decl, Decls);
elsif Is_Empty_List (Decls) then
- Decl := Make_Null_Statement (Sloc (Sem_U));
- Append_To (Decls, Decl);
-
- else
- Decl := First (Decls);
+ Append_To (Decls, Make_Null_Statement (Loc));
end if;
else
- Decls := Declarations (Sem_U);
+ Decls := Declarations (Unit_Decl);
if No (Decls) then
- Decl := Make_Null_Statement (Sloc (Sem_U));
- Decls := New_List (Decl);
- Set_Declarations (Sem_U, Decls);
+ Decls := New_List (Make_Null_Statement (Loc));
+ Set_Declarations (Unit_Decl, Decls);
elsif Is_Empty_List (Decls) then
- Decl := Make_Null_Statement (Sloc (Sem_U));
- Append_To (Decls, Decl);
-
- else
- Decl := First (Decls);
+ Append_To (Decls, Make_Null_Statement (Loc));
end if;
end if;
- return Decl;
- end Current_Unit_First_Declaration;
+ -- The current unit has an existing anonymous master, traverse its
+ -- declarations and locate the entity.
- ------------------------
- -- Current_Unit_Scope --
- ------------------------
+ if Has_Anonymous_Master (Unit_Id) then
+ Fin_Mas_Id := First_Entity (Unit_Id);
+ while Present (Fin_Mas_Id) loop
- function Current_Unit_Scope return Entity_Id is
- Scop_Id : Entity_Id := Cunit_Entity (Current_Sem_Unit);
- Subp_Bod : Node_Id;
+ -- Look for the first variable whose type is Finalization_Master
- begin
- if Ekind (Scop_Id) = E_Subprogram_Body then
-
- -- When processing subprogram bodies, the proper scope is always
- -- that of the spec.
+ if Ekind (Fin_Mas_Id) = E_Variable
+ and then Etype (Fin_Mas_Id) = RTE (RE_Finalization_Master)
+ then
+ return Fin_Mas_Id;
+ end if;
- Subp_Bod := Scop_Id;
- while Present (Subp_Bod)
- and then Nkind (Subp_Bod) /= N_Subprogram_Body
- loop
- Subp_Bod := Parent (Subp_Bod);
+ Next_Entity (Fin_Mas_Id);
end loop;
- Scop_Id := Corresponding_Spec (Subp_Bod);
- end if;
+ raise Program_Error;
+
+ -- Create a new anonymous master
- return Scop_Id;
- end Current_Unit_Scope;
+ else
+ declare
+ First_Decl : constant Node_Id := First (Decls);
+ Action : Node_Id;
+
+ begin
+ -- Since the master and its associated initialization is inserted
+ -- at top level, use the scope of the unit when analyzing.
+
+ Push_Scope (Unit_Id);
+
+ -- Create the finalization master
+
+ Fin_Mas_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Unit_Id), "AM"));
+
+ -- Generate:
+ -- <Fin_Mas_Id> : Finalization_Master;
+
+ Action :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Fin_Mas_Id,
+ Object_Definition =>
+ New_Reference_To (RTE (RE_Finalization_Master), Loc));
+
+ Insert_Before_And_Analyze (First_Decl, Action);
+
+ -- Mark the unit to prevent the generation of multiple masters
+
+ Set_Has_Anonymous_Master (Unit_Id);
+
+ -- Do not set the base pool and mode of operation on .NET/JVM
+ -- since those targets do not support pools and all VM masters
+ -- are heterogeneous by default.
+
+ if VM_Target = No_VM then
+
+ -- Generate:
+ -- Set_Base_Pool
+ -- (<Fin_Mas_Id>, Global_Pool_Object'Unrestricted_Access);
+
+ Action :=
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Set_Base_Pool), Loc),
+
+ Parameter_Associations => New_List (
+ New_Reference_To (Fin_Mas_Id, Loc),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Reference_To (RTE (RE_Global_Pool_Object), Loc),
+ Attribute_Name => Name_Unrestricted_Access)));
+
+ Insert_Before_And_Analyze (First_Decl, Action);
+
+ -- Generate:
+ -- Set_Is_Heterogeneous (<Fin_Mas_Id>);
+
+ Action :=
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Set_Is_Heterogeneous), Loc),
+ Parameter_Associations => New_List (
+ New_Reference_To (Fin_Mas_Id, Loc)));
+
+ Insert_Before_And_Analyze (First_Decl, Action);
+ end if;
+
+ -- Restore the original state of the scope stack
+
+ Pop_Scope;
+
+ return Fin_Mas_Id;
+ end;
+ end if;
+ end Current_Anonymous_Master;
--------------------------------
-- Displace_Allocator_Pointer --
if No (Associated_Storage_Pool (PtrT))
and then VM_Target = No_VM
then
- Set_Associated_Storage_Pool (PtrT,
- Get_Global_Pool_For_Access_Type (PtrT));
+ Set_Associated_Storage_Pool
+ (PtrT, Get_Global_Pool_For_Access_Type (PtrT));
end if;
-- The finalization master must be inserted and analyzed as part of
-- the current semantic unit.
if No (Finalization_Master (PtrT)) then
- Build_Finalization_Master
- (Typ => PtrT,
- Ins_Node => Current_Unit_First_Declaration,
- Encl_Scope => Current_Unit_Scope);
+ Set_Finalization_Master (PtrT, Current_Anonymous_Master);
end if;
end if;
-- If "reverse" is present, then the initialization of the cursor
-- uses Last and the step becomes Prev. Pack is the name of the
- -- package which instantiates the container.
+ -- scope where the container package is instantiated.
declare
Element_Type : constant Entity_Id := Etype (Id);
-- use-visible, so we introduce the name of the enclosing package
-- in the declarations below. The Iterator type is declared in a
-- an instance within the container package itself.
+ -- If the container type is a derived type, the cursor type is
+ -- found in the package of the parent type.
Iter_Type := Etype (Name (I_Spec));
if Is_Iterator (Iter_Type) then
- Pack := Scope (Scope (Etype (Container)));
+ if Is_Derived_Type (Container_Typ) then
+ Pack := Scope (Scope (Root_Type (Container_Typ)));
+ else
+ Pack := Scope (Scope (Container_Typ));
+ end if;
else
- Pack := Scope (Etype (Container));
+ if Is_Derived_Type (Container_Typ) then
+ Pack := Scope (Root_Type (Container_Typ));
+ else
+ Pack := Scope (Container_Typ);
+ end if;
end if;
-- The "of" case uses an internally generated cursor whose type
end;
-- X in Iterate (S) : type of iterator is type of explicitly
- -- given Iterate function.
+ -- given Iterate function, and the loop variable is the cursor.
else
Cursor := Id;
"Latrailing_required_switches#" &
"Lapic_option#" &
"Sapath_syntax#" &
- "Sasource_file_switches#" &
+ "Lasource_file_switches#" &
"Saobject_file_suffix#" &
"Laobject_file_switches#" &
"Lamulti_unit_switches#" &
-- Handle dispatching domains
- elsif T.Common.Domain /= null then
+ -- To avoid changing CPU affinities when not needed, we set the
+ -- affinity only when assigning to a domain other than the default
+ -- one, or when the default one has been modified.
+
+ elsif T.Common.Domain /= null and then
+ (T.Common.Domain /= ST.System_Domain
+ or else T.Common.Domain.all /=
+ (Multiprocessors.CPU'First ..
+ Multiprocessors.Number_Of_CPUs => True))
+ then
declare
CPU_Set : aliased cpu_set_t := (bits => (others => False));
Call : Node_Id;
Subp : Entity_Id) return Entity_Id;
-- If the subprogram is a valid interpretation, record it, and add
- -- to the list of interpretations of Subprog.
+ -- to the list of interpretations of Subprog. Otherwise return Empty.
procedure Complete_Object_Operation
(Call_Node : Node_Id;
and then N = Name (Parent (N))
then
goto Next_Hom;
+
+ -- If the context is a function call, ignore procedures
+ -- in the name of the call.
+
+ elsif Ekind (Hom) = E_Procedure
+ and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
+ then
+ goto Next_Hom;
end if;
Set_Etype (Call_Node, Any_Type);
return;
end if;
- if Try_Primitive_Operation
- (Call_Node => New_Call_Node,
- Node_To_Replace => Node_To_Replace)
- or else
- Try_Class_Wide_Operation
- (Call_Node => New_Call_Node,
- Node_To_Replace => Node_To_Replace)
- then
- null;
- end if;
+ declare
+ Dup_Call_Node : constant Node_Id := New_Copy (New_Call_Node);
+ CW_Result : Boolean;
+ Prim_Result : Boolean;
+ pragma Unreferenced (CW_Result);
+
+ begin
+ Prim_Result :=
+ Try_Primitive_Operation
+ (Call_Node => New_Call_Node,
+ Node_To_Replace => Node_To_Replace);
+
+ -- Check if there is a class-wide subprogram covering the
+ -- primitive. This check must be done even if a candidate
+ -- was found in order to report ambiguous calls.
+
+ if not (Prim_Result) then
+ CW_Result :=
+ Try_Class_Wide_Operation
+ (Call_Node => New_Call_Node,
+ Node_To_Replace => Node_To_Replace);
+
+ -- If we found a primitive we search for class-wide subprograms
+ -- using a duplicate of the call node (done to avoid missing its
+ -- decoration if there is no ambiguity).
+
+ else
+ CW_Result :=
+ Try_Class_Wide_Operation
+ (Call_Node => Dup_Call_Node,
+ Node_To_Replace => Node_To_Replace);
+ end if;
+ end;
end Try_One_Prefix_Interpretation;
-----------------------------
then
return;
+ -- When expansion is suppressed, an unexpanded call to 'Input can occur,
+ -- and in that case we can simply return.
+
+ elsif Nkind (Actual) = N_Attribute_Reference then
+ pragma Assert (Attribute_Name (Actual) = Name_Input);
+
+ return;
+
-- Only other possibilities are parenthesized or qualified expression,
-- or an expander-generated unchecked conversion of a function call to
-- a stream Input attribute.
-- Start of processing for Replace_Actual_Discriminants
begin
- if not Expander_Active then
+ if not Full_Expander_Active then
return;
end if;
if (Attr = Attribute_Access or else
Attr = Attribute_Unchecked_Access or else
Attr = Attribute_Unrestricted_Access)
- and then Expander_Active
+ and then Full_Expander_Active
and then Get_PCS_Name /= Name_No_DSA
then
Check_Subtype_Conformant
-- Why the Expander_Active test here ???
- if Expander_Active
+ if Full_Expander_Active
and then
(Ekind_In (T, E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
-- We must preserve the original entity in a generic setting, so that
-- the legality of the operation can be verified in an instance.
- if not Expander_Active then
+ if not Full_Expander_Active then
return;
end if;
-- transformation while analyzing generic units, as type information
-- would be lost when reanalyzing the constant node in the instance.
- if Is_Discrete_Type (Typ) and then Expander_Active then
+ if Is_Discrete_Type (Typ) and then Full_Expander_Active then
if Is_OK_Static_Expression (L) then
Fold_Uint (L, Expr_Value (L), Is_Static_Expression (L));
end if;
-- expression coincides with the target type.
if Ada_Version >= Ada_2005
- and then Expander_Active
+ and then Full_Expander_Active
and then Operand_Typ /= Target_Typ
then
declare
-- premature (e.g. if the slice is within a transient scope). This needs
-- to be done only if expansion is enabled.
- elsif Expander_Active then
+ elsif Full_Expander_Active then
Ensure_Defined (Typ => Slice_Subtype, N => N);
end if;
end Set_Slice_Subtype;
OSDN Git Service
