+2009-07-22 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb (Gen_Loop): Do not qualify the bounds of the range if
+ they are already of the base type of the index.
+
+2009-07-22 Brett Porter <porter@adacore.com>
+
+ * sysdep.c, init.c: Fix typo: _SPE_ should have been __SPE__.
+
+2009-07-22 Robert Dewar <dewar@adacore.com>
+
+ * vms_data.ads: Add entry for SCO_OUTPUT (-gnateS)
+ * gnat_ugn.texi: Add documentation for -gnateS switch
+ * ug_words: Add entry for -gnateS /SCO_OUTPUT
+ * gcc-interface/Make-lang.in: Update dependenciest.3
+
+ * get_scos.adb, get_scos.ads, gnat1drv.adb, par_sco.adb,
+ par_sco.ads, put_scos.adb, put_scos.ads, scos.adb, scos.ads: Initial
+ complete information for SCO input/output.
+
2009-07-22 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update doc for some gnatcheck rules.
function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is
L_J : Node_Id;
+ L_L : Node_Id;
+ -- Index_Base'(L)
+
+ L_H : Node_Id;
+ -- Index_Base'(H)
+
L_Range : Node_Id;
-- Index_Base'(L) .. Index_Base'(H)
L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
- -- Construct "L .. H"
+ -- Construct "L .. H" in Index_Base. We use a qualified expression
+ -- for the bound to convert to the index base, but we don't need
+ -- to do that if we already have the base type at hand.
+
+ if Etype (L) = Index_Base then
+ L_L := L;
+ else
+ L_L :=
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => Index_Base_Name,
+ Expression => L);
+ end if;
+
+ if Etype (H) = Index_Base then
+ L_H := H;
+ else
+ L_H :=
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => Index_Base_Name,
+ Expression => H);
+ end if;
L_Range :=
- Make_Range
- (Loc,
- Low_Bound => Make_Qualified_Expression
- (Loc,
- Subtype_Mark => Index_Base_Name,
- Expression => L),
- High_Bound => Make_Qualified_Expression
- (Loc,
- Subtype_Mark => Index_Base_Name,
- Expression => H));
+ Make_Range (Loc,
+ Low_Bound => L_L,
+ High_Bound => L_H);
-- Construct "for L_J in Index_Base range L .. H"
ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
ada/erroutc.ads ada/exp_tss.ads ada/expander.ads ada/fmap.ads \
ada/fname.ads ada/fname-uf.ads ada/frontend.ads ada/get_targ.ads \
- ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnat1drv.ads \
- ada/gnat1drv.adb ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
- ada/inline.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
- ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads ada/lib-xref.ads \
- ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \
- ada/osint.ads ada/output.ads ada/par_sco.ads ada/prepcomp.ads \
- ada/repinfo.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
- ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_ch10.ads \
- ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \
- ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
- ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_elim.ads \
- ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads ada/sem_util.ads \
- ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
- ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
- ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-assert.ads \
- ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
- ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \
- ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
- ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \
- ada/validsw.ads ada/widechar.ads
+ ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/g-table.ads \
+ ada/g-table.adb ada/gnat1drv.ads ada/gnat1drv.adb ada/gnatvsn.ads \
+ ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/lib.ads ada/lib.adb \
+ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads \
+ ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
+ ada/nmake.ads ada/opt.ads ada/osint.ads ada/output.ads ada/par_sco.ads \
+ ada/prepcomp.ads ada/repinfo.ads ada/restrict.ads ada/rident.ads \
+ ada/rtsfind.ads ada/scos.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
+ ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
+ ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
+ ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
+ ada/sem_elim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads \
+ ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+ ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/sprint.ads \
+ ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
+ ada/s-assert.ads ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+ ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+ ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+ ada/table.adb ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads \
+ ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
+ ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+ ada/usage.ads ada/validsw.ads ada/widechar.ads
ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \
ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \
begin
loop
Skipc;
- C := Getc;
+ C := Nextc;
exit when C /= LF and then C /= CR;
if C = ' ' then
Skip_Spaces;
+ C := Nextc;
exit when C /= LF and then C /= CR;
end if;
end loop;
-- Start of processing for Get_Scos
begin
- SCO_Table.Init;
- SCO_Unit_Table.Init;
+ SCOs.Initialize;
-- Loop through lines of SCO information
Cond := C;
Get_Sloc_Range (Loc1, Loc2);
Add_SCO
- (C2 => C,
+ (C2 => Cond,
From => Loc1,
To => Loc2,
Last => False);
then
Add_SCO (C1 => C, Last => False);
+ elsif C = ' ' then
+ Skip_Spaces;
+
else
raise Data_Error;
end if;
+
+ C := Getc;
end loop;
-- Reset Last indication to True for last entry
-- --
------------------------------------------------------------------------------
--- 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.
+-- 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.
+ -- 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.
+ -- 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
with Repinfo; use Repinfo;
with Restrict;
with Rtsfind;
+with SCOs;
with Sem;
with Sem_Ch8;
with Sem_Ch12;
Urealp.Initialize;
Errout.Initialize;
Namet.Initialize;
+ SCOs.Initialize;
Snames.Initialize;
Stringt.Initialize;
Inline.Initialize;
@end ifclear
(@pxref{Integrated Preprocessing}).
+@item -gnateS
+@cindex @option{-gnateS} (@command{gcc})
+Generate SCO (Source Coverage Obligation) information in the ALI
+file. This information is used by advanced coverage tools. See
+unit @file{SCOs} in the compiler sources for details in files
+@file{scos.ads} and @file{scos.adb}.
+
@item -gnatE
@cindex @option{-gnatE} (@command{gcc})
Full dynamic elaboration checks.
* Improperly_Called_Protected_Entries::
@end ignore
* Metrics::
+* Misnamed_Controlling_Parameters::
* Misnamed_Identifiers::
* Multiple_Entries_In_Protected_Definitions::
* Name_Clashes::
-RMetrics_Cyclomatic_Complexity
@end smallexample
+
+@node Misnamed_Controlling_Parameters
+@subsection @code{Misnamed_Controlling_Parameters}
+@cindex @code{Misnamed_Controlling_Parameters} rule (for @command{gnatcheck})
+
+@noindent
+Flags a declaration of a dispatching operation, if the first parameter is
+not a controlling one and its name is not @code{This} (the check for
+parameter name is not case-sensitive). Declarations of dispatching functions
+with controlling result and no controlling parameter are never flagged.
+
+A subprogram body declaration, subprogram renaming declaration of subprogram
+body stub is flagged only if it is not a completion of a pripr subprogram
+declaration.
+
+This rule has no parameters.
+
+
+
@node Misnamed_Identifiers
@subsection @code{Misnamed_Identifiers}
@cindex @code{Misnamed_Identifiers} rule (for @command{gnatcheck})
overflow settings are an OS configuration issue. The instructions
below have no effect. */
#if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
-#if defined (_SPE_)
+#if defined (__SPE__)
{
const unsigned long spefscr_mask = 0xfffffff3;
unsigned long spefscr;
with Debug; use Debug;
with Lib; use Lib;
with Lib.Util; use Lib.Util;
+with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
with Put_SCOs;
+with SCOs; use SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Table;
package body Par_SCO is
- ---------------
- -- SCO_Table --
- ---------------
-
- -- Internal table used to store recorded SCO values. Table is populated by
- -- calls to SCO_Record, and entries may be modified by Set_SCO_Condition.
-
- type SCO_Table_Entry is record
- From : Source_Ptr;
- To : Source_Ptr;
- C1 : Character;
- C2 : Character;
- Last : Boolean;
- end record;
-
- package SCO_Table is new Table.Table (
- Table_Component_Type => SCO_Table_Entry,
- Table_Index_Type => Nat,
- Table_Low_Bound => 1,
- Table_Initial => 500,
- Table_Increment => 300,
- Table_Name => "SCO_Table_Entry");
-
- -- The SCO_Table_Entry values appear as follows:
-
- -- Statements
- -- C1 = 'S'
- -- C2 = ' '
- -- From = starting sloc
- -- To = ending sloc
- -- Last = unused
-
- -- Exit
- -- C1 = 'T'
- -- C2 = ' '
- -- From = starting sloc
- -- To = ending sloc
- -- Last = unused
-
- -- Simple Decision
- -- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
- -- C2 = 'c', 't', or 'f'
- -- From = starting sloc
- -- To = ending sloc
- -- 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 sloc
- -- To = ending sloc
- -- 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 --
- ----------------
+ -----------------------
+ -- Unit Number 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.
+ -- This table parallels the SCO_Unit_Table, keeping track of the unit
+ -- numbers corresponding to the entries made in this table, so that before
+ -- writing out the SCO information to the ALI file, we can fill in the
+ -- proper dependency numbers and file names.
- type SCO_Unit_Table_Entry is record
- Unit : Unit_Number_Type;
- From : Nat;
- To : Nat;
- end record;
+ -- Note that the zero'th entry is here for convenience in sorting the
+ -- table, the real lower bound is 1.
- package SCO_Unit_Table is new Table.Table (
- Table_Component_Type => SCO_Unit_Table_Entry,
- Table_Index_Type => Int,
- Table_Low_Bound => 0,
+ package SCO_Unit_Number_Table is new Table.Table (
+ Table_Component_Type => Unit_Number_Type,
+ Table_Index_Type => SCO_Unit_Index,
+ Table_Low_Bound => 0, -- see note above on sort
Table_Initial => 20,
Table_Increment => 200,
- Table_Name => "SCO_Unit_Table_Entry");
+ Table_Name => "SCO_Unit_Number_Entry");
--------------------------
-- Condition Hash Table --
procedure Traverse_Subprogram_Body (N : Node_Id);
-- Traverse the corresponding construct, generating SCO table entries
- procedure dsco;
- -- Debug routine to dump SCO table
+ procedure Write_SCOs_To_ALI_File is new Put_SCOs;
+ -- Write SCO information to the ALI file using routines in Lib.Util
----------
-- dsco --
procedure dsco is
begin
+ -- Dump SCO unit table
+
Write_Line ("SCO Unit Table");
Write_Line ("--------------");
- for Index in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop
- Write_Str (" ");
- Write_Int (Index);
- Write_Str (". Unit = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).Unit));
- Write_Str (" From = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).From));
- Write_Str (" To = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).To));
- Write_Eol;
+ for Index in 1 .. SCO_Unit_Table.Last loop
+ declare
+ UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
+
+ begin
+ Write_Str (" ");
+ Write_Int (Int (Index));
+ Write_Str (". Dep_Num = ");
+ Write_Int (Int (UTE.Dep_Num));
+ Write_Str (" From = ");
+ Write_Int (Int (UTE.From));
+ Write_Str (" To = ");
+ Write_Int (Int (UTE.To));
+
+ Write_Str (" File_Name = """);
+
+ if UTE.File_Name /= null then
+ Write_Str (UTE.File_Name.all);
+ end if;
+
+ Write_Char ('"');
+ Write_Eol;
+ end;
end loop;
+ -- Dump SCO Unit number table if it contains any entries
+
+ if SCO_Unit_Number_Table.Last >= 1 then
+ Write_Eol;
+ Write_Line ("SCO Unit Number Table");
+ Write_Line ("---------------------");
+
+ for Index in 1 .. SCO_Unit_Number_Table.Last loop
+ Write_Str (" ");
+ Write_Int (Int (Index));
+ Write_Str (". Unit_Number = ");
+ Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
+ Write_Eol;
+ end loop;
+ end if;
+
+ -- Dump SCO table itself
+
Write_Eol;
Write_Line ("SCO Table");
Write_Line ("---------");
- for Index in SCO_Table.First .. SCO_Table.Last loop
+ for Index in 1 .. SCO_Table.Last loop
declare
T : SCO_Table_Entry renames SCO_Table.Table (Index);
begin
- Write_Str (" ");
- Write_Int (Index);
- Write_Str (". C1 = '");
- Write_Char (T.C1);
- Write_Str ("' C2 = '");
- Write_Char (T.C2);
- Write_Str ("' From = ");
- Write_Location (T.From);
- Write_Str (" To = ");
- Write_Location (T.To);
- Write_Str (" Last = ");
+ Write_Str (" ");
+ Write_Int (Index);
+ Write_Char ('.');
+
+ if T.C1 /= ' ' then
+ Write_Str (" C1 = '");
+ Write_Char (T.C1);
+ Write_Char (''');
+ end if;
+
+ if T.C2 /= ' ' then
+ Write_Str (" C2 = '");
+ Write_Char (T.C2);
+ Write_Char (''');
+ end if;
+
+ if T.From /= No_Source_Location then
+ Write_Str (" From = ");
+ Write_Int (Int (T.From.Line));
+ Write_Char (':');
+ Write_Int (Int (T.From.Col));
+ end if;
+
+ if T.To /= No_Source_Location then
+ Write_Str (" To = ");
+ Write_Int (Int (T.To.Line));
+ Write_Char (':');
+ Write_Int (Int (T.To.Col));
+ end if;
if T.Last then
- Write_Str (" True");
+ Write_Str (" True");
else
- Write_Str (" False");
+ Write_Str (" False");
end if;
Write_Eol;
procedure Initialize is
begin
- SCO_Unit_Table.Init;
- SCO_Unit_Table.Increment_Last;
- SCO_Table.Init;
+ SCO_Unit_Number_Table.Init;
+
+ -- Set dummy 0'th entry in place for sort
+
+ SCO_Unit_Number_Table.Increment_Last;
end Initialize;
-------------------------
C : Character;
L : Node_Id;
- FSloc : Source_Ptr;
- LSloc : Source_Ptr;
-
begin
if No (N) then
return;
end if;
end if;
- Sloc_Range (N, FSloc, LSloc);
- Set_Table_Entry (C, ' ', FSloc, LSloc, False);
+ Set_Table_Entry (C, ' ', No_Location, No_Location, False);
Output_Decision_Operand (L);
Output_Decision_Operand (Right_Opnd (N));
----------------
procedure SCO_Output is
- Start : Nat;
- Stop : Nat;
- U : Unit_Number_Type;
-
- procedure Output_Range (From : Source_Ptr; To : Source_Ptr);
- -- Outputs Sloc range in line:col-line:col format (for now we do not
- -- worry about generic instantiations???)
-
- ------------------
- -- Output_Range --
- ------------------
-
- procedure Output_Range (From : Source_Ptr; To : Source_Ptr) is
- begin
- Write_Info_Nat (Int (Get_Logical_Line_Number (From)));
- Write_Info_Char (':');
- Write_Info_Nat (Int (Get_Column_Number (From)));
- Write_Info_Char ('-');
- Write_Info_Nat (Int (Get_Logical_Line_Number (To)));
- Write_Info_Char (':');
- Write_Info_Nat (Int (Get_Column_Number (To)));
- end Output_Range;
-
- -- Start of processing for SCO_Output
-
begin
if Debug_Flag_Dot_OO then
dsco;
end if;
- -- Sort the unit table
+ -- Sort the unit tables based on dependency numbers
Unit_Table_Sort : declare
function Lt (Op1, Op2 : Natural) return Boolean is
begin
- return Dependency_Num (SCO_Unit_Table.Table (Nat (Op1)).Unit) <
- Dependency_Num (SCO_Unit_Table.Table (Nat (Op2)).Unit);
+ return
+ Dependency_Num
+ (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
+ <
+ Dependency_Num
+ (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
end Lt;
----------
procedure Move (From : Natural; To : Natural) is
begin
- SCO_Unit_Table.Table (Nat (To)) :=
- SCO_Unit_Table.Table (Nat (From));
+ SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
+ SCO_Unit_Table.Table (SCO_Unit_Index (From));
+ SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
+ SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
end Move;
package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
Sorting.Sort (Integer (SCO_Unit_Table.Last));
end Unit_Table_Sort;
- -- Loop through entries in the unit table
+ -- Loop through entries in the unit table to set file name and
+ -- dependency number entries.
for J in 1 .. SCO_Unit_Table.Last loop
- U := SCO_Unit_Table.Table (J).Unit;
-
- -- Output header line preceded by blank line
-
- Write_Info_Terminate;
- Write_Info_Initiate ('C');
- Write_Info_Char (' ');
- Write_Info_Nat (Dependency_Num (U));
- Write_Info_Char (' ');
- Write_Info_Name (Reference_Name (Source_Index (U)));
- Write_Info_Terminate;
-
- Start := SCO_Unit_Table.Table (J).From;
- Stop := SCO_Unit_Table.Table (J).To;
-
- -- Loop through relevant entries in SCO table, outputting C lines
-
- while Start <= Stop loop
- declare
- T : SCO_Table_Entry renames SCO_Table.Table (Start);
-
- begin
- Write_Info_Initiate ('C');
- Write_Info_Char (T.C1);
-
- case T.C1 is
-
- -- Statements, exit
-
- when 'S' | 'T' =>
- Write_Info_Char (' ');
- Output_Range (T.From, T.To);
-
- -- 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 (T.From, T.To);
- end if;
-
- exit when T.Last;
- Start := Start + 1;
- end;
- end loop;
-
- when others =>
- raise Program_Error;
- end case;
-
- Write_Info_Terminate;
- end;
+ declare
+ U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
+ UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
+ begin
+ Get_Name_String (Reference_Name (Source_Index (U)));
+ UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
+ UTE.Dep_Num := Dependency_Num (U);
+ end;
+ end loop;
- exit when Start = Stop;
- Start := Start + 1;
+ -- Now the tables are all setup for output to the ALI file
- pragma Assert (Start <= Stop);
- end loop;
- end loop;
+ Write_SCOs_To_ALI_File;
end SCO_Output;
----------------
-- Ignore call if this unit already recorded
- for J in 1 .. SCO_Unit_Table.Last loop
- if SCO_Unit_Table.Table (J).Unit = U then
+ for J in 1 .. SCO_Unit_Number_Table.Last loop
+ if U = SCO_Unit_Number_Table.Table (J) then
return;
end if;
end loop;
Process_Decisions (Lu, 'X');
end if;
- -- Make entry for new unit in unit table
+ -- Make entry for new unit in unit tables, we will fill in the file
+ -- name and dependency numbers later.
- SCO_Unit_Table.Append ((Unit => U, From => From, To => SCO_Table.Last));
+ SCO_Unit_Table.Append (
+ (Dep_Num => 0,
+ File_Name => null,
+ From => From,
+ To => SCO_Table.Last));
+
+ SCO_Unit_Number_Table.Append (U);
end SCO_Record;
-----------------------
To : Source_Ptr;
Last : Boolean)
is
+ function To_Source_Location (S : Source_Ptr) return Source_Location;
+ -- Converts Source_Ptr value to Source_Location (line/col) format
+
+ ------------------------
+ -- To_Source_Location --
+ ------------------------
+
+ function To_Source_Location (S : Source_Ptr) return Source_Location is
+ begin
+ if S = No_Location then
+ return No_Source_Location;
+ else
+ return
+ (Line => Get_Logical_Line_Number (S),
+ Col => Get_Column_Number (S));
+ end if;
+ end To_Source_Location;
+
+ -- Start of processing for Set_Table_Entry
+
begin
- SCO_Table.Append ((C1 => C1,
- C2 => C2,
- From => From,
- To => To,
- Last => Last));
+ Add_SCO
+ (C1 => C1,
+ C2 => C2,
+ From => To_Source_Location (From),
+ To => To_Source_Location (To),
+ Last => Last);
end Set_Table_Entry;
-----------------------------------------
-- unit U in the ALI file, as recorded by previous calls to SCO_Record,
-- possibly modified by calls to Set_SCO_Condition.
+ procedure dsco;
+ -- Debug routine to dump SCO table. This is a raw format dump showing
+ -- exactly what the tables contain.
+
procedure pscos;
- -- Debugging procedure to output contents of SCO binary tables in SCOs
+ -- Debugging procedure to output contents of SCO binary tables in the
+ -- format in which they appear in an ALI file.
end Par_SCO;
begin
-- Loop through entries in SCO_Unit_Table
- for U in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop
+ for U in 1 .. SCO_Unit_Table.Last loop
declare
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
-- Loop through SCO entries for this unit
- Start := SCO_Table.First;
- Stop := SCO_Table.Last;
+ Start := SUT.From;
+ Stop := SUT.To;
loop
- declare
+ exit when Start = Stop + 1;
+ pragma Assert (Start <= Stop);
+
+ Output_SCO_Line : declare
T : SCO_Table_Entry renames SCO_Table.Table (Start);
- procedure Output_Range;
+ procedure Output_Range (T : SCO_Table_Entry);
-- Outputs T.From and T.To in line:col-line:col format
- procedure Output_Range is
+ ------------------
+ -- Output_Range --
+ ------------------
+
+ procedure Output_Range (T : SCO_Table_Entry) is
begin
Write_Info_Nat (Nat (T.From.Line));
Write_Info_Char (':');
Write_Info_Nat (Nat (T.To.Col));
end Output_Range;
+ -- Start of processing for Output_SCO_Line
+
begin
Write_Info_Initiate ('C');
Write_Info_Char (T.C1);
when 'S' | 'T' =>
Write_Info_Char (' ');
- Output_Range;
+ Output_Range (T);
-- Decision
else
Write_Info_Char (T.C2);
- Output_Range;
+ Output_Range (T);
end if;
exit when T.Last;
end case;
Write_Info_Terminate;
- end;
+ end Output_SCO_Line;
- 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;
with Types; use Types;
generic
- -- The following procedures are used to output text information
+ -- The following procedures are used to output text information. The
+ -- destination of the text information is thus under control of the
+ -- particular instantiation. In particular, this procedure is used to
+ -- write output to the ALI file, and also for debugging output.
with procedure Write_Info_Char (C : Character) is <>;
-- Outputs one character
package body SCOs is
+ -------------
+ -- Add_SCO --
+ -------------
+
procedure Add_SCO
- (From : Source_Location := No_Location;
- To : Source_Location := No_Location;
+ (From : Source_Location := No_Source_Location;
+ To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Last : Boolean := False)
SCO_Table.Append ((From, To, C1, C2, Last));
end Add_SCO;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize is
+ begin
+ SCO_Table.Init;
+ SCO_Unit_Table.Init;
+
+ -- Set dummy zeroth entry for sort routine, real entries start at 1
+
+ SCO_Unit_Table.Increment_Last;
+ end Initialize;
+
end SCOs;
Col : Column_Number;
end record;
- No_Location : Source_Location := (No_Line_Number, No_Column_Number);
+ No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
type SCO_Table_Entry is record
From : Source_Location;
-- 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.
+ -- unused, it is for convenience in calling the sort routine. Thus the
+ -- real lower bound for active entries is 1.
type SCO_Unit_Index is new Int;
-- Used to index values in this table. Values start at 1 and are assigned
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_Low_Bound => 0, -- see note above on sorting
Table_Initial => 20,
Table_Increment => 200);
-- Subprograms --
-----------------
+ procedure Initialize;
+ -- Reset tables for a new compilation
+
procedure Add_SCO
- (From : Source_Location := No_Location;
- To : Source_Location := No_Location;
+ (From : Source_Location := No_Source_Location;
+ To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Last : Boolean := False);
/* Force VX_FP_TASK because it is almost always required */
options |= VX_FP_TASK;
-#if defined (_SPE_)
+#if defined (__SPE__)
options |= VX_SPE_TASK;
#endif
-gnateG ^ /GENERATE_PROCESSED_SOURCE
-gnatem ^ /MAPPING_FILE
-gnatep ^ /DATA_PREPROCESSING
+-gnateS ^ /SCO_OUTPUT
-gnatE ^ /CHECKS=ELABORATION
-gnatf ^ /REPORT_ERRORS=FULL
-gnatF ^ /UPPERCASE_EXTERNALS
--
-- Build against an alternate runtime system named xxx or RTS-xxx.
+ S_GCC_SCO : aliased constant S := "/SCO_OUTPUT " &
+ "-gnateS";
+ -- /NOSCO_OUTPUT (D)
+ -- /SCO_OUTPUT
+ --
+ -- Controls the output of SCO (Source Coverage Obligation) information
+ -- in the generated ALI file. This information is used by advanced source
+ -- coverage tools. For a full description of the SCO format, see unit
+ -- SCOs in the compiler sources (sco.ads/sco.adb).
+
S_GCC_Search : aliased constant S := "/SEARCH=*" &
"-I*";
-- /SEARCH=(directory[,...])
S_GCC_Repinfo 'Access,
S_GCC_RepinfX 'Access,
S_GCC_RTS 'Access,
+ S_GCC_SCO 'Access,
S_GCC_Search 'Access,
S_GCC_Style 'Access,
S_GCC_StyleX 'Access,
git://gcc.gnu.org / gcc.git / commitdiff