-- --
-- 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 --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- 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. --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
..
+(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;
+ -- 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
(Left : Time;
with Ada.Calendar; use Ada.Calendar;
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
--------------------------
-- --
-- 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 --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- 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. --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- --
-- 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 --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- 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. --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
- -- Returns, as a number of minutes, the difference between the
- -- implementation-defined time zone of Calendar, and UTC time, at the time
- -- Date. If the time zone of the Calendar implementation is unknown, then
- -- Unknown_Zone_Error is raised.
+ -- Returns (in minutes), the difference between the implementation-defined
+ -- time zone of Calendar, and UTC time, at the time Date. If the time zone
+ -- of the Calendar implementation is unknown, raises Unknown_Zone_Error.
end Ada.Calendar.Time_Zones;
File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
- procedure gigi (
- gnat_root : Int;
+ procedure gigi
+ (gnat_root : Int;
max_gnat_node : Int;
number_name : Nat;
nodes_ptr : Address;
return;
end if;
- for I in 1 .. Last_Source_File loop
- File_Info_Array (I).File_Name := Full_Debug_Name (I);
- File_Info_Array (I).Num_Source_Lines := Num_Source_Lines (I);
+ for J in 1 .. Last_Source_File loop
+ File_Info_Array (J).File_Name := Full_Debug_Name (J);
+ File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
end loop;
- gigi (
- gnat_root => Int (Cunit (Main_Unit)),
+ gigi
+ (gnat_root => Int (Cunit (Main_Unit)),
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
number_name => Name_Entries_Count,
nodes_ptr => Nodes_Address,
type Arg_Array is array (Nat) of BSP;
type Arg_Array_Ptr is access Arg_Array;
- -- Import flag_stack_check from toplev.c
-
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;
- pragma Import (C, save_argc); -- Import from toplev.c
+ pragma Import (C, save_argc);
+ -- Import from toplev.c
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;
- -- Set to True after having scanned the file_name for
- -- switch "-gnatO file_name"
+ -- Set to True after having scanned file_name for switch "-gnatO file"
-- Local functions
function Len_Arg (Arg : Pos) return Nat;
- -- Determine length of argument number Arg on the original
- -- command line from gnat1
+ -- Determine length of argument number Arg on the original command line
+ -- from gnat1.
procedure Scan_Back_End_Switches (Switch_Chars : String);
-- Procedure to scan out switches stored in Switch_Chars. The first
Last := Last - 1;
end if;
- -- For these switches, skip following argument and 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"
+ -- For switches -o, -dumpbase, --param, skip following argument and
+ -- 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"
then
Next_Arg := Next_Arg + 1;
elsif Switch_Chars (First .. Last) = "quiet" then
null;
- else
- -- Store any other GCC switches
+ -- Store any other GCC switches
+ else
Store_Compilation_Switch (Switch_Chars);
-- Special check, the back end switch -fno-inline also sets the
Output_File_Name_Seen := True;
end if;
- -- If the previous switch has set the Search_Directory_Present
- -- flag (that is if we have just seen -I), then the next
- -- argument is a search directory path.
+ -- If the previous switch has set the Search_Directory_Present
+ -- flag (that is if we have just seen -I), then the next argument
+ -- is a search directory path.
elsif Search_Directory_Present then
if Is_Switch (Argv) then
procedure Scan_Compiler_Arguments;
-- Acquires command-line parameters passed to the compiler and processes
- -- them. Calls Scan_Front_End_Switches for any front-end switches
- -- encountered.
+ -- them. Calls Scan_Front_End_Switches for any front-end switches found.
--
- -- The processing of arguments is private to the back end, since
- -- the way of acquiring the arguments as well as the set of allowable
- -- back end switches is different depending on the particular back end
- -- being used.
+ -- The processing of arguments is private to the back end, since the way
+ -- of acquiring the arguments as well as the set of allowable back end
+ -- switches is different depending on the particular back end being used.
--
- -- Any processed switches that influence the result of a compilation
- -- must be added to the Compilation_Arguments table.
+ -- Any processed switches that influence the result of a compilation must
+ -- be added to the Compilation_Arguments table.
end Back_End;
"""__gnat_handler_installed"");");
-- 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
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
end if;
if VM_Target = CLI_Target
+ and then Bind_Main_Program
and then not No_Main_Subprogram
then
WBI ("");
end if;
-- 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
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
Gen_Elab_Calls_Ada;
if VM_Target = CLI_Target
+ and then Bind_Main_Program
and then not No_Main_Subprogram
then
if ALIs.Table (ALIs.First).Main_Program = Func then
end if;
-- 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
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
end if;
-- 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
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
(Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean;
-- 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
- -- the predefined library units. On return, Name_Buffer contains the
- -- file name. The Renamings_Included parameter indicates 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.
+ -- file name with no directory information) is the file name for one of the
+ -- predefined library units (i.e. part of the Ada, System, or Interface
+ -- hierarchies). Note that units in the GNAT hierarchy are not considered
+ -- predefined (see Is_Internal_File_Name below). On return, Name_Buffer
+ -- contains the file name. The Renamings_Included parameter indicates
+ -- 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
(Renamings_Included : Boolean := True) return Boolean;
function Is_Internal_File_Name
(Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean;
- -- Similar to Is_Predefined_File_Name. The internal file set is a
- -- superset of the predefined file set including children of GNAT,
- -- and also children of DEC for the VMS case.
+ -- Similar to Is_Predefined_File_Name. The internal file set is a superset
+ -- of the predefined file set including children of GNAT, and also children
+ -- of DEC for the VMS case.
procedure Tree_Read;
-- Dummy procedure (reads dummy table values from tree file)
-- support of the target. Note that this means that there may be
-- minor differences in results between targets when the floating-
-- 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
-- from those obtained on a true hardware Altivec target if the
-- floating-point implementation is not 100% compatible.
-- 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
-- exactly one space character.
+ --
-- 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
-- character.
- -- Trailing characters (in particular spaces) are not allowed.
+ --
+ -- Trailing characters (in particular spaces) are not allowed
--
-- yyyy*mm*dd
-- yy*mm*dd - Year is assumed to be 20yy
procedure Put_Time
(Date : Ada.Calendar.Time;
Picture : Picture_String);
- -- Put Date with format Picture. Raise Picture_Error if picture string is
- -- wrong
+ -- Put Date with format Picture. Raise Picture_Error if bad picture string
private
ISO_Date : constant Picture_String := "%Y-%m-%d";
package GNAT.Traceback.Symbolic is
pragma Elaborate_Body;
- ------------------------
- -- Symbolic_Traceback --
- ------------------------
-
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
-- Build a string containing a symbolic traceback of the given call chain
Hash => Hash,
Equal => "=");
-- 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
(In_Tree : Project_Tree_Ref;
Data : Project_Data);
-- Find the list of files that should not be considered as source files
- -- for this project.
- -- Sets the list in the Excluded_Sources_Htable
+ -- for this project. Sets the list in the Excluded_Sources_Htable.
function Hash (Unit : Unit_Info) return Header_Num;
Key => Unit_Info,
Hash => Hash,
Equal => "=");
- -- A table to check if a unit with an exceptional name will hide
- -- a source with a file name following the naming convention.
+ -- A table to check if a unit with an exceptional name will hide a source
+ -- with a file name following the naming convention.
procedure Add_Source
(Id : out Source_Id;
-- In_Tree and modify its data Data if it has the value "true".
procedure Check_Library_Attributes
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
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
-- and modify its data Data accordingly.
-- 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
(Project : Project_Id;
-- 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.
-- 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
(Project : Project_Id;
function Compute_Directory_Last (Dir : String) return Natural;
-- 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
(Project : Project_Id;
Current_Dir : String);
-- 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
- -- efficiency to avoid system calls to recompute it
+ -- efficiency to avoid system calls to recompute it.
procedure Find_Sources
(Project : Project_Id;
Data : in out Project_Data;
For_All_Sources : Boolean);
-- Search the source directories to find the sources.
- -- If For_All_Sources is True, check each regular file name against
- -- the naming schemes of the different languages. Otherwise consider
- -- only the file names in the hash table Source_Names.
+ -- If For_All_Sources is True, check each regular file name against the
+ -- naming schemes of the different languages. Otherwise consider only the
+ -- file names in the hash table Source_Names.
procedure Check_File
(Project : Project_Id;
-- Get the object directory, the exec directory and the source directories
-- of a project.
-- 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
(Project : Project_Id;
Data : in out Project_Data);
-- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable.
- -- Lang indicates which language is being processed when in Ada_Only
- -- mode (all languages are processed anyway when in Multi_Language mode)
+ -- Lang indicates which language is being processed when in Ada_Only mode
+ -- (all languages are processed anyway when in Multi_Language mode).
procedure Get_Unit
(In_Tree : Project_Tree_Ref;
Unit_Kind : out Spec_Or_Body;
Needs_Pragma : out Boolean);
-- 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
- -- unit, then Unit_Name will be No_Name. If the file is a multi-unit source
- -- or an exception to the naming scheme, then Exception_Id is set to
- -- the unit or units that the source contains.
+ -- specific SFN pragma is needed. If the file name corresponds to no unit,
+ -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
+ -- exception to the naming scheme, then Exception_Id is set to the unit or
+ -- units that the source contains.
function Is_Illegal_Suffix
(Suffix : String;
Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
- -- Returns True if the string Suffix cannot be used as
- -- a spec suffix, a body suffix or a separate suffix.
+ -- Returns True if the string Suffix cannot be used as a spec suffix, a
+ -- body suffix or a separate suffix.
procedure Locate_Directory
(Project : Project_Id;
-- the directory. If the directory does not exist and Project_Setup is
-- false, then Dir and Display are set to No_Name.
-- 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
(Project : Project_Id;
-- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly.
-- 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
(File_Name : File_Name_Type;
-- Put a unit in the list of units of a project, if the file name
-- corresponds to a valid unit name.
-- 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
(Project : Project_Id;
Project : Project_Id;
Data : in out Project_Data;
In_Tree : Project_Tree_Ref);
+ -- ??? needs comment
procedure Report_No_Sources
(Project : Project_Id;
Conventions : Array_Element_Id;
Specs : Boolean;
Extending : Boolean);
- -- Check that individual naming conventions apply to immediate
- -- sources of the project; if not, issue a warning.
+ -- Check that individual naming conventions apply to immediate sources of
+ -- the project. If not, issue a warning.
----------------
-- Add_Source --
Src_Data.Display_File := Display_File;
Src_Data.Dependency :=
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.Naming_Exception := Naming_Exception;
-- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only.
Must_Check_Configuration : Boolean := False;
- -- Whether the contents of the configuration file must be checked. This is
- -- in general only needed by gprbuild itself, since other applications can
- -- ignore such errors when they don't need to build directly. Calling
+ -- True when the contents of the configuration file must be checked. This
+ -- is in general only needed by gprbuild itself, since other applications
+ -- can ignore such errors when they don't need to build directly. Calling
-- Set_Mode will reset this variable, default is for Ada_Only.
function In_Configuration return Boolean;
-- for libraries.
Executable_Suffix : Name_Id := No_Name;
- -- The suffix of executables, when specified in the configuration or
- -- in package Builder of the main project. When this is not
+ -- The suffix of executables, when specified in the configuration
+ -- or in package Builder of the main project. When this is not
-- specified, the executable suffix is the default for the platform.
-- Linking
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.
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.
Linker_Executable_Option : Name_List_Index := No_Name_List;
-- "-L".
Linker_Lib_Name_Option : Name_Id := No_Name;
- -- The option to specify the name of a library for linking.
- -- Specified in the configuration. When not specified, defaults to
- -- "-l".
+ -- The option to specify the name of a library for linking. Specified
+ -- in the configuration. When not specified, defaults to "-l".
-- Libraries
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;
-- The level of library support. Specified in the configuration.
-- default to ".so".
Shared_Lib_Min_Options : Name_List_Index := No_Name_List;
- --
+ -- Comment ???
Lib_Version_Options : Name_List_Index := No_Name_List;
- --
+ -- Comment ???
Symbolic_Link_Supported : Boolean := False;
- --
+ -- Comment ???
Lib_Maj_Min_Id_Supported : Boolean := False;
- --
+ -- Comment ???
Auto_Init_Supported : Boolean := False;
- --
+ -- Comment ???
end record;
Default_Project_Config : constant Project_Configuration :=
-- Symbol file name, reference symbol file name, symbol policy
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;
- -- Identical to Ada_Sources. For upward compatibility of GPS.
+ -- Identical to Ada_Sources (for upward compatibility with GPS)
First_Source : Source_Id := No_Source;
Last_Source : Source_Id := No_Source;
(Extending : Project_Id;
Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean;
+ -- ??? needs comment
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
Language_Name : Name_Id) return Boolean;
- -- Whether Language_Name is one of the languages used for the project.
- -- Language_Name must be lower cased.
+ -- Return True when Language_Name (which must be lower case) is one of the
+ -- languages used for the project.
function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref;
Project : Project_Id) return Boolean;
+ -- ??? needs comment
+ -- ??? Name sounds strange, suggested replacement: Ada_Sources_Present
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
Table_Increment => 100);
-- The set of all project files
- type Spec_Or_Body is
- (Specification, Body_Part);
+ type Spec_Or_Body is (Specification, Body_Part);
type File_Name_Data is record
Name : File_Name_Type := No_File;
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String);
- -- Check that the current token is The_Token. If it is not, then
- -- output an error message.
+ -- Check that the current token is The_Token. If it is not, then output
+ -- an error message.
procedure Initialize (Tree : Project_Tree_Ref);
-- This procedure must be called before using any services from the Prj
if Is_Character_Type (Component_Typ)
and then No (Next_Index (Nxt_Ind))
- and then (Nkind (Expr) = N_String_Literal
- or else Nkind (Expr) = N_Operator_Symbol)
+ and then Nkind_In (Expr, N_String_Literal, N_Operator_Symbol)
then
-- A string literal used in a multidimensional array
-- aggregate in place of the final one-dimensional
if Ada_Version = Ada_83
and then Assoc /= First (Component_Associations (N))
- and then (Nkind (Parent (N)) = N_Assignment_Statement
- or else
- Nkind (Parent (N)) = N_Object_Declaration)
+ and then Nkind_In (Parent (N), N_Assignment_Statement,
+ N_Object_Declaration)
then
Error_Msg_N
("(Ada 83) illegal context for OTHERS choice", N);
function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is
Kind : constant Node_Kind := Nkind (Expr);
-
begin
- return ((Kind = N_Aggregate
- or else Kind = N_Extension_Aggregate)
+ return (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate)
and then Present (Etype (Expr))
and then Is_Record_Type (Etype (Expr))
and then Expansion_Delayed (Expr))
-
or else (Kind = N_Qualified_Expression
and then Has_Expansion_Delayed (Expression (Expr)));
end Has_Expansion_Delayed;
else
Root_Typ := Root_Type (Typ);
- if Nkind (Parent (Base_Type (Root_Typ)))
- = N_Private_Type_Declaration
+ if Nkind (Parent (Base_Type (Root_Typ))) =
+ N_Private_Type_Declaration
then
Error_Msg_NE
("type of aggregate has private ancestor&!",
Err : exception;
- pragma Warnings (Off);
- -- These seem not to be referenced, but they are (by * operator)
-
A : VString := Nul;
B : VString := Nul;
C : VString := Nul;
Rtn : VString := Nul;
Term : VString := Nul;
- pragma Warnings (On);
-
InB : File_Type;
-- Used to read initial header from body
Err : exception;
-- Raised to terminate execution
- pragma Warnings (Off);
- -- The following are modified by * operator
-
A : VString := Nul;
Arg : VString := Nul;
Arg_List : VString := Nul;
Done : exception;
Err : exception;
- pragma Warnings (Off);
- -- Below variables are referenced using * operator
-
A : VString := Nul;
Arg : VString := Nul;
Comment : VString := Nul;
Rtn : 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_For : constant Pattern := wsp & "for";
InH : File_Type;
OutH : File_Type;
- pragma Warnings (Off);
- -- Variables below are modifed by * operator
-
A, B : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Oval : VString := Nul;
Restl : VString := Nul;
- pragma Warnings (On);
-
Tdigs : constant Pattern := Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set);
Err : exception;
-- Raised on fatal error
- pragma Warnings (Off);
- -- Following variables are assigned by * operator
-
A : VString := Nul;
Ffield : VString := Nul;
Field : VString := Nul;
Synonym : VString := Nul;
Term : VString := Nul;
- pragma Warnings (On);
-
subtype Sfile is Ada.Streams.Stream_IO.File_Type;
OutS : Sfile;
OSDN Git Service
