procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

a-teioed.adb, [...]: Minor reformatting

Browse source 
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

From-SVN: r150251
This commit is contained in:
Robert Dewar 2009-07-30 09:23:06 +00:00 • committed by Arnaud Charlet
parent 08dab97a61
commit 16c5f1c624
11 changed files with 81 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/ada/ChangeLog
View file

@ -1,3 +1,9 @@
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

10
gcc/ada/a-teioed.adb
View file

@ -71,16 +71,16 @@ package body Ada.Text_IO.Editing is
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;

14
gcc/ada/exp_disp.adb
View file

@ -6915,13 +6915,12 @@ package body Exp_Disp is
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;
@ -6931,7 +6930,8 @@ package body Exp_Disp is
-- 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;

2
gcc/ada/s-linux-hppa.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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- --

2
gcc/ada/s-linux.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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- --

7
gcc/ada/s-tasini.adb
View file

@ -190,13 +190,14 @@ package body System.Tasking.Initialization is
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;

5
gcc/ada/sem_ch13.adb
View file

@ -2202,6 +2202,11 @@ package body Sem_Ch13 is
-- 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);

30
gcc/ada/sem_ch3.adb
View file

@ -753,6 +753,7 @@ package body Sem_Ch3 is
-- 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
@ -1532,11 +1533,10 @@ package body Sem_Ch3 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));
@ -1572,19 +1572,19 @@ package body Sem_Ch3 is
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;

53
gcc/ada/sem_ch3.ads
View file

@ -100,23 +100,22 @@ package Sem_Ch3 is
-- 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;
@ -143,8 +142,8 @@ package Sem_Ch3 is
-- 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;
@ -167,8 +166,8 @@ package Sem_Ch3 is
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
@ -237,7 +236,7 @@ package Sem_Ch3 is
-- 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.
@ -248,16 +247,16 @@ package Sem_Ch3 is
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;

19
gcc/ada/sem_ch6.adb
View file

@ -4496,25 +4496,26 @@ package body Sem_Ch6 is
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
@ -4535,7 +4536,7 @@ package body Sem_Ch6 is
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);

2
gcc/ada/sem_ch7.adb
View file

@ -1912,7 +1912,7 @@ package body Sem_Ch7 is
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);