+2009-07-30 Robert Dewar <dewar@adacore.com>
+
+ * a-teioed.adb, exp_disp.adb, s-linux-hppa.ads, s-linux.ads,
+ s-tasini.adb, sem_ch13.adb, sem_ch3.adb, sem_ch3.ads, sem_ch6.adb,
+ sem_ch7.adb: Minor reformatting
+
2009-07-29 Javier Miranda <miranda@adacore.com>
* sem_ch3.ads, sem_ch3.adb (Add_Internal_Interface_Entities): Routine
case Picture (Picture_Index) is
when '(' =>
- Int_IO.Get (Picture (Picture_Index + 1 .. Picture'Last),
- Count, Last);
+ Int_IO.Get
+ (Picture (Picture_Index + 1 .. Picture'Last), Count, Last);
if Picture (Last + 1) /= ')' then
raise Picture_Error;
end if;
- -- In what follows note that one copy of the repeated
- -- character has already been made, so a count of one is a
- -- no-op, and a count of zero erases a character.
+ -- In what follows note that one copy of the repeated character
+ -- has already been made, so a count of one is a no-op, and a
+ -- count of zero erases a character.
if Result_Index + Count - 2 > Result'Last then
raise Picture_Error;
begin
pragma Assert (Present (First_Tag_Component (Typ)));
- -- Set the DT_Position for each primitive operation. Perform some
- -- sanity checks to avoid to build completely inconsistent dispatch
- -- tables.
+ -- Set the DT_Position for each primitive operation. Perform some sanity
+ -- checks to avoid building inconsistent dispatch tables.
- -- First stage: Set the DTC entity of all the primitive operations
- -- This is required to properly read the DT_Position attribute in
- -- the latter stages.
+ -- First stage: Set the DTC entity of all the primitive operations. This
+ -- is required to properly read the DT_Position attribute in the latter
+ -- stages.
Prim_Elmt := First_Prim;
Count_Prim := 0;
-- Predefined primitives have a separate dispatch table
if not (Is_Predefined_Dispatching_Operation (Prim)
- or else Is_Predefined_Dispatching_Alias (Prim))
+ or else
+ Is_Predefined_Dispatching_Alias (Prim))
then
Count_Prim := Count_Prim + 1;
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2009, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
-- S p e c --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2009, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
return;
end if;
+ -- The following assertion is by default disabled. See the comment in
+ -- Defer_Abort on the situations in which it may be useful to uncomment
+ -- this assertion and enable the test.
+
-- pragma Assert
-- (Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else
-- Self_ID.Deferral_Level > 0);
- -- See comment in Defer_Abort on the situations in which it may be
- -- useful to uncomment the above assertion.
-
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
end Defer_Abort_Nestable;
-- Analyze_Freeze_Entity --
---------------------------
+ -- This does not belong in sem_ch13, and I don't like the big new
+ -- dependency on sem_ch3, I would in fact move this to sem_ch3 or
+ -- somewhere else, and then Add_Internal_Interface_Entitites can be
+ -- private to sem_ch3.adb. ???
+
procedure Analyze_Freeze_Entity (N : Node_Id) is
E : constant Entity_Id := Entity (N);
-- is associated with one of the protected operations, and must
-- be available in the scope that encloses the protected declaration.
-- Otherwise the type is in the scope enclosing the subprogram.
+
-- If the function has formals, The return type of a subprogram
-- declaration is analyzed in the scope of the subprogram (see
-- Process_Formals) and thus the protected type, if present, is
while Present (Iface_Elmt) loop
Iface := Node (Iface_Elmt);
- -- Exclude from this processing interfaces that are parents
- -- of Tagged_Type because their primitives are located in the
- -- primary dispatch table (and hence no auxiliary internal
- -- entities are required to handle secondary dispatch tables
- -- in such case).
+ -- Exclude from this processing interfaces that are parents of
+ -- Tagged_Type because their primitives are located in the primary
+ -- dispatch table (and hence no auxiliary internal entities are
+ -- required to handle secondary dispatch tables in such case).
if not Is_Ancestor (Iface, Tagged_Type) then
Elmt := First_Elmt (Primitive_Operations (Iface));
Set_Interface_Alias (New_Subp, Iface_Prim);
-- Internal entities associated with interface types are
- -- only registered in the list of primitives of the
- -- tagged type. They are only used to fill the contents
- -- of the secondary dispatch tables. Therefore they are
- -- not needed in the homonym chains.
+ -- only registered in the list of primitives of the tagged
+ -- type. They are only used to fill the contents of the
+ -- secondary dispatch tables. Therefore they are not needed
+ -- in the homonym chains.
Remove_Homonym (New_Subp);
- -- Hidden entities associated with interfaces must have
- -- set the Has_Delay_Freeze attribute to ensure that, in
- -- case of locally defined tagged types (or compiling
- -- with static dispatch tables generation disabled) the
- -- corresponding entry of the secondary dispatch table is
- -- filled when such entity is frozen.
+ -- Hidden entities associated with interfaces must have set
+ -- the Has_Delay_Freeze attribute to ensure that, in case of
+ -- locally defined tagged types (or compiling with static
+ -- dispatch tables generation disabled) the corresponding
+ -- entry of the secondary dispatch table is filled when
+ -- such an entity is frozen.
Set_Has_Delayed_Freeze (New_Subp);
end if;
-- Could both mechanisms be merged ???
procedure Check_Abstract_Overriding (T : Entity_Id);
- -- Check that all abstract subprograms inherited from T's parent type
- -- have been overridden as required, and that nonabstract subprograms
- -- have not been incorrectly overridden with an abstract subprogram.
+ -- Check that all abstract subprograms inherited from T's parent type have
+ -- been overridden as required, and that nonabstract subprograms have not
+ -- been incorrectly overridden with an abstract subprogram.
procedure Check_Aliased_Component_Types (T : Entity_Id);
-- Given an array type or record type T, check that if the type is
- -- nonlimited, then the nominal subtype of any components of T
- -- that have discriminants must be constrained.
+ -- nonlimited, then the nominal subtype of any components of T that
+ -- have discriminants must be constrained.
procedure Check_Completion (Body_Id : Node_Id := Empty);
- -- At the end of a declarative part, verify that all entities that
- -- require completion have received one. If Body_Id is absent, the
- -- error indicating a missing completion is placed on the declaration
- -- that needs completion. If Body_Id is present, it is the defining
- -- identifier of a package body, and errors are posted on that node,
- -- rather than on the declarations that require completion in the package
- -- declaration.
+ -- At the end of a declarative part, verify that all entities that require
+ -- completion have received one. If Body_Id is absent, the error indicating
+ -- a missing completion is placed on the declaration that needs completion.
+ -- If Body_Id is present, it is the defining identifier of a package body,
+ -- and errors are posted on that node, rather than on the declarations that
+ -- require completion in the package declaration.
procedure Derive_Subprogram
(New_Subp : in out Entity_Id;
-- the derived subprograms are aliased to those of the actual, not those of
-- the ancestor.
--
- -- Note: one might expect this to be private to the package body, but
- -- there is one rather unusual usage in package Exp_Dist.
+ -- Note: one might expect this to be private to the package body, but there
+ -- is one rather unusual usage in package Exp_Dist.
function Find_Hidden_Interface
(Src : Elist_Id;
Typ_For_Constraint : Entity_Id;
Constraint : Elist_Id) return Node_Id;
-- ??? MORE DOCUMENTATION
- -- Given a discriminant somewhere in the Typ_For_Constraint tree
- -- and a Constraint, return the value of that discriminant.
+ -- Given a discriminant somewhere in the Typ_For_Constraint tree and a
+ -- Constraint, return the value of that discriminant.
function Is_Null_Extension (T : Entity_Id) return Boolean;
-- Returns True if the tagged type T has an N_Full_Type_Declaration that
-- of the dependant private subtypes. The second action is to recopy the
-- primitive operations of the private view (in the tagged case).
-- N is the N_Full_Type_Declaration node.
-
+ --
-- Full_T is the full view of the type whose full declaration is in N.
--
-- Priv_T is the private view of the type whose full declaration is in N.
Check_List : List_Id := Empty_List;
R_Check_Off : Boolean := False);
-- Process a range expression that appears in a declaration context. The
- -- range is analyzed and resolved with the base type of the given type,
- -- and an appropriate check for expressions in non-static contexts made
- -- on the bounds. R is analyzed and resolved using T, so the caller should
- -- if necessary link R into the tree before the call, and in particular in
- -- the case of a subtype declaration, it is appropriate to set the parent
- -- pointer of R so that the types get properly frozen. The Check_List
- -- parameter is used when the subprogram is called from
- -- Build_Record_Init_Proc and is used to return a set of constraint
- -- checking statements generated by the Checks package. R_Check_Off is set
- -- to True when the call to Range_Check is to be skipped.
+ -- range is analyzed and resolved with the base type of the given type, and
+ -- an appropriate check for expressions in non-static contexts made on the
+ -- bounds. R is analyzed and resolved using T, so the caller should if
+ -- necessary link R into the tree before the call, and in particular in the
+ -- case of a subtype declaration, it is appropriate to set the parent
+ -- pointer of R so that the types get properly frozen. Check_List is used
+ -- when the subprogram is called from Build_Record_Init_Proc and is used to
+ -- return a set of constraint checking statements generated by the Checks
+ -- package. R_Check_Off is set to True when the call to Range_Check is to
+ -- be skipped.
function Process_Subtype
(S : Node_Id;
elsif Nkind (Subp) = N_Defining_Operator_Symbol then
declare
- Typ : constant Entity_Id :=
- Base_Type (Etype (First_Formal (Subp)));
+ Typ : constant Entity_Id :=
+ Base_Type (Etype (First_Formal (Subp)));
+
Can_Override : constant Boolean :=
- Operator_Matches_Spec (Subp, Subp)
- and then Scope (Subp) = Scope (Typ)
- and then not Is_Class_Wide_Type (Typ);
+ Operator_Matches_Spec (Subp, Subp)
+ and then Scope (Subp) = Scope (Typ)
+ and then not Is_Class_Wide_Type (Typ);
begin
if Must_Not_Override (Spec) then
- -- If this is not a primitive or a protected subprogram,
- -- then "not overriding" is illegal.
+ -- If this is not a primitive or a protected subprogram, then
+ -- "not overriding" is illegal.
if not Is_Primitive
and then Ekind (Scope (Subp)) /= E_Protected_Type
then
Error_Msg_N
("overriding indicator only allowed "
- & "if subprogram is primitive", Subp);
+ & "if subprogram is primitive", Subp);
elsif Can_Override then
Error_Msg_NE
and then Can_Override
and then
not Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Subp)))
+ (Unit_File_Name (Get_Source_Unit (Subp)))
then
Set_Is_Overriding_Operation (Subp);
Set_Is_Limited_Record (Id, Limited_Present (Def));
Set_Has_Delayed_Freeze (Id, True);
- -- Create a class-wide type with the same attributes.
+ -- Create a class-wide type with the same attributes
Make_Class_Wide_Type (Id);
projects / platform / upstream / gcc.git / commitdiff