+2009-07-22 Sergey Rybin <rybin@adacore.com>
+
+ * gnat_ugn.texi: Update doc for some gnatcheck rules.
+
+2009-07-22 Robert Dewar <dewar@adacore.com>
+
+ * par_sco.adb, par_sco.ads (pscos): New debug routine to output
+ contents of SCO tables.
+ * put_scos.adb, put_scos.ads, get_scos.adb, get_scos.ads,
+ scos.adb, scos.ads: New files.
+ * gcc-interface/Make-lang.in: Update dependencies.
+
+ * lib-util.ads, gnatbind.ads, ali.ads, binderr.ads: Minor comment
+ fixes and reformatting.
+
2009-07-22 Robert Dewar <dewar@adacore.com>
* g-socket.ads: Minor reformatting
-- Id Types --
--------------
- -- The various entries are stored in tables with distinct subscript
- -- ranges. The following type definitions indicate the ranges used
- -- for the subscripts (Id values) for the various tables.
+ -- The various entries are stored in tables with distinct subscript ranges.
+ -- The following type definitions show the ranges used for the subscripts
+ -- (Id values) for the various tables.
type ALI_Id is range 0 .. 999_999;
-- Id values used for ALIs table entries
-- V lines are ignored as a result of the Ignore_Lines parameter.
Ver_Len : Natural;
- -- Length of characters stored in Ver. Not set if V lines are
- -- ignored as a result of the Ignore_Lines parameter.
+ -- Length of characters stored in Ver. Not set if V lines are ignored as
+ -- a result of the Ignore_Lines parameter.
SAL_Interface : Boolean;
-- Set True when this is an interface to a standalone library
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- Insertion character { (Left brace: insert file name from Names table)
-- The character { is replaced by the text for the file name specified
-- by the File_Name_Type value stored in Error_Msg_File_1. The name is
- -- always enclosed in quotes. A second % may appear in a single message
+ -- always enclosed in quotes. A second { may appear in a single message
-- in which case it is similarly replaced by the name which is
-- specified by the File_Name_Type value stored in Error_Msg_File_2.
-- Insertion character $ (Dollar: insert unit name from Names table)
-- The character & is replaced by the text for the unit name specified
-- by the Name_Id value stored in Error_Msg_Unit_1. The name is always
- -- enclosed in quotes. A second & may appear in a single message in
+ -- enclosed in quotes. A second $ may appear in a single message in
-- which case it is similarly replaced by the name which is specified
-- by the Name_Id value stored in Error_Msg_Unit_2.
ada/g-hesora.o ada/g-htable.o ada/s-os_lib.o \
ada/g-speche.o ada/g-spchge.o ada/g-u3spch.o ada/s-string.o \
ada/s-utf_32.o ada/s-crc32.o ada/get_targ.o \
+ ada/get_scos.o \
ada/gnatvsn.o ada/hlo.o ada/hostparm.o ada/impunit.o ada/interfac.o \
ada/itypes.o ada/inline.o ada/krunch.o ada/lib.o ada/layout.o \
ada/lib-load.o ada/lib-util.o ada/lib-xref.o ada/lib-writ.o ada/live.o \
ada/namet.o ada/namet-sp.o \
ada/nlists.o ada/nmake.o ada/opt.o ada/osint.o ada/osint-c.o \
- ada/output.o ada/par_sco.o \
- ada/par.o ada/prep.o ada/prepcomp.o ada/repinfo.o ada/restrict.o \
+ ada/output.o \
+ ada/par_sco.o \
+ ada/par.o ada/prep.o ada/prepcomp.o ada/put_scos.o \
+ ada/repinfo.o ada/restrict.o \
ada/rident.o ada/rtsfind.o \
ada/s-addope.o ada/s-assert.o ada/s-parame.o ada/s-stache.o \
ada/s-stalib.o ada/s-imgenu.o ada/s-imenne.o ada/s-stoele.o ada/s-soflin.o \
ada/s-conca2.o ada/s-conca3.o ada/s-conca4.o ada/s-conca5.o \
ada/s-conca6.o ada/s-conca7.o ada/s-conca8.o ada/s-conca9.o \
ada/s-unstyp.o ada/scans.o ada/scng.o ada/scn.o ada/sdefault.o ada/sem.o \
+ ada/scos.o \
ada/sem_aggr.o ada/sem_attr.o ada/sem_aux.o \
ada/sem_cat.o ada/sem_ch10.o ada/sem_ch11.o \
ada/sem_ch12.o ada/sem_ch13.o ada/sem_ch2.o ada/sem_ch3.o ada/sem_ch4.o \
ada/g-u3spch.ads ada/g-u3spch.adb ada/system.ads ada/s-wchcnv.ads \
ada/s-wchcon.ads
+ada/get_scos.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
+ ada/get_scos.ads ada/get_scos.adb ada/gnat.ads ada/g-table.ads \
+ ada/g-table.adb ada/scos.ads ada/system.ads ada/s-exctab.ads \
+ ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
+ ada/unchconv.ads ada/unchdeal.ads
+
ada/get_targ.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
ada/get_targ.adb ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/fname.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-hesorg.adb ada/g-htable.ads \
- ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
- ada/lib-sort.adb ada/lib-util.ads ada/lib-util.adb ada/namet.ads \
- ada/nlists.ads ada/nlists.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \
- ada/output.ads ada/par_sco.ads ada/par_sco.adb ada/sinfo.ads \
- ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
- ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
- ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
- ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-strhas.ads \
- ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/widechar.ads
+ ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/lib.ads \
+ ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-util.ads \
+ ada/lib-util.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
+ ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
+ ada/par_sco.ads ada/par_sco.adb ada/put_scos.ads ada/put_scos.adb \
+ ada/scos.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
+ ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
+ ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
+ ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
+ ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/csets.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
+ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
+ ada/g-table.adb ada/put_scos.ads ada/put_scos.adb ada/scos.ads \
+ ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
+ ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
+
ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/fname.ads \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
+ada/scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
+ ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
+ ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
+ ada/types.ads ada/unchconv.ads ada/unchdeal.ads
+
ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
ada/debug_a.ads ada/debug_a.adb ada/einfo.ads ada/einfo.adb \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G E T _ S C O S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with SCOs; use SCOs;
+with Types; use Types;
+
+with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+
+procedure Get_SCOs is
+ Dnum : Nat;
+ C : Character;
+ Loc1 : Source_Location;
+ Loc2 : Source_Location;
+ Cond : Character;
+ Dtyp : Character;
+
+ use ASCII;
+ -- For CR/LF
+
+ procedure Check (C : Character);
+ -- Checks that file is positioned at given character, and if so skips past
+ -- it, If not, raises Data_Error.
+
+ function Get_Int return Int;
+ -- On entry the file is positioned to a digit. On return, the file is
+ -- positioned past the last digit, and the returned result is the decimal
+ -- value read. Data_Error is raised for overflow (value greater than
+ -- Int'Last), or if the initial character is not a digit.
+
+ procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location);
+ -- Skips initial spaces, then reads a source location range in the form
+ -- line:col-line:col and places the two source locations in Loc1 and Loc2.
+ -- Raises Data_Error if format does not match this requirement.
+
+ procedure Skip_EOL;
+ -- Called with the current character about to be read being LF or CR. Skips
+ -- past LR/CR characters until either a non-CR/LF character is found, or
+ -- the end of file is encountered.
+
+ procedure Skip_Spaces;
+ -- Skips zero or more spaces at the current position, leaving the file
+ -- positioned at the first non-blank character (or Types.EOF).
+
+ -----------
+ -- Check --
+ -----------
+
+ procedure Check (C : Character) is
+ begin
+ if Nextc = C then
+ Skipc;
+ else
+ raise Data_Error;
+ end if;
+ end Check;
+
+ -------------
+ -- Get_Int --
+ -------------
+
+ function Get_Int return Int is
+ Val : Int;
+ C : Character;
+
+ begin
+ C := Nextc;
+ Val := 0;
+
+ if C not in '0' .. '9' then
+ raise Data_Error;
+ end if;
+
+ -- Loop to read digits of integer value
+
+ loop
+ declare
+ pragma Unsuppress (Overflow_Check);
+ begin
+ Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
+ end;
+
+ Skipc;
+ C := Nextc;
+
+ exit when C not in '0' .. '9';
+ end loop;
+
+ return Val;
+
+ exception
+ when Constraint_Error =>
+ raise Data_Error;
+ end Get_Int;
+
+ --------------------
+ -- Get_Sloc_Range --
+ --------------------
+
+ procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location) is
+ pragma Unsuppress (Range_Check);
+
+ begin
+ Skip_Spaces;
+
+ Loc1.Line := Logical_Line_Number (Get_Int);
+ Check (':');
+ Loc1.Col := Column_Number (Get_Int);
+
+ Check ('-');
+
+ Loc2.Line := Logical_Line_Number (Get_Int);
+ Check (':');
+ Loc2.Col := Column_Number (Get_Int);
+
+ exception
+ when Constraint_Error =>
+ raise Data_Error;
+ end Get_Sloc_Range;
+
+ --------------
+ -- Skip_EOL --
+ --------------
+
+ procedure Skip_EOL is
+ C : Character;
+
+ begin
+ loop
+ Skipc;
+ C := Getc;
+ exit when C /= LF and then C /= CR;
+
+ if C = ' ' then
+ Skip_Spaces;
+ exit when C /= LF and then C /= CR;
+ end if;
+ end loop;
+ end Skip_EOL;
+
+ -----------------
+ -- Skip_Spaces --
+ -----------------
+
+ procedure Skip_Spaces is
+ begin
+ while Nextc = ' ' loop
+ Skipc;
+ end loop;
+ end Skip_Spaces;
+
+-- Start of processing for Get_Scos
+
+begin
+ SCO_Table.Init;
+ SCO_Unit_Table.Init;
+
+ -- Loop through lines of SCO information
+
+ while Nextc = 'C' loop
+ Skipc;
+
+ C := Getc;
+
+ -- Make sure first line is a header line
+
+ if SCO_Unit_Table.Last = 0 and then C /= ' ' then
+ raise Data_Error;
+ end if;
+
+ -- Otherwise dispatch on type of line
+
+ case C is
+
+ -- Header entry
+
+ when ' ' =>
+
+ -- Complete previous entry if any
+
+ if SCO_Unit_Table.Last /= 0 then
+ SCO_Unit_Table.Table (SCO_Unit_Table.Last).To :=
+ SCO_Table.Last;
+ end if;
+
+ -- Scan out dependency number and file name
+
+ declare
+ Ptr : String_Ptr := new String (1 .. 32768);
+ N : Integer;
+
+ begin
+ Skip_Spaces;
+ Dnum := Get_Int;
+
+ Skip_Spaces;
+
+ N := 0;
+ while Nextc > ' ' loop
+ N := N + 1;
+ Ptr.all (N) := Getc;
+ end loop;
+
+ -- Make new unit table entry (will fill in To later)
+
+ SCO_Unit_Table.Append (
+ (File_Name => new String'(Ptr.all (1 .. N)),
+ Dep_Num => Dnum,
+ From => SCO_Table.Last + 1,
+ To => 0));
+
+ Free (Ptr);
+ end;
+
+ -- Statement entry
+
+ when 'S' =>
+ Get_Sloc_Range (Loc1, Loc2);
+ Add_SCO (C1 => 'S', From => Loc1, To => Loc2);
+
+ -- Exit entry
+
+ when 'T' =>
+ Get_Sloc_Range (Loc1, Loc2);
+ Add_SCO (C1 => 'T', From => Loc1, To => Loc2);
+
+ -- Decision entry
+
+ when 'I' | 'E' | 'W' | 'X' =>
+ Dtyp := C;
+ Skip_Spaces;
+ C := Getc;
+
+ -- Case of simple condition
+
+ if C = 'c' or else C = 't' or else C = 'f' then
+ Cond := C;
+ Get_Sloc_Range (Loc1, Loc2);
+ Add_SCO
+ (C1 => Dtyp,
+ C2 => Cond,
+ From => Loc1,
+ To => Loc2,
+ Last => True);
+
+ -- Complex expression
+
+ else
+ Add_SCO (C1 => Dtyp, Last => False);
+
+ -- Loop through terms in complex expression
+
+ while C /= CR and then C /= LF loop
+ if C = 'c' or else C = 't' or else C = 'f' then
+ Cond := C;
+ Get_Sloc_Range (Loc1, Loc2);
+ Add_SCO
+ (C2 => C,
+ From => Loc1,
+ To => Loc2,
+ Last => False);
+
+ elsif C = '!' or else
+ C = '^' or else
+ C = '&' or else
+ C = '|'
+ then
+ Add_SCO (C1 => C, Last => False);
+
+ else
+ raise Data_Error;
+ end if;
+ end loop;
+
+ -- Reset Last indication to True for last entry
+
+ SCO_Table.Table (SCO_Table.Last).Last := True;
+ end if;
+
+ when others =>
+ raise Data_Error;
+ end case;
+
+ Skip_EOL;
+ end loop;
+
+ -- Here with all SCO's stored, complete last SCO Unit table entry
+
+ SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;
+end Get_SCOs;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G E T _ S C O S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains the function used to read SCO information from an
+-- ALI file and populate the tables defined in package SCOs with the result.
+
+generic
+ -- These subprograms provide access to the ALI file. Locating, opening
+ -- and providing access to the ALI file is the callers' responsibility.
+
+ with function Getc return Character is <>;
+ -- Get next character, positioning the ALI file ready to read the
+ -- following character (equivalent to calling Skipc, then Nextc). If
+ -- the end of file is encountered, the value Types.EOF is returned.
+
+ with function Nextc return Character is <>;
+ -- Look at the next character, and return it, leaving the position of the
+ -- file unchanged, so that a subsequent call to Getc or Nextc will return
+ -- this same character. If the file is positioned at the end of file, then
+ -- Types.EOF is returned.
+
+ with procedure Skipc is <>;
+ -- Skip past the current character (which typically was read with Nextc),
+ -- and position to the next character, which will be returned by the next
+ -- call to Getc or Nextc.
+
+procedure Get_SCOs;
+-- Load SCO information from ALI file text format into internal SCO tables
+-- (SCOs.SCO_Table and SCOs.SCO_Unit_Table). On entry the input file is
+-- positioned to the initial 'C' of the first SCO line in the ALI file.
+-- On return, the file is positioned either to the end of file, or to the
+-- first character of the line following the SCO information (which will
+-- never start with a 'C').
+--
+-- If a format error is detected in the input, then an exceptions is raised
+-- (Ada.IO_Exceptions.Data_Error), with the file positioned to the error.
@ignore
* Ceiling_Violations::
@end ignore
+* Complex_Inlined_Subprograms::
* Controlled_Type_Declarations::
* Declarations_In_Blocks::
+* Deep_Inheritance_Hierarchies::
+* Deeply_Nested_Generics::
+* Deeply_Nested_Inlining::
+@ignore
+* Deeply_Nested_Local_Inlining::
+@end ignore
* Default_Parameters::
+* Direct_Calls_To_Primitives::
* Discriminated_Records::
* Enumeration_Ranges_In_CASE_Statements::
* Exceptions_As_Control_Flow::
* Expanded_Loop_Exit_Names::
* Explicit_Full_Discrete_Ranges::
* Float_Equality_Checks::
+* Forbidden_Attributes::
* Forbidden_Pragmas::
* Function_Style_Procedures::
* Generics_In_Subprograms::
* Side_Effect_Functions::
@end ignore
* Slices::
+* Too_Many_Parents::
* Unassigned_OUT_Parameters::
* Uncommented_BEGIN_In_Package_Bodies::
* Unconditional_Exits::
* Unused_Subprograms::
@end ignore
* USE_PACKAGE_Clauses::
+* Visible_Components::
* Volatile_Objects_Without_Address_Clauses::
@end menu
@ignore
@node Ceiling_Violations
-@subsection @code{Ceiling_Violations} (under construction, GLOBAL)
+@subsection @code{Ceiling5_Violations} (under construction, GLOBAL)
@cindex @code{Ceiling_Violations} rule (for @command{gnatcheck})
@noindent
This rule has no parameters.
+@node Complex_Inlined_Subprograms
+@subsection @code{Complex_Inlined_Subprograms}
+@cindex @code{Complex_Inlined_Subprograms} rule (for @command{gnatcheck})
+
+@noindent
+Flags a subprogram body if a pragma Inline is applied to the subprogram or
+generic subprogram and this subprogram is too complex to be inlined.
+
+A subprogram is considered as being too complex for inlining if at least one
+of the following conditions is met for its body:
+
+@itemize @bullet
+@item
+number of local declarations + number of statements in subprogram body is
+more that a value specified by the @option{N} rule parameter;
+
+@item
+the body statement sequence contains a loop, if or case statement;
+
+@end itemize
+
+@noindent
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed total number of local
+declarations and statements in subprogram body.
+@end table
+
@node Declarations_In_Blocks
@subsection @code{Declarations_In_Blocks}
This rule has no parameters.
+@node Deep_Inheritance_Hierarchies
+@subsection @code{Deep_Inheritance_Hierarchies}
+@cindex @code{Deep_Inheritance_Hierarchies} rule (for @command{gnatcheck})
+
+@noindent
+Flags tagged derived type declarations and formal tagged derived type
+declarations if the corresponding inheritance hierarchy is deeper that
+a value specified by the @option{N} rule parameter.
+
+The depth of the inheritance hierarchy is the length of the longest
+path from the root to a leaf in the type inheritance tree.
+
+The rule does not flag interface types and private extension
+declarations (in case of a private extension, the correspondong full
+declaration is checked)
+
+This rule has the following parameter for +R option:
+
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed depth of the inheritance tree.
+@end table
+
+
+@node Deeply_Nested_Generics
+@subsection @code{Deeply_Nested_Generics}
+@cindex @code{Deeply_Nested_Generics} rule (for @command{gnatcheck})
+
+@noindent
+Flags generic declarations nested in another generic declarations if
+the level of generics-in-generics nesting is higher that
+a value specified by the @option{N} rule parameter.
+The level of generics-in-generics
+nesting is the number of generic declaratons that enclose the given (generic)
+declaration. Formal packages are not flagged by this rule.
+
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed level of
+generics-in-generics nesting.
+@end table
+
+@node Deeply_Nested_Inlining
+@subsection @code{Deeply_Nested_Inlining}
+@cindex @code{Deeply_Nested_Inlining} rule (for @command{gnatcheck})
+
+@noindent
+Flags a subprogram if a pragma @code{Inline} is applied to the corresponding
+subprogram (or generic subprogram in case if a flagged subprogram is a generic
+instantiation) and the subprogram body contains a call to another inlined
+subprogram that results in nested inlining with nesting depth more then
+a value specified by the @option{N} rule parameter. This rule
+assumes that calls to subprograms in with'ed units are inlided if
+at the place of the call the corresponding Inline pragma is visible. This
+rule may be usefull for the case when eiter @option{-gnatn} or @option{-gnatN}
+option is used when building the executable.
+
+If a subprogram should be flagged according to this rule, the body declaration
+is flagged only if it is not a completion of a subprogram declaration.
+
+This rule requires the global analysis of all the set of compilation units that
+are @command{gnatcheck} arguments, that may affect performance.
+
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed level of nested inlining.
+@end table
+
+
+@ignore
+@node Deeply_Nested_Local_Inlining
+@subsection @code{Deeply_Nested_Local_Inlining}
+@cindex @code{Deeply_Nested_Local_Inlining} rule (for @command{gnatcheck})
+
+@noindent
+Flags a subprogram body if a pragma @code{Inline} is applied to the
+corresponding subprogram (or generic subprogram) and the body contains a call
+to another inlined subprogram that results in nested inlining with nesting
+depth more then a value specified by the @option{N} rule parameter.
+This rule is similar to @code{Deeply_Nested_Inlining} rule, but it
+assumes that calls to subprograms in
+with'ed units are not inlided, so all the analysis of the depth of inlining is
+limited by the compilation unit where the subprogram body is located and the
+units it depends semantically upon. Such analysis may be usefull for the case
+when neiter @option{-gnatn} nor @option{-gnatN} option is used when building
+the executable.
+
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed level of nested inlining.
+@end table
+
+@end ignore
+
@node Default_Parameters
@subsection @code{Default_Parameters}
@cindex @code{Default_Parameters} rule (for @command{gnatcheck})
This rule has no parameters.
+@node Direct_Calls_To_Primitives
+@subsection @code{Direct_Calls_To_Primitives}
+@cindex @code{Direct_Calls_To_Primitives} rule (for @command{gnatcheck})
+
+@noindent
+Flags any non-dispatching call to a dispatching primitive operation, except
+when a primitive of a tagged type calls directly the same primitive of the
+immediate ancestor.
+
+This rule has no parameters.
+
+
@node Discriminated_Records
@subsection @code{Discriminated_Records}
@cindex @code{Discriminated_Records} rule (for @command{gnatcheck})
This rule has no parameters.
+@node Forbidden_Attributes
+@subsection @code{Forbidden_Attributes}
+@cindex @code{Forbidden_Attributes} rule (for @command{gnatcheck})
+
+@noindent
+Flag each use of the specified attributes. The attributes to be detected are
+named in the rule's parameters.
+
+This rule has the following parameters:
+
+@itemize @bullet
+@item For the @option{+R} option
+
+@table @asis
+@item @emph{Attribute_Designator}
+Adds the specified attribute to the set of attributes to be checked and sets
+the checks for all the specified attributes ON. If @emph{Attribute_Designator}
+does not correspond to any attribute designator defined in the Ada standard
+or to the designator of a GNAT-specific attribute defined in
+@ref{Implementation Defined Attributes,,, gnat_rm, GNAT Reference
+Manual}, it is treated as the name of unknown attribute.
+
+@item @code{GNAT}
+All the GNAT-specific attributes are detected; this sets
+the checks for all the specified attributes ON.
+
+@item @code{ALL}
+All attributes are detected; this sets the rule ON.
+@end table
+
+@item For the @option{-R} option
+@table @asis
+@item @emph{Attribute_Designator}
+Removes the specified attribute from the set of attributes to be
+checked without affecting checks for
+other attributes. If @emph{Attribute_Designator} does not correspond to any
+attribute designator defined in the Ada standard or to the designator
+of a GNAT-specific attribute defined in
+@ref{Implementation Defined Attributes,,, gnat_rm, GNAT Reference Manual},
+this option is treated as turning OFF detection of all unknown pragmas.
+
+@item GNAT
+Turn OFF detection of all GNAT-specific attributes
+
+@item ALL
+Clear the list of the attributes to be detected and
+turn the rule OFF.
+@end table
+@end itemize
+
+@noindent
+Parameters are not case sensitive. If @emph{Attribute_Designator} does not have
+the syntax of an Ada identifier and therefore can not be considered as a (part
+of an) attribute designator, a diagnostic message is generated and the
+corresponding parameter is ignored. (If an attribute allows a static
+expression to be a part of the attribute designator, this expression is
+ignored by this rule.
+
+When more then one parameter is given in the same rule option, the parameters
+must be separated by a comma.
+
+If more then one option for this rule is specified for the gnatcheck call, a
+new option overrides the previous one(s).
+
+The @option{+R} option with no parameters turns the rule ON with the set of
+attributes to be detected defined by the previous rule options.
+(By default this set is empty, so if the only option specified for the rule is
+@option{+RForbidden_Attributes} (with
+no parameter), then the rule is enabled, but it does not detect anything).
+The @option{-R} option with no parameter turns the rule OFF, but it does not
+affect the set of attributes to be detected.
+
+
@node Forbidden_Pragmas
@subsection @code{Forbidden_Pragmas}
@cindex @code{Forbidden_Pragmas} rule (for @command{gnatcheck})
This rule has no parameters.
+@node Too_Many_Parents
+@subsection @code{Too_Many_Parents}
+@cindex @code{Too_Many_Parents} rule (for @command{gnatcheck})
+
+@noindent
+Flags any type declaration, single task declaration or single protected
+declaration that has more then @option{N} parents, @option{N} is a parameter
+of the rule.
+A parent here is either a (sub)type denoted by the subtype mark from the
+parent_subtype_indication (in case of a derived type declaration), or
+any of the progenitors from the interface list, if any.
+
+This rule has the following (mandatory) parameters for the @option{+R} option:
+
+@table @emph
+@item N
+Positive integer specifying the maximal allowed number of parents.
+@end table
+
+
@node Unassigned_OUT_Parameters
@subsection @code{Unassigned_OUT_Parameters}
@cindex @code{Unassigned_OUT_Parameters} rule (for @command{gnatcheck})
This rule has no parameters.
+@node Visible_Components
+@subsection @code{Visible_Components}
+@cindex @code{Visible_Components} rule (for @command{gnatcheck})
+
+@noindent
+Flags all the type declarations located in the visible part of a library
+package or a library generic package that can declare a visible component. A
+type is considered as declaring a visible component if it contains a record
+definition by its own or as a part of a record extension. Type declaration is
+flagged even if it contains a record definition that defines no components.
+
+Declarations located in private parts of local (generic) packages are not
+flagged. Declarations in private packages are not flagged.
+
+This rule has no parameters.
+
@node Volatile_Objects_Without_Address_Clauses
@subsection @code{Volatile_Objects_Without_Address_Clauses}
-- --
-- G N A T B I N D --
-- --
--- B o d y --
+-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- if the host system needs a write for each line.
procedure Write_Info_Initiate (Key : Character);
- -- Initiates write of new line to info file, the parameter is the
- -- keyword character for the line. The caller is responsible for
- -- writing the required blank after the key character.
+ -- Initiates write of new line to info file, the parameter is the keyword
+ -- character for the line. The caller is responsible for writing the
+ -- required blank after the key character if needed.
procedure Write_Info_Nat (N : Nat);
-- Adds image of N to Info_Buffer with no leading or trailing blanks
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
+with Put_SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Table;
Traverse (N);
end Process_Decisions;
+ -----------
+ -- pscos --
+ -----------
+
+ procedure pscos is
+
+ procedure Write_Info_Char (C : Character) renames Write_Char;
+ -- Write one character;
+
+ procedure Write_Info_Initiate (Key : Character) renames Write_Char;
+ -- Start new one and write one character;
+
+ procedure Write_Info_Nat (N : Nat);
+ -- Write value of N
+
+ procedure Write_Info_Terminate renames Write_Eol;
+ -- Terminate current line
+
+ --------------------
+ -- Write_Info_Nat --
+ --------------------
+
+ procedure Write_Info_Nat (N : Nat) is
+ begin
+ Write_Int (N);
+ end Write_Info_Nat;
+
+ procedure Debug_Put_SCOs is new Put_SCOs;
+
+ -- Start of processing for pscos
+
+ begin
+ Debug_Put_SCOs;
+ end pscos;
+
----------------
-- SCO_Output --
----------------
-- unit U in the ALI file, as recorded by previous calls to SCO_Record,
-- possibly modified by calls to Set_SCO_Condition.
+ procedure pscos;
+ -- Debugging procedure to output contents of SCO binary tables in SCOs
+
end Par_SCO;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P U T _ S C O S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with SCOs; use SCOs;
+
+procedure Put_SCOs is
+begin
+ -- Loop through entries in SCO_Unit_Table
+
+ for U in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop
+ declare
+ SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
+
+ Start : Nat;
+ Stop : Nat;
+
+ begin
+ Write_Info_Initiate ('C');
+ Write_Info_Char (' ');
+ Write_Info_Nat (SUT.Dep_Num);
+ Write_Info_Char (' ');
+
+ for N in SUT.File_Name'Range loop
+ Write_Info_Char (SUT.File_Name (N));
+ end loop;
+
+ Write_Info_Terminate;
+
+ -- Loop through SCO entries for this unit
+
+ Start := SCO_Table.First;
+ Stop := SCO_Table.Last;
+ loop
+ declare
+ T : SCO_Table_Entry renames SCO_Table.Table (Start);
+
+ procedure Output_Range;
+ -- Outputs T.From and T.To in line:col-line:col format
+
+ procedure Output_Range is
+ begin
+ Write_Info_Nat (Nat (T.From.Line));
+ Write_Info_Char (':');
+ Write_Info_Nat (Nat (T.From.Col));
+ Write_Info_Char ('-');
+ Write_Info_Nat (Nat (T.To.Line));
+ Write_Info_Char (':');
+ Write_Info_Nat (Nat (T.To.Col));
+ end Output_Range;
+
+ begin
+ Write_Info_Initiate ('C');
+ Write_Info_Char (T.C1);
+
+ case T.C1 is
+
+ -- Statements, exit
+
+ when 'S' | 'T' =>
+ Write_Info_Char (' ');
+ Output_Range;
+
+ -- Decision
+
+ when 'I' | 'E' | 'W' | 'X' =>
+ if T.C2 = ' ' then
+ Start := Start + 1;
+ end if;
+
+ -- Loop through table entries for this decision
+
+ loop
+ declare
+ T : SCO_Table_Entry renames SCO_Table.Table (Start);
+
+ begin
+ Write_Info_Char (' ');
+
+ if T.C1 = '!' or else
+ T.C1 = '^' or else
+ T.C1 = '&' or else
+ T.C1 = '|'
+ then
+ Write_Info_Char (T.C1);
+
+ else
+ Write_Info_Char (T.C2);
+ Output_Range;
+ end if;
+
+ exit when T.Last;
+ Start := Start + 1;
+ end;
+ end loop;
+
+ when others =>
+ raise Program_Error;
+ end case;
+
+ Write_Info_Terminate;
+ end;
+
+ exit when Start = Stop;
+ Start := Start + 1;
+
+ pragma Assert (Start <= Stop);
+ end loop;
+ end;
+
+ -- If not last entry, blank line
+
+ if U /= SCO_Unit_Table.Last then
+ Write_Info_Terminate;
+ end if;
+ end loop;
+end Put_SCOs;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P U T _ S C O S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains the function used to read SCO information from the
+-- internal tables defined in package SCOs, and output text information for
+-- the ALI file. The interface allows control over the destination of the
+-- output, so that this routine can also be used for debugging purposes.
+
+with Types; use Types;
+
+generic
+ -- The following procedures are used to output text information
+
+ with procedure Write_Info_Char (C : Character) is <>;
+ -- Outputs one character
+
+ with procedure Write_Info_Initiate (Key : Character) is <>;
+ -- Initiates write of new line to output file, the parameter is the
+ -- keyword character for the line.
+
+ with procedure Write_Info_Nat (N : Nat) is <>;
+ -- Writes image of N to output file with no leading or trailing blanks
+
+ with procedure Write_Info_Terminate is <>;
+ -- Terminate current info line and output lines built in Info_Buffer
+
+procedure Put_SCOs;
+-- Read information from SCOs.SCO_Table and SCOs.SCO_Unit_Table and output
+-- corresponding information in ALI format using the Write_Info procedures.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S C O S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body SCOs is
+
+ procedure Add_SCO
+ (From : Source_Location := No_Location;
+ To : Source_Location := No_Location;
+ C1 : Character := ' ';
+ C2 : Character := ' ';
+ Last : Boolean := False)
+ is
+ begin
+ SCO_Table.Append ((From, To, C1, C2, Last));
+ end Add_SCO;
+
+end SCOs;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S C O S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package defines tables used to store Source Coverage Obligations. It
+-- is used by Par_SCO to build the SCO information before writing it out to
+-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
+-- is used in the ALI file.
+
+with Types; use Types;
+
+with GNAT.Table;
+
+package SCOs is
+
+ -- SCO information can exist in one of two forms. In the ALI file, it is
+ -- represented using a text format that is described in this specification.
+ -- Internally it is stored using two tables SCO_Table and SCO_Unit_Table,
+ -- which are also defined in this unit.
+
+ -- Par_SCO is part of the compiler. It scans the parsed source tree and
+ -- populates the internal tables.
+
+ -- Get_SCO reads the text lines in ALI format and populates the internal
+ -- tables with corresponding information.
+
+ -- Put_SCO reads the internal tables and generates text lines in the ALI
+ -- format.
+
+ --------------------
+ -- SCO ALI Format --
+ --------------------
+
+ -- Source coverage obligations are generated on a unit-by-unit basis in the
+ -- ALI file, using lines that start with the identifying character C. These
+ -- lines are generated if the -gnatC switch is set.
+
+ -- Sloc Ranges
+
+ -- In several places in the SCO lines, Sloc ranges appear. These are used
+ -- to indicate the first and last Sloc of some construct in the tree and
+ -- they have the form:
+
+ -- line:col-line:col
+
+ -- Note that SCO's are generated only for generic templates, not for
+ -- generic instances (since only the first are part of the source). So
+ -- we don't need generic instantiation stuff in these line:col items.
+
+ -- SCO File headers
+
+ -- The SCO information follows the cross-reference information, so it
+ -- need not be read by tools like gnatbind, gnatmake etc. The SCO output
+ -- is divided into sections, one section for each unit for which SCO's
+ -- are generated. A SCO section has a header of the form:
+
+ -- C dependency-number filename
+
+ -- This header precedes SCO information for the unit identified by
+ -- dependency number and file name. The dependency number is the
+ -- index into the generated D lines and is ones origin (i.e. 2 =
+ -- reference to second generated D line).
+
+ -- Note that the filename here will reflect the original name if
+ -- a Source_Reference pragma was encountered (since all line number
+ -- references will be with respect to the original file).
+
+ -- Statements
+
+ -- For the purpose of SCO generation, the notion of statement includes
+ -- simple statements and also the following declaration types:
+
+ -- type_declaration
+ -- subtype_declaration
+ -- object_declaration
+ -- renaming_declaration
+ -- generic_instantiation
+
+ -- Statement lines
+
+ -- These lines correspond to a sequence of one or more statements which
+ -- are always exeecuted in sequence, The first statement may be an entry
+ -- point (e.g. statement after a label), and the last statement may be
+ -- an exit point (e.g. an exit statement), but no other entry or exit
+ -- points may occur within the sequence of statements. The idea is that
+ -- the sequence can be treated as a single unit from a coverage point of
+ -- view, if any of the code for the statement sequence is executed, this
+ -- corresponds to coverage of the entire statement sequence. The form of
+ -- a statement line in the ALI file is:
+
+ -- CS sloc-range
+
+ -- Exit points
+
+ -- An exit point is a statement that causes transfer of control. Examples
+ -- are exit statements, raise statements and return statements. The form
+ -- of an exit point in the ALI file is:
+
+ -- CT sloc-range
+
+ -- Decisions
+
+ -- Decisions represent the most significant section of the SCO lines
+
+ -- Note: in the following description, logical operator includes the
+ -- short circuited forms (so can be any of AND, OR, XOR, NOT, AND THEN,
+ -- or OR ELSE).
+
+ -- Decisions are either simple or complex. A simple decision is a boolean
+ -- expresssion that occurs in the context of a control structure in the
+ -- source program, including WHILE, IF, EXIT WHEN. Note that a boolean
+ -- expression in any other context, for example, on the right side of an
+ -- assignment, is not considered to be a decision.
+
+ -- A complex decision is an occurrence of a logical operator which is not
+ -- itself an operand of some other logical operator. If any operand of
+ -- the logical operator is itself a logical operator, this is not a
+ -- separate decision, it is part of the same decision.
+
+ -- So for example, if we have
+
+ -- A, B, C, D : Boolean;
+ -- function F (Arg : Boolean) return Boolean);
+ -- ...
+ -- A and then (B or else F (C and then D))
+
+ -- There are two (complex) decisions here:
+
+ -- 1. X and then (Y or else Z)
+
+ -- where X = A, Y = B, and Z = F (C and then D)
+
+ -- 2. C and then D
+
+ -- For each decision, a decision line is generated with the form:
+
+ -- C* expression
+
+ -- Here * is one of the following characters:
+
+ -- I decision in IF statement or conditional expression
+ -- E decision in EXIT WHEN statement
+ -- W decision in WHILE iteration scheme
+ -- X decision appearing in some other expression context
+
+ -- The expression is a prefix polish form indicating the structure of
+ -- the decision, including logical operators and short circuit forms.
+ -- The following is a grammar showing the structure of expression:
+
+ -- expression ::= term (if expr is not logical operator)
+ -- expression ::= & term term (if expr is AND or AND THEN)
+ -- expression ::= | term term (if expr is OR or OR ELSE)
+ -- expression ::= ^ term term (if expr is XOR)
+ -- expression ::= !term (if expr is NOT)
+
+ -- term ::= element
+ -- term ::= expression
+
+ -- element ::= outcome sloc-range
+
+ -- outcome is one of the following letters:
+
+ -- c condition
+ -- t true condition
+ -- f false condition
+
+ -- where t/f are used to mark a condition that has been recognized by
+ -- the compiler as always being true or false.
+
+ -- & indicates either AND or AND THEN connecting two conditions. In the
+ -- context of couverture we only permit AND THEN in the source in any
+ -- case, so & can always be understood to be AND THEN.
+
+ -- | indicates either OR or OR ELSE connection two conditions. In the
+ -- context of couverture we only permit OR ELSE in the source in any
+ -- case, so | can always be understood to be OR ELSE.
+
+ -- ^ indicates XOR connecting two conditions. In the context of
+ -- couverture, we do not permit XOR, so this will never appear.
+
+ -- ! indicates NOT applied to the expression.
+
+ ---------------------------------------------------------------------
+ -- Internal table used to store Source Coverage Obligations (SCOs) --
+ ---------------------------------------------------------------------
+
+ type Source_Location is record
+ Line : Logical_Line_Number;
+ Col : Column_Number;
+ end record;
+
+ No_Location : Source_Location := (No_Line_Number, No_Column_Number);
+
+ type SCO_Table_Entry is record
+ From : Source_Location;
+ To : Source_Location;
+ C1 : Character;
+ C2 : Character;
+ Last : Boolean;
+ end record;
+
+ package SCO_Table is new GNAT.Table (
+ Table_Component_Type => SCO_Table_Entry,
+ Table_Index_Type => Nat,
+ Table_Low_Bound => 1,
+ Table_Initial => 500,
+ Table_Increment => 300);
+
+ -- The SCO_Table_Entry values appear as follows:
+
+ -- Statements
+ -- C1 = 'S'
+ -- C2 = ' '
+ -- From = starting source location
+ -- To = ending source location
+ -- Last = unused
+
+ -- Exit
+ -- C1 = 'T'
+ -- C2 = ' '
+ -- From = starting source location
+ -- To = ending source location
+ -- Last = unused
+
+ -- Simple Decision
+ -- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
+ -- C2 = 'c', 't', or 'f'
+ -- From = starting source location
+ -- To = ending source location
+ -- Last = True
+
+ -- Complex Decision
+ -- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
+ -- C2 = ' '
+ -- From = No_Location
+ -- To = No_Location
+ -- Last = False
+
+ -- Operator
+ -- C1 = '!', '^', '&', '|'
+ -- C2 = ' '
+ -- From = No_Location
+ -- To = No_Location
+ -- Last = False
+
+ -- Element
+ -- C1 = ' '
+ -- C2 = 'c', 't', or 'f' (condition/true/false)
+ -- From = starting source location
+ -- To = ending source location
+ -- Last = False for all but the last entry, True for last entry
+
+ -- Note: the sequence starting with a decision, and continuing with
+ -- operators and elements up to and including the first one labeled with
+ -- Last=True, indicate the sequence to be output for a complex decision
+ -- on a single CD decision line.
+
+ ----------------
+ -- Unit Table --
+ ----------------
+
+ -- This table keeps track of the units and the corresponding starting and
+ -- ending indexes (From, To) in the SCO table. Note that entry zero is
+ -- unused, it is for convenience in calling the sort routine. The Info
+ -- field is an identifier supplied when an entry is built (e.g. in the
+ -- compiler this is the Unit_Number_Type value.
+
+ type SCO_Unit_Index is new Int;
+ -- Used to index values in this table. Values start at 1 and are assigned
+ -- sequentially as entries are constructed.
+
+ type SCO_Unit_Table_Entry is record
+ File_Name : String_Ptr;
+ -- Pointer to file name in ALI file
+
+ Dep_Num : Nat;
+ -- Dependency number in ALI file
+
+ From : Nat;
+ -- Starting index in SCO_Table of SCO information for this unit
+
+ To : Nat;
+ -- Ending index in SCO_Table of SCO information for this unit
+ end record;
+
+ package SCO_Unit_Table is new GNAT.Table (
+ Table_Component_Type => SCO_Unit_Table_Entry,
+ Table_Index_Type => SCO_Unit_Index,
+ Table_Low_Bound => 0,
+ Table_Initial => 20,
+ Table_Increment => 200);
+
+ -----------------
+ -- Subprograms --
+ -----------------
+
+ procedure Add_SCO
+ (From : Source_Location := No_Location;
+ To : Source_Location := No_Location;
+ C1 : Character := ' ';
+ C2 : Character := ' ';
+ Last : Boolean := False);
+ -- Adds one entry to SCO table with given field values
+
+end SCOs;
OSDN Git Service
