Commit a5b62485 by Arnaud Charlet

g-socket.ads (Get_Host_By_Address, [...]): Clarify documentation of the…

g-socket.ads (Get_Host_By_Address, [...]): Clarify documentation of the behaviour of these functions when...

	* g-socket.ads (Get_Host_By_Address, Get_Host_By_Name): Clarify
	documentation of the behaviour of these functions when passed an IP
	address that has no record in the system hosts database and no reverse
	record in the DNS.

	* cstand.adb, a-tags.ads: Fix typos in comment.

	* exp_ch2.adb, exp_ch3.adb, exp_ch5.adb, exp_ch8.adb,
	exp_ch9.adb, exp_pakd.adb, interfac.ads, sem_ch6.adb,
	sem_ch7.adb, sem_ch10.adb, sem_ch13.adb, sem_ch3.adb,
	s-poosiz.ads: Minor reformatting

	* make.adb: Minor reformatting
	Add some ??? comments asking for more comments

	* s-poosiz.adb: Minor reformatting
	Add comments on alignment requirement

	* sinfo.ads: Remove obsolete comment and fix typo.

	* gnat_ugn.texi: Update the section "The GNAT Driver and Project
	Files" with the new tool and package names.
	Reformatting to suppress most of the warnings for line too long
	Document the new section "Project Search Path:" in the output of
	gnatls -v.
	Add gnatmetric section

	* vms_data.ads: Correct GNAT METRIC qualifiers: -I-, -Idir and
	-gnatec= are not direct switches of gnatmetric. Changed -eis to -eps
	and -eit to -ept. Added qualifier
	/ELEMENT_METRICS=CONSTRUCT_NESTING_MAX for new switch -ec.

From-SVN: r91896
parent 4e8c0836
......@@ -60,11 +60,11 @@ private
---------------------------------------------------------------
-- GNAT's Dispatch Table format is customizable in order to match the
-- format used in another langauge. GNAT supports programs that use
-- two different dispatch table format at the same time: the native
-- format used in another language. GNAT supports programs that use
-- two different dispatch table formats at the same time: the native
-- format that supports Ada 95 tagged types and which is described in
-- Ada.Tags and a foreign format for types that are imported from some
-- other language (typically C++) which is described in interfaces.cpp.
-- Ada.Tags, and a foreign format for types that are imported from some
-- other language (typically C++) which is described in Interfaces.CPP.
-- The runtime information kept for each tagged type is separated into
-- two objects: the Dispatch Table and the Type Specific Data record.
-- These two objects are allocated statically using the constants:
......
......@@ -1045,7 +1045,7 @@ package body CStand is
Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
-- In standard 64-bit mode, the size is 64-bits and the delta and
-- amll values are set to nanoseconds (1.0**(10.0**(-9))
-- small values are set to nanoseconds (1.0**(10.0**(-9))
else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
......
......@@ -661,7 +661,7 @@ package body Exp_Ch2 is
Set_Etype (N, Etype (Prival (E)));
Scop := Current_Scope;
-- Find entity for protected operation, which must be on scope stack.
-- Find entity for protected operation, which must be on scope stack
while not Is_Protected_Type (Scope (Scop)) loop
Scop := Scope (Scop);
......
......@@ -640,7 +640,7 @@ package body Exp_Ch3 is
P : Node_Id;
begin
-- Nothing to do if there is no task hierarchy.
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
......@@ -686,7 +686,7 @@ package body Exp_Ch3 is
end loop;
end if;
-- Now define the renaming of the master_id.
-- Now define the renaming of the master_id
M_Id :=
Make_Defining_Identifier (Loc,
......@@ -1310,7 +1310,7 @@ package body Exp_Ch3 is
Decl : Node_Id;
begin
-- Nothing to do if there is no task hierarchy.
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
......@@ -2663,7 +2663,7 @@ package body Exp_Ch3 is
Expressions => New_List (New_Occurrence_Of (Rnn, Loc))))),
End_Label => Empty);
-- Build exit condition.
-- Build exit condition
declare
F_Ass : constant List_Id := New_List;
......@@ -3970,7 +3970,7 @@ package body Exp_Ch3 is
end loop;
end if;
-- Now build an array declaration.
-- Now build an array declaration
-- typA : array (Natural range 0 .. num - 1) of ctype :=
-- (v, v, v, v, v, ....)
......@@ -4081,7 +4081,7 @@ package body Exp_Ch3 is
if Enumeration_Rep (Ent) = Last_Repval then
-- Another special case: for a single literal, Pos is zero.
-- Another special case: for a single literal, Pos is zero
Pos_Expr := Make_Integer_Literal (Loc, Uint_0);
......@@ -4542,7 +4542,7 @@ package body Exp_Ch3 is
if RACW_Seen then
-- If there are RACWs designating this type, make stubs now.
-- If there are RACWs designating this type, make stubs now
Remote_Types_Tagged_Full_View_Encountered (Def_Id);
end if;
......@@ -4574,7 +4574,7 @@ package body Exp_Ch3 is
begin
if Scope (Old_C) = Base_Type (Def_Id) then
-- The entity is the one in the parent. Create new one.
-- The entity is the one in the parent. Create new one
New_C := New_Copy (Old_C);
Set_Parent (New_C, Parent (Old_C));
......
......@@ -387,7 +387,7 @@ package body Exp_Ch5 is
-- File.Storage := Contents;
-- end Write_All;
-- We expand to a loop in either of these two cases.
-- We expand to a loop in either of these two cases
-- Question for future thought. Another potentially more efficient
-- approach would be to create the actual subtype, and then do an
......@@ -1459,7 +1459,7 @@ package body Exp_Ch5 is
end if;
end loop;
-- Now we can insert and analyze the pre-assignment.
-- Now we can insert and analyze the pre-assignment
-- If the right-hand side requires a transient scope, it has
-- already been placed on the stack. However, the declaration is
......@@ -2480,7 +2480,7 @@ package body Exp_Ch5 is
Enumeration_Rep (First_Literal (Btype))),
Right_Opnd => New_Reference_To (New_Id, Loc)));
else
-- Use the constructed array Enum_Pos_To_Rep.
-- Use the constructed array Enum_Pos_To_Rep
Expr :=
Make_Indexed_Component (Loc,
......@@ -2667,7 +2667,7 @@ package body Exp_Ch5 is
if No (Exp) then
Kind := Ekind (Scope_Id);
-- If it is a return from procedures do no extra steps.
-- If it is a return from procedures do no extra steps
if Kind = E_Procedure or else Kind = E_Generic_Procedure then
return;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -182,7 +182,7 @@ package body Exp_Ch8 is
elsif K = N_Type_Conversion then
Evaluate_Name (Expression (Fname));
-- For a function call, we evaluate the call.
-- For a function call, we evaluate the call
elsif K = N_Function_Call then
Force_Evaluation (Fname);
......
......@@ -1347,7 +1347,7 @@ package body Exp_Pakd is
-- the "or ..." is omitted if rhs is constant and all 0 bits
-- rhs is converted to the appropriate type.
-- rhs is converted to the appropriate type
-- The result is converted back to the array type, since
-- otherwise we lose knowledge of the packed nature.
......@@ -1545,7 +1545,7 @@ package body Exp_Pakd is
-- Set_nn (Arr'address, Subscr, Bits_nn!(Rhs))
-- where Subscr is the computed linear subscript.
-- where Subscr is the computed linear subscript
declare
Bits_nn : constant Entity_Id := RTE (Bits_Id (Csiz));
......@@ -1556,7 +1556,7 @@ package body Exp_Pakd is
begin
if No (Bits_nn) then
-- Error, most likely High_Integrity_Mode restriction.
-- Error, most likely High_Integrity_Mode restriction
return;
end if;
......@@ -1774,7 +1774,7 @@ package body Exp_Pakd is
-- convert to the base type, since this would be unconstrained, and
-- hence not have a corresponding packed array type set.
-- Note that both operands must be modular for this code to be used.
-- Note that both operands must be modular for this code to be used
if Is_Modular_Integer_Type (PAT)
and then
......@@ -1916,7 +1916,7 @@ package body Exp_Pakd is
return;
end if;
-- Remaining processing is for the bit-packed case.
-- Remaining processing is for the bit-packed case
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
......@@ -1967,7 +1967,7 @@ package body Exp_Pakd is
-- Component_Type!(Get_nn (Arr'address, Subscr))
-- where Subscr is the computed linear subscript.
-- where Subscr is the computed linear subscript
declare
Get_nn : Entity_Id;
......
......@@ -502,12 +502,16 @@ package GNAT.Sockets is
function Get_Host_By_Address
(Address : Inet_Addr_Type;
Family : Family_Type := Family_Inet) return Host_Entry_Type;
-- Return host entry structure for the given inet address
-- Return host entry structure for the given Inet address.
-- Note that no result will be returned if there is no mapping of this
-- IP address to a host name in the system tables (host database,
-- DNS or otherwise).
function Get_Host_By_Name
(Name : String) return Host_Entry_Type;
-- Return host entry structure for the given host name. Here name
-- is either a host name, or an IP address.
-- is either a host name, or an IP address. If Name is an IP address,
-- this is equivalent to Get_Host_By_Address (Inet_Addr (Name)).
function Host_Name return String;
-- Return the name of the current host
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -69,103 +69,83 @@ pragma Pure (Interfaces);
function Shift_Left
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Right
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Right_Arithmetic
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Rotate_Left
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Rotate_Right
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Left
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Right
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Right_Arithmetic
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Rotate_Left
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Rotate_Right
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Left
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Right
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Right_Arithmetic
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Rotate_Left
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Rotate_Right
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Left
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Shift_Right
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Shift_Right_Arithmetic
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Rotate_Left
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Rotate_Right
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -153,8 +153,15 @@ package body System.Pool_Size is
----------------
procedure Initialize (Pool : in out Stack_Bounded_Pool) is
-- Define the appropriate alignment for allocations. This is the
-- maximum of the requested alignment, and the alignment required
-- for Storage_Count values. The latter test is to ensure that we
-- can properly reference the linked list pointers for free lists.
Align : constant SSE.Storage_Count :=
SSE.Storage_Count'Max (SSE.Storage_Count'Alignment, Pool.Alignment);
SSE.Storage_Count'Max
(SSE.Storage_Count'Alignment, Pool.Alignment);
begin
if Pool.Elmt_Size = 0 then
......@@ -165,7 +172,7 @@ package body System.Pool_Size is
Pool.First_Empty := 1;
-- Compute the size to allocate given the size of the element and
-- the possible Alignment clause
-- the possible alignment requirement as defined above.
Pool.Aligned_Elmt_Size :=
SSE.Storage_Count'Max (SC_Size,
......@@ -178,8 +185,7 @@ package body System.Pool_Size is
------------------
function Storage_Size
(Pool : Stack_Bounded_Pool)
return SSE.Storage_Count
(Pool : Stack_Bounded_Pool) return SSE.Storage_Count
is
begin
return Pool.Pool_Size;
......@@ -205,20 +211,17 @@ package body System.Pool_Size is
function Size
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count;
Chunk : SSE.Storage_Count) return SSE.Storage_Count;
-- Fetch the field 'size' of a chunk of available storage
function Next
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count;
Chunk : SSE.Storage_Count) return SSE.Storage_Count;
-- Fetch the field 'next' of a chunk of available storage
function Chunk_Of
(Pool : Stack_Bounded_Pool;
Addr : System.Address)
return SSE.Storage_Count;
Addr : System.Address) return SSE.Storage_Count;
-- Give the chunk number in the pool from its Address
--------------
......@@ -284,8 +287,7 @@ package body System.Pool_Size is
function Chunk_Of
(Pool : Stack_Bounded_Pool;
Addr : System.Address)
return SSE.Storage_Count
Addr : System.Address) return SSE.Storage_Count
is
begin
return 1 + abs (Addr - Pool.The_Pool (1)'Address);
......@@ -339,8 +341,7 @@ package body System.Pool_Size is
function Next
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count
Chunk : SSE.Storage_Count) return SSE.Storage_Count
is
begin
pragma Warnings (Off);
......@@ -397,8 +398,7 @@ package body System.Pool_Size is
function Size
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count
Chunk : SSE.Storage_Count) return SSE.Storage_Count
is
begin
pragma Warnings (Off);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992,1993,1994 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -66,8 +66,7 @@ pragma Elaborate_Body;
end record;
function Storage_Size
(Pool : Stack_Bounded_Pool)
return System.Storage_Elements.Storage_Count;
(Pool : Stack_Bounded_Pool) return System.Storage_Elements.Storage_Count;
procedure Allocate
(Pool : in out Stack_Bounded_Pool;
......
......@@ -178,7 +178,7 @@ package body Sem_Ch10 is
-- analysis (should it appear otherwise in the context).
procedure Remove_Context_Clauses (N : Node_Id);
-- Subsidiary of previous one. Remove use_ and with_clauses.
-- Subsidiary of previous one. Remove use_ and with_clauses
procedure Remove_Limited_With_Clause (N : Node_Id);
-- Remove from visibility the shadow entities introduced for a package
......@@ -337,7 +337,7 @@ package body Sem_Ch10 is
Semantics (Lib_Unit);
Check_Unused_Withs (Get_Cunit_Unit_Number (Lib_Unit));
-- Verify that the library unit is a package declaration.
-- Verify that the library unit is a package declaration
if Nkind (Unit (Lib_Unit)) /= N_Package_Declaration
and then
......@@ -476,7 +476,7 @@ package body Sem_Ch10 is
if Is_Child_Spec (Unit_Node) then
-- Set the entities of all parents in the program_unit_name.
-- Set the entities of all parents in the program_unit_name
Generate_Parent_References (
Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
......@@ -864,7 +864,7 @@ package body Sem_Ch10 is
Next (Item);
end loop;
-- Third pass: examine all limited_with clauses.
-- Third pass: examine all limited_with clauses
Item := First (Context_Items (N));
......@@ -878,7 +878,7 @@ package body Sem_Ch10 is
& " package specification", Item);
end if;
-- Skip analyzing with clause if no unit, see above.
-- Skip analyzing with clause if no unit, see above
if Present (Library_Unit (Item)) then
Analyze (Item);
......@@ -905,7 +905,7 @@ package body Sem_Ch10 is
Nam : Entity_Id;
begin
-- The package declaration must be in the current declarative part.
-- The package declaration must be in the current declarative part
Check_Stub_Level (N);
Nam := Current_Entity_In_Scope (Id);
......@@ -1197,7 +1197,7 @@ package body Sem_Ch10 is
begin
Check_Stub_Level (N);
-- First occurence of name may have been as an incomplete type.
-- First occurence of name may have been as an incomplete type
if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then
Nam := Full_View (Nam);
......@@ -1484,7 +1484,7 @@ package body Sem_Ch10 is
begin
if not Is_Empty_List (Context_Items (N)) then
-- Save current use clauses.
-- Save current use clauses
Remove_Scope;
Remove_Context (Lib_Unit);
......@@ -1539,7 +1539,7 @@ package body Sem_Ch10 is
Re_Install_Use_Clauses;
Install_Context (N);
-- Restore state of suppress flags for current body.
-- Restore state of suppress flags for current body
Scope_Suppress := Svg;
......@@ -1568,7 +1568,7 @@ package body Sem_Ch10 is
begin
Check_Stub_Level (N);
-- First occurence of name may have been as an incomplete type.
-- First occurence of name may have been as an incomplete type
if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then
Nam := Full_View (Nam);
......@@ -1831,7 +1831,7 @@ package body Sem_Ch10 is
and then Present (System_Extend_Unit)
and then Present_System_Aux (N)
then
-- If the extension is not present, an error will have been emitted.
-- If the extension is not present, an error will have been emitted
null;
end if;
......@@ -1859,7 +1859,7 @@ package body Sem_Ch10 is
Sel : Node_Id;
procedure Decorate_Tagged_Type (T : Entity_Id);
-- Set basic attributes of type, including its class_wide type.
-- Set basic attributes of type, including its class_wide type
function In_Chain (E : Entity_Id) return Boolean;
-- Check that the imported type is not already in the homonym chain,
......@@ -1884,7 +1884,7 @@ package body Sem_Ch10 is
Set_Current_Entity (T);
end if;
-- Build bogus class_wide type, if not previously done.
-- Build bogus class_wide type, if not previously done
if No (Class_Wide_Type (T)) then
CW := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
......@@ -1999,7 +1999,7 @@ package body Sem_Ch10 is
if Nkind (Parent (P)) = N_Defining_Program_Unit_Name then
-- Make parent packages visible.
-- Make parent packages visible
declare
Parent_Comp : Node_Id;
......@@ -2149,7 +2149,7 @@ package body Sem_Ch10 is
Lib_Unit : constant Node_Id := Unit (N);
procedure Check_Parent_Context (U : Node_Id);
-- Examine context items of parent unit to locate with_type clauses.
-- Examine context items of parent unit to locate with_type clauses
--------------------------
-- Check_Parent_Context --
......@@ -2532,7 +2532,7 @@ package body Sem_Ch10 is
Withn : Node_Id;
function Build_Ancestor_Name (P : Node_Id) return Node_Id;
-- Build prefix of child unit name. Recurse if needed.
-- Build prefix of child unit name. Recurse if needed
function Build_Unit_Name return Node_Id;
-- If the unit is a child unit, build qualified name with all
......@@ -2657,7 +2657,7 @@ package body Sem_Ch10 is
then
if Limited_Present (Item) then
-- Limited withed units will be installed later.
-- Limited withed units will be installed later
goto Continue;
......@@ -4167,7 +4167,7 @@ package body Sem_Ch10 is
Lib_Unit : constant Node_Id := Unit (N);
begin
-- If this is a child unit, first remove the parent units.
-- If this is a child unit, first remove the parent units
if Is_Child_Spec (Lib_Unit) then
Remove_Parents (Lib_Unit);
......@@ -4394,7 +4394,11 @@ package body Sem_Ch10 is
P : Entity_Id;
procedure Unchain (E : Entity_Id);
-- Remove entity from visibility list.
-- Remove entity from visibility list
-------------
-- Unchain --
-------------
procedure Unchain (E : Entity_Id) is
Prev : Entity_Id;
......@@ -4424,13 +4428,15 @@ package body Sem_Ch10 is
end if;
end Unchain;
-- Start of Remove_With_Type_Clause
-- Start of processing for Remove_With_Type_Clause
begin
if Nkind (Name) = N_Selected_Component then
Typ := Entity (Selector_Name (Name));
if No (Typ) then -- error in declaration.
-- If no Typ, then error in declaration, ignore
if No (Typ) then
return;
end if;
else
......@@ -4456,7 +4462,7 @@ package body Sem_Ch10 is
Set_From_With_Type (P, False);
-- If P is a child unit, remove parents as well.
-- If P is a child unit, remove parents as well
P := Scope (P);
......
......@@ -83,7 +83,7 @@ package body Sem_Ch13 is
-- operational attributes.
function Address_Aliased_Entity (N : Node_Id) return Entity_Id;
-- If expression N is of the form E'Address, return E.
-- If expression N is of the form E'Address, return E
procedure Mark_Aliased_Address_As_Volatile (N : Node_Id);
-- This is used for processing of an address representation clause. If
......@@ -2131,7 +2131,7 @@ package body Sem_Ch13 is
("component clause previously given#", CC);
else
-- Update Fbit and Lbit to the actual bit number.
-- Update Fbit and Lbit to the actual bit number
Fbit := Fbit + UI_From_Int (SSU) * Posit;
Lbit := Lbit + UI_From_Int (SSU) * Posit;
......@@ -2647,7 +2647,7 @@ package body Sem_Ch13 is
return;
end if;
-- Otherwise look at the identifier and see if it is OK.
-- Otherwise look at the identifier and see if it is OK
if Ekind (Ent) = E_Named_Integer
or else
......@@ -3206,7 +3206,7 @@ package body Sem_Ch13 is
raise Program_Error;
end if;
-- Fall through with Hi and Lo set. Deal with biased case.
-- Fall through with Hi and Lo set. Deal with biased case
if (Biased and then not Is_Fixed_Point_Type (T))
or else Has_Biased_Representation (T)
......
......@@ -129,15 +129,6 @@ package body Sem_Ch6 is
-- N is the N_Subprogram_Body node for a subprogram. This routine applies
-- the alpha ordering rule for N if this ordering requirement applicable.
function Is_Non_Overriding_Operation
(Prev_E : Entity_Id;
New_E : Entity_Id) return Boolean;
-- Enforce the rule given in 12.3(18): a private operation in an instance
-- overrides an inherited operation only if the corresponding operation
-- was overriding in the generic. This can happen for primitive operations
-- of types derived (in the generic unit) from formal private or formal
-- derived types.
procedure Check_Returns
(HSS : Node_Id;
Mode : Character;
......@@ -172,6 +163,15 @@ package body Sem_Ch6 is
-- sufficient: the formals must become the current entities for
-- their names.
function Is_Non_Overriding_Operation
(Prev_E : Entity_Id;
New_E : Entity_Id) return Boolean;
-- Enforce the rule given in 12.3(18): a private operation in an instance
-- overrides an inherited operation only if the corresponding operation
-- was overriding in the generic. This can happen for primitive operations
-- of types derived (in the generic unit) from formal private or formal
-- derived types.
procedure Make_Inequality_Operator (S : Entity_Id);
-- Create the declaration for an inequality operator that is implicitly
-- created by a user-defined equality operator that yields a boolean.
......
......@@ -92,7 +92,7 @@ package body Sem_Ch7 is
-- is an inner package.
function Is_Private_Base_Type (E : Entity_Id) return Boolean;
-- True for a private type that is not a subtype.
-- True for a private type that is not a subtype
function Is_Visible_Dependent (Dep : Entity_Id) return Boolean;
-- If the private dependent is a private type whose full view is
......@@ -288,7 +288,7 @@ package body Sem_Ch7 is
Append_Entity (Body_Id, Scope (Spec_Id));
end if;
-- Indicate that we are currently compiling the body of the package.
-- Indicate that we are currently compiling the body of the package
Set_In_Package_Body (Spec_Id);
Set_Has_Completion (Spec_Id);
......@@ -377,7 +377,7 @@ package body Sem_Ch7 is
End_Package_Scope (Spec_Id);
-- All entities declared in body are not visible.
-- All entities declared in body are not visible
declare
E : Entity_Id;
......@@ -877,7 +877,7 @@ package body Sem_Ch7 is
Analyze_Declarations (Vis_Decls);
end if;
-- Verify that incomplete types have received full declarations.
-- Verify that incomplete types have received full declarations
E := First_Entity (Id);
while Present (E) loop
......@@ -1485,7 +1485,7 @@ package body Sem_Ch7 is
Next_Entity (Id);
end loop;
-- Next make other declarations in the private part visible as well.
-- Next make other declarations in the private part visible as well
Id := First_Private_Entity (P);
......@@ -1669,7 +1669,7 @@ package body Sem_Ch7 is
-- that need to be available for the partial view also.
function Type_In_Use (T : Entity_Id) return Boolean;
-- Check whether type or base type appear in an active use_type clause.
-- Check whether type or base type appear in an active use_type clause
------------------------------
-- Preserve_Full_Attributes --
......@@ -1767,7 +1767,7 @@ package body Sem_Ch7 is
In_Use (P) and not Is_Hidden (Id));
end if;
-- Local entities are not immediately visible outside of the package.
-- Local entities are not immediately visible outside of the package
Set_Is_Immediately_Visible (Id, False);
......
......@@ -2159,7 +2159,7 @@ package Sinfo is
-- INTEGER_TYPE_DEFINITION ::=
-- SIGNED_INTEGER_TYPE_DEFINITION
-- MODULAR_TYPE_DEFINITION
-- | MODULAR_TYPE_DEFINITION
-------------------------------------------
-- 3.5.4 Signed Integer Type Definition --
......@@ -2168,17 +2168,17 @@ package Sinfo is
-- SIGNED_INTEGER_TYPE_DEFINITION ::=
-- range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
-- Note: the Low_Bound and High_Bound fields are set to Empty for
-- integer types defined in package Standard.
-- Note: the Low_Bound and High_Bound fields are set to Empty
-- for integer types defined in package Standard.
-- N_Signed_Integer_Type_Definition
-- Sloc points to RANGE
-- Low_Bound (Node1)
-- High_Bound (Node2)
-----------------------------------------
-- 3.5.4 Unsigned Range Specification --
-----------------------------------------
------------------------------------
-- 3.5.4 Modular Type Definition --
------------------------------------
-- MODULAR_TYPE_DEFINITION ::= mod static_EXPRESSION
......@@ -2236,9 +2236,6 @@ package Sinfo is
-- Note: In Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
-- Note: the Delta_Expression and Real_Range_Specification fields
-- are set to Empty for fixed point types declared in Standard.
-- N_Ordinary_Fixed_Point_Definition
-- Sloc points to DELTA
-- Delta_Expression (Node3)
......
......@@ -4051,22 +4051,6 @@ package VMS_Data is
-- Switches for GNAT METRIC --
------------------------------
S_Metric_Config : aliased constant S := "/CONFIGURATION_PRAGMAS_FILE=<" &
"-gnatec>";
-- /CONFIGURATION_PRAGMAS_FILE=file
--
-- Specify a configuration pragmas file that need to be taken into account
S_Metric_Current : aliased constant S := "/CURRENT_DIRECTORY " &
"!-I-";
-- /CURRENT_DIRECTORY (D)
--
-- Look for files in the directory where GNAT METRIC was invoked
--
-- /NOCURRENT_DIRECTORY
--
-- Do not look for files in the directory where GNAT METRIC was invoked
S_Metric_Debug : aliased constant S := "/DEBUG_OUTPUT " &
"-dv";
-- /DEBUG_OUTPUT
......@@ -4082,8 +4066,9 @@ package VMS_Data is
S_Metric_Element : aliased constant S := "/ELEMENT_METRICS=" &
"ALL " &
"!-ed,!-es,!-enl,!-eis," &
"!-eas,!-eit,!-eat,!-enu " &
"!-ed,!-es,!-enl,!-eps," &
"!-eas,!-ept,!-eat,!-enu," &
"!-ec " &
"DECLARATION_TOTAL " &
"-ed " &
"STATEMENT_TOTAL " &
......@@ -4091,15 +4076,17 @@ package VMS_Data is
"LOOP_NESTING_MAX " &
"-enl " &
"INT_SUBPROGRAMS " &
"-eis " &
"-eps " &
"SUBPROGRAMS_ALL " &
"-eas " &
"INT_TYPES " &
"-eit " &
"-ept " &
"TYPES_ALL " &
"-eat " &
"PROGRAM_NESTING_MAX " &
"-enu";
"-enu " &
"CONSTRUCT_NESTING_MAX " &
"-ec";
-- /ELEMENT_METRICS=(option, option ...)
--
-- Specifies the element metrics to be computed (if not set, all the
......@@ -4232,12 +4219,6 @@ package VMS_Data is
-- the number of program units left to be processed. This option turns
-- this trace off.
S_Metric_Search : aliased constant S := "/SEARCH=*" &
"-I*";
-- /SEARCH=(directory, ...)
--
-- When looking for source files also look in the specified directories.
S_Metric_Suffix : aliased constant S := "/SUFFIX_DETAILS=" & '"' &
"-o" & '"';
-- /SUFFIX_DETAILS=suffix
......@@ -4290,9 +4271,7 @@ package VMS_Data is
-- Place the XML output into the specified file
Metric_Switches : aliased constant Switches :=
(S_Metric_Config 'Access,
S_Metric_Current 'Access,
S_Metric_Debug 'Access,
(S_Metric_Debug 'Access,
S_Metric_Direct 'Access,
S_Metric_Element 'Access,
S_Metric_Ext 'Access,
......@@ -4303,7 +4282,6 @@ package VMS_Data is
S_Metric_Mess 'Access,
S_Metric_Project 'Access,
S_Metric_Quiet 'Access,
S_Metric_Search 'Access,
S_Metric_Suffix 'Access,
S_Metric_Suppress 'Access,
S_Metric_Verbose 'Access,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment