-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
procedure Scan_Compiler_Arguments is
Next_Arg : Pos := 1;
- subtype Big_String is String (Positive);
- type BSP is access Big_String;
-
- type Arg_Array is array (Nat) of BSP;
+ type Arg_Array is array (Nat) of Big_String_Ptr;
type Arg_Array_Ptr is access Arg_Array;
flag_stack_check : Int;
while Next_Arg < save_argc loop
Look_At_Arg : declare
- Argv_Ptr : constant BSP := save_argv (Next_Arg);
- Argv_Len : constant Nat := Len_Arg (Next_Arg);
- Argv : constant String := Argv_Ptr (1 .. Natural (Argv_Len));
+ Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
+ Argv_Len : constant Nat := Len_Arg (Next_Arg);
+ Argv : constant String :=
+ Argv_Ptr (1 .. Natural (Argv_Len));
begin
-- If the previous switch has set the Output_File_Name_Present
with Style;
with Uname; use Uname;
-with Unchecked_Conversion;
-
package body Errout is
Errors_Must_Be_Ignored : Boolean := False;
-- If error message line length set, and this is a continuation message
-- then all we do is to append the text to the text of the last message
- -- with a comma space separator.
+ -- with a comma space separator (eliminating a possible (style) or
+ -- info prefix).
if Error_Msg_Line_Length /= 0
and then Continuation
Oldm : String_Ptr := Errors.Table (Cur_Msg).Text;
Newm : String (1 .. Oldm'Last + 2 + Msglen);
Newl : Natural;
+ M : Natural;
begin
-- First copy old message to new one and free it
Newl := Oldm'Length;
Free (Oldm);
+ -- Remove (style) or info: at start of message
+
+ if Msglen > 8 and then Msg_Buffer (1 .. 8) = "(style) " then
+ M := 9;
+ elsif Msglen > 6 and then Msg_Buffer (1 .. 6) = "info: " then
+ M := 7;
+ else
+ M := 1;
+ end if;
+
-- Now deal with separation between messages. Normally this
-- is simply comma space, but there are some special cases.
-- successive parenthetical remarks into a single one with
-- separating commas).
- elsif Msg_Buffer (1) = '(' and then Msg_Buffer (Msglen) = ')' then
+ elsif Msg_Buffer (M) = '(' and then Msg_Buffer (Msglen) = ')' then
-- Case where existing message ends in right paren, remove
-- and separate parenthetical remarks with a comma.
if Newm (Newl) = ')' then
Newm (Newl) := ',';
- Msg_Buffer (1) := ' ';
+ Msg_Buffer (M) := ' ';
- -- Case where we are adding new parenthetical comment
+ -- Case where we are adding new parenthetical comment
else
Newl := Newl + 1;
-- Append new message
- Newm (Newl + 1 .. Newl + Msglen) := Msg_Buffer (1 .. Msglen);
- Newl := Newl + Msglen;
+ Newm (Newl + 1 .. Newl + Msglen - M + 1) :=
+ Msg_Buffer (M .. Msglen);
+ Newl := Newl + Msglen - M + 1;
Errors.Table (Cur_Msg).Text := new String'(Newm (1 .. Newl));
end;
and then Compiler_State = Parsing
and then not All_Errors_Mode
then
- -- Don't delete unconditional messages and at this stage,
- -- don't delete continuation lines (we attempted to delete
- -- those earlier if the parent message was deleted.
+ -- Don't delete unconditional messages and at this stage, don't
+ -- delete continuation lines (we attempted to delete those earlier
+ -- if the parent message was deleted.
if not Errors.Table (Cur_Msg).Uncond
and then not Continuation
-- Bump appropriate statistics count
- if Errors.Table (Cur_Msg).Warn
- or else Errors.Table (Cur_Msg).Style
- then
+ if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
Warnings_Detected := Warnings_Detected + 1;
+
else
Total_Errors_Detected := Total_Errors_Detected + 1;
Last_Killed := True;
end if;
- if not Is_Warning_Msg and then not Is_Style_Msg then
+ if not (Is_Warning_Msg or Is_Style_Msg) then
Set_Posted (N);
end if;
end Error_Msg_NEL;
and then Errors.Table (E).Optr = Loc
- -- Don't remove if not warning message. Note that we do not
- -- remove style messages here. They are warning messages but
- -- not ones we want removed in this context.
+ -- Don't remove if not warning/info message. Note that we do
+ -- not remove style messages here. They are warning messages
+ -- but not ones we want removed in this context.
and then Errors.Table (E).Warn
and then Original_Node (N) /= N
and then No (Condition (N))
then
- -- Warnings may have been posted on subexpressions of
- -- the original tree. We place the original node back
- -- on the tree to remove those warnings, whose sloc
- -- do not match those of any node in the current tree.
- -- Given that we are in unreachable code, this modification
- -- to the tree is harmless.
+ -- Warnings may have been posted on subexpressions of the original
+ -- tree. We place the original node back on the tree to remove
+ -- those warnings, whose sloc do not match those of any node in
+ -- the current tree. Given that we are in unreachable code, this
+ -- modification to the tree is harmless.
declare
Status : Traverse_Final_Result;
begin
if Is_Non_Empty_List (L) then
Stat := First (L);
-
while Present (Stat) loop
Remove_Warning_Messages (Stat);
Next (Stat);
(Identifier_Name : System.Address;
File_Name : System.Address)
is
- type Big_String is array (Positive) of Character;
- type Big_String_Ptr is access all Big_String;
-
- function To_Big_String_Ptr is new Unchecked_Conversion
- (System.Address, Big_String_Ptr);
-
Ident : constant Big_String_Ptr := To_Big_String_Ptr (Identifier_Name);
File : constant Big_String_Ptr := To_Big_String_Ptr (File_Name);
Flen : Natural;
for J in Name_Buffer'Range loop
Name_Buffer (J) := Ident (J);
- if Name_Buffer (J) = ASCII.Nul then
+ if Name_Buffer (J) = ASCII.NUL then
Name_Len := J - 1;
exit;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2008, 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- --
package body Fmap is
- subtype Big_String is String (Positive);
- type Big_String_Ptr is access all Big_String;
+ No_Mapping_File : Boolean := False;
+ -- Set to True when the specified mapping file cannot be read in
+ -- procedure Initialize, so that no attempt is made to oopen the mapping
+ -- file in procedure Update_Mapping_File.
function To_Big_String_Ptr is new Unchecked_Conversion
(Source_Buffer_Ptr, Big_String_Ptr);
Write_Str ("warning: could not read mapping file """);
Write_Str (File_Name);
Write_Line ("""");
+ No_Mapping_File := True;
else
BS := To_Big_String_Ptr (Src);
-- Start of Update_Mapping_File
begin
+ -- If the mapping file could not be read, then it will not be possible
+ -- to update it.
+ if No_Mapping_File then
+ return;
+ end if;
-- Only Update if there are new entries in the mappings
if Last_In_Table < File_Mapping.Last then
- -- If the tables have been emptied, recreate the file.
- -- Otherwise, append to it.
-
- if Last_In_Table = 0 then
- declare
- Discard : Boolean;
- pragma Warnings (Off, Discard);
- begin
- Delete_File (File_Name, Discard);
- end;
-
- File := Create_File (File_Name, Binary);
-
- else
- File := Open_Read_Write (Name => File_Name, Fmode => Binary);
- end if;
+ File := Open_Read_Write (Name => File_Name, Fmode => Binary);
if File /= Invalid_FD then
if Last_In_Table > 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
package body Fname.SF is
- subtype Big_String is String (Positive);
- type Big_String_Ptr is access all Big_String;
-
function To_Big_String_Ptr is new Unchecked_Conversion
(Source_Buffer_Ptr, Big_String_Ptr);
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2006, AdaCore --
+-- Copyright (C) 2000-2008, AdaCore --
-- --
-- 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- --
type Table_Type is
array (Table_Index_Type range <>) of Table_Component_Type;
-
subtype Big_Table_Type is
Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
- -- We work with pointers to a bogus array type that is constrained
- -- with the maximum possible range bound. This means that the pointer
- -- is a thin pointer, which is more efficient. Since subscript checks
- -- in any case must be on the logical, rather than physical bounds,
- -- safety is not compromised by this approach.
+ -- We work with pointers to a bogus array type that is constrained with
+ -- the maximum possible range bound. This means that the pointer is a thin
+ -- pointer, which is more efficient. Since subscript checks in any case
+ -- must be on the logical, rather than physical bounds, safety is not
+ -- compromised by this approach. These types should not be used by the
+ -- client.
type Table_Ptr is access all Big_Table_Type;
- -- The table is actually represented as a pointer to allow reallocation
+ for Table_Ptr'Storage_Size use 0;
+ -- The table is actually represented as a pointer to allow reallocation.
+ -- This type should not be used by the client.
type Table_Private is private;
-- Table private data that is not exported in Instance
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2007, AdaCore --
+-- Copyright (C) 1998-2008, AdaCore --
-- --
-- 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- --
type Table_Type is
array (Table_Index_Type range <>) of Table_Component_Type;
-
subtype Big_Table_Type is
Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
-- We work with pointers to a bogus array type that is constrained
-- with the maximum possible range bound. This means that the pointer
-- is a thin pointer, which is more efficient. Since subscript checks
-- in any case must be on the logical, rather than physical bounds,
- -- safety is not compromised by this approach.
+ -- safety is not compromised by this approach. These types should never
+ -- be used by the client.
type Table_Ptr is access all Big_Table_Type;
- -- The table is actually represented as a pointer to allow reallocation
+ for Table_Ptr'Storage_Size use 0;
+ -- The table is actually represented as a pointer to allow reallocation.
+ -- This type should never be used by the client.
Table : aliased Table_Ptr := null;
-- The table itself. The lower bound is the value of Low_Bound.
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2008, 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- --
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
+ for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is range -128 .. +127;
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
+ for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2008, 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- --
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
+ for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is mod 2 ** 8;
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
+ for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2008, 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- --
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
+ for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is mod 2 ** 8;
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
+ for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
-- safety is not compromised by this approach.
type Table_Ptr is access all Big_Table_Type;
+ for Table_Ptr'Storage_Size use 0;
-- The table is actually represented as a pointer to allow reallocation
Table : aliased Table_Ptr := null;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
-- 2s-complement. If there are any machines for which this is not a correct
-- assumption, a significant number of changes will be required!
+with System;
+with Unchecked_Conversion;
with Unchecked_Deallocation;
package Types is
procedure Free is new Unchecked_Deallocation (String, String_Ptr);
-- Procedure for freeing dynamically allocated String values
+ subtype Big_String is String (Positive);
+ type Big_String_Ptr is access all Big_String;
+ for Big_String_Ptr'Storage_Size use 0;
+ -- Virtual type for handling imported big strings
+
+ function To_Big_String_Ptr is
+ new Unchecked_Conversion (System.Address, Big_String_Ptr);
+ -- Used to obtain Big_String_Ptr values from external addresses
+
subtype Word_Hex_String is String (1 .. 8);
-- Type used to represent Word value as 8 hex digits, with lower case
-- letters for the alphabetic cases.
-- type Source_Buffer_Ptr, see Osint.Read_Source_File for details.
type Source_Buffer_Ptr is access all Big_Source_Buffer;
+ for Source_Buffer_Ptr'Storage_Size use 0;
-- Pointer to source buffer. We use virtual origin addressing for source
-- buffers, with thin pointers. The pointer points to a virtual instance
-- of type Big_Source_Buffer, where the actual type is in fact of type
projects / gcc.git / commitdiff