OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

back_end.adb, [...]: Minor reformatting

Browse Source 
2008-03-26  Robert Dewar  <dewar@adacore.com>

	* back_end.adb, back_end.ads: Minor reformatting

	* bindgen.adb: Minor clarification of comments

	* fname.ads: Minor comment fixes

	* g-altive.ads, g-catiio.ads, g-trasym.ads, prj.ads,
	prj-nmsc.adb, sem_aggr.adb: Minor reformatting

	* xeinfo.adb, xnmake.adb, xsinfo.adb, xtreeprs.adb,
	xsnames.adb: Remove warnings off pragma no longer needed

	* a-catizo.ads, a-calari.ads, a-calfor.adb,
	a-calfor.ads: Fix header.

From-SVN: r133585
This commit is contained in:
Robert Dewar 2008-03-26 08:43:27 +01:00 committed by Arnaud Charlet
parent 14063a127c
commit f53f9dd781
19 changed files with 136 additions and 227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/a-calari.ads
View File

@ -6,32 +6,12 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- apply solely to the contents of the part following the private keyword. -- -- copy and modify this specification, provided that if you redistribute a --
-- -- -- modified version, any changes that you have made are clearly indicated. --
-- 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
@ -50,10 +30,10 @@ package Ada.Calendar.Arithmetic is
.. ..
+(366 * (1 + Year_Number'Last - Year_Number'First)); +(366 * (1 + Year_Number'Last - Year_Number'First));
-- Negative leap seconds occur whenever the astronomical time is faster
-- than the atomic time or as a result of Difference when Left < Right.
subtype Leap_Seconds_Count is Integer range -2047 .. 2047; subtype Leap_Seconds_Count is Integer range -2047 .. 2047;
-- Count of leap seconds. Negative leap seconds occur whenever the
-- astronomical time is faster than the atomic time or as a result of
-- Difference when Left < Right.
procedure Difference procedure Difference
(Left : Time; (Left : Time;

2
gcc/ada/a-calfor.adb
View File

@ -34,8 +34,6 @@
with Ada.Calendar; use Ada.Calendar; with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones; with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
pragma Warnings (Off); -- temp till we fix out param warnings ???
package body Ada.Calendar.Formatting is package body Ada.Calendar.Formatting is
-------------------------- --------------------------

28
gcc/ada/a-calfor.ads
View File

@ -6,32 +6,12 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- apply solely to the contents of the part following the private keyword. -- -- copy and modify this specification, provided that if you redistribute a --
-- -- -- modified version, any changes that you have made are clearly indicated. --
-- 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------

35
gcc/ada/a-catizo.ads
View File

@ -6,32 +6,12 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- apply solely to the contents of the part following the private keyword. -- -- copy and modify this specification, provided that if you redistribute a --
-- -- -- modified version, any changes that you have made are clearly indicated. --
-- 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
@ -47,9 +27,8 @@ package Ada.Calendar.Time_Zones is
Unknown_Zone_Error : exception; Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset; function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
-- Returns, as a number of minutes, the difference between the -- Returns (in minutes), the difference between the implementation-defined
-- implementation-defined time zone of Calendar, and UTC time, at the time -- time zone of Calendar, and UTC time, at the time Date. If the time zone
-- Date. If the time zone of the Calendar implementation is unknown, then -- of the Calendar implementation is unknown, raises Unknown_Zone_Error.
-- Unknown_Zone_Error is raised.
end Ada.Calendar.Time_Zones; end Ada.Calendar.Time_Zones;

53
gcc/ada/back_end.adb
View File

@ -59,8 +59,8 @@ package body Back_End is
File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type; File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
procedure gigi ( procedure gigi
gnat_root : Int; (gnat_root : Int;
max_gnat_node : Int; max_gnat_node : Int;
number_name : Nat; number_name : Nat;
nodes_ptr : Address; nodes_ptr : Address;
@ -90,13 +90,13 @@ package body Back_End is
return; return;
end if; end if;
for I in 1 .. Last_Source_File loop for J in 1 .. Last_Source_File loop
File_Info_Array (I).File_Name := Full_Debug_Name (I); File_Info_Array (J).File_Name := Full_Debug_Name (J);
File_Info_Array (I).Num_Source_Lines := Num_Source_Lines (I); File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
end loop; end loop;
gigi ( gigi
gnat_root => Int (Cunit (Main_Unit)), (gnat_root => Int (Cunit (Main_Unit)),
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
number_name => Name_Entries_Count, number_name => Name_Entries_Count,
nodes_ptr => Nodes_Address, nodes_ptr => Nodes_Address,
@ -131,26 +131,26 @@ package body Back_End is
type Arg_Array is array (Nat) of BSP; type Arg_Array is array (Nat) of BSP;
type Arg_Array_Ptr is access Arg_Array; type Arg_Array_Ptr is access Arg_Array;
-- Import flag_stack_check from toplev.c
flag_stack_check : Int; flag_stack_check : Int;
pragma Import (C, flag_stack_check); -- Import from toplev.c pragma Import (C, flag_stack_check);
-- Import from toplev.c
save_argc : Nat; save_argc : Nat;
pragma Import (C, save_argc); -- Import from toplev.c pragma Import (C, save_argc);
-- Import from toplev.c
save_argv : Arg_Array_Ptr; save_argv : Arg_Array_Ptr;
pragma Import (C, save_argv); -- Import from toplev.c pragma Import (C, save_argv);
-- Import from toplev.c
Output_File_Name_Seen : Boolean := False; Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned the file_name for -- Set to True after having scanned file_name for switch "-gnatO file"
-- switch "-gnatO file_name"
-- Local functions -- Local functions
function Len_Arg (Arg : Pos) return Nat; function Len_Arg (Arg : Pos) return Nat;
-- Determine length of argument number Arg on the original -- Determine length of argument number Arg on the original command line
-- command line from gnat1 -- from gnat1.
procedure Scan_Back_End_Switches (Switch_Chars : String); procedure Scan_Back_End_Switches (Switch_Chars : String);
-- Procedure to scan out switches stored in Switch_Chars. The first -- Procedure to scan out switches stored in Switch_Chars. The first
@ -196,13 +196,12 @@ package body Back_End is
Last := Last - 1; Last := Last - 1;
end if; end if;
-- For these switches, skip following argument and do not -- For switches -o, -dumpbase, --param, skip following argument and
-- store either the switch or the following argument -- do not store either the switch or the following argument.
if Switch_Chars (First .. Last) = "o"
or else Switch_Chars (First .. Last) = "dumpbase"
or else Switch_Chars (First .. Last) = "-param"
if Switch_Chars (First .. Last) = "o" or else
Switch_Chars (First .. Last) = "dumpbase" or else
Switch_Chars (First .. Last) = "-param"
then then
Next_Arg := Next_Arg + 1; Next_Arg := Next_Arg + 1;
@ -211,9 +210,9 @@ package body Back_End is
elsif Switch_Chars (First .. Last) = "quiet" then elsif Switch_Chars (First .. Last) = "quiet" then
null; null;
else -- Store any other GCC switches
-- Store any other GCC switches
else
Store_Compilation_Switch (Switch_Chars); Store_Compilation_Switch (Switch_Chars);
-- Special check, the back end switch -fno-inline also sets the -- Special check, the back end switch -fno-inline also sets the
@ -256,9 +255,9 @@ package body Back_End is
Output_File_Name_Seen := True; Output_File_Name_Seen := True;
end if; end if;
-- If the previous switch has set the Search_Directory_Present -- If the previous switch has set the Search_Directory_Present
-- flag (that is if we have just seen -I), then the next -- flag (that is if we have just seen -I), then the next argument
-- argument is a search directory path. -- is a search directory path.
elsif Search_Directory_Present then elsif Search_Directory_Present then
if Is_Switch (Argv) then if Is_Switch (Argv) then

14
gcc/ada/back_end.ads
View File

@ -52,15 +52,13 @@ package Back_End is
procedure Scan_Compiler_Arguments; procedure Scan_Compiler_Arguments;
-- Acquires command-line parameters passed to the compiler and processes -- Acquires command-line parameters passed to the compiler and processes
-- them. Calls Scan_Front_End_Switches for any front-end switches -- them. Calls Scan_Front_End_Switches for any front-end switches found.
-- encountered.
-- --
-- The processing of arguments is private to the back end, since -- The processing of arguments is private to the back end, since the way
-- the way of acquiring the arguments as well as the set of allowable -- of acquiring the arguments as well as the set of allowable back end
-- back end switches is different depending on the particular back end -- switches is different depending on the particular back end being used.
-- being used.
-- --
-- Any processed switches that influence the result of a compilation -- Any processed switches that influence the result of a compilation must
-- must be added to the Compilation_Arguments table. -- be added to the Compilation_Arguments table.
end Back_End; end Back_End;

10
gcc/ada/bindgen.adb
View File

@ -607,7 +607,7 @@ package body Bindgen is
"""__gnat_handler_installed"");"); """__gnat_handler_installed"");");
-- Initialize stack limit variable of the environment task if the -- Initialize stack limit variable of the environment task if the
-- stack check method is stack limit and if stack check is enabled. -- stack check method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set) and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
@ -619,6 +619,7 @@ package body Bindgen is
end if; end if;
if VM_Target = CLI_Target if VM_Target = CLI_Target
and then Bind_Main_Program
and then not No_Main_Subprogram and then not No_Main_Subprogram
then then
WBI (""); WBI ("");
@ -782,7 +783,7 @@ package body Bindgen is
end if; end if;
-- Initialize stack limit variable of the environment task if the -- Initialize stack limit variable of the environment task if the
-- stack check method is stack limit and if stack check is enabled. -- stack check method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set) and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
@ -797,6 +798,7 @@ package body Bindgen is
Gen_Elab_Calls_Ada; Gen_Elab_Calls_Ada;
if VM_Target = CLI_Target if VM_Target = CLI_Target
and then Bind_Main_Program
and then not No_Main_Subprogram and then not No_Main_Subprogram
then then
if ALIs.Table (ALIs.First).Main_Program = Func then if ALIs.Table (ALIs.First).Main_Program = Func then
@ -1033,7 +1035,7 @@ package body Bindgen is
end if; end if;
-- Initialize stack limit for the environment task if the stack -- Initialize stack limit for the environment task if the stack
-- check method is stack limit and if stack check is enabled. -- check method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set) and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
@ -2566,7 +2568,7 @@ package body Bindgen is
end if; end if;
-- Initialize stack limit for the environment task if the stack -- Initialize stack limit for the environment task if the stack
-- check method is stack limit and if stack check is enabled. -- check method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set) and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)

20
gcc/ada/fname.ads
View File

@ -68,12 +68,14 @@ package Fname is
(Fname : File_Name_Type; (Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean; Renamings_Included : Boolean := True) return Boolean;
-- This function determines if the given file name (which must be a simple -- This function determines if the given file name (which must be a simple
-- file name with no directory information) is the file name for one of -- file name with no directory information) is the file name for one of the
-- the predefined library units. On return, Name_Buffer contains the -- predefined library units (i.e. part of the Ada, System, or Interface
-- file name. The Renamings_Included parameter indicates whether annex -- hierarchies). Note that units in the GNAT hierarchy are not considered
-- J renamings such as Text_IO are to be considered as predefined. If -- predefined (see Is_Internal_File_Name below). On return, Name_Buffer
-- Renamings_Included is True, then Text_IO will return True, otherwise -- contains the file name. The Renamings_Included parameter indicates
-- only children of Ada, Interfaces and System return True. -- whether annex J renamings such as Text_IO are to be considered as
-- predefined. If Renamings_Included is True, then Text_IO will return
-- True, otherwise only children of Ada, Interfaces and System return True.
function Is_Predefined_File_Name function Is_Predefined_File_Name
(Renamings_Included : Boolean := True) return Boolean; (Renamings_Included : Boolean := True) return Boolean;
@ -82,9 +84,9 @@ package Fname is
function Is_Internal_File_Name function Is_Internal_File_Name
(Fname : File_Name_Type; (Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean; Renamings_Included : Boolean := True) return Boolean;
-- Similar to Is_Predefined_File_Name. The internal file set is a -- Similar to Is_Predefined_File_Name. The internal file set is a superset
-- superset of the predefined file set including children of GNAT, -- of the predefined file set including children of GNAT, and also children
-- and also children of DEC for the VMS case. -- of DEC for the VMS case.
procedure Tree_Read; procedure Tree_Read;
-- Dummy procedure (reads dummy table values from tree file) -- Dummy procedure (reads dummy table values from tree file)

2
gcc/ada/g-altive.ads
View File

@ -345,7 +345,7 @@ package GNAT.Altivec is
-- support of the target. Note that this means that there may be -- support of the target. Note that this means that there may be
-- minor differences in results between targets when the floating- -- minor differences in results between targets when the floating-
-- point implementations are slightly different, as would happen -- point implementations are slightly different, as would happen
-- with normal non-altivec floating-point operations. In particular -- with normal non-Altivec floating-point operations. In particular
-- the Altivec simulations may yield slightly different results -- the Altivec simulations may yield slightly different results
-- from those obtained on a true hardware Altivec target if the -- from those obtained on a true hardware Altivec target if the
-- floating-point implementation is not 100% compatible. -- floating-point implementation is not 100% compatible.

7
gcc/ada/g-catiio.ads
View File

@ -125,10 +125,12 @@ package GNAT.Calendar.Time_IO is
-- The following formats are also supported. They all accept an optional -- The following formats are also supported. They all accept an optional
-- time with the format "hh:mm:ss". The time is separated from the date by -- time with the format "hh:mm:ss". The time is separated from the date by
-- exactly one space character. -- exactly one space character.
--
-- When the time is not specified, it is set to 00:00:00. The delimiter '*' -- When the time is not specified, it is set to 00:00:00. The delimiter '*'
-- must be either '-' and '/' and both occurrences must use the same -- must be either '-' and '/' and both occurrences must use the same
-- character. -- character.
-- Trailing characters (in particular spaces) are not allowed. --
-- Trailing characters (in particular spaces) are not allowed
-- --
-- yyyy*mm*dd -- yyyy*mm*dd
-- yy*mm*dd - Year is assumed to be 20yy -- yy*mm*dd - Year is assumed to be 20yy
@ -145,8 +147,7 @@ package GNAT.Calendar.Time_IO is
procedure Put_Time procedure Put_Time
(Date : Ada.Calendar.Time; (Date : Ada.Calendar.Time;
Picture : Picture_String); Picture : Picture_String);
-- Put Date with format Picture. Raise Picture_Error if picture string is -- Put Date with format Picture. Raise Picture_Error if bad picture string
-- wrong
private private
ISO_Date : constant Picture_String := "%Y-%m-%d"; ISO_Date : constant Picture_String := "%Y-%m-%d";

4
gcc/ada/g-trasym.ads
View File

@ -84,10 +84,6 @@ with Ada.Exceptions; use Ada.Exceptions;
package GNAT.Traceback.Symbolic is package GNAT.Traceback.Symbolic is
pragma Elaborate_Body; pragma Elaborate_Body;
------------------------
-- Symbolic_Traceback --
------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String; function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
-- Build a string containing a symbolic traceback of the given call chain -- Build a string containing a symbolic traceback of the given call chain

61
gcc/ada/prj-nmsc.adb
View File

@ -174,14 +174,13 @@ package body Prj.Nmsc is
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- A hash table to store the excluded files, if any. This is filled by -- A hash table to store the excluded files, if any. This is filled by
-- Find_Excluded_Sources below -- Find_Excluded_Sources below.
procedure Find_Excluded_Sources procedure Find_Excluded_Sources
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Data : Project_Data); Data : Project_Data);
-- Find the list of files that should not be considered as source files -- Find the list of files that should not be considered as source files
-- for this project. -- for this project. Sets the list in the Excluded_Sources_Htable.
-- Sets the list in the Excluded_Sources_Htable
function Hash (Unit : Unit_Info) return Header_Num; function Hash (Unit : Unit_Info) return Header_Num;
@ -199,8 +198,8 @@ package body Prj.Nmsc is
Key => Unit_Info, Key => Unit_Info,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- A table to check if a unit with an exceptional name will hide -- A table to check if a unit with an exceptional name will hide a source
-- a source with a file name following the naming convention. -- with a file name following the naming convention.
procedure Add_Source procedure Add_Source
(Id : out Source_Id; (Id : out Source_Id;
@ -274,14 +273,14 @@ package body Prj.Nmsc is
-- In_Tree and modify its data Data if it has the value "true". -- In_Tree and modify its data Data if it has the value "true".
procedure Check_Library_Attributes procedure Check_Library_Attributes
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Current_Dir : String; Current_Dir : String;
Data : in out Project_Data); Data : in out Project_Data);
-- Check the library attributes of project Project in project tree In_Tree -- Check the library attributes of project Project in project tree In_Tree
-- and modify its data Data accordingly. -- and modify its data Data accordingly.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Check_Package_Naming procedure Check_Package_Naming
(Project : Project_Id; (Project : Project_Id;
@ -315,7 +314,7 @@ package body Prj.Nmsc is
-- Check if project Project in project tree In_Tree is a Stand-Alone -- Check if project Project in project tree In_Tree is a Stand-Alone
-- Library project, and modify its data Data accordingly if it is one. -- Library project, and modify its data Data accordingly if it is one.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Get_Path_Names_And_Record_Ada_Sources procedure Get_Path_Names_And_Record_Ada_Sources
(Project : Project_Id; (Project : Project_Id;
@ -327,7 +326,7 @@ package body Prj.Nmsc is
function Compute_Directory_Last (Dir : String) return Natural; function Compute_Directory_Last (Dir : String) return Natural;
-- Return the index of the last significant character in Dir. This is used -- Return the index of the last significant character in Dir. This is used
-- to avoid duplicates '/' at the end of directory names -- to avoid duplicate '/' (slash) characters at the end of directory names.
procedure Error_Msg procedure Error_Msg
(Project : Project_Id; (Project : Project_Id;
@ -345,7 +344,7 @@ package body Prj.Nmsc is
Current_Dir : String); Current_Dir : String);
-- Find all the Ada sources in all of the source directories of a project -- Find all the Ada sources in all of the source directories of a project
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Find_Sources procedure Find_Sources
(Project : Project_Id; (Project : Project_Id;
@ -362,9 +361,9 @@ package body Prj.Nmsc is
Data : in out Project_Data; Data : in out Project_Data;
For_All_Sources : Boolean); For_All_Sources : Boolean);
-- Search the source directories to find the sources. -- Search the source directories to find the sources.
-- If For_All_Sources is True, check each regular file name against -- If For_All_Sources is True, check each regular file name against the
-- the naming schemes of the different languages. Otherwise consider -- naming schemes of the different languages. Otherwise consider only the
-- only the file names in the hash table Source_Names. -- file names in the hash table Source_Names.
procedure Check_File procedure Check_File
(Project : Project_Id; (Project : Project_Id;
@ -424,7 +423,7 @@ package body Prj.Nmsc is
-- Get the object directory, the exec directory and the source directories -- Get the object directory, the exec directory and the source directories
-- of a project. -- of a project.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Get_Mains procedure Get_Mains
(Project : Project_Id; (Project : Project_Id;
@ -449,8 +448,8 @@ package body Prj.Nmsc is
Data : in out Project_Data); Data : in out Project_Data);
-- Process the Source_Files and Source_List_File attributes, and store -- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable. -- the list of source files into the Source_Names htable.
-- Lang indicates which language is being processed when in Ada_Only -- Lang indicates which language is being processed when in Ada_Only mode
-- mode (all languages are processed anyway when in Multi_Language mode) -- (all languages are processed anyway when in Multi_Language mode).
procedure Get_Unit procedure Get_Unit
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
@ -461,16 +460,16 @@ package body Prj.Nmsc is
Unit_Kind : out Spec_Or_Body; Unit_Kind : out Spec_Or_Body;
Needs_Pragma : out Boolean); Needs_Pragma : out Boolean);
-- Find out, from a file name, the unit name, the unit kind and if a -- Find out, from a file name, the unit name, the unit kind and if a
-- specific SFN pragma is needed. If the file name corresponds to no -- specific SFN pragma is needed. If the file name corresponds to no unit,
-- unit, then Unit_Name will be No_Name. If the file is a multi-unit source -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
-- or an exception to the naming scheme, then Exception_Id is set to -- exception to the naming scheme, then Exception_Id is set to the unit or
-- the unit or units that the source contains. -- units that the source contains.
function Is_Illegal_Suffix function Is_Illegal_Suffix
(Suffix : String; (Suffix : String;
Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean; Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
-- Returns True if the string Suffix cannot be used as -- Returns True if the string Suffix cannot be used as a spec suffix, a
-- a spec suffix, a body suffix or a separate suffix. -- body suffix or a separate suffix.
procedure Locate_Directory procedure Locate_Directory
(Project : Project_Id; (Project : Project_Id;
@ -490,7 +489,7 @@ package body Prj.Nmsc is
-- the directory. If the directory does not exist and Project_Setup is -- the directory. If the directory does not exist and Project_Setup is
-- false, then Dir and Display are set to No_Name. -- false, then Dir and Display are set to No_Name.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Look_For_Sources procedure Look_For_Sources
(Project : Project_Id; (Project : Project_Id;
@ -500,7 +499,7 @@ package body Prj.Nmsc is
-- Find all the sources of project Project in project tree In_Tree and -- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. -- update its Data accordingly.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
function Path_Name_Of function Path_Name_Of
(File_Name : File_Name_Type; (File_Name : File_Name_Type;
@ -535,7 +534,7 @@ package body Prj.Nmsc is
-- Put a unit in the list of units of a project, if the file name -- Put a unit in the list of units of a project, if the file name
-- corresponds to a valid unit name. -- corresponds to a valid unit name.
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it -- efficiency to avoid system calls to recompute it.
procedure Record_Other_Sources procedure Record_Other_Sources
(Project : Project_Id; (Project : Project_Id;
@ -553,6 +552,7 @@ package body Prj.Nmsc is
Project : Project_Id; Project : Project_Id;
Data : in out Project_Data; Data : in out Project_Data;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- ??? needs comment
procedure Report_No_Sources procedure Report_No_Sources
(Project : Project_Id; (Project : Project_Id;
@ -579,8 +579,8 @@ package body Prj.Nmsc is
Conventions : Array_Element_Id; Conventions : Array_Element_Id;
Specs : Boolean; Specs : Boolean;
Extending : Boolean); Extending : Boolean);
-- Check that individual naming conventions apply to immediate -- Check that individual naming conventions apply to immediate sources of
-- sources of the project; if not, issue a warning. -- the project. If not, issue a warning.
---------------- ----------------
-- Add_Source -- -- Add_Source --
@ -642,7 +642,8 @@ package body Prj.Nmsc is
Src_Data.Display_File := Display_File; Src_Data.Display_File := Display_File;
Src_Data.Dependency := Src_Data.Dependency :=
In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind; In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind;
Src_Data.Dep_Name := Dependency_Name (File_Name, Src_Data.Dependency); Src_Data.Dep_Name :=
Dependency_Name (File_Name, Src_Data.Dependency);
Src_Data.Switches := Switches_Name (File_Name); Src_Data.Switches := Switches_Name (File_Name);
Src_Data.Naming_Exception := Naming_Exception; Src_Data.Naming_Exception := Naming_Exception;

49
gcc/ada/prj.ads
View File

@ -68,9 +68,9 @@ package Prj is
-- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only. -- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only.
Must_Check_Configuration : Boolean := False; Must_Check_Configuration : Boolean := False;
-- Whether the contents of the configuration file must be checked. This is -- True when the contents of the configuration file must be checked. This
-- in general only needed by gprbuild itself, since other applications can -- is in general only needed by gprbuild itself, since other applications
-- ignore such errors when they don't need to build directly. Calling -- can ignore such errors when they don't need to build directly. Calling
-- Set_Mode will reset this variable, default is for Ada_Only. -- Set_Mode will reset this variable, default is for Ada_Only.
function In_Configuration return Boolean; function In_Configuration return Boolean;
@ -1066,18 +1066,18 @@ package Prj is
-- for libraries. -- for libraries.
Executable_Suffix : Name_Id := No_Name; Executable_Suffix : Name_Id := No_Name;
-- The suffix of executables, when specified in the configuration or -- The suffix of executables, when specified in the configuration
-- in package Builder of the main project. When this is not -- or in package Builder of the main project. When this is not
-- specified, the executable suffix is the default for the platform. -- specified, the executable suffix is the default for the platform.
-- Linking -- Linking
Linker : Path_Name_Type := No_Path; Linker : Path_Name_Type := No_Path;
-- Path name of the linker driver; specified in the configuration -- Path name of the linker driver. Specified in the configuration
-- or in the package Builder of the main project. -- or in the package Builder of the main project.
Minimum_Linker_Options : Name_List_Index := No_Name_List; Minimum_Linker_Options : Name_List_Index := No_Name_List;
-- The minimum options for the linker driver; specified in the -- The minimum options for the linker driver. Specified in the
-- configuration. -- configuration.
Linker_Executable_Option : Name_List_Index := No_Name_List; Linker_Executable_Option : Name_List_Index := No_Name_List;
@ -1091,14 +1091,13 @@ package Prj is
-- "-L". -- "-L".
Linker_Lib_Name_Option : Name_Id := No_Name; Linker_Lib_Name_Option : Name_Id := No_Name;
-- The option to specify the name of a library for linking. -- The option to specify the name of a library for linking. Specified
-- Specified in the configuration. When not specified, defaults to -- in the configuration. When not specified, defaults to "-l".
-- "-l".
-- Libraries -- Libraries
Library_Builder : Path_Name_Type := No_Path; Library_Builder : Path_Name_Type := No_Path;
-- The executable to build library. Specified in the configuration. -- The executable to build library (specified in the configuration)
Lib_Support : Library_Support := None; Lib_Support : Library_Support := None;
-- The level of library support. Specified in the configuration. -- The level of library support. Specified in the configuration.
@ -1134,19 +1133,19 @@ package Prj is
-- default to ".so". -- default to ".so".
Shared_Lib_Min_Options : Name_List_Index := No_Name_List; Shared_Lib_Min_Options : Name_List_Index := No_Name_List;
-- -- Comment ???
Lib_Version_Options : Name_List_Index := No_Name_List; Lib_Version_Options : Name_List_Index := No_Name_List;
-- -- Comment ???
Symbolic_Link_Supported : Boolean := False; Symbolic_Link_Supported : Boolean := False;
-- -- Comment ???
Lib_Maj_Min_Id_Supported : Boolean := False; Lib_Maj_Min_Id_Supported : Boolean := False;
-- -- Comment ???
Auto_Init_Supported : Boolean := False; Auto_Init_Supported : Boolean := False;
-- -- Comment ???
end record; end record;
Default_Project_Config : constant Project_Configuration := Default_Project_Config : constant Project_Configuration :=
@ -1287,10 +1286,10 @@ package Prj is
-- Symbol file name, reference symbol file name, symbol policy -- Symbol file name, reference symbol file name, symbol policy
Ada_Sources : String_List_Id := Nil_String; Ada_Sources : String_List_Id := Nil_String;
-- The list of all the Ada source file names (gnatmake only). -- The list of all the Ada source file names (gnatmake only)
Sources : String_List_Id := Nil_String; Sources : String_List_Id := Nil_String;
-- Identical to Ada_Sources. For upward compatibility of GPS. -- Identical to Ada_Sources (for upward compatibility with GPS)
First_Source : Source_Id := No_Source; First_Source : Source_Id := No_Source;
Last_Source : Source_Id := No_Source; Last_Source : Source_Id := No_Source;
@ -1465,17 +1464,20 @@ package Prj is
(Extending : Project_Id; (Extending : Project_Id;
Extended : Project_Id; Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean; In_Tree : Project_Tree_Ref) return Boolean;
-- ??? needs comment
function Is_A_Language function Is_A_Language
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Data : Project_Data; Data : Project_Data;
Language_Name : Name_Id) return Boolean; Language_Name : Name_Id) return Boolean;
-- Whether Language_Name is one of the languages used for the project. -- Return True when Language_Name (which must be lower case) is one of the
-- Language_Name must be lower cased. -- languages used for the project.
function There_Are_Ada_Sources function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id) return Boolean; Project : Project_Id) return Boolean;
-- ??? needs comment
-- ??? Name sounds strange, suggested replacement: Ada_Sources_Present
Project_Error : exception; Project_Error : exception;
-- Raised by some subprograms in Prj.Attr -- Raised by some subprograms in Prj.Attr
@ -1488,8 +1490,7 @@ package Prj is
Table_Increment => 100); Table_Increment => 100);
-- The set of all project files -- The set of all project files
type Spec_Or_Body is type Spec_Or_Body is (Specification, Body_Part);
(Specification, Body_Part);
type File_Name_Data is record type File_Name_Data is record
Name : File_Name_Type := No_File; Name : File_Name_Type := No_File;
@ -1597,8 +1598,8 @@ package Prj is
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc -- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String); procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then -- Check that the current token is The_Token. If it is not, then output
-- output an error message. -- an error message.
procedure Initialize (Tree : Project_Tree_Ref); procedure Initialize (Tree : Project_Tree_Ref);
-- This procedure must be called before using any services from the Prj -- This procedure must be called before using any services from the Prj

17
gcc/ada/sem_aggr.adb
View File

@ -1402,8 +1402,7 @@ package body Sem_Aggr is
if Is_Character_Type (Component_Typ) if Is_Character_Type (Component_Typ)
and then No (Next_Index (Nxt_Ind)) and then No (Next_Index (Nxt_Ind))
and then (Nkind (Expr) = N_String_Literal and then Nkind_In (Expr, N_String_Literal, N_Operator_Symbol)
or else Nkind (Expr) = N_Operator_Symbol)
then then
-- A string literal used in a multidimensional array -- A string literal used in a multidimensional array
-- aggregate in place of the final one-dimensional -- aggregate in place of the final one-dimensional
@ -1513,9 +1512,8 @@ package body Sem_Aggr is
if Ada_Version = Ada_83 if Ada_Version = Ada_83
and then Assoc /= First (Component_Associations (N)) and then Assoc /= First (Component_Associations (N))
and then (Nkind (Parent (N)) = N_Assignment_Statement and then Nkind_In (Parent (N), N_Assignment_Statement,
or else N_Object_Declaration)
Nkind (Parent (N)) = N_Object_Declaration)
then then
Error_Msg_N Error_Msg_N
("(Ada 83) illegal context for OTHERS choice", N); ("(Ada 83) illegal context for OTHERS choice", N);
@ -2484,14 +2482,11 @@ package body Sem_Aggr is
function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is
Kind : constant Node_Kind := Nkind (Expr); Kind : constant Node_Kind := Nkind (Expr);
begin begin
return ((Kind = N_Aggregate return (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate)
or else Kind = N_Extension_Aggregate)
and then Present (Etype (Expr)) and then Present (Etype (Expr))
and then Is_Record_Type (Etype (Expr)) and then Is_Record_Type (Etype (Expr))
and then Expansion_Delayed (Expr)) and then Expansion_Delayed (Expr))
or else (Kind = N_Qualified_Expression or else (Kind = N_Qualified_Expression
and then Has_Expansion_Delayed (Expression (Expr))); and then Has_Expansion_Delayed (Expression (Expr)));
end Has_Expansion_Delayed; end Has_Expansion_Delayed;
@ -2848,8 +2843,8 @@ package body Sem_Aggr is
else else
Root_Typ := Root_Type (Typ); Root_Typ := Root_Type (Typ);
if Nkind (Parent (Base_Type (Root_Typ))) if Nkind (Parent (Base_Type (Root_Typ))) =
= N_Private_Type_Declaration N_Private_Type_Declaration
then then
Error_Msg_NE Error_Msg_NE
("type of aggregate has private ancestor&!", ("type of aggregate has private ancestor&!",

5
gcc/ada/xeinfo.adb
View File

@ -63,9 +63,6 @@ procedure XEinfo is
Err : exception; Err : exception;
pragma Warnings (Off);
-- These seem not to be referenced, but they are (by * operator)
A : VString := Nul; A : VString := Nul;
B : VString := Nul; B : VString := Nul;
C : VString := Nul; C : VString := Nul;
@ -88,8 +85,6 @@ procedure XEinfo is
Rtn : VString := Nul; Rtn : VString := Nul;
Term : VString := Nul; Term : VString := Nul;
pragma Warnings (On);
InB : File_Type; InB : File_Type;
-- Used to read initial header from body -- Used to read initial header from body

3
gcc/ada/xnmake.adb
View File

@ -63,9 +63,6 @@ procedure XNmake is
Err : exception; Err : exception;
-- Raised to terminate execution -- Raised to terminate execution
pragma Warnings (Off);
-- The following are modified by * operator
A : VString := Nul; A : VString := Nul;
Arg : VString := Nul; Arg : VString := Nul;
Arg_List : VString := Nul; Arg_List : VString := Nul;

9
gcc/ada/xsinfo.adb
View File

@ -55,9 +55,6 @@ procedure XSinfo is
Done : exception; Done : exception;
Err : exception; Err : exception;
pragma Warnings (Off);
-- Below variables are referenced using * operator
A : VString := Nul; A : VString := Nul;
Arg : VString := Nul; Arg : VString := Nul;
Comment : VString := Nul; Comment : VString := Nul;
@ -68,10 +65,8 @@ procedure XSinfo is
Rtn : VString := Nul; Rtn : VString := Nul;
Term : VString := Nul; Term : VString := Nul;
pragma Warnings (On); InS : File_Type;
Ofile : File_Type;
InS : File_Type;
Ofile : File_Type;
wsp : constant Pattern := Span (' ' & ASCII.HT); wsp : constant Pattern := Span (' ' & ASCII.HT);
Wsp_For : constant Pattern := wsp & "for"; Wsp_For : constant Pattern := wsp & "for";

5
gcc/ada/xsnames.adb
View File

@ -47,9 +47,6 @@ procedure XSnames is
InH : File_Type; InH : File_Type;
OutH : File_Type; OutH : File_Type;
pragma Warnings (Off);
-- Variables below are modifed by * operator
A, B : VString := Nul; A, B : VString := Nul;
Line : VString := Nul; Line : VString := Nul;
Name : VString := Nul; Name : VString := Nul;
@ -58,8 +55,6 @@ procedure XSnames is
Oval : VString := Nul; Oval : VString := Nul;
Restl : VString := Nul; Restl : VString := Nul;
pragma Warnings (On);
Tdigs : constant Pattern := Any (Decimal_Digit_Set) & Tdigs : constant Pattern := Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set) & Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set); Any (Decimal_Digit_Set);

5
gcc/ada/xtreeprs.adb
View File

@ -59,9 +59,6 @@ procedure XTreeprs is
Err : exception; Err : exception;
-- Raised on fatal error -- Raised on fatal error
pragma Warnings (Off);
-- Following variables are assigned by * operator
A : VString := Nul; A : VString := Nul;
Ffield : VString := Nul; Ffield : VString := Nul;
Field : VString := Nul; Field : VString := Nul;
@ -78,8 +75,6 @@ procedure XTreeprs is
Synonym : VString := Nul; Synonym : VString := Nul;
Term : VString := Nul; Term : VString := Nul;
pragma Warnings (On);
subtype Sfile is Ada.Streams.Stream_IO.File_Type; subtype Sfile is Ada.Streams.Stream_IO.File_Type;
OutS : Sfile; OutS : Sfile;