---------------------------------------------------------------
-- 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:
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));
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);
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;
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,
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;
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;
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, ....)
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);
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;
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));
-- 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
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
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,
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;
-- --
-- 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- --
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);
S : Node_Id;
function Actual_Family_Offset (Hi, Lo : Node_Id) return Node_Id;
- -- Compute difference between bounds of entry family.
+ -- Compute difference between bounds of entry family
--------------------------
-- Actual_Family_Offset --
-- designated one, to which is added the index expression, if this
-- expression denotes a member of a family.
- -- The following is a place holder for the count of simple entries.
+ -- The following is a place holder for the count of simple entries
Num := Make_Integer_Literal (Sloc, 1);
Expr := Num;
end if;
- -- Now add lengths of preceding entries and entry families.
+ -- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp);
Right_Opnd =>
Make_Integer_Literal (Sloc, 1)));
- -- Other components are anonymous types to be ignored.
+ -- Other components are anonymous types to be ignored
else
null;
Siz : Node_Id := Empty;
procedure Add_If_Clause (Expr : Node_Id);
- -- Add test for range of current entry.
+ -- Add test for range of current entry
function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
-- If a bound of an entry is given by a discriminant, retrieve the
Expression => Make_Integer_Literal (Loc, Index + 1)));
begin
- -- Index for current entry body.
+ -- Index for current entry body
Index := Index + 1;
- -- Compute total length of entry queues so far.
+ -- Compute total length of entry queues so far
if No (Siz) then
Siz := Expr;
Parameter_Associations => Uactuals);
end if;
- -- Wrap call in block that will be covered by an at_end handler.
+ -- Wrap call in block that will be covered by an at_end handler
if not Exc_Safe then
Unprot_Call := Make_Block_Statement (Loc,
Conctyp := Designated_Type (Conctyp);
end if;
- -- Special case for protected subprogram calls.
+ -- Special case for protected subprogram calls
if Is_Protected_Type (Conctyp)
and then Is_Subprogram (Entity (Ename))
-- objectV!(name)._Object
- -- for a protected object.
-
- -- For the case of an access to a concurrent object,
- -- there is an extra explicit dereference:
+ -- for a protected object. For the case of an access to a concurrent
+ -- object, there is an extra explicit dereference:
-- taskV!(name.all)._Task_Id
-- objectV!(name.all)._Object
-- designated one, to which is added the index expression, if this
-- expression denotes a member of a family.
- -- The following is a place holder for the count of simple entries.
+ -- The following is a place holder for the count of simple entries
Num := Make_Integer_Literal (Sloc, 1);
Expr := Num;
end if;
- -- Now add lengths of preceding entries and entry families.
+ -- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp);
Left_Opnd => Expr,
Right_Opnd => Family_Size (Sloc, Hi, Lo, Ttyp));
- -- Other components are anonymous types to be ignored.
+ -- Other components are anonymous types to be ignored
else
null;
pragma Assert (Nkind (Acc_Alt) = N_Accept_Alternative);
pragma Assert (Nkind (Sel_Acc) = N_Selective_Accept);
- -- ??? Consider a single label for select statements.
+ -- ??? Consider a single label for select statements
if Present (Handled_Statement_Sequence (N)) then
Prepend (Ldecl2,
Def1 : Node_Id;
begin
- -- Create access to protected subprogram with full signature.
+ -- Create access to protected subprogram with full signature
if Nkind (Type_Definition (N)) = N_Access_Function_Definition then
Def1 :=
-- Expand_N_Asynchronous_Select --
----------------------------------
- -- This procedure assumes that the trigger statement is an entry
- -- call. A delay alternative should already have been expanded
- -- into an entry call to the appropriate delay object Wait entry.
+ -- This procedure assumes that the trigger statement is an entry call. A
+ -- delay alternative should already have been expanded into an entry call
+ -- to the appropriate delay object Wait entry.
- -- If the trigger is a task entry call, the select is implemented
- -- with Task_Entry_Call:
+ -- If the trigger is a task entry call, the select is implemented with
+ -- a Task_Entry_Call:
-- declare
-- B : Boolean;
-- C : Boolean;
-- P : parms := (parm, parm, parm);
- -- -- Clean is added by Exp_Ch7.Expand_Cleanup_Actions.
+ -- -- Clean is added by Exp_Ch7.Expand_Cleanup_Actions
-- procedure _clean is
-- begin
-- ...
-- end;
- -- The job is to convert this to the asynchronous form.
+ -- The job is to convert this to the asynchronous form
- -- If the trigger is a delay statement, it will have been expanded
- -- into a call to one of the GNARL delay procedures. This routine
- -- will convert this into a protected entry call on a delay object
- -- and then continue processing as for a protected entry call trigger.
- -- This requires declaring a Delay_Block object and adding a pointer
- -- to this object to the parameter list of the delay procedure to form
- -- the parameter list of the entry call. This object is used by
- -- the runtime to queue the delay request.
+ -- If the trigger is a delay statement, it will have been expanded into a
+ -- call to one of the GNARL delay procedures. This routine will convert
+ -- this into a protected entry call on a delay object and then continue
+ -- processing as for a protected entry call trigger. This requires
+ -- declaring a Delay_Block object and adding a pointer to this object to
+ -- the parameter list of the delay procedure to form the parameter list of
+ -- the entry call. This object is used by the runtime to queue the delay
+ -- request.
-- For a description of the use of P and the assignments after the
-- call, see Expand_N_Entry_Call_Statement.
Prefix => New_Reference_To (Dblock_Ent, Loc),
Attribute_Name => Name_Unchecked_Access));
- -- Create the inner block to protect the abortable part.
+ -- Create the inner block to protect the abortable part
Hdle := New_List (
Make_Exception_Handler (Loc,
Defining_Identifier => Cancel_Param,
Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
- -- Remove and save the call to Call_Simple.
+ -- Remove and save the call to Call_Simple
Stmt := First (Stmts);
Call := Stmt;
- -- Create the inner block to protect the abortable part.
+ -- Create the inner block to protect the abortable part
Hdle := New_List (
Make_Exception_Handler (Loc,
Index_Decl : List_Id;
begin
- -- Add the renamings for private declarations and discriminants.
+ -- Add the renamings for private declarations and discriminants
Add_Discriminal_Declarations
(Declarations (N), Defining_Identifier (Dec), Name_uObject, Loc);
when N_Subprogram_Body =>
- -- Exclude functions created to analyze defaults.
+ -- Exclude functions created to analyze defaults
if not Is_Eliminated (Defining_Entity (Op_Body))
and then not Is_Eliminated (Corresponding_Spec (Op_Body))
-- <some more of the statement sequence for entry>
- -- -- Requeue from an entry body to a task entry.
+ -- -- Requeue from an entry body to a task entry
-- Requeue_Protected_To_Task_Entry (
-- New._task_id,
-- end;
-- end entE;
- -- Requeue of a task entry call to a task entry.
+ -- Requeue of a task entry call to a task entry
-- Accept_Call (E, Ann);
-- <start of statement sequence for accept statement>
-- when all others =>
-- Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
- -- Requeue of a task entry call to a protected entry.
+ -- Requeue of a task entry call to a protected entry
-- Accept_Call (E, Ann);
-- <start of statement sequence for accept statement>
-- statements of an accept or delay alternative.
function Make_Select_Call (Select_Mode : Entity_Id) return Node_Id;
- -- Build call to Selective_Wait runtime routine.
+ -- Build call to Selective_Wait runtime routine
procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int);
-- Add code to compare value of delay with previous values, and
if No (Alt_Stats) then
- -- Accept with no body, followed by trailing statements.
+ -- Accept with no body, followed by trailing statements
Choices := New_List (
Make_Integer_Literal (Loc, Index));
Adjust_Condition (Condition (Alt));
- -- Determine the smallest specified delay.
+ -- Determine the smallest specified delay
+
-- for each delay alternative generate:
-- if guard-expression then
-- end if;
-- end if;
- -- The enclosing if-statement is omitted if there is no guard.
+ -- The enclosing if-statement is omitted if there is no guard
if Delay_Count = 1
or else First_Delay
if No (Condition (Alt)) then
- -- This guard will always be open.
+ -- This guard will always be open
Check_Guard := False;
end if;
Append (X, Decls);
- -- After this follow procedure declarations for each accept body.
+ -- After this follow procedure declarations for each accept body
-- procedure Pnn is
-- begin
-- build them unconditionally, and not significantly inefficient,
-- since if they are short they will be inlined anyway.
- -- The procedure declarations have been assembled in Body_List.
+ -- The procedure declarations have been assembled in Body_List
-- If delays are present, we must compute the required delay.
-- We first generate the declarations:
-- Delay_Val : Some_Time_Type.Time;
-- Delay_Index will be set to the index of the minimum delay, i.e. the
- -- active delay that is actually chosen as the basis for the possible
- -- delay if an immediate rendez-vous is not possible.
- -- In the most common case there is a single delay statement, and this
- -- is handled specially.
+ -- active delay that is actually chosen as the basis for the possible
+ -- delay if an immediate rendez-vous is not possible.
+
+ -- In the most common case there is a single delay statement, and this
+ -- is handled specially.
if Delay_Count > 0 then
-- ...
-- Exit:
- -- Generate label for common exit.
+ -- Generate label for common exit
End_Lab := Make_And_Declare_Label (Num_Alts + 1);
- -- First entry is the default case, when no rendezvous is possible.
+ -- First entry is the default case, when no rendezvous is possible
Choices := New_List (New_Reference_To (RTE (RE_No_Rendezvous), Loc));
if Else_Present then
- -- If no rendezvous is possible, the else part is executed.
+ -- If no rendezvous is possible, the else part is executed
Lab := Make_And_Declare_Label (0);
Alt_Stats := New_List (
Insert_After (Parm, New_Reference_To (M, Loc));
Insert_After (Parm, New_Reference_To (D, Loc));
- -- Create a call to RTS.
+ -- Create a call to RTS
Rewrite (Select_Call,
Make_Procedure_Call_Statement (Loc,
-- This is done last, since the corresponding record initialization
-- procedure will reference the previously created entities.
- -- Fill in the component declarations. First the _Task_Id field.
+ -- Fill in the component declarations -- first the _Task_Id field
Append_To (Cdecls,
Make_Component_Declaration (Loc,
B := Make_Defining_Identifier (Loc, Name_uB);
- -- Create a boolean object used for a return parameter.
+ -- Create a boolean object used for a return parameter
Prepend_To (Decls,
Make_Object_Declaration (Loc,
Dummy := Remove_Next (Next (Parm));
- -- In case some garbage is following the Cancel_Param, remove.
+ -- Remove garbage is following the Cancel_Param if present
Dummy := Next (Parm);
- -- Remove the mode of the Protected_Entry_Call call, the
- -- Communication_Block of the Protected_Entry_Call call, and add a
- -- Duration and a Delay_Mode parameter
+ -- Remove the mode of the Protected_Entry_Call call, then remove the
+ -- Communication_Block of the Protected_Entry_Call call, and finally
+ -- add Duration and a Delay_Mode parameter
pragma Assert (Present (Parm));
Rewrite (Parm, New_Reference_To (D, Loc));
Rewrite (Dummy, New_Reference_To (M, Loc));
- -- Add a Boolean flag for successful entry call.
+ -- Add a Boolean flag for successful entry call
Append_To (Parms, New_Reference_To (B, Loc));
or else Restriction_Active (No_Entry_Queue) = False
or else Number_Entries (Ptyp) > 1
then
- -- Find index mapping function (clumsy but ok for now).
+ -- Find index mapping function (clumsy but ok for now)
while Ekind (P_Arr) /= E_Function loop
Next_Entity (P_Arr);
Next_Rep_Item (Ritem);
end loop;
- -- Appends the table argument we just built.
+ -- Append the table argument we just built
+
Append_To (Args, Make_Aggregate (Loc, Table));
- -- Appends the Install_Handler call to the statements.
+ -- Append the Install_Handler call to the statements
+
Append_To (L,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Install_Handlers), Loc),
return Skip;
elsif Nkind (N) = N_String_Literal then
- -- array type, but bounds are constant.
+
+ -- Array type, but bounds are constant
+
return OK;
elsif Nkind (N) = N_Object_Declaration
-- 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.
-- 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));
begin
if No (Bits_nn) then
- -- Error, most likely High_Integrity_Mode restriction.
+ -- Error, most likely High_Integrity_Mode restriction
return;
end if;
-- 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
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);
-- 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;
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
* GNAT Project Manager::
* The Cross-Referencing Tools gnatxref and gnatfind::
* The GNAT Pretty-Printer gnatpp::
+* The GNAT Metric Tool gnatmetric::
* File Name Krunching Using gnatkr::
* Preprocessing Using gnatprep::
@ifset vms
* Switches for gnatpp::
* Formatting Rules::
+The GNAT Metrics Tool gnatmetric
+
+* Switches for gnatmetric::
+
File Name Krunching Using gnatkr
* About gnatkr::
comment placement, and other elements of program presentation style.
@item
+@ref{The GNAT Metric Tool gnatmetric}, shows how to compute various
+metrics for an Ada source file, such as the number of types and subprograms,
+and assorted complexity measures.
+
+@item
@ref{File Name Krunching Using gnatkr}, describes the @code{gnatkr}
file name krunching utility, used to handle shortened
file names on operating systems with a limit on the length of names.
@item
@code{Eliminate}
@item
+@code{Pretty_Printer}
+@item
+@code{Metrics}
+@item
@code{gnatls}
@item
@code{gnatstub}
@item
@code{IDE}
+@item
+@code{Language_Processing}
@end itemize
@noindent
@command{^gnatls^gnatls^},
@command{^gnatelim^gnatelim^},
@command{^gnatpp^gnatpp^},
+@command{^gnatmetric^gnatmetric^},
+@command{^gnatstub^gnatstub^},
and @command{^gnatxref^gnatxref^}. However, none of these tools can be invoked
directly with a project file switch (@option{^-P^/PROJECT_FILE=^}).
They must be invoked through the @command{gnat} driver.
@item
PP or PRETTY to invoke @command{^gnatpp^gnatpp^}
@item
+METRIC to invoke @command{^gnatmetric^gnatmetric^}
+@item
STUB to invoke @command{^gnatstub^gnatstub^}
@item
XREF to invoke @command{^gnatxref^gnatxref^}
@end smallexample
@noindent
-In addition, for command BIND, COMP or COMPILE, FIND, ELIM, LS or LIST, LINK,
-PP or PRETTY and XREF, the project file related switches
+In addition, for commands BIND, COMP or COMPILE, FIND, ELIM, LS or LIST, LINK,
+METRIC, PP or PRETTY, STUB and XREF, the project file related switches
(@option{^-P^/PROJECT_FILE^},
@option{^-X^/EXTERNAL_REFERENCE^} and
@option{^-vP^/MESSAGES_PROJECT_FILE=^x}) may be used in addition to
the immediate sources of the specified project file.
@noindent
-For each of these commands, there is optionally a corresponding package
-in the main project.
+When GNAT METRIC is used with a project file, but with no source
+specified on the command line, it invokes @command{^gnatmetric^gnatmetric^}
+with all the immediate sources of the specified project file and with
+@option{^-d^/DIRECTORY^} with the parameter pointing to the object directory
+of the project.
+
+@noindent
+For each of the following commands, there is optionally a corresponding
+package in the main project.
@itemize @bullet
@item
package @code{Linker} for command LINK (invoking @code{^gnatlink^gnatlink^})
@item
+package @code{Metrics} for command METRIC
+(invoking @code{^gnatmetric^gnatmetric^})
+
+@item
package @code{Pretty_Printer} for command PP or PRETTY
(invoking @code{^gnatpp^gnatpp^})
@item
+package @code{Gnatstub} for command STUB
+(invoking @code{^gnatstub^gnatstub^})
+
+@item
package @code{Cross_Reference} for command XREF (invoking
@code{^gnatxref^gnatxref^})
@end cartouche
@end smallexample
+@c *********************************
+@node The GNAT Metric Tool gnatmetric
+@chapter The GNAT Metric Tool @command{gnatmetric}
+@findex gnatmetric
+@cindex Metric tool
+
+@noindent
+^The @command{gnatmetric} tool^GNAT METRIC^ is an ASIS-based utility
+for computing various program metrics.
+It takes an Ada source file as input and generates a file containing the
+metrics data as output. Various switches control which
+metrics are computed and output.
+
+@command{gnatmetric} generates and uses the ASIS
+tree for the input source and thus requires the input to be syntactically and
+semantically legal.
+If this condition is not met, @command{gnatmetric} will generate
+an error message; no metric information for this file will be
+computed and reported.
+
+If the compilation unit contained in the input source depends semantically
+upon units located outside the current directory, you have to provide the
+source search path when invoking @command{gnatmetric}.
+If these units are contained in files
+with names that do not follow the GNAT file naming rules, you have to provide
+the configuration file describing the corresponding naming scheme; see the
+description of the @command{gnatmetric} switches below. Another possibility
+is to use a project file and to
+call @command{gnatmetric} through the @command{gnat} driver
+
+The @command{gnatmetric} command has the form
+
+@smallexample
+$ gnatmetric [@var{switches}] @var{filename} [@var{-cargs gcc_switches}]
+@end smallexample
+
+@noindent
+where
+@itemize @bullet
+@item
+@var{switches} is an optional sequence of switches specifying
+the set of metrics to compute and defining the destination for the
+output information
+
+@item
+@var{filename} is the name (including the extension) of the source file to
+process; ``wildcards'' or several file names on the same @command{gnatmetric}
+command are allowed. The file name may contain path information; in this case
+it does not have to follow the GNAT file naming rules
+
+@item
+@option{-cargs gcc_switches} is a list of switches that are valid switches for
+@command{gcc}. They will be passed on to all compiler invocations made by
+@command{gnatmetric} to generate the ASIS trees. Here you can provide
+@option{-I} switches to form the source search path,
+and use the @var{-gnatec} switch to set the configuration file.
+@end itemize
+
+@menu
+* Switches for gnatmetric::
+@end menu
+
+@node Switches for gnatmetric
+@section Switches for @command{gnatmetric}
+
+@noindent
+The following subsections describe the various switches accepted by
+@command{gnatmetric}, organized by category.
+
+@menu
+* Output Files Control::
+* Disable Metrics For Local Units::
+* Line Metrics Control::
+* Syntax Metrics Control::
+* Complexity Metrics Control::
+* Other gnatmetric Switches::
+@end menu
+
+@node Output Files Control
+@subsection Output File Control
+@cindex Output file control in @command{gnatmetric}
+
+@noindent
+@command{gnatmetric} has two output formats. It can generate the output in
+textual (human-readable) form, and also as XML. By default only textual
+output is generated.
+
+When generating the output in textual form, @command{gnatmetric} creates
+for each Ada source file a corresponding text file
+containing the computed metrics. By default, this file
+is placed in the same directory as where the source file is located, and
+its name is obtained
+by appending the ^@file{.metrix}^@file{$METRIX}^ suffix to the name of the
+input file.
+
+All the output information generated in XML format is placed in a single
+file. By default this file is placed in the current directory and has the
+name ^@file{metrix.xml}^@file{METRIX$XML}^.
+
+Some of the computed metrics are summed over the units passed to
+@command{gnatmetric}; for example, the total number of lines of code.
+By default this information is sent to @file{stdout}, but a file
+can be specified with the @option{-og} switch.
+
+The following switches may be used to control the @command{gnatmetric} output:
+
+@table @option
+@cindex @option{^-x^/XML^} (@command{gnatmetric})
+@item ^-x^/XML^
+Generate the XML output
+
+@cindex @option{^-nt^/NO_TEXT^} (@command{gnatmetric})
+@item ^-nt^/NO_TEXT^
+Do not generate the output in text form (implies @option{^-x^/XML^})
+
+@cindex @option{^-d^/DIRECTORY^} (@command{gnatmetric})
+@item ^-d @var{output_dir}^/DIRECTORY=@var{output_dir}^
+Put textual files with detailed metrics into @var{output_dir}
+
+@cindex @option{^-o^/SUFFIX_DETAILS^} (@command{gnatmetric})
+@item ^-o @var{file_suffix}^/SUFFIX_DETAILS=@var{file_suffix}^
+Use @var{file_suffix} to form the name of the file for the detailed metrics.
+
+@cindex @option{^-og^/GLOBAL_OUTPUT^} (@command{gnatmetric})
+@item ^-og @var{file_name}^/GLOBAL_OUTPUT=@var{file_name}^
+Put global metrics info into @var{file_name}
+
+@cindex @option{^-ox^/XML_OUTPUT^} (@command{gnatmetric})
+@item ^-ox @var{file_name}^/XML_OUTPUT=@var{file_name}^
+Put the XML output into @var{file_name} (also implies @option{^-x^/XML^})
+
+@cindex @option{^-sfn^/SHORT_SOURCE_FILE_NAME^} (@command{gnatmetric})
+@item ^-sfn^/SHORT_SOURCE_FILE_NAME^
+Use short source file names in the output
+
+@end table
+
+@node Disable Metrics For Local Units
+@subsection Disable Metrics For Local Units
+@cindex Disable Metrics For Local Units in @command{gnatmetric}
+
+@noindent
+@command{gnatmetric} relies on the GNAT compilation model @minus{}
+one compilation
+unit per one source file. It computes some metrics for the whole source
+file (mostly ``number of lines'' metrics) and it always computes metrics for
+the top program unit of the corresponding compilation unit.
+
+@command{gnatmetric} considers the following constructs as program units to
+compute metrics for:
+
+@itemize @bullet
+@item
+a library item or a subunit into a compilation unit;
+
+@item
+all kinds of bodies;
+
+@item
+declarations of tasks and protected types and objects, package and generic
+
+@item
+package declarations;
+
+@end itemize
+
+@noindent
+That is, a subprogram declaration, a generic instantiation or a renaming is
+considered as a program unit only if it is a library item of a compilation
+unit.
+
+@table @option
+@cindex @option{^-n@var{x}^/SUPPRESS^} (@command{gnatmetric})
+@item ^-nolocal^/SUPPRESS=LOCAL_DETAILS^
+Do not compute detailed metrics for local program units
+
+@end table
+
+@node Line Metrics Control
+@subsection Line Metrics Control
+@cindex Line metrics control in @command{gnatmetric}
+
+@noindent
+For any source file containing a legal compilation unit, and for any program
+unit, @command{gnatmetric} computes the following metrics:
+
+@itemize @bullet
+@item
+the total number of lines in the file;
+
+@item
+the total number of code lines (i.e., non-blank lines that are not comments)
+
+@item
+the number of comment lines
+
+@item
+the number of code lines containing end-of-line comments;
+
+@item
+the number of empty lines and lines containing only space characters and/or
+format effectors (blank lines)
+
+@end itemize
+
+If @command{gnatmetric} is invoked on more than one source file, it sums the
+values of the line metrics for all the files being processed and then prints
+out the cumulative results.
+
+By default, all the line metrics are computed and reported. You can use the
+following switches to select the specific line metrics to be computed and
+reported (if any of these parameters is set, only explicitly specified line
+metrics are computed)
+
+@table @option
+@cindex @option{^-la^/LINES_ALL^} (@command{gnatmetric})
+@item ^-la^/LINES_ALL^
+Compute and print out the number of all lines
+
+@cindex @option{^-lcode^/CODE_LINES^} (@command{gnatmetric})
+@item ^-lcode^/CODE_LINES^
+Compute and print out the number of code lines
+
+@cindex @option{^-lcomm^/COMENT_LINES^} (@command{gnatmetric})
+@item ^-lcomm^/COMENT_LINES^
+Compute and print out the number of comment lines
+
+@cindex @option{^-leol^/MIXED_CODE_COMMENTS^} (@command{gnatmetric})
+@item ^-leol^/MIXED_CODE_COMMENTS^
+Compute and print out the number of code lines containing
+end-of-line comments
+
+@cindex @option{^-lb^/BLANK_LINES^} (@command{gnatmetric})
+@item ^-lb^/BLANK_LINES^
+ Compute and print out the number of blank lines
+
+@end table
+
+@node Syntax Metrics Control
+@subsection Syntax Metrics Control
+@cindex Syntax metrics control in @command{gnatmetric}
+
+@noindent
+For any program unit, @command{gnatmetri}c computes the total number of
+declarations and the total number of statements. The sum of all the statements
+and all the declarations is considered as @emph{LSLOC} (Logical Source
+Lines Of Code)
+and is reported as a separate metric.
+
+For any body and any task, protected, package and generic package declaration a
+maximal nesting level of nested program units is computed. According to
+@cite{Ada 95 Language Reference Manual}, 10.1(1), ``A program unit is either a
+package, a task unit, a protected unit, a
+protected entry, a generic unit, or an explicitly declared subprogram other
+than an enumeration literal.''
+
+For any program unit @command{gnatmetric} computes the maximal nesting level of
+composite syntactic constructs. This corresponds to the notion of the
+maximum nesting level in the GNAT built-in style checks
+(see @ref{Style Checking})
+
+For any library-level program unit @command{gnatmetric} additionally computes
+the following metrics:
+
+@table @emph
+@item Public subprograms
+This metric is computed for non-private compilation units only. It is a number
+of the subprograms and generic subprograms declared in the given compilation
+unit that can be called
+or instantiated outside the unit. Formal generic subprograms and generic
+instantiations are not counted. Protected subprograms are counted in the same
+way as non-protected ones.
+
+@item All subprograms
+This metric is computed for all the library level bodies and subunits. The
+metric is equal to a total number of subprogram bodies in the compilation unit.
+Neither generic instantiations nor renamings-as-a-body nor body stubs
+are counted. Any subprogram body is counted, independently of its nesting
+level and enclosing constructs. Generic bodies and bodies of protected
+subprograms are counted in the same way as ``usual'' subprogram bodies.
+
+@item Public types
+This metric is computed only for non-private package declarations and
+generic package declarations. It is the total number of types
+that can be referenced from outside this compilation unit, plus the
+number of types from all the visible parts of all the visible generic packages.
+Generic formal types are not counted.
+
+@noindent
+Along with counting the total number of public types, the following
+types are counted and reported separately:
+
+@itemize @bullet
+@item
+abstract types;
+
+@item
+tagged types (abstract, non-abstract, private, non-private). Type
+extensions are @emph{not} counted as tagged types; the idea is to count
+possible roots for classes of extendable types;
+
+@item
+private types (including private extensions);
+
+@item
+task types;
+
+@item
+protected types.
+
+@end itemize
+
+@item All types
+This metric is computed for any compilation unit. It is equal to the total
+number of the declarations of different types given in the compilation unit.
+The private and the corresponding full type declaration are counted as one
+type declaration. Incomplete type declarations and generic formal types
+are not counted.
+No distinction is made among different kinds of types (abstract,
+private etc.); the total number of types is computed and reported.
+
+@end table
+
+@noindent
+By default, all the syntax metrics are computed and reported. You can use the
+following switches to select specific syntax metrics;
+if any of these is set, only the explicitly specified metrics are computed.
+
+@table @option
+@cindex @option{^-ed^/DECLARATION_TOTAL^} (@command{gnatmetric})
+@item ^-ed^/DECLARATION_TOTAL^
+Compute and print out the total number of declarations
+
+@cindex @option{^-es^/STATEMENT_TOTAL^} (@command{gnatmetric})
+@item ^-es^/STATEMENT_TOTAL^
+Compute and print out the total number of statements
+
+@cindex @option{^-eps^/^} (@command{gnatmetric})
+@item ^-eps^/INT_SUBPROGRAMS^
+Compute and print out the number of public subprograms in a
+compilation unit
+
+@cindex @option{^-eas^/SUBPROGRAMS_ALL^} (@command{gnatmetric})
+@item ^-eas^/SUBPROGRAMS_ALL^
+Compute and print out the number of all the subprograms in a
+compilation unit
+
+@cindex @option{^-ept^/INT_TYPES^} (@command{gnatmetric})
+@item ^-ept^/INT_TYPES^
+Compute and print out the number of public types in a compilation
+unit
+
+@cindex @option{^-eat^/TYPES_ALL^} (@command{gnatmetric})
+@item ^-eat^/TYPES_ALL^
+Compute and print out the number of all the types in a compilation
+unit
+
+@cindex @option{^-enu^/PROGRAM_NESTING_MAX^} (@command{gnatmetric})
+@item ^-enu^/PROGRAM_NESTING_MAX^
+Compute and print out the maximal program unit nesting level
+
+@cindex @option{^-ec^/CONSTRUCT_NESTING_MAX^} (@command{gnatmetric})
+@item ^-ec^/CONSTRUCT_NESTING_MAX^
+Compute and print out the maximal construct nesting level
+
+@end table
+
+@node Complexity Metrics Control
+@subsection Complexity Metrics Control
+@cindex Complexity metrics control in @command{gnatmetric}
+
+@noindent
+For a program unit that is an executable body (a subprogram body (including
+generic bodies), task body, entry body or a package body containing
+its own statement sequence ) @command{gnatmetric} computes the following
+complexity metrics:
+
+@itemize @bullet
+@item
+McCabe cyclomatic complexity;
+
+@item
+McCabe essential complexity;
+
+@item
+maximal loop nesting level
+
+@end itemize
+
+@noindent
+The McCabe complexity metrics are defined
+in @url{www.mccabe.com/pdf/nist235r.pdf}
+
+According to McCabe, both control statements and short-circuit control forms
+should be taken into account when computing cyclomatic complexity. For each
+body, we compute three metric values:
+
+@itemize @bullet
+@item
+the complexity introduced by control
+statements only, without taking into account short-circuit forms,
+
+@item
+the complexity introduced by short-circuit control forms only, and
+
+@item
+the total
+cyclomatic complexity, which is the sum of these two values.
+@end itemize
+
+@noindent
+When computing cyclomatic and essential complexity, @command{gnatmetric} skips
+the code in the exception handlers and in all the nested program units
+
+By default, all the complexity metrics are computed and reported.
+For more finely-grained control you can use
+the following switches:
+
+@table @option
+@cindex @option{^-n@var{x}^/SUPPRESS^} (@command{gnatmetric})
+
+@item ^-nocc^/SUPPRESS=CYCLOMATIC_COMPLEXITY^
+Do not compute the McCabe Cyclomatic Complexity
+
+@item ^noec-^/SUPPRESS=ESSENTIAL_COMPLEXITY^
+Do not compute the Essential Complexity
+
+@item ^-nonl^/SUPPRESS=MAXIMAL_LOOP_NESTING^
+Do not compute maximal loop nesting level
+
+@item ^-ne^/SUPPRESS=EXITS_AS_GOTOS^
+Do not consider @code{exit} statements as @code{goto}s when
+computing Essential Complexity
+
+@end table
+
+@node Other gnatmetric Switches
+@subsection Other @code{gnatmetric} Switches
+
+@noindent
+Additional @command{gnatmetric} switches are as follows:
+
+@table @option
+@item ^-files @var{filename}^/FILES=@var{filename}^
+@cindex @option{^-files^/FILES^} (@code{gnatmetric})
+Take the argument source files from the specified file. This file should be an
+ordinary textual file containing file names separated by spaces or
+line breaks. You can use this switch more then once in the same call to
+@command{gnatmetric}. You also can combine this switch with explicit list of
+files.
+
+@item ^-v^/VERBOSE^
+@cindex @option{^-v^/VERBOSE^} (@code{gnatmetric})
+Verbose mode;
+@command{gnatmetric} generates version information and then
+a trace of sources being procesed.
+
+@item ^-dv^/DEBUG_OUTPUT^
+@cindex @option{^-dv^/DEBUG_OUTPUT^} (@code{gnatmetric})
+Debug mode;
+@command{gnatmetric} generates various messages useful to understand what
+happens during the metrics computation
+
+@item ^-q^/QUIET^
+@cindex @option{^-q^/QUIET^} (@code{gnatmetric})
+Quiet mode.
+@end table
+
@c ***********************************
@node File Name Krunching Using gnatkr
@chapter File Name Krunching Using @code{gnatkr}
@item ^-v^/OUTPUT=VERBOSE^
@cindex @option{^-v^/OUTPUT=VERBOSE^} (@code{gnatls})
-Verbose mode. Output the complete source and object paths. Do not use
+Verbose mode. Output the complete source, object and project paths. Do not use
the default column layout but instead use long format giving as much as
information possible on each requested units, including special
characteristics such as:
@smallexample
$ gnatls -v -I.. demo1.o
-GNATLS 3.10w (970212) Copyright 1999 Free Software Foundation, Inc.
+GNATLS 5.03w (20041123-34)
+Copyright 1997-2004 Free Software Foundation, Inc.
Source Search Path:
<Current_Directory>
../
/home/comar/local/lib/gcc-lib/mips-sni-sysv4/2.7.2/adalib/
+Project Search Path:
+ <Current_Directory>
+ /home/comar/local/lib/gnat/
+
./demo1.o
Unit =>
Name => demo1
-- --
-- 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 --
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);
-- --
-- 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- --
----------------
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
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,
------------------
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;
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
--------------
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);
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);
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);
-- --
-- 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- --
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;
-- 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
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
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))));
Next (Item);
end loop;
- -- Third pass: examine all limited_with clauses.
+ -- Third pass: examine all limited_with clauses
Item := First (Context_Items (N));
& " 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);
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);
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);
begin
if not Is_Empty_List (Context_Items (N)) then
- -- Save current use clauses.
+ -- Save current use clauses
Remove_Scope;
Remove_Context (Lib_Unit);
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;
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);
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;
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,
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'));
if Nkind (Parent (P)) = N_Defining_Program_Unit_Name then
- -- Make parent packages visible.
+ -- Make parent packages visible
declare
Parent_Comp : Node_Id;
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 --
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
then
if Limited_Present (Item) then
- -- Limited withed units will be installed later.
+ -- Limited withed units will be installed later
goto Continue;
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);
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;
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
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);
-- 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
("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;
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
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)
-- SI is the N_Subtype_Indication node containing the constraint and
-- the unconstrained type to constrain.
--
- -- Def_Id is the entity for the resulting constrained subtype. A
- -- value of Empty for Def_Id indicates that an implicit type must be
- -- created, but creation is delayed (and must be done by this procedure)
- -- because other subsidiary implicit types must be created first (which
- -- is why Def_Id is an in/out parameter).
+ -- Def_Id is the entity for the resulting constrained subtype. A value
+ -- of Empty for Def_Id indicates that an implicit type must be created,
+ -- but creation is delayed (and must be done by this procedure) because
+ -- other subsidiary implicit types must be created first (which is why
+ -- Def_Id is an in/out parameter).
--
-- Related_Nod gives the place where this type has to be inserted
-- in the tree
Related_Id : Entity_Id;
Suffix : Character;
Suffix_Index : Nat);
- -- Process an index constraint in a constrained array declaration.
- -- The constraint can be a subtype name, or a range with or without
- -- an explicit subtype mark. The index is the corresponding index of the
+ -- Process an index constraint in a constrained array declaration. The
+ -- constraint can be a subtype name, or a range with or without an
+ -- explicit subtype mark. The index is the corresponding index of the
-- unconstrained array. The Related_Id and Suffix parameters are used to
-- build the associated Implicit type name.
Set_Is_Access_Constant (Anon_Type, Constant_Present (N));
-- The context is either a subprogram declaration or an access
- -- discriminant, in a private or a full type declaration. In
- -- the case of a subprogram, If the designated type is incomplete,
- -- the operation will be a primitive operation of the full type, to
- -- be updated subsequently. If the type is imported through a limited
- -- with clause, it is not a primitive operation of the type (which
- -- is declared elsewhere in some other scope).
+ -- discriminant, in a private or a full type declaration. In the case
+ -- of a subprogram, If the designated type is incomplete, the operation
+ -- will be a primitive operation of the full type, to be updated
+ -- subsequently. If the type is imported through a limited with clause,
+ -- it is not a primitive operation of the type (which is declared
+ -- elsewhere in some other scope).
if Ekind (Desig_Type) = E_Incomplete_Type
and then not From_With_Type (Desig_Type)
Process_Formals (Formals, Parent (T_Def));
-- A bit of a kludge here, End_Scope requires that the parent
- -- pointer be set to something reasonable, but Itypes don't
- -- have parent pointers. So we set it and then unset it ???
- -- If and when Itypes have proper parent pointers to their
- -- declarations, this kludge can be removed.
+ -- pointer be set to something reasonable, but Itypes don't have
+ -- parent pointers. So we set it and then unset it ??? If and when
+ -- Itypes have proper parent pointers to their declarations, this
+ -- kludge can be removed.
Set_Parent (Desig_Type, T_Name);
End_Scope;
Set_Etype (Id, T);
Set_Is_Aliased (Id, Aliased_Present (Component_Definition (N)));
- -- The component declaration may have a per-object constraint, set the
- -- appropriate flag in the defining identifier of the subtype.
+ -- The component declaration may have a per-object constraint, set
+ -- the appropriate flag in the defining identifier of the subtype.
if Present (Subtype_Indication (Component_Definition (N))) then
declare
end if;
-- At the end of a declarative part, freeze remaining entities
- -- declared in it. The end of the visible declarations of a
- -- package specification is not the end of a declarative part
- -- if private declarations are present. The end of a package
- -- declaration is a freezing point only if it a library package.
- -- A task definition or protected type definition is not a freeze
- -- point either. Finally, we do not freeze entities in generic
- -- scopes, because there is no code generated for them and freeze
- -- nodes will be generated for the instance.
+ -- declared in it. The end of the visible declarations of package
+ -- specification is not the end of a declarative part if private
+ -- declarations are present. The end of a package declaration is a
+ -- freezing point only if it a library package. A task definition or
+ -- protected type definition is not a freeze point either. Finally,
+ -- we do not freeze entities in generic scopes, because there is no
+ -- code generated for them and freeze nodes will be generated for
+ -- the instance.
-- The end of a package instantiation is not a freeze point, but
-- for now we make it one, because the generic body is inserted
End_Scope;
- -- If the type has discriminants, non-trivial subtypes may be
- -- be declared before the full view of the type. The full views
- -- of those subtypes will be built after the full view of the type.
+ -- If the type has discriminants, non-trivial subtypes may be be
+ -- declared before the full view of the type. The full views of those
+ -- subtypes will be built after the full view of the type.
Set_Private_Dependents (T, New_Elmt_List);
Set_Is_Pure (T, F);
-- worthile building the corresponding subtype.
function Count_Tasks (T : Entity_Id) return Uint;
- -- This function is called when a library level object of type T
- -- is declared. It's function is to count the static number of
- -- tasks declared within the type (it is only called if Has_Tasks
- -- is set for T). As a side effect, if an array of tasks with
- -- non-static bounds or a variant record type is encountered,
- -- Check_Restrictions is called indicating the count is unknown.
+ -- This function is called when a library level object of type is
+ -- declared. It's function is to count the static number of tasks
+ -- declared within the type (it is only called if Has_Tasks is set for
+ -- T). As a side effect, if an array of tasks with non-static bounds or
+ -- a variant record type is encountered, Check_Restrictions is called
+ -- indicating the count is unknown.
---------------------------
-- Build_Default_Subtype --
-- where the defining identifier has already been entered into the
-- scope but the declaration as a whole needs to be analyzed.
- -- This case in particular happens for derived enumeration types.
- -- The derived enumeration type is processed as an inserted enumeration
+ -- This case in particular happens for derived enumeration types. The
+ -- derived enumeration type is processed as an inserted enumeration
-- type declaration followed by a rewritten subtype declaration. The
-- defining identifier, however, is entered into the name scope very
-- early in the processing of the original type declaration and
-- therefore needs to be avoided here, when the created subtype
-- declaration is analyzed. (See Build_Derived_Types)
- -- This also happens when the full view of a private type is a
- -- derived type with constraints. In this case the entity has been
- -- introduced in the private declaration.
+ -- This also happens when the full view of a private type is derived
+ -- type with constraints. In this case the entity has been introduced
+ -- in the private declaration.
if Present (Etype (Id))
and then (Is_Private_Type (Etype (Id))
begin
-- In the case where the base type is different from the first
- -- subtype, we pre-allocate a freeze node, and set the proper
- -- link to the first subtype. Freeze_Entity will use this
- -- preallocated freeze node when it freezes the entity.
+ -- subtype, we pre-allocate a freeze node, and set the proper link
+ -- to the first subtype. Freeze_Entity will use this preallocated
+ -- freeze node when it freezes the entity.
if B /= T then
Ensure_Freeze_Node (B);
Insert_Before (N, Type_Decl);
Analyze (Type_Decl);
- -- After the implicit base is analyzed its Etype needs to be
- -- changed to reflect the fact that it is derived from the
- -- parent type which was ignored during analysis. We also set
- -- the size at this point.
+ -- After the implicit base is analyzed its Etype needs to be changed
+ -- to reflect the fact that it is derived from the parent type which
+ -- was ignored during analysis. We also set the size at this point.
Set_Etype (Implicit_Base, Parent_Type);
else
-- Constraint is a Range attribute. Replace with the
- -- explicit mention of the bounds of the prefix, which
- -- must be a subtype.
+ -- explicit mention of the bounds of the prefix, which must
+ -- be a subtype.
Analyze (Prefix (R));
Hi :=
Analyze (N);
- -- If pragma Discard_Names applies on the first subtype
- -- of the parent type, then it must be applied on this
- -- subtype as well.
+ -- If pragma Discard_Names applies on the first subtype of the
+ -- parent type, then it must be applied on this subtype as well.
if Einfo.Discard_Names (First_Subtype (Parent_Type)) then
Set_Discard_Names (Derived_Type);
end if;
- -- Apply a range check. Since this range expression doesn't
- -- have an Etype, we have to specifically pass the Source_Typ
- -- parameter. Is this right???
+ -- Apply a range check. Since this range expression doesn't have an
+ -- Etype, we have to specifically pass the Source_Typ parameter. Is
+ -- this right???
if Nkind (Indic) = N_Subtype_Indication then
Apply_Range_Check (Range_Expression (Constraint (Indic)),
Discard_Node (Process_Subtype (Indic, N));
- -- Introduce an implicit base type for the derived type even if
- -- there is no constraint attached to it, since this seems closer
- -- to the Ada semantics.
+ -- Introduce an implicit base type for the derived type even if there
+ -- is no constraint attached to it, since this seems closer to the Ada
+ -- semantics.
Implicit_Base :=
Create_Itype (Ekind (Parent_Base), N, Derived_Type, 'B');
Set_Includes_Infinities (Scalar_Range (Implicit_Base));
end if;
- -- The Derived_Type, which is the entity of the declaration, is
- -- a subtype of the implicit base. Its Ekind is a subtype, even
- -- in the absence of an explicit constraint.
+ -- The Derived_Type, which is the entity of the declaration, is a
+ -- subtype of the implicit base. Its Ekind is a subtype, even in the
+ -- absence of an explicit constraint.
Set_Etype (Derived_Type, Implicit_Base);
Set_Ekind (Derived_Type, Subtype_Kind (Ekind (Parent_Type)));
end if;
- -- If we did not have a range constraint, then set the range
- -- from the parent type. Otherwise, the call to Process_Subtype
- -- has set the bounds.
+ -- If we did not have a range constraint, then set the range from the
+ -- parent type. Otherwise, the call to Process_Subtype has set the
+ -- bounds.
if No_Constraint
or else not Has_Range_Constraint (Indic)
elsif Is_Fixed_Point_Type (Parent_Type) then
- -- Small of base type and derived type are always copied from
- -- the parent base type, since smalls never change. The delta
- -- of the base type is also copied from the parent base type.
- -- However the delta of the derived type will have been set
- -- already if a constraint was present.
+ -- Small of base type and derived type are always copied from the
+ -- parent base type, since smalls never change. The delta of the
+ -- base type is also copied from the parent base type. However the
+ -- delta of the derived type will have been set already if a
+ -- constraint was present.
Set_Small_Value (Derived_Type, Small_Value (Parent_Base));
Set_Small_Value (Implicit_Base, Small_Value (Parent_Base));
Convert_Scalar_Bounds (N, Parent_Type, Derived_Type, Loc);
-- The implicit_base should be frozen when the derived type is frozen,
- -- but note that it is used in the conversions of the bounds. For
- -- fixed types we delay the determination of the bounds until the proper
+ -- but note that it is used in the conversions of the bounds. For fixed
+ -- types we delay the determination of the bounds until the proper
-- freezing point. For other numeric types this is rejected by GCC, for
-- reasons that are currently unclear (???), so we choose to freeze the
-- implicit base now. In the case of integers and floating point types
if Present (Full_View (Parent_Type)) then
if not Is_Completion then
- -- Copy declaration for subsequent analysis, to
- -- provide a completion for what is a private
- -- declaration. Indicate that the full type is
- -- internally generated.
+ -- Copy declaration for subsequent analysis, to provide a
+ -- completion for what is a private declaration. Indicate that
+ -- the full type is internally generated.
Full_Decl := New_Copy_Tree (N);
Full_Der := New_Copy (Derived_Type);
Swapped := True;
end if;
- -- Build full view of derived type from full view of
- -- parent which is now installed.
- -- Subprograms have been derived on the partial view,
- -- the completion does not derive them anew.
+ -- Build full view of derived type from full view of parent which
+ -- is now installed. Subprograms have been derived on the partial
+ -- view, the completion does not derive them anew.
if not Is_Tagged_Type (Parent_Type) then
Build_Derived_Record_Type
Set_Full_View (Derived_Type, Full_Der);
Set_Full_View (Der_Base, Base_Type (Full_Der));
- -- Copy the discriminant list from full view to
- -- the partial views (base type and its subtype).
- -- Gigi requires that the partial and full views
- -- have the same discriminants.
- -- ??? Note that since the partial view is pointing
- -- to discriminants in the full view, their scope
- -- will be that of the full view. This might
- -- cause some front end problems and need
- -- adjustment?
+ -- Copy the discriminant list from full view to the partial views
+ -- (base type and its subtype). Gigi requires that the partial
+ -- and full views have the same discriminants.
+
+ -- Note that since the partial view is pointing to discriminants
+ -- in the full view, their scope will be that of the full view.
+ -- This might cause some front end problems and need
+ -- adjustment???
Discr := First_Discriminant (Base_Type (Full_Der));
Set_First_Entity (Der_Base, Discr);
(Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type));
end if;
- -- Construct the implicit full view by deriving from full
- -- view of the parent type. In order to get proper visibility,
- -- we install the parent scope and its declarations.
+ -- Construct the implicit full view by deriving from full view of
+ -- the parent type. In order to get proper visibility, we install
+ -- the parent scope and its declarations.
-- ??? if the parent is untagged private and its completion is
-- tagged, this mechanism will not work because we cannot derive
Copy_And_Build;
Uninstall_Declarations (Par_Scope);
- -- If parent scope is open and in another unit, and
- -- parent has a completion, then the derivation is taking
- -- place in the visible part of a child unit. In that
- -- case retrieve the full view of the parent momentarily.
+ -- If parent scope is open and in another unit, and parent has a
+ -- completion, then the derivation is taking place in the visible
+ -- part of a child unit. In that case retrieve the full view of
+ -- the parent momentarily.
elsif not In_Same_Source_Unit (N, Parent_Type) then
Full_P := Full_View (Parent_Type);
-- in R and T have the same position in objects of type R and T.
-- This has two implications. The first is that the entire tree for R's
- -- declaration needs to be copied for T in the untagged case, so that
- -- T can be viewed as a record type of its own with its own representation
+ -- declaration needs to be copied for T in the untagged case, so that T
+ -- can be viewed as a record type of its own with its own representation
-- clauses. The second implication is the way we handle discriminants.
-- Specifically, in the untagged case we need a way to communicate to Gigi
-- what are the real discriminants in the record, while for the semantics
-- o The discriminants specified by a new KNOWN_DISCRIMINANT_PART, if
-- there is one;
- -- o Otherwise, each discriminant of the parent type (implicitly
- -- declared in the same order with the same specifications). In this
- -- case, the discriminants are said to be "inherited", or if unknown in
- -- the parent are also unknown in the derived type.
+ -- o Otherwise, each discriminant of the parent type (implicitly declared
+ -- in the same order with the same specifications). In this case, the
+ -- discriminants are said to be "inherited", or if unknown in the parent
+ -- are also unknown in the derived type.
-- Furthermore if a KNOWN_DISCRIMINANT_PART is provided, then [3.7(13-18)]:
-- components are inherited in the derived type from the parent type. In
-- the absence of discriminants component, inheritance is straightforward
-- as components can simply be copied from the parent.
+
-- If the parent has discriminants, inheriting components constrained with
-- these discriminants requires caution. Consider the following example:
-- 9. IMPLEMENTATION OF TYPE DERIVATION FOR PRIVATE EXTENSIONS
-- The full view of a private extension is handled exactly as described
- -- above. The model chose for the private view of a private extension
- -- is the same for what concerns discriminants (ie they receive the same
+ -- above. The model chose for the private view of a private extension is
+ -- the same for what concerns discriminants (ie they receive the same
-- treatment as in the tagged case). However, the private view of the
-- private extension always inherits the components of the parent base,
- -- without replacing any discriminant reference. Strictly speaking this
- -- is incorrect. However, Gigi never uses this view to generate code so
- -- this is a purely semantic issue. In theory, a set of transformations
- -- similar to those given in 5. and 6. above could be applied to private
- -- views of private extensions to have the same model of component
- -- inheritance as for non private extensions. However, this is not done
- -- because it would further complicate private type processing.
- -- Semantically speaking, this leaves us in an uncomfortable
- -- situation. As an example consider:
+ -- without replacing any discriminant reference. Strictly speaking this is
+ -- incorrect. However, Gigi never uses this view to generate code so this
+ -- is a purely semantic issue. In theory, a set of transformations similar
+ -- to those given in 5. and 6. above could be applied to private views of
+ -- private extensions to have the same model of component inheritance as
+ -- for non private extensions. However, this is not done because it would
+ -- further complicate private type processing. Semantically speaking, this
+ -- leaves us in an uncomfortable situation. As an example consider:
-- package Pack is
-- type R (D : integer) is tagged record
-- a private extension such as T, we first mark T as unconstrained, we
-- process it, we perform program derivation and just before returning from
-- Build_Derived_Record_Type we mark T as constrained.
+
-- ??? Are there are other uncomfortable cases that we will have to
-- deal with.
Mark_Rewrite_Insertion (New_Decl);
Insert_Before (N, New_Decl);
- -- Note that this call passes False for the Derive_Subps
- -- parameter because subprogram derivation is deferred until
- -- after creating the subtype (see below).
+ -- Note that this call passes False for the Derive_Subps parameter
+ -- because subprogram derivation is deferred until after creating
+ -- the subtype (see below).
Build_Derived_Type
(New_Decl, Parent_Base, New_Base,
exit;
end if;
- -- If a new discriminant is used in the constraint,
- -- then its subtype must be statically compatible
- -- with the parent discriminant's subtype (3.7(15)).
+ -- If a new discriminant is used in the constraint, then its
+ -- subtype must be statically compatible with the parent
+ -- discriminant's subtype (3.7(15)).
if Present (Corresponding_Discriminant (Discrim))
and then
return;
end if;
- -- Set delayed freeze and then derive subprograms, we need to do
- -- this in this order so that derived subprograms inherit the
- -- derived freeze if necessary.
+ -- Set delayed freeze and then derive subprograms, we need to do this
+ -- in this order so that derived subprograms inherit the derived freeze
+ -- if necessary.
Set_Has_Delayed_Freeze (Derived_Type);
if Derive_Subps then
while Present (Elmt) loop
Subp := Node (Elmt);
- -- Special exception, do not complain about failure to
- -- override _Input and _Output, since we always provide
+ -- Special exception, do not complain about failure to override the
+ -- stream routines _Input and _Output, since we always provide
-- automatic overridings for these subprograms.
if Is_Abstract (Subp)
C : Entity_Id;
begin
- -- ??? Also need to check components of record extensions,
- -- but not components of protected types (which are always
- -- limited).
+ -- ??? Also need to check components of record extensions, but not
+ -- components of protected types (which are always limited).
if not Is_Limited_Type (T) then
if Ekind (T) = E_Record_Type then
end if;
-- If a generated entity has no completion, then either previous
- -- semantic errors have disabled the expansion phase, or else
- -- we had missing subunits, or else we are compiling without expan-
- -- sion, or else something is very wrong.
+ -- semantic errors have disabled the expansion phase, or else we had
+ -- missing subunits, or else we are compiling without expan- sion,
+ -- or else something is very wrong.
if not Comes_From_Source (E) then
pragma Assert
-- parent:
-- procedure Parent.Child (...);
- --
+
-- with Parent.Child;
-- package body Parent is
then
Post_Error;
- -- A single task declared in the current scope is
- -- a constant, verify that the body of its anonymous
- -- type is in the same scope. If the task is defined
- -- elsewhere, this may be a renaming declaration for
+ -- A single task declared in the current scope is a constant, verify
+ -- that the body of its anonymous type is in the same scope. If the
+ -- task is defined elsewhere, this may be a renaming declaration for
-- which no completion is needed.
elsif Ekind (E) = E_Constant
Set_First_Rep_Item (Full, First_Rep_Item (Full_Base));
Set_Depends_On_Private (Full, Has_Private_Component (Full));
- -- Freeze the private subtype entity if its parent is delayed,
- -- and not already frozen. We skip this processing if the type
- -- is an anonymous subtype of a record component, or is the
- -- corresponding record of a protected type, since ???
+ -- Freeze the private subtype entity if its parent is delayed, and not
+ -- already frozen. We skip this processing if the type is an anonymous
+ -- subtype of a record component, or is the corresponding record of a
+ -- protected type, since ???
if not Is_Type (Scope (Full)) then
Set_Has_Delayed_Freeze (Full,
Set_Cloned_Subtype (Full, Full_Base);
end if;
- -- It is unsafe to share to bounds of a scalar type, because the
- -- Itype is elaborated on demand, and if a bound is non-static
- -- then different orders of elaboration in different units will
- -- lead to different external symbols.
+ -- It is unsafe to share to bounds of a scalar type, because the Itype
+ -- is elaborated on demand, and if a bound is non-static then different
+ -- orders of elaboration in different units will lead to different
+ -- external symbols.
if Is_Scalar_Type (Full_Base) then
Set_Scalar_Range (Full,
end if;
end if;
- -- ??? It seems that a lot of fields are missing that should be
- -- copied from Full_Base to Full. Here are some that are introduced
- -- in a non-disruptive way but a cleanup is necessary.
+ -- ??? It seems that a lot of fields are missing that should be copied
+ -- from Full_Base to Full. Here are some that are introduced in a
+ -- non-disruptive way but a cleanup is necessary.
if Is_Tagged_Type (Full_Base) then
Set_Is_Tagged_Type (Full);
function Build_Constrained_Array_Type
(Old_Type : Entity_Id) return Entity_Id;
- -- If Old_Type is an array type, one of whose indices is
- -- constrained by a discriminant, build an Itype whose constraint
- -- replaces the discriminant with its value in the constraint.
+ -- If Old_Type is an array type, one of whose indices is constrained
+ -- by a discriminant, build an Itype whose constraint replaces the
+ -- discriminant with its value in the constraint.
function Build_Constrained_Discriminated_Type
(Old_Type : Entity_Id) return Entity_Id;
Btyp : Entity_Id := Base_Type (T);
begin
- -- The Related_Node better be here or else we won't be able
- -- to attach new itypes to a node in the tree.
+ -- The Related_Node better be here or else we won't be able to
+ -- attach new itypes to a node in the tree.
pragma Assert (Present (Related_Node));
-- The corresponding_Discriminant mechanism is incomplete, because
-- the correspondence between new and old discriminants is not one
- -- to one: one new discriminant can constrain several old ones.
- -- In that case, scan sequentially the stored_constraint, the list
- -- of discriminants of the parents, and the constraints.
+ -- to one: one new discriminant can constrain several old ones. In
+ -- that case, scan sequentially the stored_constraint, the list of
+ -- discriminants of the parents, and the constraints.
if Is_Derived_Type (Typ)
and then Present (Stored_Constraint (Typ))
Set_First_Entity (Full, First_Entity (Priv));
Set_Last_Entity (Full, Last_Entity (Priv));
- -- If access types have been recorded for later handling, keep them
- -- in the full view so that they get handled when the full view
- -- freeze node is expanded.
+ -- If access types have been recorded for later handling, keep them in
+ -- the full view so that they get handled when the full view freeze
+ -- node is expanded.
if Present (Freeze_Node (Priv))
and then Present (Access_Types_To_Process (Freeze_Node (Priv)))
procedure Collect_Fixed_Components (Typ : Entity_Id) is
begin
- -- Build association list for discriminants, and find components of
- -- the variant part selected by the values of the discriminants.
+ -- Build association list for discriminants, and find components of the
+ -- variant part selected by the values of the discriminants.
Old_C := First_Discriminant (Typ);
Discr_Val := First_Elmt (Constraints);
Prev : Entity_Id;
begin
- -- The visible operation that is overriden is a homonym of
- -- the parent subprogram. We scan the homonym chain to find
- -- the one whose alias is the subprogram we are deriving.
+ -- The visible operation that is overriden is a homonym of the
+ -- parent subprogram. We scan the homonym chain to find the one
+ -- whose alias is the subprogram we are deriving.
Prev := Homonym (Parent_Subp);
while Present (Prev) loop
-- or if we are in the private part of an instance. This test
-- should still be refined ???
- -- The test for In_Instance_Not_Visible avoids inheriting the
- -- derived operation as a non-visible operation in cases where
- -- the parent subprogram might not be visible now, but was
- -- visible within the original generic, so it would be wrong
- -- to make the inherited subprogram non-visible now. (Not
- -- clear if this test is fully correct; are there any cases
- -- where we should declare the inherited operation as not
- -- visible to avoid it being overridden, e.g., when the
- -- parent type is a generic actual with private primitives ???)
+ -- The test for In_Instance_Not_Visible avoids inheriting the derived
+ -- operation as a non-visible operation in cases where the parent
+ -- subprogram might not be visible now, but was visible within the
+ -- original generic, so it would be wrong to make the inherited
+ -- subprogram non-visible now. (Not clear if this test is fully
+ -- correct; are there any cases where we should declare the inherited
+ -- operation as not visible to avoid it being overridden, e.g., when
+ -- the parent type is a generic actual with private primitives ???)
-- (they should be treated the same as other private inherited
-- subprograms, but it's not clear how to do this cleanly). ???
New_Formal := New_Copy (Formal);
-- Normally we do not go copying parents, but in the case of
- -- formals, we need to link up to the declaration (which is
- -- the parameter specification), and it is fine to link up to
- -- the original formal's parameter specification in this case.
+ -- formals, we need to link up to the declaration (which is the
+ -- parameter specification), and it is fine to link up to the
+ -- original formal's parameter specification in this case.
Set_Parent (New_Formal, Parent (Formal));
(New_Subp, Is_Valued_Procedure (Parent_Subp));
end if;
- -- A derived function with a controlling result is abstract.
- -- If the Derived_Type is a nonabstract formal generic derived
- -- type, then inherited operations are not abstract: check is
- -- done at instantiation time. If the derivation is for a generic
- -- actual, the function is not abstract unless the actual is.
+ -- A derived function with a controlling result is abstract. If the
+ -- Derived_Type is a nonabstract formal generic derived type, then
+ -- inherited operations are not abstract: the required check is done at
+ -- instantiation time. If the derivation is for a generic actual, the
+ -- function is not abstract unless the actual is.
if Is_Generic_Type (Derived_Type)
and then not Is_Abstract (Derived_Type)
New_Overloaded_Entity (New_Subp, Derived_Type);
- -- Check for case of a derived subprogram for the instantiation
- -- of a formal derived tagged type, if so mark the subprogram as
- -- dispatching and inherit the dispatching attributes of the
- -- parent subprogram. The derived subprogram is effectively a
- -- renaming of the actual subprogram, so it needs to have the
- -- same attributes as the actual.
+ -- Check for case of a derived subprogram for the instantiation of a
+ -- formal derived tagged type, if so mark the subprogram as dispatching
+ -- and inherit the dispatching attributes of the parent subprogram. The
+ -- derived subprogram is effectively renaming of the actual subprogram,
+ -- so it needs to have the same attributes as the actual.
if Present (Actual_Subp)
and then Is_Dispatching_Operation (Parent_Subp)
end if;
end if;
- -- Indicate that a derived subprogram does not require a body
- -- and that it does not require processing of default expressions.
+ -- Indicate that a derived subprogram does not require a body and that
+ -- it does not require processing of default expressions.
Set_Has_Completion (New_Subp);
Set_Default_Expressions_Processed (New_Subp);
Act_Elmt := No_Elmt;
end if;
- -- Literals are derived earlier in the process of building the
- -- derived type, and are skipped here.
+ -- Literals are derived earlier in the process of building the derived
+ -- type, and are skipped here.
Elmt := First_Elmt (Op_List);
while Present (Elmt) loop
or else (Is_Class_Wide_Type (Parent_Type)
and then Etype (Parent_Type) = T)
then
- -- If Parent_Type is undefined or illegal, make new type into
- -- a subtype of Any_Type, and set a few attributes to prevent
- -- cascaded errors. If this is a self-definition, emit error now.
+ -- If Parent_Type is undefined or illegal, make new type into a
+ -- subtype of Any_Type, and set a few attributes to prevent cascaded
+ -- errors. If this is a self-definition, emit error now.
if T = Parent_Type
or else T = Etype (Parent_Type)
elsif No (Extension) and then Taggd then
- -- If this is within a private part (or body) of a generic
- -- instantiation then the derivation is allowed (the parent
- -- type can only appear tagged in this case if it's a generic
- -- actual type, since it would otherwise have been rejected
- -- in the analysis of the generic template).
+ -- If this declaration is within a private part (or body) of a
+ -- generic instantiation then the derivation is allowed (the parent
+ -- type can only appear tagged in this case if it's a generic actual
+ -- type, since it would otherwise have been rejected in the analysis
+ -- of the generic template).
if not Is_Generic_Actual_Type (Parent_Type)
or else In_Visible_Part (Scope (Parent_Type))
elsif Ekind (Prev) = E_Incomplete_Type then
- -- Indicate that the incomplete declaration has a matching
- -- full declaration. The defining occurrence of the incomplete
+ -- Indicate that the incomplete declaration has a matching full
+ -- declaration. The defining occurrence of the incomplete
-- declaration remains the visible one, and the procedure
-- Get_Full_View dereferences it whenever the type is used.
Subtype_Indication => Relocate_Node (Obj_Def)));
-- This subtype may need freezing, and this will not be done
- -- automatically if the object declaration is not in a
- -- declarative part. Since this is an object declaration, the
- -- type cannot always be frozen here. Deferred constants do not
- -- freeze their type (which often enough will be private).
+ -- automatically if the object declaration is not in declarative
+ -- part. Since this is an object declaration, the type cannot always
+ -- be frozen here. Deferred constants do not freeze their type
+ -- (which often enough will be private).
if Nkind (P) = N_Object_Declaration
and then Constant_Present (P)
-- type T0 (Dx, Dy, Dz...)
- -- There are zero or more levels of derivation, with each
- -- derivation either purely inheriting the discriminants, or
- -- defining its own.
+ -- There are zero or more levels of derivation, with each derivation
+ -- either purely inheriting the discriminants, or defining its own.
-- type Ti is new Ti-1
-- or
-- or
-- subtype Ti is ...
- -- The subtype issue is avoided by the use of
- -- Original_Record_Component, and the fact that derived subtypes
- -- also derive the constraints.
+ -- The subtype issue is avoided by the use of Original_Record_Component,
+ -- and the fact that derived subtypes also derive the constraints.
-- This chain leads back from
(Old_C : Entity_Id;
Plain_Discrim : Boolean := False;
Stored_Discrim : Boolean := False);
- -- Inherits component Old_C from Parent_Base to the Derived_Base.
- -- If Plain_Discrim is True, Old_C is a discriminant.
- -- If Stored_Discrim is True, Old_C is a stored discriminant.
- -- If they are both false then Old_C is a regular component.
+ -- Inherits component Old_C from Parent_Base to the Derived_Base. If
+ -- Plain_Discrim is True, Old_C is a discriminant. If Stored_Discrim is
+ -- True, Old_C is a stored discriminant. If they are both false then
+ -- Old_C is a regular component.
-----------------------
-- Inherit_Component --
-- See if we can apply the second transformation for derived types, as
-- explained in point 6. in the comments above Build_Derived_Record_Type
- -- This is achieved by appending Derived_Base discriminants into
- -- Discs, which has the side effect of returning a non empty Discs
- -- list to the caller of Inherit_Components, which is what we want.
- -- This must be done for private derived types if there are explicit
- -- stored discriminants, to ensure that we can retrieve the values of
- -- the constraints provided in the ancestors.
+ -- This is achieved by appending Derived_Base discriminants into Discs,
+ -- which has the side effect of returning a non empty Discs list to the
+ -- caller of Inherit_Components, which is what we want. This must be
+ -- done for private derived types if there are explicit stored
+ -- discriminants, to ensure that we can retrieve the values of the
+ -- constraints provided in the ancestors.
if Inherit_Discr
and then Is_Empty_Elmt_List (Discs)
Type_Scope : Entity_Id;
function Is_Local_Type (Typ : Entity_Id) return Boolean;
- -- Check whether parent type of inherited component is declared
- -- locally, possibly within a nested package or instance. The
- -- current scope is the derived record itself.
+ -- Check whether parent type of inherited component is declared locally,
+ -- possibly within a nested package or instance. The current scope is
+ -- the derived record itself.
-------------------
-- Is_Local_Type --
elsif not Comes_From_Source (Original_Comp) then
return True;
- -- If we are in the body of an instantiation, the component is
- -- visible even when the parent type (possibly defined in an
- -- enclosing unit or in a parent unit) might not.
+ -- If we are in the body of an instantiation, the component is visible
+ -- even when the parent type (possibly defined in an enclosing unit or
+ -- in a parent unit) might not.
elsif In_Instance_Body then
return True;
-- private
-- type T is new A2 with null record;
- -- In this case, the full view of T inherits F1 and F2 but the
- -- private view inherits only F1
+ -- In this case, the full view of T inherits F1 and F2 but the private
+ -- view inherits only F1
else
declare
and then Is_Type (Entity (Prefix (Low_Bound (I))))
and then Is_Discrete_Type (Entity (Prefix (Low_Bound (I))))
then
- -- The type of the index will be the type of the prefix,
- -- as long as the upper bound is 'Last of the same type.
+ -- The type of the index will be the type of the prefix, as long
+ -- as the upper bound is 'Last of the same type.
Def_Id := Entity (Prefix (Low_Bound (I)));
return;
end if;
- -- We will now create the appropriate Itype to describe the
- -- range, but first a check. If we originally had a subtype,
- -- then we just label the range with this subtype. Not only
- -- is there no need to construct a new subtype, but it is wrong
- -- to do so for two reasons:
+ -- We will now create the appropriate Itype to describe the range, but
+ -- first a check. If we originally had a subtype, then we just label
+ -- the range with this subtype. Not only is there no need to construct
+ -- a new subtype, but it is wrong to do so for two reasons:
- -- 1. A legality concern, if we have a subtype, it must not
- -- freeze, and the Itype would cause freezing incorrectly
+ -- 1. A legality concern, if we have a subtype, it must not freeze,
+ -- and the Itype would cause freezing incorrectly
- -- 2. An efficiency concern, if we created an Itype, it would
- -- not be recognized as the same type for the purposes of
- -- eliminating checks in some circumstances.
+ -- 2. An efficiency concern, if we created an Itype, it would not be
+ -- recognized as the same type for the purposes of eliminating
+ -- checks in some circumstances.
-- We signal this case by setting the subtype entity in Def_Id
Set_Delta_Value (Implicit_Base, Delta_Val);
- -- Compute default small from given delta, which is the largest
- -- power of two that does not exceed the given delta value.
+ -- Compute default small from given delta, which is the largest power
+ -- of two that does not exceed the given delta value.
declare
Tmp : Ureal := Ureal_1;
end;
end if;
- -- The range for both the implicit base and the declared first
- -- subtype cannot be set yet, so we use the special routine
- -- Set_Fixed_Range to set a temporary range in place. Note that
- -- the bounds of the base type will be widened to be symmetrical
- -- and to fill the available bits when the type is frozen.
+ -- The range for both the implicit base and the declared first subtype
+ -- cannot be set yet, so we use the special routine Set_Fixed_Range to
+ -- set a temporary range in place. Note that the bounds of the base
+ -- type will be widened to be symmetrical and to fill the available
+ -- bits when the type is frozen.
-- We could do this with all discrete types, and probably should, but
-- we absolutely have to do it for fixed-point, since the end-points
begin
if Present (Full_B) then
- -- The Base_Type is already completed, we can complete the
- -- subtype now. We have to create a new entity with the same name,
- -- Thus we can't use Create_Itype.
+ -- The Base_Type is already completed, we can complete the subtype
+ -- now. We have to create a new entity with the same name, Thus we
+ -- can't use Create_Itype.
+
-- This is messy, should be fixed ???
Full := Make_Defining_Identifier (Sloc (Id), Chars (Id));
end if;
-- Create a full declaration for all its subtypes recorded in
- -- Private_Dependents and swap them similarly to the base type.
- -- These are subtypes that have been define before the full
- -- declaration of the private type. We also swap the entry in
- -- Private_Dependents list so we can properly restore the
- -- private view on exit from the scope.
+ -- Private_Dependents and swap them similarly to the base type. These
+ -- are subtypes that have been define before the full declaration of
+ -- the private type. We also swap the entry in Private_Dependents list
+ -- so we can properly restore the private view on exit from the scope.
declare
Priv_Elmt : Elmt_Id;
else
-- In this case the partial view is untagged, so here we
-- locate all of the earlier primitives that need to be
- -- treated as dispatching (those that appear between the
- -- two views). Note that these additional operations must
- -- all be new operations (any earlier operations that
- -- override inherited operations of the full view will
- -- already have been inserted in the primitives list and
- -- marked as dispatching by Check_Operation_From_Private_View.
- -- Note that implicit "/=" operators are excluded from being
- -- added to the primitives list since they shouldn't be
- -- treated as dispatching (tagged "/=" is handled specially).
+ -- treated as dispatching (those that appear between the two
+ -- views). Note that these additional operations must all be
+ -- new operations (any earlier operations that override
+ -- inherited operations of the full view will already have
+ -- been inserted in the primitives list and marked as
+ -- dispatching by Check_Operation_From_Private_View. Note that
+ -- implicit "/=" operators are excluded from being added to
+ -- the primitives list since they shouldn't be treated as
+ -- dispatching (tagged "/=" is handled specially).
Prim := Next_Entity (Full_T);
while Present (Prim) and then Prim /= Priv_T loop
Set_Etype (Hi, T);
end if;
- -- If the bounds of the range have been mistakenly given as
- -- string literals (perhaps in place of character literals),
- -- then an error has already been reported, but we rewrite
- -- the string literal as a bound of the range's type to
- -- avoid blowups in later processing that looks at static
- -- values.
+ -- If the bounds of the range have been mistakenly given as string
+ -- literals (perhaps in place of character literals), then an error
+ -- has already been reported, but we rewrite the string literal as a
+ -- bound of the range's type to avoid blowups in later processing
+ -- that looks at static values.
if Nkind (Lo) = N_String_Literal then
Rewrite (Lo,
-- not be raised.
-- ??? The following code should be cleaned up as follows
+
-- 1. The Is_Null_Range (Lo, Hi) test should disappear since it
-- is done in the call to Range_Check (R, T); below
+
-- 2. The use of R_Check_Off should be investigated and possibly
-- removed, this would clean up things a bit.
Def_Id := Defining_Identifier (Parent (P));
-- Implicit case, the Def_Id must be created as an implicit type.
- -- The one exception arises in the case of concurrent types,
- -- array and access types, where other subsidiary implicit types
- -- may be created and must appear before the main implicit type.
- -- In these cases we leave Def_Id set to Empty as a signal that
- -- Create_Itype has not yet been called to create Def_Id.
+ -- The one exception arises in the case of concurrent types, array
+ -- and access types, where other subsidiary implicit types may be
+ -- created and must appear before the main implicit type. In these
+ -- cases we leave Def_Id set to Empty as a signal that Create_Itype
+ -- has not yet been called to create Def_Id.
else
if Is_Array_Type (Subtype_Mark_Id)
-- A small clause may affect the values of the end-points
-- We try to include the end-points if it does not affect the size
- -- This means that the actual end-points must be established at the
- -- point when the type is frozen. Meanwhile, we first narrow the range
- -- as permitted (so that it will fit if necessary in a small specified
- -- size), and then build a range subtree with these narrowed bounds.
+ -- This means that the actual end-points must be established at the point
+ -- when the type is frozen. Meanwhile, we first narrow the range as
+ -- permitted (so that it will fit if necessary in a small specified size),
+ -- and then build a range subtree with these narrowed bounds.
- -- Set_Fixed_Range constructs the range from real literal values, and
- -- sets the range as the Scalar_Range of the given fixed-point type
- -- entity.
+ -- Set_Fixed_Range constructs the range from real literal values, and sets
+ -- the range as the Scalar_Range of the given fixed-point type entity.
- -- The parent of this range is set to point to the entity so that it
- -- is properly hooked into the tree (unlike normal Scalar_Range entries
- -- for other scalar types, which are just pointers to the range in the
+ -- The parent of this range is set to point to the entity so that it is
+ -- properly hooked into the tree (unlike normal Scalar_Range entries for
+ -- other scalar types, which are just pointers to the range in the
-- original tree, this would otherwise be an orphan).
-- The tree is left unanalyzed. When the type is frozen, the processing
-- 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;
-- 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.
-- 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
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);
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;
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
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);
-- 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 --
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);
-- INTEGER_TYPE_DEFINITION ::=
-- SIGNED_INTEGER_TYPE_DEFINITION
- -- MODULAR_TYPE_DEFINITION
+ -- | MODULAR_TYPE_DEFINITION
-------------------------------------------
-- 3.5.4 Signed Integer Type Definition --
-- 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
-- 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)
-- 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
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 " &
"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
-- 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
-- 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,
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,
OSDN Git Service
