pragma Pure (Assertions);
Assertion_Error : exception renames System.Assertions.Assert_Failure;
+ -- This is the renaming that is allowed by 11.4.2(24). Note that the
+ -- Exception_Name will refer to the one in System.Assertions (see
+ -- AARM-11.4.1(12.b)).
procedure Assert (Check : Boolean);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
(Element_Type'Has_Access_Values,
"Element_Type for Direct_IO instance has access values");
+ pragma Compile_Time_Warning
+ (Element_Type'Has_Tagged_Values,
+ "Element_Type for Direct_IO instance has tagged values");
+
type File_Type is limited private;
type File_Mode is (In_File, Inout_File, Out_File);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
(Element_Type'Has_Access_Values,
"Element_Type for Sequential_IO instance has access values");
+ pragma Compile_Time_Warning
+ (Element_Type'Has_Tagged_Values,
+ "Element_Type for Sequential_IO instance has tagged values");
+
type File_Type is limited private;
type File_Mode is (In_File, Out_File, Append_File);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
Reference : String_Access := Null_String'Access;
Last : Natural := 0;
end record;
-
-- The Unbounded_String is using a buffered implementation to increase
-- speed of the Append/Delete/Insert procedures. The Reference string
-- pointer above contains the current string value and extra room at the
-- Reference (1 .. Last).
pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
+ -- Provide stream routines without dragging in Ada.Streams
pragma Finalize_Storage_Only (Unbounded_String);
-- Finalization is required only for freeing storage
-- --
-- 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- --
-- been generated, compute the Aft next digits (without rounding).
-- Once a non-zero digit is generated, determine the exact number
-- of digits remaining and compute them with rounding.
+
-- Since a large number of iterations might be necessary in case
-- of Aft = 1, the following optimization would be desirable.
+
-- Count the number Z of leading zero bits in the integer
- -- representation of X, and start with producing
- -- Aft + Z * 1000 / 3322 digits in the first scaled division.
+ -- representation of X, and start with producing Aft + Z * 1000 /
+ -- 3322 digits in the first scaled division.
-- However, the floating-point routines are still used now ???
-- --
-- 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- --
-- Local Subprograms --
-----------------------
- procedure Fix_Parents (Old_Node, New_Node : Node_Id);
- -- Fixup parent pointers for the syntactic children of New_Node after
- -- a copy, setting them to New_Node when they pointed to Old_Node.
+ procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id);
+ -- Fixup parent pointers for the syntactic children of Fix_Node after
+ -- a copy, setting them to Fix_Node when they pointed to Ref_Node.
function Allocate_Initialize_Node
(Src : Node_Id;
-- Fix_Parents --
-----------------
- procedure Fix_Parents (Old_Node, New_Node : Node_Id) is
+ procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id) is
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id);
- -- Fixup one parent pointer. Field is checked to see if it
- -- points to a node, list, or element list that has a parent that
- -- points to Old_Node. If so, the parent is reset to point to New_Node.
+ procedure Fix_Parent (Field : Union_Id);
+ -- Fixup one parent pointer. Field is checked to see if it points to
+ -- a node, list, or element list that has a parent that points to
+ -- Ref_Node. If so, the parent is reset to point to Fix_Node.
----------------
-- Fix_Parent --
----------------
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id) is
+ procedure Fix_Parent (Field : Union_Id) is
begin
-- Fix parent of node that is referenced by Field. Note that we must
-- exclude the case where the node is a member of a list, because in
if Field in Node_Range
and then Present (Node_Id (Field))
and then not Nodes.Table (Node_Id (Field)).In_List
- and then Parent (Node_Id (Field)) = Old_Node
+ and then Parent (Node_Id (Field)) = Ref_Node
then
- Set_Parent (Node_Id (Field), New_Node);
+ Set_Parent (Node_Id (Field), Fix_Node);
-- Fix parent of list that is referenced by Field
elsif Field in List_Range
and then Present (List_Id (Field))
- and then Parent (List_Id (Field)) = Old_Node
+ and then Parent (List_Id (Field)) = Ref_Node
then
- Set_Parent (List_Id (Field), New_Node);
+ Set_Parent (List_Id (Field), Fix_Node);
end if;
end Fix_Parent;
-- Start of processing for Fix_Parents
begin
- Fix_Parent (Field1 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field2 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field3 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field4 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field5 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field1 (Fix_Node));
+ Fix_Parent (Field2 (Fix_Node));
+ Fix_Parent (Field3 (Fix_Node));
+ Fix_Parent (Field4 (Fix_Node));
+ Fix_Parent (Field5 (Fix_Node));
end Fix_Parents;
-----------------------------------
end if;
New_Node := New_Copy (Source);
- Fix_Parents (Source, New_Node);
+ Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
-- We now set the parent of the new node to be the same as the
-- parent of the source. Almost always this parent will be
-- Fix parents of substituted node, since it has changed identity
- Fix_Parents (New_Node, Old_Node);
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
-- Since we are doing a replace, we assume that the original node
-- is intended to become the new replaced node. The call would be
Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
end if;
- Fix_Parents (New_Node, Old_Node);
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
end Rewrite;
------------------
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node1 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node2 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node3 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node4 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node5 (N, Val);
-- --
-- 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- --
-- Line for --RTS
- Write_Line (" --RTS=dir specify the default source and " &
+ Write_Line (" --RTS=dir Specify the default source and " &
"object search path");
-- Line for sfile
-- --
-- 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- --
Write_Eol;
P ("package Standard is");
- P ("pragma Pure(Standard);");
+ P ("pragma Pure (Standard);");
Write_Eol;
P (" type Boolean is (False, True);");
-- --
-- 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- --
if Etype (Left) = Universal_Real then
if Nkind (Left) = N_Real_Literal then
- Do_Multiply_Fixed_Universal (N, Right, Left);
+ Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
elsif Nkind (Left) = N_Type_Conversion then
Rewrite_Non_Static_Universal (Left);
Right : constant Node_Id := Right_Opnd (N);
begin
if Etype (Left) = Universal_Real then
- Do_Multiply_Fixed_Universal (N, Right, Left);
+ Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
elsif Etype (Right) = Universal_Real then
Do_Multiply_Fixed_Universal (N, Left, Right);
else
-- --
-- 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 Expand (N : Node_Id) is
begin
- -- If we were analyzing a default expression the Full_Analysis flag must
- -- be off. If we are in expansion mode then we must be performing a full
- -- analysis. If we are analyzing a generic then Expansion must be off.
+ -- If we were analyzing a default expression (or other spec expression)
+ -- the Full_Analysis flag must be off. If we are in expansion mode then
+ -- we must be performing a full analysis. If we are analyzing a generic
+ -- then Expansion must be off.
pragma Assert
- (not (Full_Analysis and then In_Default_Expression)
+ (not (Full_Analysis and then In_Spec_Expression)
and then (Full_Analysis or else not Expander_Active)
and then not (Inside_A_Generic and then Expander_Active));
-- --
-- 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- --
-- (b) when starting/completing the pre-analysis of an expression
-- (see the spec of package Sem for more info on pre-analysis.)
--
- -- Note that when processing a default expression (In_Default_Expression
+ -- Note that when processing a spec expression (In_Spec_Expression
-- is True) or performing semantic analysis of a generic spec or body
-- (Inside_A_Generic) or when performing pre-analysis (Full_Analysis is
-- False) the Expander_Active flag is False.
-- --
-- S p e c --
-- --
--- Copyright (C) 2007, AdaCore --
+-- Copyright (C) 2007-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- --
end loop;
exception
- when Constraint_Error =>
+ when Constraint_Error =>
Bad;
end Non_UTF8_Brackets;
end if;
-- --
-- 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- --
-- is equivalent to the UNIX basename command. The following rule is
-- always true:
--
- -- 'Path' and 'Dir_Name (Path) & Directory_Separator & Base_Name (Path)'
+ -- 'Path' and 'Dir_Name (Path) & Dir_Separator & Base_Name (Path)'
-- represent the same file.
--
-- The comparison of Suffix is case-insensitive on systems such as Windows
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, 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- --
-- The backtrace output can also be customized by way of a "decorator" which
-- may return any string output in association with a provided call chain.
+-- The decorator replaces the default backtrace mentioned above.
with GNAT.Traceback; use GNAT.Traceback;
-- Set the decorator to be used for future automatic outputs. Restore
-- the default behavior (output of raw addresses) if the provided
-- access value is null.
+ --
+ -- Note: GNAT.Traceback.Symbolic.Symbolic_Traceback may be used as the
+ -- Decorator, to get a symbolic traceback. This will cause a significant
+ -- cpu and memory overhead.
end GNAT.Exception_Traces;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2006, AdaCore --
+-- Copyright (C) 1999-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- --
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2007, AdaCore --
+-- Copyright (C) 1999-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- --
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
-- Build a string containing a symbolic traceback of the given call chain
+ --
+ -- Note: This procedure may be installed by Set_Trace_Decorator, to get a
+ -- symbolic traceback on all exceptions raised (see GNAT.Exception_Traces).
function Symbolic_Traceback (E : Exception_Occurrence) return String;
-- Build string containing symbolic traceback of given exception occurrence
-- --
-- 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- --
Offset => 0,
Chars => Chars,
Check => False);
- Poke (nul, into => Pointer + size_t'(Chars'Length));
+ Poke (nul, Into => Pointer + size_t'(Chars'Length));
end if;
return Pointer;
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
-- GNAT Defined Additions to Ada --
-----------------------------------
+ "a-calcon", -- Ada.Calendar.Conversions
"a-chlat9", -- Ada.Characters.Latin_9
"a-clrefi", -- Ada.Command_Line.Response_File
"a-colien", -- Ada.Command_Line.Environment
"g-table ", -- GNAT.Table
"g-tasloc", -- GNAT.Task_Lock
"g-thread", -- GNAT.Threads
+ "g-timsta", -- GNAT.Time_Stamp
"g-traceb", -- GNAT.Traceback
"g-trasym", -- GNAT.Traceback.Symbolic
"g-utf_32", -- GNAT.UTF_32
"i-cpp ", -- Interfaces.CPP
"i-cstrea", -- Interfaces.C.Streams
"i-java ", -- Interfaces.Java
+ "i-javjni", -- Interfaces.Java.JNI
"i-pacdec", -- Interfaces.Packed_Decimal
"i-vxwoio", -- Interfaces.VxWorks.IO
"i-vxwork", -- Interfaces.VxWorks
"s-pooloc", -- System.Pool_Local
"s-restri", -- System.Restrictions
"s-rident", -- System.Rident
+ "s-ststop", -- System.Strings.Stream_Ops
"s-tasinf", -- System.Task_Info
"s-wchcnv", -- System.Wch_Cnv
"s-wchcon"); -- System.Wch_Con
"a-coteio", -- Ada.Complex_Text_IO
"a-direct", -- Ada.Directories
"a-diroro", -- Ada.Dispatching.Round_Robin
+ "a-disedf", -- Ada.Dispatching.EDF
"a-dispat", -- Ada.Dispatching
"a-envvar", -- Ada.Environment_Variables
"a-exetim", -- Ada.Execution_Time
-- --
-- B o d y --
-- --
--- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1991-2008, Free Software Foundation, Inc. --
-- --
-- GNARL 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 Initialize is
begin
- -- "Reserve" all the interrupts, except those that are explicitely
+ -- "Reserve" all the interrupts, except those that are explicitly
-- defined.
for J in Interrupt_ID'Range loop
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-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- --
-- Referenced directly from generated code using external symbols so it
-- must always be present in a build, even if no unit has a direct with
-- of this unit. Also referenced from exception handling routines.
--- This is needed for programs that don't use exceptions explicitely but
+-- This is needed for programs that don't use exceptions explicitly but
-- direct calls to Ada.Exceptions are generated by gigi (for example,
-- by calling __gnat_raise_constraint_error directly).
-- --
-- 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- --
pragma Warnings (On);
type Big_String_Ptr is access all String (Positive);
+ for Big_String_Ptr'Storage_Size use 0;
-- A non-fat pointer type for null terminated strings
function To_Ptr is
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, 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- --
WV : constant Unsigned_32 := Wide_Wide_Character'Pos (WC);
begin
if WV > 16#FFFF# then
- raise Constraint_Error
- with "out of range character for Value attribute";
+ raise Constraint_Error with
+ "out of range character for Value attribute";
else
return Wide_Character'Val (WV);
end if;
-- --
-- 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- --
function In_Char return Character is
begin
if P > S'Last then
- raise Constraint_Error
- with "badly formed wide character code";
+ raise Constraint_Error with "badly formed wide character code";
else
P := P + 1;
return S (P - 1);
Get_Next_Code (S, SP, V, EM);
if V > 16#FFFF# then
- raise Constraint_Error
- with "out of range value for wide character";
+ raise Constraint_Error with
+ "out of range value for wide character";
end if;
L := L + 1;
-- --
-- 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- --
package Sem_Dist is
function Get_PCS_Name return PCS_Names;
- -- Return the name of a literal of type System.Partition_Interface.
- -- DSA_Implementation_Type indicating what PCS is currently in use.
+ -- Return the name of a literal of type DSA_Implementation_Name in package
+ -- System.Partition_Interface indicating what PCS is currently in use.
function Get_PCS_Version return Int;
-- Return the version number of the PCS API implemented by the PCS.
-- --
-- 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- --
end if;
-- Check for overloaded CIL convention stuff because the CIL libraries
- -- do sick things like Console.Write_Line where it matches
- -- two different overloads, so just pick the first ???
+ -- do sick things like Console.Write_Line where it matches two different
+ -- overloads, so just pick the first ???
if Convention (Nam1) = Convention_CIL
and then Convention (Nam2) = Convention_CIL
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-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 Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target);
VM_Target : Virtual_Machine_Kind := No_VM;
-- Kind of virtual machine targetted
+ -- Needs comments, don't depend on names ???
-------------------------------
-- Backend Arithmetic Checks --
-- --
-- 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- --
function UI_Gt (Left : Uint; Right : Uint) return Boolean is
begin
- return UI_Lt (Right, Left);
+ return UI_Lt (Left => Right, Right => Left);
end UI_Gt;
---------------
function UI_Le (Left : Uint; Right : Uint) return Boolean is
begin
- return not UI_Lt (Right, Left);
+ return not UI_Lt (Left => Right, Right => Left);
end UI_Le;
------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, 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- --
function WC_In is new Char_Sequence_To_UTF_32 (In_Char);
- -- Start of processingf for Scan_Wide
+ -- Start of processing for Scan_Wide
begin
Chr := In_Char;
projects / gcc.git / commitdiff