2007-10-15 Robert Dewar <dewar@adacore.com> * s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb, s-taprop-vxworks.adb, s-taprop-posix.adb, a-calend-vms.adb, a-calend.adb, a-nuflra.adb, a-tigeau.adb, a-wtgeau.adb, checks.adb, bindgen.adb, eval_fat.adb, exp_fixd.adb, fmap.adb, freeze.adb, g-awk.adb, g-calend.adb, g-diopit.adb, g-expect.adb, gnatchop.adb, gnatlink.adb, g-spipat.adb, g-thread.adb, make.adb, mdll.adb, mlib.adb, mlib-prj.adb, osint.adb, par-ch3.adb, prj.adb, prj-makr.adb, sem_prag.adb, sem_type.adb, s-fatgen.adb, s-fileio.adb, sinfo.ads, sinput-d.adb, s-taasde.adb, s-tasdeb.ads, s-tasren.adb, s-tassta.adb, s-tpobop.adb, s-tposen.adb, stylesw.adb, types.ads, uintp.adb, validsw.adb, makegpr.adb, a-rbtgso.adb, a-crbtgo.adb, a-coorse.adb, a-convec.adb, a-coinve.adb, a-cohama.adb, a-ciorse.adb, a-cihama.adb, a-cidlli.adb, a-chtgop.adb, a-cdlili.adb, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb, a-ciorma.adb, a-coorma.adb, a-ztgeau.adb, symbols-vms.adb, a-crdlli.adb, a-calari.adb, a-calfor.adb, s-os_lib.adb, s-regpat.adb, a-ngrear.adb: Minor reformatting. Add Unreferenced and Warnings (Off) pragmas for cases of variables modified calls where they are IN OUT or OUT parameters and the resulting values are not subsequently referenced. In a few cases, we also remove redundant code found by the new warnings. * ug_words, vms_data.ads, usage.adb, sem_util.adb, sem_util.ads, sem_warn.adb, sem_warn.ads, sem_res.adb, sem_ch7.adb, sem_ch8.adb, sem_ch5.adb, opt.ads, lib-xref.adb, lib-xref.ads, exp_smem.adb, sem_ch11.adb, exp_ch6.adb, einfo.ads, einfo.adb: implement a new warning controlled by -gnatw.o that warns on cases of out parameter values being ignored. From-SVN: r129318
115 lines
4.4 KiB
Ada
115 lines
4.4 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S I N P U T . D --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2002-2007, 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 Osint; use Osint;
|
|
with Osint.C; use Osint.C;
|
|
|
|
package body Sinput.D is
|
|
|
|
Dfile : Source_File_Index;
|
|
-- Index of currently active debug source file
|
|
|
|
------------------------
|
|
-- Close_Debug_Source --
|
|
------------------------
|
|
|
|
procedure Close_Debug_Source is
|
|
S : Source_File_Record renames Source_File.Table (Dfile);
|
|
Src : Source_Buffer_Ptr;
|
|
|
|
pragma Warnings (Off, S);
|
|
|
|
begin
|
|
Trim_Lines_Table (Dfile);
|
|
Close_Debug_File;
|
|
|
|
-- Now we need to read the file that we wrote and store it in memory for
|
|
-- subsequent access.
|
|
|
|
Read_Source_File
|
|
(S.Full_Debug_Name, S.Source_First, S.Source_Last, Src);
|
|
S.Source_Text := Src;
|
|
end Close_Debug_Source;
|
|
|
|
-------------------------
|
|
-- Create_Debug_Source --
|
|
-------------------------
|
|
|
|
procedure Create_Debug_Source
|
|
(Source : Source_File_Index;
|
|
Loc : out Source_Ptr)
|
|
is
|
|
begin
|
|
Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
|
|
Source_File.Append (Source_File.Table (Source));
|
|
Dfile := Source_File.Last;
|
|
|
|
declare
|
|
S : Source_File_Record renames Source_File.Table (Dfile);
|
|
|
|
begin
|
|
S.Full_Debug_Name := Create_Debug_File (S.File_Name);
|
|
S.Debug_Source_Name := Strip_Directory (S.Full_Debug_Name);
|
|
S.Source_First := Loc;
|
|
S.Source_Last := Loc;
|
|
S.Lines_Table := null;
|
|
S.Last_Source_Line := 1;
|
|
|
|
-- Allocate lines table, guess that it needs to be three times bigger
|
|
-- than the original source (in number of lines).
|
|
|
|
Alloc_Line_Tables
|
|
(S, Int (Source_File.Table (Source).Last_Source_Line * 3));
|
|
S.Lines_Table (1) := Loc;
|
|
end;
|
|
end Create_Debug_Source;
|
|
|
|
----------------------
|
|
-- Write_Debug_Line --
|
|
----------------------
|
|
|
|
procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
|
|
S : Source_File_Record renames Source_File.Table (Dfile);
|
|
|
|
begin
|
|
-- Ignore write request if null line at start of file
|
|
|
|
if Str'Length = 0 and then Loc = S.Source_First then
|
|
return;
|
|
|
|
-- Here we write the line, compute the source location for the following
|
|
-- line, allocate its table entry, and update the source record entry.
|
|
|
|
else
|
|
Write_Debug_Info (Str (Str'First .. Str'Last - 1));
|
|
Loc := Loc - 1 + Source_Ptr (Str'Length + Debug_File_Eol_Length);
|
|
Add_Line_Tables_Entry (S, Loc);
|
|
S.Source_Last := Loc;
|
|
Set_Source_File_Index_Table (Dfile);
|
|
end if;
|
|
end Write_Debug_Line;
|
|
|
|
end Sinput.D;
|