+2014-07-31 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch5.adb, sem_ch3.adb, exp_ch7.adb, exp_util.adb, exp_ch9.adb,
+ sem_ch7.adb, checks.adb, s-exctra.adb, exp_ch6.adb, exp_disp.adb,
+ exp_dist.adb, sem_ch13.adb, exp_strm.adb, exp_ch3.adb: Minor
+ reformatting.
+
2014-07-31 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb: Minor reformatting.
-- For an untagged derived type, use the discriminants of the parent
-- which have been renamed in the derivation, possibly by a one-to-many
- -- discriminant constraint. For non-tagged type, initially get the Etype
+ -- discriminant constraint. For untagged type, initially get the Etype
-- of the prefix
else
-- The resulting operation is a TSS subprogram.
procedure Build_Variant_Record_Equality (Typ : Entity_Id);
- -- Create An Equality function for the non-tagged variant record Typ
- -- and attach it to the TSS list
+ -- Create An Equality function for the untagged variant record Typ and
+ -- attach it to the TSS list
procedure Check_Stream_Attributes (Typ : Entity_Id);
-- Check that if a limited extension has a parent with user-defined stream
CL : Node_Id;
Discrs : Elist_Id := New_Elmt_List) return List_Id;
-- Building block for variant record equality. Defined to share the code
- -- between the tagged and non-tagged case. Given a Component_List node CL,
+ -- between the tagged and untagged case. Given a Component_List node CL,
-- it generates an 'if' followed by a 'case' statement that compares all
-- components of local temporaries named X and Y (that are declared as
-- formals at some upper level). E provides the Sloc to be used for the
(E : Entity_Id;
L : List_Id) return Node_Id;
-- Building block for variant record equality. Defined to share the code
- -- between the tagged and non-tagged case. Given the list of components
+ -- between the tagged and untagged case. Given the list of components
-- (or discriminants) L, it generates a return statement that compares all
-- components of local temporaries named X and Y (that are declared as
-- formals at some upper level). E provides the Sloc to be used for the
-- objects on list Decls.
function Build_Init_Call_Thru (Parameters : List_Id) return List_Id;
- -- Given a non-tagged type-derivation that declares discriminants,
- -- such as
+ -- Given a untagged type-derivation that declares discriminants, e.g.
--
- -- type R (R1, R2 : Integer) is record ... end record;
- --
- -- type D (D1 : Integer) is new R (1, D1);
+ -- type R (R1, R2 : Integer) is record ... end record;
+ -- type D (D1 : Integer) is new R (1, D1);
--
-- we make the _init_proc of D be
--
-- Handle C++ constructor calls. Note that we do not check that
-- Typ is a tagged type since the equivalent Ada type of a C++
- -- class that has no virtual methods is a non-tagged limited
+ -- class that has no virtual methods is a untagged limited
-- record type.
elsif Is_CPP_Constructor_Call (Expr) then
Next_Component (Comp);
end loop;
- -- Handle constructors of non-tagged CPP_Class types
+ -- Handle constructors of untagged CPP_Class types
if not Is_Tagged_Type (Def_Id) and then Is_CPP_Class (Def_Id) then
Set_CPP_Constructors (Def_Id);
end if;
end if;
- -- In the non-tagged case, ever since Ada 83 an equality function must
+ -- In the untagged case, ever since Ada 83 an equality function must
-- be provided for variant records that are not unchecked unions.
-- In Ada 2012 the equality function composes, and thus must be built
-- explicitly just as for tagged records.
-- using the standard Insert_Actions mechanism.
procedure Expand_Assign_Record (N : Node_Id);
- -- N is an assignment of a non-tagged record value. This routine handles
+ -- N is an assignment of a untagged record value. This routine handles
-- the case where the assignment must be made component by component,
-- either because the target is not byte aligned, or there is a change
-- of representation, or when we have a tagged type with a representation
-- entity and Orig_Subp is the entity of the call node N.
function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
- -- Within an instance, a type derived from a non-tagged formal derived
+ -- Within an instance, a type derived from an untagged formal derived
-- type inherits from the original parent, not from the actual. The
-- current derivation mechanism has the derived type inherit from the
-- actual, which is only correct outside of the instance. If the
Utyp := Underlying_Type (Base_Type (Utyp));
Set_Assignment_OK (Ref);
- -- Deal with non-tagged derivation of private views
+ -- Deal with untagged derivation of private views
if Is_Untagged_Derivation (Typ) then
Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
Utyp := Underlying_Type (Base_Type (Utyp));
Set_Assignment_OK (Ref);
- -- Deal with non-tagged derivation of private views. If the parent type
+ -- Deal with untagged derivation of private views. If the parent type
-- is a protected type, Deep_Finalize is found on the corresponding
-- record of the ancestor.
Utyp := Underlying_Type (Base_Type (Utyp));
- -- Deal with non-tagged derivation of private views
+ -- Deal with untagged derivation of private views
if Is_Untagged_Derivation (Typ) and then not Is_Conc then
Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
Utyp := Underlying_Type (Base_Type (Utyp));
- -- Deal with non-tagged derivation of private views. If the parent is
+ -- Deal with untagged derivation of private views. If the parent is
-- now known to be protected, the finalization routine is the one
-- defined on the corresponding record of the ancestor (corresponding
-- records do not automatically inherit operations, but maybe they
-- Start of processing for Build_Wrapper_Spec
begin
- -- There is no point in building wrappers for non-tagged concurrent
- -- types.
+ -- No point in building wrappers for untagged concurrent types
pragma Assert (Is_Tagged_Type (Obj_Typ));
(Subp : Entity_Id;
Tagged_Type : Entity_Id;
Typ : Entity_Id);
- -- Verify that all non-tagged types in the profile of a subprogram
- -- are frozen at the point the subprogram is frozen. This enforces
- -- the rule on RM 13.14 (14) as modified by AI05-019. At the point a
- -- subprogram is frozen, enough must be known about it to build the
- -- activation record for it, which requires at least that the size of
- -- all parameters be known. Controlling arguments are by-reference,
- -- and therefore the rule only applies to non-tagged types.
- -- Typical violation of the rule involves an object declaration that
- -- freezes a tagged type, when one of its primitive operations has a
- -- type in its profile whose full view has not been analyzed yet.
- -- More complex cases involve composite types that have one private
- -- unfrozen subcomponent.
+ -- Verify that all untagged types in the profile of a subprogram are
+ -- frozen at the point the subprogram is frozen. This enforces the rule
+ -- on RM 13.14 (14) as modified by AI05-019. At the point a subprogram
+ -- is frozen, enough must be known about it to build the activation
+ -- record for it, which requires at least that the size of all
+ -- parameters be known. Controlling arguments are by-reference,
+ -- and therefore the rule only applies to non-tagged types. Typical
+ -- violation of the rule involves an object declaration that freezes a
+ -- tagged type, when one of its primitive operations has a type in its
+ -- profile whose full view has not been analyzed yet. More complex cases
+ -- involve composite types that have one private unfrozen subcomponent.
procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0);
-- Export the dispatch table DT of tagged type Typ. Required to generate
Make_Defining_Identifier (Loc,
Chars => Make_Init_Proc_Name (Typ));
- -- Case 1: Constructor of non-tagged type
+ -- Case 1: Constructor of untagged type
-- If the C++ class has no virtual methods then the matching Ada
- -- type is a non-tagged record type. In such case there is no need
+ -- type is an untagged record type. In such case there is no need
-- to generate a wrapper of the C++ constructor because the _tag
-- component is not available.
elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
- -- Non-tagged derived type: convert to root type
+ -- Untagged derived type: convert to root type
declare
Rt_Type : constant Entity_Id := Root_Type (Typ);
elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then
- -- Non-tagged record type
+ -- Untagged record type
if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
declare
-- return V;
-- end typSI[_nnn]
- -- Note: the suffix [_nnn] is present for non-tagged types, where we
- -- generate a local subprogram at the point of the occurrence of the
- -- attribute reference, so the name must be unique.
+ -- Note: the suffix [_nnn] is present for untagged types, where we generate
+ -- a local subprogram at the point of the occurrence of the attribute
+ -- reference, so the name must be unique.
procedure Build_Array_Input_Function
(Loc : Source_Ptr;
Utyp := Underlying_Type (Base_Type (Utyp));
- -- Deal with non-tagged derivation of private views. If the parent is
+ -- Deal with untagged derivation of private views. If the parent is
-- now known to be protected, the finalization routine is the one
-- defined on the corresponding record of the ancestor (corresponding
-- records do not automatically inherit operations, but maybe they
-- --
------------------------------------------------------------------------------
+with Ada.Unchecked_Conversion;
+
with System.Standard_Library; use System.Standard_Library;
with System.Soft_Links; use System.Soft_Links;
(Traceback : System.Address;
Len : Natural) return String
is
- Decorator_Traceback : Traceback_Entries.Tracebacks_Array (1 .. Len);
- for Decorator_Traceback'Address use Traceback;
+ -- Note: do not use an address clause, which is not supported under .NET
+
+ subtype Trace_Array is Traceback_Entries.Tracebacks_Array (1 .. Len);
+ type Trace_Array_Access is access all Trace_Array;
- -- Handle the "transition" from the array stored in the exception
- -- occurrence to the array expected by the decorator.
+ function To_Trace_Array is new
+ Ada.Unchecked_Conversion (Address, Trace_Array_Access);
- pragma Import (Ada, Decorator_Traceback);
+ Decorator_Traceback : constant Trace_Array_Access :=
+ To_Trace_Array (Traceback);
begin
- return Current_Decorator.all (Decorator_Traceback);
+ return Current_Decorator.all (Decorator_Traceback.all);
end Decorator_Wrapper;
-------------------------
Nam : TSS_Name_Type);
-- Create a subprogram renaming of a given stream attribute to the
-- designated subprogram and then in the tagged case, provide this as a
- -- primitive operation, or in the non-tagged case make an appropriate TSS
+ -- primitive operation, or in the untagged case make an appropriate TSS
-- entry. This is more properly an expansion activity than just semantics,
- -- but the presence of user-defined stream functions for limited types is a
- -- legality check, which is why this takes place here rather than in
+ -- but the presence of user-defined stream functions for limited types
+ -- is a legality check, which is why this takes place here rather than in
-- exp_ch13, where it was previously. Nam indicates the name of the TSS
-- function to be generated.
--
return True;
- -- Check for case of non-tagged derived type whose parent either has
+ -- Check for case of untagged derived type whose parent either has
-- primitive operations, or is a by reference type (RM 13.1(10)). In
-- this case we do not output a Too_Late message, since there is no
-- earlier point where the rep item could be placed to make it legal.
or else Null_Present (Component_List (Def))
then
if not Is_Tagged_Type (T) then
- Check_SPARK_Restriction ("non-tagged record cannot be null", Def);
+ Check_SPARK_Restriction ("untagged record cannot be null", Def);
end if;
else
end if;
else
- -- Non-tagged type, scan forward to locate inherited hidden
+ -- For untagged type, scan forward to locate inherited hidden
-- operations.
Prim_Op := Next_Entity (E);
projects / thirdparty / gcc.git / commitdiff
