diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/binderr.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 49 | ||||
| -rw-r--r-- | gcc/ada/get_scos.adb | 311 | ||||
| -rw-r--r-- | gcc/ada/get_scos.ads | 58 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 266 | ||||
| -rw-r--r-- | gcc/ada/gnatbind.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/lib-util.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/par_sco.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/par_sco.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/put_scos.adb | 138 | ||||
| -rw-r--r-- | gcc/ada/put_scos.ads | 51 | ||||
| -rw-r--r-- | gcc/ada/scos.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/scos.ads | 326 |
15 files changed, 1291 insertions, 29 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d2b6375b7fa..b5b2d5672fa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +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 diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index b6e16bea8a7..9e8da30a22f 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -42,9 +42,9 @@ package ALI is -- 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 @@ -103,8 +103,8 @@ package ALI is -- 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 diff --git a/gcc/ada/binderr.ads b/gcc/ada/binderr.ads index e7b3ad11738..3a419d5d697 100644 --- a/gcc/ada/binderr.ads +++ b/gcc/ada/binderr.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -54,14 +54,14 @@ package Binderr is -- 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. diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 7783a11651a..bea5d7370eb 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -134,13 +134,16 @@ GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-exc 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 \ @@ -150,6 +153,7 @@ GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-exc 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 \ @@ -2272,6 +2276,12 @@ ada/g-u3spch.o : ada/gnat.ads ada/g-spchge.ads ada/g-spchge.adb \ 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 @@ -2671,18 +2681,19 @@ ada/par_sco.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/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 \ @@ -2717,6 +2728,11 @@ ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \ @@ -2963,6 +2979,11 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \ diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb new file mode 100644 index 00000000000..185d80acc43 --- /dev/null +++ b/gcc/ada/get_scos.adb @@ -0,0 +1,311 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/get_scos.ads b/gcc/ada/get_scos.ads new file mode 100644 index 00000000000..0ece1ab0ef3 --- /dev/null +++ b/gcc/ada/get_scos.ads @@ -0,0 +1,58 @@ +------------------------------------------------------------------------------ +-- -- +-- 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. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index f5e9ac3906b..ad202ca59d2 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -20979,9 +20979,17 @@ used as a parameter of the @option{+R} or @option{-R} options. @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:: @@ -20990,6 +20998,7 @@ used as a parameter of the @option{+R} or @option{-R} options. * Expanded_Loop_Exit_Names:: * Explicit_Full_Discrete_Ranges:: * Float_Equality_Checks:: +* Forbidden_Attributes:: * Forbidden_Pragmas:: * Function_Style_Procedures:: * Generics_In_Subprograms:: @@ -21034,6 +21043,7 @@ used as a parameter of the @option{+R} or @option{-R} options. * Side_Effect_Functions:: @end ignore * Slices:: +* Too_Many_Parents:: * Unassigned_OUT_Parameters:: * Uncommented_BEGIN_In_Package_Bodies:: * Unconditional_Exits:: @@ -21044,6 +21054,7 @@ used as a parameter of the @option{+R} or @option{-R} options. * Unused_Subprograms:: @end ignore * USE_PACKAGE_Clauses:: +* Visible_Components:: * Volatile_Objects_Without_Address_Clauses:: @end menu @@ -21131,7 +21142,7 @@ This rule has no parameters. @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 @@ -21185,6 +21196,36 @@ component is not checked. 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} @@ -21198,6 +21239,108 @@ containing only pragmas and/or @code{use} clauses is not flagged. 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}) @@ -21209,6 +21352,18 @@ declarations of formal and generic subprograms are also checked. 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}) @@ -21309,6 +21464,79 @@ and ``@code{/=}'' operations for fixed-point types. 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}) @@ -22342,6 +22570,26 @@ Flag all uses of array slicing 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}) @@ -22467,6 +22715,22 @@ not flagged. 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} diff --git a/gcc/ada/gnatbind.ads b/gcc/ada/gnatbind.ads index 85bce5604e7..be78dcd0448 100644 --- a/gcc/ada/gnatbind.ads +++ b/gcc/ada/gnatbind.ads @@ -4,9 +4,9 @@ -- -- -- 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- -- diff --git a/gcc/ada/lib-util.ads b/gcc/ada/lib-util.ads index f08e890e21b..a8326ac2a50 100644 --- a/gcc/ada/lib-util.ads +++ b/gcc/ada/lib-util.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -45,9 +45,9 @@ package Lib.Util is -- 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 diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 663959de64d..5bda78e224b 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -30,6 +30,7 @@ with Lib.Util; use Lib.Util; 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; @@ -549,6 +550,41 @@ package body Par_SCO is 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 -- ---------------- diff --git a/gcc/ada/par_sco.ads b/gcc/ada/par_sco.ads index a977a11daa1..9f24af4930c 100644 --- a/gcc/ada/par_sco.ads +++ b/gcc/ada/par_sco.ads @@ -211,4 +211,7 @@ package Par_SCO is -- 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; diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb new file mode 100644 index 00000000000..6597f264006 --- /dev/null +++ b/gcc/ada/put_scos.adb @@ -0,0 +1,138 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/put_scos.ads b/gcc/ada/put_scos.ads new file mode 100644 index 00000000000..a2ea41e6b81 --- /dev/null +++ b/gcc/ada/put_scos.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- 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. diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb new file mode 100644 index 00000000000..e5dfcd234ac --- /dev/null +++ b/gcc/ada/scos.adb @@ -0,0 +1,39 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads new file mode 100644 index 00000000000..0e641624ff3 --- /dev/null +++ b/gcc/ada/scos.ads @@ -0,0 +1,326 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; |