mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-11 18:01:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

a-dirval-mingw.adb, [...]: Minor reformatting

Browse Source 
2005-09-01  Robert Dewar  <dewar@adacore.com>

	* a-dirval-mingw.adb, a-direct.adb, a-coinve.adb,
	g-dynhta.adb, g-dynhta.ads, cstand.adb, exp_smem.adb, g-debuti.ads,
	g-dirope.adb, g-table.adb, lib-sort.adb, sem_maps.adb,
	exp_fixd.adb, exp_aggr.adb, a-intnam-mingw.ads, a-intnam-vxworks.ads,
	g-arrspl.adb, g-arrspl.ads, g-awk.adb, g-awk.ads, g-boubuf.ads,
	g-boubuf.ads, g-boubuf.ads, g-bubsor.ads, g-bubsor.adb, g-busora.adb,
	g-busora.ads, g-busorg.adb, g-busorg.ads, g-calend.adb, g-calend.ads,
	g-casuti.adb, g-casuti.ads, g-catiio.adb, g-catiio.ads, g-cgi.adb,
	g-cgi.ads, g-cgicoo.adb, g-cgicoo.ads, g-cgideb.adb, g-cgideb.ads,
	g-comlin.adb, g-comver.ads, g-semaph.ads, g-socthi.ads,
	sem_ch7.adb, a-direio.adb, a-caldel.ads, i-cstrea-vms.adb,
	a-ztedit.adb, a-ztenau.adb, g-socthi-vms.adb, g-socthi-vms.ads,
	g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vxworks.ads,
	a-intnam-irix.ads, a-intnam-irix.ads, a-intnam-hpux.ads,
	a-intnam-os2.ads, a-intnam-os2.ads, a-caldel-vms.adb, a-calend-vms.adb,
	a-calend-vms.ads, g-heasor.adb, g-heasor.ads, g-hesora.adb,
	g-hesora.ads, g-hesorg.adb, g-hesorg.ads, g-htable.adb, g-htable.ads,
	g-io.adb, g-io.ads, g-io_aux.adb, g-io_aux.ads, g-locfil.ads,
	g-memdum.adb, g-memdum.ads, g-traceb.adb, g-traceb.ads, i-cobol.adb,
	i-cobol.ads, i-cstrea.ads, i-cstrin.adb, a-wtedit.adb, a-tifiio.adb,
	a-wtenau.adb, a-wtenau.adb, a-teioed.adb: Minor reformatting

From-SVN: r103894
This commit is contained in:
Robert Dewar 2005-09-05 10:07:00 +02:00 committed by Arnaud Charlet
parent f67b3771d5
commit a2cb348ef4
84 changed files with 574 additions and 669 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/a-caldel-vms.adb
View File

@ -32,7 +32,7 @@
-- --
------------------------------------------------------------------------------
-- This is the Alpha/VMS version.
-- This is the Alpha/VMS version
with System.OS_Primitives;
-- Used for Max_Sensible_Delay

2
gcc/ada/a-caldel.ads
View File

@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This package implements Calendar.Time delays using protected objects.
-- This package implements Calendar.Time delays using protected objects
-- Note: the compiler generates direct calls to this interface, in the
-- processing of time types.

4
gcc/ada/a-calend-vms.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the Alpha/VMS version.
-- This is the Alpha/VMS version
with System.Aux_DEC; use System.Aux_DEC;

2
gcc/ada/a-calend-vms.ads
View File

@ -35,7 +35,7 @@
-- --
------------------------------------------------------------------------------
-- This is the Alpha/VMS version.
-- This is the Alpha/VMS version
with System.OS_Primitives;
package Ada.Calendar is

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

@ -592,7 +592,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index_As_Int : constant Int := Int (Index);
Old_Last_As_Int : constant Int := Int (Container.Last);
-- TODO: somewhat vestigial...fix.
-- TODO: somewhat vestigial...fix ???
Count1 : constant Int'Base := Int (Count);
Count2 : constant Int'Base := Old_Last_As_Int - Index_As_Int + 1;
N : constant Int'Base := Int'Min (Count1, Count2);

4
gcc/ada/a-direct.adb
View File

@ -62,7 +62,7 @@ package body Ada.Directories is
procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
function File_Exists (Name : String) return Boolean;
-- Returns True if the named file exists.
-- Returns True if the named file exists
procedure Fetch_Next_Entry (Search : Search_Type);
-- Get the next entry in a directory, setting Entry_Fetched if successful
@ -126,7 +126,7 @@ package body Ada.Directories is
then
raise Name_Error;
-- This is not an invalid case. Build the path name.
-- This is not an invalid case so build the path name
else
Last := Containing_Directory'Length;

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

@ -51,7 +51,7 @@ package body Ada.Direct_IO is
Zeroes : constant System.Storage_Elements.Storage_Array :=
(1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
-- Buffer used to fill out partial records.
-- Buffer used to fill out partial records
package FCB renames System.File_Control_Block;
package FIO renames System.File_IO;

4
gcc/ada/a-dirval-mingw.adb
View File

@ -7,7 +7,7 @@
-- B o d y --
-- (Windows Version) --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-2005 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- --
@ -147,7 +147,7 @@ package body Ada.Directories.Validity is
end if;
end loop;
-- If no invalid chars, and not all spaces, file name is valid.
-- If no invalid chars, and not all spaces, file name is valid
return not Only_Spaces;
end if;

2
gcc/ada/a-intnam-hpux.ads
View File

@ -32,7 +32,7 @@
-- --
------------------------------------------------------------------------------
-- This is a HP-UX version of this package.
-- This is a HP-UX version of this package
-- The following signals are reserved by the run time:

2
gcc/ada/a-intnam-irix.ads
View File

@ -177,7 +177,7 @@ package Ada.Interrupts.Names is
SIGUME : constant Interrupt_ID :=
System.OS_Interface.SIGUME; -- Uncorrectable memory error
-- Signals defined for Posix 1003.1c.
-- Signals defined for Posix 1003.1c
SIGPTINTR : constant Interrupt_ID :=
System.OS_Interface.SIGPTINTR; -- Pthread Interrupt Signal

6
gcc/ada/a-intnam-mingw.ads
View File

@ -31,10 +31,10 @@
-- --
------------------------------------------------------------------------------
-- This is a NT (native) version of this package.
-- This is a NT (native) version of this package
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
-- This target-dependent package spec contains names of interrupts supported
-- by the local system.
with System.OS_Interface;
-- used for names of interrupts

2
gcc/ada/a-intnam-os2.ads
View File

@ -32,7 +32,7 @@
-- --
------------------------------------------------------------------------------
-- This is an OS/2 version of this package.
-- This is an OS/2 version of this package
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.

4
gcc/ada/a-intnam-vxworks.ads
View File

@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
-- This is the VxWorks version of this package
with System.OS_Interface;
@ -39,6 +39,6 @@ package Ada.Interrupts.Names is
subtype Hardware_Interrupts is Interrupt_ID
range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
-- Range of values that can be used for hardware interrupts.
-- Range of values that can be used for hardware interrupts
end Ada.Interrupts.Names;

61
gcc/ada/a-teioed.adb
View File

@ -90,7 +90,7 @@ package body Ada.Text_IO.Editing is
Result_Index := Result_Index + Count - 1;
-- Last + 1 was a ')' throw it away too.
-- Last + 1 was a ')' throw it away too
Picture_Index := Last + 2;
@ -139,10 +139,10 @@ package body Ada.Text_IO.Editing is
In_Currency : Boolean := False;
Dollar : Boolean := False;
-- Overridden immediately if necessary.
-- Overridden immediately if necessary
Zero : Boolean := True;
-- Set to False when a non-zero digit is output.
-- Set to False when a non-zero digit is output
begin
@ -236,7 +236,7 @@ package body Ada.Text_IO.Editing is
for J in reverse Last .. Answer'Last loop
exit when J = Pic.Radix_Position;
-- Do this test First, Separator_Character can equal Pic.Floater.
-- Do this test First, Separator_Character can equal Pic.Floater
if Answer (J) = Pic.Floater then
exit;
@ -692,11 +692,11 @@ package body Ada.Text_IO.Editing is
end case;
end loop;
-- Now get rid of Blank_when_Zero and complete Star fill.
-- Now get rid of Blank_when_Zero and complete Star fill
if Zero and Pic.Blank_When_Zero then
-- Value is zero, and blank it.
-- Value is zero, and blank it
Last := Answer'Last;
@ -897,7 +897,7 @@ package body Ada.Text_IO.Editing is
raise Picture_Error;
end if;
-- Two decimal points is a no-no.
-- Two decimal points is a no-no
Answer.Has_Fraction := True;
Answer.End_Of_Fraction := J;
@ -917,7 +917,7 @@ package body Ada.Text_IO.Editing is
Answer.Start_Of_Int := Answer.End_Of_Int + 1;
end if;
-- No significant (intger) digits needs a null range.
-- No significant (integer) digits needs a null range
return Answer;
end Parse_Number_String;
@ -953,7 +953,7 @@ package body Ada.Text_IO.Editing is
type Legality is (Okay, Reject);
State : Legality := Reject;
-- Start in reject, which will reject null strings.
-- Start in reject, which will reject null strings
Index : Pic_Index := Pic.Picture.Expanded'First;
@ -1067,7 +1067,7 @@ package body Ada.Text_IO.Editing is
begin
Debug_Start ("Floating_Bracket");
-- Two different floats not allowed.
-- Two different floats not allowed
if Pic.Floater /= '!' and then Pic.Floater /= '<' then
raise Picture_Error;
@ -1393,6 +1393,7 @@ package body Ada.Text_IO.Editing is
raise Picture_Error;
else
-- Overwrite Floater and Start_Float
Pic.Floater := '*';
Pic.Start_Float := Index;
Star_Suppression;
@ -1411,7 +1412,7 @@ package body Ada.Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- A single dollar does not a floating make.
-- A single dollar does not a floating make
Number_Completion;
return;
@ -1423,8 +1424,8 @@ package body Ada.Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one dollar before the sign is okay,
-- but doesn't float.
-- Only one dollar before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1459,7 +1460,7 @@ package body Ada.Text_IO.Editing is
-- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
Must_Float : Boolean := False;
-- Set to true if a '#' occurs after an insert.
-- Set to true if a '#' occurs after an insert
begin
Debug_Start ("Leading_Pound");
@ -1548,7 +1549,7 @@ package body Ada.Text_IO.Editing is
when '9' =>
if State /= Okay then
-- A single '#' doesn't float.
-- A single '#' doesn't float
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
@ -1565,8 +1566,8 @@ package body Ada.Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one pound before the sign is okay,
-- but doesn't float.
-- Only one pound before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1631,7 +1632,7 @@ package body Ada.Text_IO.Editing is
return;
end if;
-- Will return in Okay state if a '9' was seen.
-- Will return in Okay state if a '9' was seen
end loop;
end Number;
@ -2075,7 +2076,7 @@ package body Ada.Text_IO.Editing is
-- Picture --
-------------
-- Note that Picture can be called in either State.
-- Note that Picture can be called in either State
-- It will set state to Valid only if a 9 is encountered or floating
-- currency is called.
@ -2136,7 +2137,7 @@ package body Ada.Text_IO.Editing is
Debug_Start ("Picture_Bracket");
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '<';
Pic.Start_Float := Index;
@ -2208,7 +2209,7 @@ package body Ada.Text_IO.Editing is
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '-';
Pic.Start_Float := Index;
@ -2253,7 +2254,7 @@ package body Ada.Text_IO.Editing is
when 'Z' | 'z' =>
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
if State = Okay then
Set_State (Reject);
@ -2272,7 +2273,7 @@ package body Ada.Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2293,7 +2294,7 @@ package body Ada.Text_IO.Editing is
Debug_Start ("Picture_Plus");
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '+';
Pic.Start_Float := Index;
@ -2320,7 +2321,7 @@ package body Ada.Text_IO.Editing is
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "++" is enough.
Set_State (Okay); -- "++" is enough
Floating_Plus;
Trailing_Currency;
return;
@ -2341,7 +2342,7 @@ package body Ada.Text_IO.Editing is
Set_State (Reject);
end if;
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
Pic.Picture.Expanded (Index) := 'Z'; -- consistency
@ -2366,7 +2367,7 @@ package body Ada.Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2427,12 +2428,12 @@ package body Ada.Text_IO.Editing is
end case;
-- Blank when zero either if the PIC does not contain a '9' or if
-- requested by the user and no '*'
-- requested by the user and no '*'.
Pic.Blank_When_Zero :=
(Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
-- Star fill if '*' and no '9'.
-- Star fill if '*' and no '9'
Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
@ -2706,7 +2707,7 @@ package body Ada.Text_IO.Editing is
when Constraint_Error =>
-- To deal with special cases like null strings.
-- To deal with special cases like null strings
raise Picture_Error;
end Precalculate;

4
gcc/ada/a-tifiio.adb
View File

@ -183,7 +183,7 @@ package body Ada.Text_IO.Fixed_IO is
-- Fore + Aft + Exp + Extra_Layout_Space
-- is always long enough for formatting any fixed point number.
-- is always long enough for formatting any fixed point number
-- Implementation of Put routines
@ -247,7 +247,7 @@ package body Ada.Text_IO.Fixed_IO is
-- least 20 in order to print T'First, which is at most -2.0**63.
-- This means D < 0, so use
-- (1) Y = -S and Z = -10**(-D).
-- (1) Y = -S and Z = -10**(-D)
-- If 1.0 / S is an integer greater than one, use

58
gcc/ada/a-wtedit.adb
View File

@ -266,7 +266,7 @@ package body Ada.Wide_Text_IO.Editing is
Result_Index := Result_Index + Count - 1;
-- Last was a ')' throw it away too.
-- Last was a ')' throw it away too
Picture_Index := Last + 1;
@ -313,10 +313,10 @@ package body Ada.Wide_Text_IO.Editing is
Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
-- Overridden immediately if necessary.
-- Overridden immediately if necessary
Zero : Boolean := True;
-- Set to False when a non-zero digit is output.
-- Set to False when a non-zero digit is output
begin
@ -856,11 +856,11 @@ package body Ada.Wide_Text_IO.Editing is
end case;
end loop;
-- Now get rid of Blank_when_Zero and complete Star fill.
-- Now get rid of Blank_when_Zero and complete Star fill
if Zero and Pic.Blank_When_Zero then
-- Value is zero, and blank it.
-- Value is zero, and blank it
Last := Answer'Last;
@ -1063,7 +1063,7 @@ package body Ada.Wide_Text_IO.Editing is
raise Picture_Error;
end if;
-- Two decimal points is a no-no.
-- Two decimal points is a no-no
Answer.Has_Fraction := True;
Answer.End_Of_Fraction := J;
@ -1083,7 +1083,7 @@ package body Ada.Wide_Text_IO.Editing is
Answer.Start_Of_Int := Answer.End_Of_Int + 1;
end if;
-- No significant (intger) digits needs a null range.
-- No significant (intger) digits needs a null range
return Answer;
end Parse_Number_String;
@ -1116,7 +1116,7 @@ package body Ada.Wide_Text_IO.Editing is
type Legality is (Okay, Reject);
State : Legality := Reject;
-- Start in reject, which will reject null strings.
-- Start in reject, which will reject null strings
Index : Pic_Index := Pic.Picture.Expanded'First;
@ -1426,7 +1426,7 @@ package body Ada.Wide_Text_IO.Editing is
procedure Leading_Dollar is
begin
-- Treat as a floating dollar, and unwind otherwise.
-- Treat as a floating dollar, and unwind otherwise
Pic.Floater := '$';
Pic.Start_Currency := Index;
@ -1495,7 +1495,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- A single dollar does not a floating make.
-- A single dollar does not a floating make
Number_Completion;
return;
@ -1507,8 +1507,8 @@ package body Ada.Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one dollar before the sign is okay,
-- but doesn't float.
-- Only one dollar before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1543,7 +1543,7 @@ package body Ada.Wide_Text_IO.Editing is
-- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
Must_Float : Boolean := False;
-- Set to true if a '#' occurs after an insert.
-- Set to true if a '#' occurs after an insert
begin
-- Treat as a floating currency. If it isn't, this will be
@ -1619,7 +1619,7 @@ package body Ada.Wide_Text_IO.Editing is
when '9' =>
if State /= Okay then
-- A single '#' doesn't float.
-- A single '#' doesn't float
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
@ -1636,8 +1636,8 @@ package body Ada.Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one pound before the sign is okay,
-- but doesn't float.
-- Only one pound before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1700,7 +1700,7 @@ package body Ada.Wide_Text_IO.Editing is
return;
end if;
-- Will return in Okay state if a '9' was seen.
-- Will return in Okay state if a '9' was seen
end loop;
end Number;
@ -2130,7 +2130,7 @@ package body Ada.Wide_Text_IO.Editing is
-- Picture --
-------------
-- Note that Picture can be called in either State.
-- Note that Picture can be called in either State
-- It will set state to Valid only if a 9 is encountered or floating
-- currency is called.
@ -2188,7 +2188,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.Sign_Position := Index;
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '<';
Pic.Start_Float := Index;
@ -2258,7 +2258,7 @@ package body Ada.Wide_Text_IO.Editing is
begin
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '-';
Pic.Start_Float := Index;
@ -2285,7 +2285,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "-- " is enough.
Set_State (Okay); -- "-- " is enough
Floating_Minus;
Trailing_Currency;
return;
@ -2303,7 +2303,7 @@ package body Ada.Wide_Text_IO.Editing is
when 'Z' | 'z' =>
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
if State = Okay then
Set_State (Reject);
@ -2322,7 +2322,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2342,7 +2342,7 @@ package body Ada.Wide_Text_IO.Editing is
begin
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '+';
Pic.Start_Float := Index;
@ -2369,7 +2369,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "++" is enough.
Set_State (Okay); -- "++" is enough
Floating_Plus;
Trailing_Currency;
return;
@ -2390,7 +2390,7 @@ package body Ada.Wide_Text_IO.Editing is
Set_State (Reject);
end if;
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
Pic.Picture.Expanded (Index) := 'Z'; -- consistency
@ -2410,7 +2410,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2474,7 +2474,7 @@ package body Ada.Wide_Text_IO.Editing is
Pic.Blank_When_Zero :=
(Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
-- Star fill if '*' and no '9'.
-- Star fill if '*' and no '9'
Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
@ -2693,7 +2693,7 @@ package body Ada.Wide_Text_IO.Editing is
when Constraint_Error =>
-- To deal with special cases like null strings.
-- To deal with special cases like null strings
raise Picture_Error;

14
gcc/ada/a-wtenau.adb
View File

@ -46,10 +46,10 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
-----------------------
procedure Store_Char
(WC : Wide_Character;
Buf : out Wide_String;
Ptr : in out Integer);
-- Store a single character in buffer, checking for overflow.
(WC : Wide_Character;
Buf : out Wide_String;
Ptr : in out Integer);
-- Store a single character in buffer, checking for overflow
-- These definitions replace the ones in Ada.Characters.Handling, which
-- do not seem to work for some strange not understood reason ??? at
@ -324,9 +324,9 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
----------------
procedure Store_Char
(WC : Wide_Character;
Buf : out Wide_String;
Ptr : in out Integer)
(WC : Wide_Character;
Buf : out Wide_String;
Ptr : in out Integer)
is
begin
if Ptr = Buf'Last then

64
gcc/ada/a-ztedit.adb
View File

@ -267,7 +267,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Result_Index := Result_Index + Count - 1;
-- Last was a ')' throw it away too.
-- Last was a ')' throw it away too
Picture_Index := Last + 1;
@ -314,10 +314,10 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
-- Overridden immediately if necessary.
-- Overridden immediately if necessary
Zero : Boolean := True;
-- Set to False when a non-zero digit is output.
-- Set to False when a non-zero digit is output
begin
@ -857,11 +857,11 @@ package body Ada.Wide_Wide_Text_IO.Editing is
end case;
end loop;
-- Now get rid of Blank_when_Zero and complete Star fill.
-- Now get rid of Blank_when_Zero and complete Star fill
if Zero and Pic.Blank_When_Zero then
-- Value is zero, and blank it.
-- Value is zero, and blank it
Last := Answer'Last;
@ -1065,7 +1065,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
raise Picture_Error;
end if;
-- Two decimal points is a no-no.
-- Two decimal points is a no-no
Answer.Has_Fraction := True;
Answer.End_Of_Fraction := J;
@ -1085,7 +1085,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Answer.Start_Of_Int := Answer.End_Of_Int + 1;
end if;
-- No significant (intger) digits needs a null range.
-- No significant (intger) digits needs a null range
return Answer;
end Parse_Number_String;
@ -1118,7 +1118,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
type Legality is (Okay, Reject);
State : Legality := Reject;
-- Start in reject, which will reject null strings.
-- Start in reject, which will reject null strings
Index : Pic_Index := Pic.Picture.Expanded'First;
@ -1418,9 +1418,8 @@ package body Ada.Wide_Wide_Text_IO.Editing is
-- Leading_Dollar --
--------------------
-- Note that Leading_Dollar can be called in either State.
-- It will set state to Okay only if a 9 or (second) $
-- is encountered.
-- Note that Leading_Dollar can be called in either State. It will set
-- state to Okay only if a 9 or (second) is encountered.
-- Also notice the tricky bit with State and Zero_Suppression.
-- Zero_Suppression is Picture_Error if a '$' or a '9' has been
@ -1428,7 +1427,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
procedure Leading_Dollar is
begin
-- Treat as a floating dollar, and unwind otherwise.
-- Treat as a floating dollar, and unwind otherwise
Pic.Floater := '$';
Pic.Start_Currency := Index;
@ -1497,7 +1496,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- A single dollar does not a floating make.
-- A single dollar does not a floating make
Number_Completion;
return;
@ -1509,8 +1508,8 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one dollar before the sign is okay,
-- but doesn't float.
-- Only one dollar before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1533,8 +1532,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
-- this procedure. Also note that Leading_Pound can be called in
-- either State.
-- It will set state to Okay only if a 9 or (second) # is
-- encountered.
-- It will set state to Okay only if a 9 or (second) # is encountered
-- One Last note: In ambiguous cases, the currency is treated as
-- floating unless there is only one '#'.
@ -1545,7 +1543,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
-- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
Must_Float : Boolean := False;
-- Set to true if a '#' occurs after an insert.
-- Set to true if a '#' occurs after an insert
begin
-- Treat as a floating currency. If it isn't, this will be
@ -1621,7 +1619,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
when '9' =>
if State /= Okay then
-- A single '#' doesn't float.
-- A single '#' doesn't float
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
@ -1638,8 +1636,8 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Only one pound before the sign is okay,
-- but doesn't float.
-- Only one pound before the sign is okay, but doesn't
-- float.
Pic.Radix_Position := Index;
Skip;
@ -1702,7 +1700,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
return;
end if;
-- Will return in Okay state if a '9' was seen.
-- Will return in Okay state if a '9' was seen
end loop;
end Number;
@ -2132,7 +2130,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
-- Picture --
-------------
-- Note that Picture can be called in either State.
-- Note that Picture can be called in either State
-- It will set state to Valid only if a 9 is encountered or floating
-- currency is called.
@ -2190,7 +2188,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.Sign_Position := Index;
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '<';
Pic.Start_Float := Index;
@ -2260,7 +2258,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
begin
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '-';
Pic.Start_Float := Index;
@ -2305,7 +2303,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
when 'Z' | 'z' =>
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
if State = Okay then
Set_State (Reject);
@ -2324,7 +2322,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2344,7 +2342,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
begin
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
-- Treat as a floating sign, and unwind otherwise
Pic.Floater := '+';
Pic.Start_Float := Index;
@ -2371,7 +2369,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "++" is enough.
Set_State (Okay); -- "++" is enough
Floating_Plus;
Trailing_Currency;
return;
@ -2392,7 +2390,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Set_State (Reject);
end if;
-- Can't have Z and a floating sign.
-- Can't have Z and a floating sign
Pic.Picture.Expanded (Index) := 'Z'; -- consistency
@ -2412,7 +2410,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.End_Float := Invalid_Position;
end if;
-- Don't assume that state is okay, haven't seen a digit.
-- Don't assume that state is okay, haven't seen a digit
Picture;
return;
@ -2476,7 +2474,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.Blank_When_Zero :=
(Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
-- Star fill if '*' and no '9'.
-- Star fill if '*' and no '9'
Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
@ -2695,7 +2693,7 @@ package body Ada.Wide_Wide_Text_IO.Editing is
when Constraint_Error =>
-- To deal with special cases like null strings.
-- To deal with special cases like null strings
raise Picture_Error;

14
gcc/ada/a-ztenau.adb
View File

@ -47,10 +47,10 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
-----------------------
procedure Store_Char
(WC : Wide_Wide_Character;
Buf : out Wide_Wide_String;
Ptr : in out Integer);
-- Store a single character in buffer, checking for overflow.
(WC : Wide_Wide_Character;
Buf : out Wide_Wide_String;
Ptr : in out Integer);
-- Store a single character in buffer, checking for overflow
-- These definitions replace the ones in Ada.Characters.Handling, which
-- do not seem to work for some strange not understood reason ??? at
@ -326,9 +326,9 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
----------------
procedure Store_Char
(WC : Wide_Wide_Character;
Buf : out Wide_Wide_String;
Ptr : in out Integer)
(WC : Wide_Wide_Character;
Buf : out Wide_Wide_String;
Ptr : in out Integer)
is
begin
if Ptr = Buf'Last then

36
gcc/ada/cstand.adb
View File

@ -114,7 +114,7 @@ package body CStand is
-- Make an entry in the names table for Nam, and set as Chars field of Id
function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id;
-- Build entity for standard operator with given name and type.
-- Build entity for standard operator with given name and type
function New_Standard_Entity
(New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
@ -537,7 +537,7 @@ package body CStand is
Set_Is_Known_Valid (Standard_Character);
Set_Size_Known_At_Compile_Time (Standard_Character);
-- Create the bounds for type Character.
-- Create the bounds for type Character
R_Node := New_Node (N_Range, Stloc);
@ -582,7 +582,7 @@ package body CStand is
Set_Is_Known_Valid (Standard_Wide_Character);
Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
-- Create the bounds for type Wide_Character.
-- Create the bounds for type Wide_Character
R_Node := New_Node (N_Range, Stloc);
@ -1259,20 +1259,22 @@ package body CStand is
(Standard_Exception_Type, True);
Make_Name (Standard_Exception_Type, "exception");
Make_Component (Standard_Exception_Type, Standard_Boolean,
"Not_Handled_By_Others");
Make_Component (Standard_Exception_Type, Standard_Character, "Lang");
Make_Component (Standard_Exception_Type, Standard_Natural,
"Name_Length");
Make_Component (Standard_Exception_Type, Standard_A_Char,
"Full_Name");
Make_Component (Standard_Exception_Type, Standard_A_Char,
"HTable_Ptr");
Make_Component (Standard_Exception_Type, Standard_Unsigned,
"Import_Code");
Make_Component (Standard_Exception_Type, Standard_A_Char,
"Raise_Hook");
-- Build tree for record declaration, for use by the back-end.
Make_Component
(Standard_Exception_Type, Standard_Boolean, "Not_Handled_By_Others");
Make_Component
(Standard_Exception_Type, Standard_Character, "Lang");
Make_Component
(Standard_Exception_Type, Standard_Natural, "Name_Length");
Make_Component
(Standard_Exception_Type, Standard_A_Char, "Full_Name");
Make_Component
(Standard_Exception_Type, Standard_A_Char, "HTable_Ptr");
Make_Component
(Standard_Exception_Type, Standard_Unsigned, "Import_Code");
Make_Component
(Standard_Exception_Type, Standard_A_Char, "Raise_Hook");
-- Build tree for record declaration, for use by the back-end
declare
Comp_List : List_Id;

23
gcc/ada/exp_fixd.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
@ -965,7 +965,7 @@ package body Exp_Fixd is
New_Occurrence_Of (Rnd, Loc))));
end if;
-- Set type of result, for use in caller.
-- Set type of result, for use in caller
Set_Etype (Qnn, QR_Typ);
end Build_Scaled_Divide_Code;
@ -1095,7 +1095,7 @@ package body Exp_Fixd is
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
-- First we reduce the left fraction to lowest terms.
-- First we reduce the left fraction to lowest terms
-- If numerator = 1, then for K = 1, the small ratio is the reciprocal
-- of an integer, and this is clearly the minimum K case, so set K = 1,
@ -1213,7 +1213,7 @@ package body Exp_Fixd is
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
-- First we reduce the left fraction to lowest terms.
-- First we reduce the left fraction to lowest terms
-- If denominator = 1, then for K = 1, the small ratio is an integer
-- (the numerator) and this is clearly the minimum K case, so set K = 1,
@ -1415,15 +1415,16 @@ package body Exp_Fixd is
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
-- First we reduce the left fraction to lowest terms.
-- First we reduce the left fraction to lowest terms
-- If denominator = 1, then for K = 1, the small ratio is an
-- integer, and this is clearly the minimum K case, so set
-- K = 1, Right_Small = Lit_Value.
-- If denominator = 1, then for K = 1, the small ratio is an integer, and
-- this is clearly the minimum K case, so set
-- If denominator > 1, then set K to the numerator of the
-- fraction, so that the resulting small ratio is the
-- reciprocal of the integer (the denominator value).
-- K = 1, Right_Small = Lit_Value.
-- If denominator > 1, then set K to the numerator of the fraction, so
-- that the resulting small ratio is the reciprocal of the integer (the
-- denominator value).
procedure Do_Multiply_Fixed_Universal
(N : Node_Id;

2
gcc/ada/exp_smem.adb
View File

@ -60,7 +60,7 @@ package body Exp_Smem is
procedure Build_Full_Name
(E : in Entity_Id;
N : out String_Id);
-- Build the fully qualified string name of a shared variable.
-- Build the fully qualified string name of a shared variable
function On_Lhs_Of_Assignment (N : Node_Id) return Boolean;
-- Determines if N is on the left hand of the assignment. This means

26
gcc/ada/g-arrspl.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2005 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- --
@ -43,8 +43,7 @@ package body GNAT.Array_Split is
function Count
(Source : Element_Sequence;
Pattern : Element_Set)
return Natural;
Pattern : Element_Set) return Natural;
-- Returns the number of occurences of Pattern elements in Source, 0 is
-- returned if no occurence is found in Source.
@ -92,8 +91,7 @@ package body GNAT.Array_Split is
function Count
(Source : Element_Sequence;
Pattern : Element_Set)
return Natural
Pattern : Element_Set) return Natural
is
C : Natural := 0;
begin
@ -144,8 +142,7 @@ package body GNAT.Array_Split is
function Separators
(S : Slice_Set;
Index : Slice_Number)
return Slice_Separators
Index : Slice_Number) return Slice_Separators
is
begin
if Index > S.N_Slice then
@ -154,7 +151,7 @@ package body GNAT.Array_Split is
elsif Index = 0
or else (Index = 1 and then S.N_Slice = 1)
then
-- Whole string, or no separator used.
-- Whole string, or no separator used
return (Before => Array_End,
After => Array_End);
@ -238,8 +235,10 @@ package body GNAT.Array_Split is
loop
if K > Count_Sep then
-- No more separator, last slice end at the end of the source
-- No more separators, last slice ends at the end of the source
-- string.
Stop := S.Source'Last;
else
Stop := S.Indexes (K) - 1;
@ -255,13 +254,17 @@ package body GNAT.Array_Split is
case Mode is
when Single =>
-- In this mode just set start to character next to the
-- current separator, advance the separator index.
Start := S.Indexes (K) + 1;
K := K + 1;
when Multiple =>
-- In this mode skip separators following each others
-- In this mode skip separators following each other
loop
Start := S.Indexes (K) + 1;
K := K + 1;
@ -282,8 +285,7 @@ package body GNAT.Array_Split is
function Slice
(S : Slice_Set;
Index : Slice_Number)
return Element_Sequence
Index : Slice_Number) return Element_Sequence
is
begin
if Index = 0 then

12
gcc/ada/g-arrspl.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2005 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- --
@ -42,7 +42,7 @@ generic
-- Element of the array, this must be a discrete type
type Element_Sequence is array (Positive range <>) of Element;
-- The array which is a sequence of element.
-- The array which is a sequence of element
type Element_Set is private;
-- This type represent a set of elements. This set does not defined a
@ -120,8 +120,7 @@ package GNAT.Array_Split is
function Slice
(S : Slice_Set;
Index : Slice_Number)
return Element_Sequence;
Index : Slice_Number) return Element_Sequence;
pragma Inline (Slice);
-- Returns the slice at position Index. First slice is 1. If Index is 0
-- the whole array is returned including the separators (this is the
@ -138,8 +137,7 @@ package GNAT.Array_Split is
function Separators
(S : Slice_Set;
Index : Slice_Number)
return Slice_Separators;
Index : Slice_Number) return Slice_Separators;
-- Returns the separators used to slice (front and back) the slice at
-- position Index. For slices at start and end of the original array, the
-- Array_End value is returned for the corresponding outer bound. In
@ -165,7 +163,7 @@ private
Start : Positive;
Stop : Natural;
end record;
-- Starting/Ending position of a slice. This does not include separators.
-- Starting/Ending position of a slice. This does not include separators
type Slices_Indexes is array (Slice_Number range <>) of Slice_Info;
type Slices_Access is access Slices_Indexes;

103
gcc/ada/g-awk.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005 Ada Core Technologies, 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- --
@ -65,7 +65,7 @@ package body GNAT.AWK is
procedure Current_Line (S : Mode; Session : Session_Type)
is abstract;
-- Split Session's current line using split mode.
-- Split current line of Session using split mode S
------------------------
-- Split on separator --
@ -102,7 +102,7 @@ package body GNAT.AWK is
package File_Table is
new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
-- List of filename associated with a Session.
-- List of file names associated with a Session
procedure Free is new Unchecked_Deallocation (String, AWK_File);
@ -114,17 +114,17 @@ package body GNAT.AWK is
First : Positive;
Last : Natural;
end record;
-- This is a field slice (First .. Last) in session's current line.
-- This is a field slice (First .. Last) in session's current line
package Field_Table is
new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
-- List of fields for the current line.
-- List of fields for the current line
--------------
-- Patterns --
--------------
-- Define all patterns style : exact string, regular expression, boolean
-- Define all patterns style: exact string, regular expression, boolean
-- function.
package Patterns is
@ -137,13 +137,12 @@ package body GNAT.AWK is
function Match
(P : Pattern;
Session : Session_Type)
return Boolean
Session : Session_Type) return Boolean
is abstract;
-- Returns True if P match for the current session and False otherwise.
-- Returns True if P match for the current session and False otherwise
procedure Release (P : in out Pattern);
-- Release memory used by the pattern structure.
-- Release memory used by the pattern structure
--------------------------
-- Exact string pattern --
@ -156,8 +155,7 @@ package body GNAT.AWK is
function Match
(P : String_Pattern;
Session : Session_Type)
return Boolean;
Session : Session_Type) return Boolean;
--------------------------------
-- Regular expression pattern --
@ -172,8 +170,7 @@ package body GNAT.AWK is
function Match
(P : Regexp_Pattern;
Session : Session_Type)
return Boolean;
Session : Session_Type) return Boolean;
procedure Release (P : in out Regexp_Pattern);
@ -187,8 +184,7 @@ package body GNAT.AWK is
function Match
(P : Callback_Pattern;
Session : Session_Type)
return Boolean;
Session : Session_Type) return Boolean;
end Patterns;
@ -211,9 +207,8 @@ package body GNAT.AWK is
procedure Call
(A : Action;
Session : Session_Type)
is abstract;
-- Call action A as required.
Session : Session_Type) is abstract;
-- Call action A as required
-------------------
-- Simple action --
@ -317,13 +312,13 @@ package body GNAT.AWK is
procedure Finalize (Session : in out Session_Type) is
begin
-- We release the session data only if it is not the default session.
-- We release the session data only if it is not the default session
if Session.Data /= Def_Session.Data then
Free (Session.Data);
-- Since we have closed the current session, set it to point
-- now to the default session.
-- Since we have closed the current session, set it to point now to
-- the default session.
Cur_Session.Data := Def_Session.Data;
end if;
@ -334,11 +329,10 @@ package body GNAT.AWK is
----------------------
function Always_True return Boolean;
-- A function that always returns True.
-- A function that always returns True
function Apply_Filters
(Session : Session_Type := Current_Session)
return Boolean;
(Session : Session_Type := Current_Session) return Boolean;
-- Apply any filters for which the Pattern is True for Session. It returns
-- True if a least one filters has been applied (i.e. associated action
-- callback has been called).
@ -358,7 +352,7 @@ package body GNAT.AWK is
-- number and the filename if possible.
procedure Read_Line (Session : Session_Type);
-- Read a line for the Session and set Current_Line.
-- Read a line for the Session and set Current_Line
procedure Split_Line (Session : Session_Type);
-- Split session's Current_Line according to the session separators and
@ -414,8 +408,7 @@ package body GNAT.AWK is
function Match
(P : String_Pattern;
Session : Session_Type)
return Boolean
Session : Session_Type) return Boolean
is
begin
return P.Str = Field (P.Rank, Session);
@ -427,8 +420,7 @@ package body GNAT.AWK is
function Match
(P : Regexp_Pattern;
Session : Session_Type)
return Boolean
Session : Session_Type) return Boolean
is
use type Regpat.Match_Location;
@ -444,8 +436,7 @@ package body GNAT.AWK is
function Match
(P : Callback_Pattern;
Session : Session_Type)
return Boolean
Session : Session_Type) return Boolean
is
pragma Unreferenced (Session);
@ -664,14 +655,13 @@ package body GNAT.AWK is
-------------------
function Apply_Filters
(Session : Session_Type := Current_Session)
return Boolean
(Session : Session_Type := Current_Session) return Boolean
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
Results : Boolean := False;
begin
-- Iterate through the filters table, if pattern match call action.
-- Iterate through the filters table, if pattern match call action
for F in 1 .. Pattern_Action_Table.Last (Filters) loop
if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
@ -748,8 +738,7 @@ package body GNAT.AWK is
function Discrete_Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Discrete
Session : Session_Type := Current_Session) return Discrete
is
begin
return Discrete'Value (Field (Rank, Session));
@ -760,8 +749,7 @@ package body GNAT.AWK is
-----------------
function End_Of_Data
(Session : Session_Type := Current_Session)
return Boolean
(Session : Session_Type := Current_Session) return Boolean
is
begin
return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
@ -773,8 +761,7 @@ package body GNAT.AWK is
-----------------
function End_Of_File
(Session : Session_Type := Current_Session)
return Boolean
(Session : Session_Type := Current_Session) return Boolean
is
begin
return Text_IO.End_Of_File (Session.Data.Current_File);
@ -786,8 +773,7 @@ package body GNAT.AWK is
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return String
Session : Session_Type := Current_Session) return String
is
Fields : Field_Table.Instance renames Session.Data.Fields;
@ -800,7 +786,7 @@ package body GNAT.AWK is
elsif Rank = 0 then
-- Returns the whole line, this is what $0 does under Session_Type.
-- Returns the whole line, this is what $0 does under Session_Type
return To_String (Session.Data.Current_Line);
@ -813,8 +799,7 @@ package body GNAT.AWK is
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Integer
Session : Session_Type := Current_Session) return Integer
is
begin
return Integer'Value (Field (Rank, Session));
@ -830,8 +815,7 @@ package body GNAT.AWK is
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Float
Session : Session_Type := Current_Session) return Float
is
begin
return Float'Value (Field (Rank, Session));
@ -850,8 +834,7 @@ package body GNAT.AWK is
----------
function File
(Session : Session_Type := Current_Session)
return String
(Session : Session_Type := Current_Session) return String
is
Files : File_Table.Instance renames Session.Data.Files;
@ -942,8 +925,7 @@ package body GNAT.AWK is
----------------------
function Number_Of_Fields
(Session : Session_Type := Current_Session)
return Count
(Session : Session_Type := Current_Session) return Count
is
begin
return Count (Field_Table.Last (Session.Data.Fields));
@ -954,8 +936,7 @@ package body GNAT.AWK is
--------------------------
function Number_Of_File_Lines
(Session : Session_Type := Current_Session)
return Count
(Session : Session_Type := Current_Session) return Count
is
begin
return Count (Session.Data.FNR);
@ -966,8 +947,7 @@ package body GNAT.AWK is
---------------------
function Number_Of_Files
(Session : Session_Type := Current_Session)
return Natural
(Session : Session_Type := Current_Session) return Natural
is
Files : File_Table.Instance renames Session.Data.Files;
@ -980,8 +960,7 @@ package body GNAT.AWK is
---------------------
function Number_Of_Lines
(Session : Session_Type := Current_Session)
return Count
(Session : Session_Type := Current_Session) return Count
is
begin
return Count (Session.Data.NR);
@ -1078,7 +1057,7 @@ package body GNAT.AWK is
Session : Session_Type)
is
function Filename return String;
-- Returns current filename and "??" if the informations is not
-- Returns current filename and "??" if this information is not
-- available.
function Line return String;
@ -1090,7 +1069,6 @@ package body GNAT.AWK is
function Filename return String is
File : constant String := AWK.File (Session);
begin
if File = "" then
return "??";
@ -1105,7 +1083,6 @@ package body GNAT.AWK is
function Line return String is
L : constant String := Natural'Image (Session.Data.FNR);
begin
return L (2 .. L'Last);
end Line;
@ -1132,6 +1109,10 @@ package body GNAT.AWK is
NR : Natural renames Session.Data.NR;
FNR : Natural renames Session.Data.FNR;
---------------
-- Read_Line --
---------------
function Read_Line return String is
Buffer : String (1 .. 1_024);
Last : Natural;

69
gcc/ada/g-awk.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005 Ada Core Technologies, 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- --
@ -187,31 +187,30 @@ with GNAT.Regpat;
package GNAT.AWK is
Session_Error : exception;
-- Raised when a Session is reused but is not closed.
-- Raised when a Session is reused but is not closed
File_Error : exception;
-- Raised when there is a file problem (see below).
-- Raised when there is a file problem (see below)
End_Error : exception;
-- Raised when an attempt is made to read beyond the end of the last
-- file of a session.
Field_Error : exception;
-- Raised when accessing a field value which does not exist.
-- Raised when accessing a field value which does not exist
Data_Error : exception;
-- Raised when it is not possible to convert a field value to a specific
-- type.
-- Raised when it is impossible to convert a field value to a specific type
type Count is new Natural;
type Widths_Set is array (Positive range <>) of Positive;
-- Used to store a set of columns widths.
-- Used to store a set of columns widths
Default_Separators : constant String := " " & ASCII.HT;
Use_Current : constant String := "";
-- Value used when no separator or filename is specified in iterators.
-- Value used when no separator or filename is specified in iterators
type Session_Type is limited private;
-- This is the main exported type. A session is used to keep the state of
@ -256,7 +255,7 @@ package GNAT.AWK is
(Separators : String := Default_Separators;
Session : Session_Type := Current_Session)
renames Set_Field_Separators;
-- FS is the AWK abbreviation for above service.
-- FS is the AWK abbreviation for above service
procedure Set_Field_Widths
(Field_Widths : Widths_Set;
@ -294,54 +293,44 @@ package GNAT.AWK is
-------------------------------------
function Number_Of_Fields
(Session : Session_Type := Current_Session)
return Count;
(Session : Session_Type := Current_Session) return Count;
pragma Inline (Number_Of_Fields);
-- Returns the number of fields in the current record. It returns 0 when
-- no file is being processed.
function NF
(Session : Session_Type := Current_Session)
return Count
(Session : Session_Type := Current_Session) return Count
renames Number_Of_Fields;
-- AWK abbreviation for above service.
-- AWK abbreviation for above service
function Number_Of_File_Lines
(Session : Session_Type := Current_Session)
return Count;
(Session : Session_Type := Current_Session) return Count;
pragma Inline (Number_Of_File_Lines);
-- Returns the current line number in the processed file. It returns 0 when
-- no file is being processed.
function FNR
(Session : Session_Type := Current_Session)
return Count renames Number_Of_File_Lines;
-- AWK abbreviation for above service.
function FNR (Session : Session_Type := Current_Session) return Count
renames Number_Of_File_Lines;
-- AWK abbreviation for above service
function Number_Of_Lines
(Session : Session_Type := Current_Session)
return Count;
(Session : Session_Type := Current_Session) return Count;
pragma Inline (Number_Of_Lines);
-- Returns the number of line processed until now. This is equal to number
-- of line in each already processed file plus FNR. It returns 0 when
-- no file is being processed.
function NR
(Session : Session_Type := Current_Session)
return Count
function NR (Session : Session_Type := Current_Session) return Count
renames Number_Of_Lines;
-- AWK abbreviation for above service.
-- AWK abbreviation for above service
function Number_Of_Files
(Session : Session_Type := Current_Session)
return Natural;
(Session : Session_Type := Current_Session) return Natural;
pragma Inline (Number_Of_Files);
-- Returns the number of files associated with Session. This is the total
-- number of files added with Add_File and Add_Files services.
function File
(Session : Session_Type := Current_Session)
return String;
function File (Session : Session_Type := Current_Session) return String;
-- Returns the name of the file being processed. It returns the empty
-- string when no file is being processed.
@ -351,24 +340,21 @@ package GNAT.AWK is
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return String;
Session : Session_Type := Current_Session) return String;
-- Returns field number Rank value of the current record. If Rank = 0 it
-- returns the current record (i.e. the line as read in the file). It
-- raises Field_Error if Rank > NF or if Session is not open.
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Integer;
Session : Session_Type := Current_Session) return Integer;
-- Returns field number Rank value of the current record as an integer. It
-- raises Field_Error if Rank > NF or if Session is not open. It
-- raises Data_Error if the field value cannot be converted to an integer.
function Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Float;
Session : Session_Type := Current_Session) return Float;
-- Returns field number Rank value of the current record as a float. It
-- raises Field_Error if Rank > NF or if Session is not open. It
-- raises Data_Error if the field value cannot be converted to a float.
@ -377,8 +363,7 @@ package GNAT.AWK is
type Discrete is (<>);
function Discrete_Field
(Rank : Count;
Session : Session_Type := Current_Session)
return Discrete;
Session : Session_Type := Current_Session) return Discrete;
-- Returns field number Rank value of the current record as a type
-- Discrete. It raises Field_Error if Rank > NF. It raises Data_Error if
-- the field value cannot be converted to type Discrete.
@ -527,16 +512,14 @@ package GNAT.AWK is
-- or by an instantiation of For_Every_Line (see below).
function End_Of_Data
(Session : Session_Type := Current_Session)
return Boolean;
(Session : Session_Type := Current_Session) return Boolean;
pragma Inline (End_Of_Data);
-- Returns True if there is no more data to be processed in Session. It
-- means that the latest session's file is being processed and that
-- there is no more data to be read in this file (End_Of_File is True).
function End_Of_File
(Session : Session_Type := Current_Session)
return Boolean;
(Session : Session_Type := Current_Session) return Boolean;
pragma Inline (End_Of_File);
-- Returns True when there is no more data to be processed on the current
-- session's file.

38
gcc/ada/g-boubuf.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, 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- --
@ -44,35 +44,34 @@ with System;
generic
type Element is private;
-- The type of the values contained within buffer objects
package GNAT.Bounded_Buffers is
pragma Pure;
type Content is array (Positive range <>) of Element;
-- Content is an internal artefact that cannot be hidden
-- because protected types cannot contain type declarations.
-- Content is an internal artefact that cannot be hidden because protected
-- types cannot contain type declarations.
Default_Ceiling : constant System.Priority := System.Default_Priority;
-- A convenience value for the Ceiling discriminant.
-- A convenience value for the Ceiling discriminant
protected type Bounded_Buffer
(Capacity : Positive;
-- Objects of type Bounded_Buffer specify the maximum
-- number of Element values they can hold via the
-- discriminant Capacity.
-- Objects of type Bounded_Buffer specify the maximum number of Element
-- values they can hold via the discriminant Capacity.
Ceiling : System.Priority)
-- Users must specify the ceiling priority for the object.
-- If the Real-Time Systems Annex is not in use this value
-- is not important.
-- Users must specify the ceiling priority for the object. If the
-- Real-Time Systems Annex is not in use this value is not important.
is
pragma Priority (Ceiling);
entry Insert (Item : in Element);
-- Insert Item into the buffer. Blocks caller
-- until space is available.
-- Insert Item into the buffer, blocks caller until space is available
entry Remove (Item : out Element);
-- Remove next available Element from buffer.
-- Blocks caller until an Element is available.
-- Remove next available Element from buffer. Blocks caller until an
-- Element is available.
function Empty return Boolean;
-- Returns whether the instance contains any Elements.
@ -89,13 +88,16 @@ package GNAT.Bounded_Buffers is
private
Values : Content (1 .. Capacity);
-- The container for the values held by the buffer instance.
-- The container for the values held by the buffer instance
Next_In : Positive := 1;
-- The index of the next Element inserted. Wraps around.
-- The index of the next Element inserted. Wraps around
Next_Out : Positive := 1;
-- The index of the next Element removed. Wraps around.
-- The index of the next Element removed. Wraps around
Count : Natural := 0;
-- The number of Elements currently held.
-- The number of Elements currently held
end Bounded_Buffer;
end GNAT.Bounded_Buffers;

2
gcc/ada/g-bubsor.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -44,7 +44,7 @@
-- has the advantage of being Pure, while this unit can only be Preelaborate.
package GNAT.Bubble_Sort is
pragma Preelaborate (Bubble_Sort);
pragma Preelaborate;
-- The data to be sorted is assumed to be indexed by integer values from
-- 1 to N, where N is the number of items to be sorted.

2
gcc/ada/g-busora.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -39,7 +39,7 @@
-- offers a similar routine with a more convenient interface.
package GNAT.Bubble_Sort_A is
pragma Preelaborate (Bubble_Sort_A);
pragma Preelaborate;
-- The data to be sorted is assumed to be indexed by integer values from
-- 1 to N, where N is the number of items to be sorted. In addition, the

2
gcc/ada/g-busorg.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -63,7 +63,7 @@ generic
-- item is greater than or equal to the Op1 item.
package GNAT.Bubble_Sort_G is
pragma Pure (Bubble_Sort_G);
pragma Pure;
procedure Sort (N : Natural);
-- This procedures sorts items in the range from 1 to N into ascending

11
gcc/ada/g-calend.adb
View File

@ -96,8 +96,7 @@ package body GNAT.Calendar is
function Julian_Day
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number)
return Integer
Day : Day_Number) return Integer
is
Internal_Year : Integer;
Internal_Month : Integer;
@ -227,8 +226,7 @@ package body GNAT.Calendar is
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0)
return Time
Sub_Second : Second_Duration := 0.0) return Time
is
Dsecs : constant Day_Duration :=
Day_Duration (Hour * 3600 + Minute * 60 + Second) +
@ -291,8 +289,7 @@ package body GNAT.Calendar is
------------------
function Week_In_Year
(Date : Ada.Calendar.Time)
return Week_In_Year_Number
(Date : Ada.Calendar.Time) return Week_In_Year_Number
is
Year : Year_Number;
Month : Month_Number;
@ -306,7 +303,7 @@ package body GNAT.Calendar is
begin
Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
-- Day offset number for the first week of the year.
-- Day offset number for the first week of the year
Offset := Julian_Day (Year, 1, 1) mod 7;

21
gcc/ada/g-calend.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1999-2005 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- --
@ -65,7 +65,7 @@ package GNAT.Calendar is
-- Second_Duration precision depends on the target clock precision.
function Day_Of_Week (Date : Ada.Calendar.Time) return Day_Name;
-- Return the day name.
-- Return the day name
function Day_In_Year (Date : Ada.Calendar.Time) return Day_In_Year_Number;
-- Returns the day number in the year. (1st January is day 1 and 31st
@ -93,9 +93,8 @@ package GNAT.Calendar is
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0)
return Ada.Calendar.Time;
-- Returns an Ada.Calendar.Time data built from the date and time values.
Sub_Second : Second_Duration := 0.0) return Ada.Calendar.Time;
-- Returns an Ada.Calendar.Time data built from the date and time values
-- C timeval conversion
@ -119,11 +118,11 @@ private
function Julian_Day
(Year : Ada.Calendar.Year_Number;
Month : Ada.Calendar.Month_Number;
Day : Ada.Calendar.Day_Number)
return Integer;
-- Compute Julian day number.
Day : Ada.Calendar.Day_Number) return Integer;
-- Compute Julian day number
--
-- The code of this function is a modified version of algorithm
-- 199 from the Collected Algorithms of the ACM.
-- The author of algorithm 199 is Robert G. Tantzen.
-- The code of this function is a modified version of algorithm 199 from
-- the Collected Algorithms of the ACM. The author of algorithm 199 is
-- Robert G. Tantzen.
end GNAT.Calendar;

2
gcc/ada/g-casuti.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

15
gcc/ada/g-casuti.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -43,13 +43,12 @@
with System.Case_Util;
package GNAT.Case_Util is
pragma Pure (Case_Util);
pragma Elaborate_Body;
-- The elaborate body is because we have a dummy body to deal with bootstrap
-- path problems (we used to have a real body, and now we don't need it any
-- more, but the bootstrap requires that we have a dummy body, since otherwise
-- the old body gets picked up.
pragma Pure;
pragma Elaborate_Body;
-- The elaborate body is because we have a dummy body to deal with
-- bootstrap path problems (we used to have a real body, and now we don't
-- need it any more, but the bootstrap requires that we have a dummy body,
-- since otherwise the old body gets picked up.
-- Note: all the following functions handle the full Latin-1 set

35
gcc/ada/g-catiio.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2005 Ada Core Technologies, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -63,10 +63,10 @@ package body GNAT.Calendar.Time_IO is
-----------------------
function Am_Pm (H : Natural) return String;
-- return AM or PM depending on the hour H
-- Return AM or PM depending on the hour H
function Hour_12 (H : Natural) return Positive;
-- Convert a 1-24h format to a 0-12 hour format.
-- Convert a 1-24h format to a 0-12 hour format
function Image (Str : String; Length : Natural := 0) return String;
-- Return Str capitalized and cut to length number of characters. If
@ -75,18 +75,15 @@ package body GNAT.Calendar.Time_IO is
function Image
(N : Long_Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String;
-- Return image of N. This number is eventually padded with zeros or
-- spaces depending of the length required. If length is 0 then no padding
-- occurs.
Length : Natural := 0) return String;
-- Return image of N. This number is eventually padded with zeros or spaces
-- depending of the length required. If length is 0 then no padding occurs.
function Image
(N : Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String;
-- As above with N provided in Integer format.
Length : Natural := 0) return String;
-- As above with N provided in Integer format
-----------
-- Am_Pm --
@ -122,8 +119,7 @@ package body GNAT.Calendar.Time_IO is
function Image
(Str : String;
Length : Natural := 0)
return String
Length : Natural := 0) return String
is
use Ada.Characters.Handling;
Local : constant String :=
@ -144,8 +140,7 @@ package body GNAT.Calendar.Time_IO is
function Image
(N : Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String
Length : Natural := 0) return String
is
begin
return Image (Long_Integer (N), Padding, Length);
@ -154,8 +149,7 @@ package body GNAT.Calendar.Time_IO is
function Image
(N : Long_Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String
Length : Natural := 0) return String
is
function Pad_Char return String;
@ -192,13 +186,12 @@ package body GNAT.Calendar.Time_IO is
function Image
(Date : Ada.Calendar.Time;
Picture : Picture_String)
return String
Picture : Picture_String) return String
is
Padding : Padding_Mode := Zero;
Padding : Padding_Mode := Zero;
-- Padding is set for one directive
Result : Unbounded_String;
Result : Unbounded_String;
Year : Year_Number;
Month : Month_Number;

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2005, AdaCore --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -116,16 +116,15 @@ package GNAT.Calendar.Time_IO is
function Image
(Date : Ada.Calendar.Time;
Picture : Picture_String)
return String;
-- Return Date as a string with format Picture.
-- raise Picture_Error if picture string is wrong
Picture : Picture_String) return String;
-- Return Date as a string with format Picture. Raise Picture_Error if
-- picture string is wrong.
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 picture string is
-- wrong
private
ISO_Date : constant Picture_String := "%Y-%m-%d";

12
gcc/ada/g-cgi.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, 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- --
@ -50,10 +50,10 @@ package body GNAT.CGI is
-- services exported by this unit.
Current_Method : Method_Type;
-- This is the current method used to pass CGI parameters.
-- This is the current method used to pass CGI parameters
Header_Sent : Boolean := False;
-- Will be set to True when the header will be sent.
-- Will be set to True when the header will be sent
-- Key/Value table declaration
@ -72,7 +72,7 @@ package body GNAT.CGI is
procedure Check_Environment;
pragma Inline (Check_Environment);
-- This procedure will raise Data_Error if Valid_Environment is False.
-- This procedure will raise Data_Error if Valid_Environment is False
procedure Initialize;
-- Initialize CGI package by reading the runtime environment. This
@ -178,7 +178,7 @@ package body GNAT.CGI is
-- for the data is passed in CONTENT_LENGTH environment variable.
procedure Set_Parameter_Table (Data : String);
-- Parse the parameter data and set the parameter table.
-- Parse the parameter data and set the parameter table
--------------------
-- Initialize_GET --
@ -328,7 +328,7 @@ package body GNAT.CGI is
Required : Boolean := False) return String
is
function Get_Environment (Variable_Name : String) return String;
-- Returns the environment variable content.
-- Returns the environment variable content
---------------------
-- Get_Environment --

14
gcc/ada/g-cgi.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005, 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- --
@ -115,7 +115,7 @@ package GNAT.CGI is
-- and will be raised when calling any services below (except for Ok).
Parameter_Not_Found : exception;
-- This exception is raised when a specific parameter is not found.
-- This exception is raised when a specific parameter is not found
Default_Header : constant String := "Content-type: text/html";
-- This is the default header returned by Put_Header. If the CGI program
@ -186,12 +186,11 @@ package GNAT.CGI is
-- the exception Data_Error.
function Method return Method_Type;
-- Returns the method used to call the CGI.
-- Returns the method used to call the CGI
function Metavariable
(Name : Metavariable_Name;
Required : Boolean := False)
return String;
Required : Boolean := False) return String;
-- Returns parameter Name value. Returns the null string if Name
-- environment variable is not defined or raises Data_Error if
-- Required is set to True.
@ -215,8 +214,7 @@ package GNAT.CGI is
function Value
(Key : String;
Required : Boolean := False)
return String;
Required : Boolean := False) return String;
-- Returns the parameter value associated to the parameter named Key.
-- If parameter does not exist, returns an empty string if Required
-- is False and raises the exception Parameter_Not_Found otherwise.
@ -227,7 +225,7 @@ package GNAT.CGI is
-- (i.e. Position > Argument_Count)
function Key_Exists (Key : String) return Boolean;
-- Returns True if the parameter named Key existx and False otherwise.
-- Returns True if the parameter named Key exists and False otherwise
function Key (Position : Positive) return String;
-- Returns the parameter key associated with the CGI parameter number

35
gcc/ada/g-cgicoo.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005, 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- --
@ -43,12 +43,12 @@ package body GNAT.CGI.Cookie is
use Ada;
Valid_Environment : Boolean := False;
-- This boolean will be set to True if the initialization was fine.
-- This boolean will be set to True if the initialization was fine
Header_Sent : Boolean := False;
-- Will be set to True when the header will be sent.
-- Will be set to True when the header will be sent
-- Cookie data that have been added.
-- Cookie data that has been added
type String_Access is access String;
@ -67,14 +67,14 @@ package body GNAT.CGI.Cookie is
end record;
package Cookie_Table is new Table (Cookie_Data, Positive, 1, 5, 50);
-- This is the table to keep all cookies to be sent back to the server.
-- This is the table to keep all cookies to be sent back to the server
package Key_Value_Table is new Table (Key_Value, Positive, 1, 1, 50);
-- This is the table to keep all cookies received from the server.
-- This is the table to keep all cookies received from the server
procedure Check_Environment;
pragma Inline (Check_Environment);
-- This procedure will raise Data_Error if Valid_Environment is False.
-- This procedure will raise Data_Error if Valid_Environment is False
procedure Initialize;
-- Initialize CGI package by reading the runtime environment. This
@ -149,7 +149,7 @@ package body GNAT.CGI.Cookie is
HTTP_COOKIE : constant String := Metavariable (CGI.HTTP_Cookie);
procedure Set_Parameter_Table (Data : String);
-- Parse Data and insert information in Key_Value_Table.
-- Parse Data and insert information in Key_Value_Table
-------------------------
-- Set_Parameter_Table --
@ -161,8 +161,8 @@ package body GNAT.CGI.Cookie is
-- Add a single parameter into the table at index K. The parameter
-- format is "key=value".
Count : constant Positive
:= 1 + Strings.Fixed.Count (Data, Strings.Maps.To_Set (";"));
Count : constant Positive :=
1 + Strings.Fixed.Count (Data, Strings.Maps.To_Set (";"));
-- Count is the number of parameters in the string. Parameters are
-- separated by ampersand character.
@ -185,6 +185,8 @@ package body GNAT.CGI.Cookie is
end if;
end Add_Parameter;
-- Start of processing for Set_Parameter_Table
begin
Key_Value_Table.Set_Last (Count);
@ -196,11 +198,13 @@ package body GNAT.CGI.Cookie is
Index := Sep + 2;
end loop;
-- add last parameter
-- Add last parameter
Add_Parameter (Count, Data (Index .. Data'Last));
end Set_Parameter_Table;
-- Start of processing for Initialize
begin
if HTTP_COOKIE /= "" then
Set_Parameter_Table (HTTP_COOKIE);
@ -245,7 +249,6 @@ package body GNAT.CGI.Cookie is
(Header : String := Default_Header;
Force : Boolean := False)
is
procedure Output_Cookies;
-- Iterate through the list of cookies to be sent to the server
-- and output them.
@ -264,7 +267,7 @@ package body GNAT.CGI.Cookie is
Max_Age : Natural;
Path : String;
Secure : Boolean);
-- Output one cookie in the CGI header.
-- Output one cookie in the CGI header
-----------------------
-- Output_One_Cookie --
@ -344,7 +347,8 @@ package body GNAT.CGI.Cookie is
Domain : String := "";
Max_Age : Natural := Natural'Last;
Path : String := "/";
Secure : Boolean := False) is
Secure : Boolean := False)
is
begin
Cookie_Table.Increment_Last;
@ -364,8 +368,7 @@ package body GNAT.CGI.Cookie is
function Value
(Key : String;
Required : Boolean := False)
return String
Required : Boolean := False) return String
is
begin
Check_Environment;

45
gcc/ada/g-cgicoo.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005, 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- --
@ -38,9 +38,9 @@
-- The complete CGI Cookie specification can be found in the RFC2109 at:
-- http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
-- This package builds up data tables whose memory is not released.
-- A CGI program is expected to be a short lived program and so it
-- is adequate to have the underlying OS free the program on exit.
-- This package builds up data tables whose memory is not released. A CGI
-- program is expected to be a short lived program and so it is adequate to
-- have the underlying OS free the program on exit.
package GNAT.CGI.Cookie is
@ -50,7 +50,7 @@ package GNAT.CGI.Cookie is
-- will be raised when calling any services below (except for Ok).
Cookie_Not_Found : exception;
-- This exception is raised when a specific parameter is not found.
-- This exception is raised when a specific parameter is not found
procedure Put_Header
(Header : String := Default_Header;
@ -67,33 +67,32 @@ package GNAT.CGI.Cookie is
-- max_age=<max_age>; path=<path>[; secured]
function Ok return Boolean;
-- Returns True if the CGI cookie environment is valid and False
-- otherwise. Every service used when the CGI environment is not valid
-- will raise the exception Data_Error.
-- Returns True if the CGI cookie environment is valid and False otherwise.
-- Every service used when the CGI environment is not valid will raise the
-- exception Data_Error.
function Count return Natural;
-- Returns the number of cookies received by the CGI.
-- Returns the number of cookies received by the CGI
function Value
(Key : String;
Required : Boolean := False)
return String;
-- Returns the cookie value associated with the cookie named Key. If
-- cookie does not exist, returns an empty string if Required is
-- False and raises the exception Cookie_Not_Found otherwise.
Required : Boolean := False) return String;
-- Returns the cookie value associated with the cookie named Key. If cookie
-- does not exist, returns an empty string if Required is False and raises
-- the exception Cookie_Not_Found otherwise.
function Value (Position : Positive) return String;
-- Returns the value associated with the cookie number Position
-- of the CGI. It raises Cookie_Not_Found if there is no such
-- cookie (i.e. Position > Count)
-- Returns the value associated with the cookie number Position of the CGI.
-- It raises Cookie_Not_Found if there is no such cookie (i.e. Position >
-- Count)
function Exists (Key : String) return Boolean;
-- Returns True if the cookie named Key exist and False otherwise.
-- Returns True if the cookie named Key exist and False otherwise
function Key (Position : Positive) return String;
-- Returns the key associated with the cookie number Position of
-- the CGI. It raises Cookie_Not_Found if there is no such cookie
-- (i.e. Position > Count)
-- Returns the key associated with the cookie number Position of the CGI.
-- It raises Cookie_Not_Found if there is no such cookie (i.e. Position >
-- Count)
procedure Set
(Key : String;
@ -103,8 +102,8 @@ package GNAT.CGI.Cookie is
Max_Age : Natural := Natural'Last;
Path : String := "/";
Secure : Boolean := False);
-- Add a cookie to the list of cookies. This will be sent back
-- to the server by the Put_Header service above.
-- Add a cookie to the list of cookies. This will be sent back to the
-- server by the Put_Header service above.
generic
with procedure

78
gcc/ada/g-cgideb.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005, 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- --
@ -37,13 +37,11 @@ package body GNAT.CGI.Debug is
use Ada.Strings.Unbounded;
--
-- Define the abstract type which act as a template for all debug IO mode.
-- Define the abstract type which act as a template for all debug IO modes.
-- To create a new IO mode you must:
-- 1. create a new package spec
-- 2. create a new type derived from IO.Format
-- 3. implement all the abstract rountines in IO
--
package IO is
@ -54,51 +52,39 @@ package body GNAT.CGI.Debug is
function Variable
(Mode : Format;
Name : String;
Value : String)
return String
is abstract;
-- Returns variable Name and its associated value.
Value : String) return String is abstract;
-- Returns variable Name and its associated value
function New_Line
(Mode : Format)
return String
is abstract;
function New_Line (Mode : Format) return String is abstract;
-- Returns a new line such as this concatenated between two strings
-- will display the strings on two lines.
function Title
(Mode : Format;
Str : String)
return String
is abstract;
function Title (Mode : Format; Str : String) return String is abstract;
-- Returns Str as a Title. A title must be alone and centered on a
-- line. Next output will be on the following line.
function Header
(Mode : Format;
Str : String)
return String
is abstract;
Str : String) return String is abstract;
-- Returns Str as an Header. An header must be alone on its line. Next
-- output will be on the following line.
end IO;
--
-- IO for HTML mode
--
----------------------
-- IO for HTML Mode --
----------------------
package HTML_IO is
-- see IO for comments about these routines.
-- See IO for comments about these routines
type Format is new IO.Format with null record;
function Variable
(IO : Format;
Name : String;
Value : String)
return String;
Value : String) return String;
function New_Line (IO : in Format) return String;
@ -108,9 +94,9 @@ package body GNAT.CGI.Debug is
end HTML_IO;
--
-- IO for plain text mode
--
----------------------------
-- IO for Plain Text Mode --
----------------------------
package Text_IO is
@ -121,8 +107,7 @@ package body GNAT.CGI.Debug is
function Variable
(IO : Format;
Name : String;
Value : String)
return String;
Value : String) return String;
function New_Line (IO : in Format) return String;
@ -188,10 +173,10 @@ package body GNAT.CGI.Debug is
NL : constant String := (1 => ASCII.LF);
function Bold (S : in String) return String;
-- Returns S as an HTML bold string.
-- Returns S as an HTML bold string
function Italic (S : in String) return String;
-- Returns S as an HTML italic string.
-- Returns S as an HTML italic string
----------
-- Bold --
@ -207,8 +192,7 @@ package body GNAT.CGI.Debug is
------------
function Header (IO : in Format; Str : in String) return String is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return "<h2>" & Str & "</h2>" & NL;
end Header;
@ -227,8 +211,7 @@ package body GNAT.CGI.Debug is
--------------
function New_Line (IO : in Format) return String is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return "<br>" & NL;
end New_Line;
@ -238,8 +221,7 @@ package body GNAT.CGI.Debug is
-----------
function Title (IO : in Format; Str : in String) return String is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
end Title;
@ -251,11 +233,9 @@ package body GNAT.CGI.Debug is
function Variable
(IO : Format;
Name : String;
Value : String)
return String
Value : String) return String
is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return Bold (Name) & " = " & Italic (Value);
end Variable;
@ -282,8 +262,7 @@ package body GNAT.CGI.Debug is
--------------
function New_Line (IO : in Format) return String is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return String'(1 => ASCII.LF);
end New_Line;
@ -295,7 +274,6 @@ package body GNAT.CGI.Debug is
function Title (IO : in Format; Str : in String) return String is
Spaces : constant Natural := (80 - Str'Length) / 2;
Indent : constant String (1 .. Spaces) := (others => ' ');
begin
return Indent & Str & New_Line (IO);
end Title;
@ -307,11 +285,9 @@ package body GNAT.CGI.Debug is
function Variable
(IO : Format;
Name : String;
Value : String)
return String
Value : String) return String
is
pragma Warnings (Off, IO);
pragma Unreferenced (IO);
begin
return " " & Name & " = " & Value;
end Variable;
@ -324,7 +300,6 @@ package body GNAT.CGI.Debug is
function HTML_Output return String is
HTML : HTML_IO.Format;
begin
return IO.Output (Mode => HTML);
end HTML_Output;
@ -335,7 +310,6 @@ package body GNAT.CGI.Debug is
function Text_Output return String is
Text : Text_IO.Format;
begin
return IO.Output (Mode => Text);
end Text_Output;

8
gcc/ada/g-cgideb.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005, 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- --
@ -36,9 +36,9 @@
package GNAT.CGI.Debug is
-- Both functions below output all possible CGI parameters set. These
-- are the form field and all CGI environment variables which make the
-- CGI environment at runtime.
-- Both functions below output all possible CGI parameters set. These are
-- the form field and all CGI environment variables which make the CGI
-- environment at runtime.
function Text_Output return String;
-- Returns a plain text version of the CGI runtime environment

44
gcc/ada/g-comlin.adb
View File

@ -49,23 +49,22 @@ package body GNAT.Command_Line is
The_Parameter : Parameter_Type;
The_Switch : Parameter_Type;
-- This type and this variable are provided to store the current switch
-- and parameter
-- and parameter.
type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
pragma Pack (Is_Switch_Type);
Is_Switch : Is_Switch_Type := (others => False);
-- Indicates wich arguments on the command line are considered not be
-- switches or parameters to switches (this leaves e.g. the filenames...)
-- switches or parameters to switches (this leaves e.g. the filenames...).
type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
pragma Pack (Section_Type);
Section : Section_Type := (others => 1);
-- Contains the number of the section associated with the current
-- switch. If this number is 0, then it is a section delimiter, which
-- is never returns by GetOpt.
-- The last element of this array is set to 0 to avoid the need to test for
-- if we have reached the end of the command line in loops.
-- Contains the number of the section associated with the current switch.
-- If this number is 0, then it is a section delimiter, which is never
-- returns by GetOpt. The last element of this array is set to 0 to avoid
-- the need to test for reaching the end of the command line in loops.
Current_Argument : Natural := 1;
-- Number of the current argument parsed on the command line
@ -82,8 +81,8 @@ package body GNAT.Command_Line is
-- True if we are expanding a file
Switch_Character : Character := '-';
-- The character at the beginning of the command line arguments,
-- indicating the beginning of a switch
-- The character at the beginning of the command line arguments, indicating
-- the beginning of a switch.
Stop_At_First : Boolean := False;
-- If it is True then Getopt stops at the first non-switch argument
@ -97,24 +96,25 @@ package body GNAT.Command_Line is
-- Set the parameter that will be returned by Parameter below
function Goto_Next_Argument_In_Section return Boolean;
-- Go to the next argument on the command line. If we are at the end
-- of the current section, we want to make sure there is no other
-- identical section on the command line (there might be multiple
-- instances of -largs). Returns True iff there is another argument.
-- Go to the next argument on the command line. If we are at the end of the
-- current section, we want to make sure there is no other identical
-- section on the command line (there might be multiple instances of
-- -largs). Returns True iff there is another argument.
function Get_File_Names_Case_Sensitive return Integer;
pragma Import (C, Get_File_Names_Case_Sensitive,
"__gnat_get_file_names_case_sensitive");
File_Names_Case_Sensitive : constant Boolean :=
Get_File_Names_Case_Sensitive /= 0;
procedure Canonical_Case_File_Name (S : in out String);
-- Given a file name, converts it to canonical case form. For systems
-- where file names are case sensitive, this procedure has no effect.
-- If file names are not case sensitive (i.e. for example if you have
-- the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
-- this call converts the given string to canonical all lower case form,
-- so that two file names compare equal if they refer to the same file.
-- Given a file name, converts it to canonical case form. For systems where
-- file names are case sensitive, this procedure has no effect. If file
-- names are not case sensitive (i.e. for example if you have the file
-- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
-- converts the given string to canonical all lower case form, so that two
-- file names compare equal if they refer to the same file.
------------------------------
-- Canonical_Case_File_Name --
@ -150,8 +150,8 @@ package body GNAT.Command_Line is
NL : Positive;
begin
-- It is assumed that a directory is opened at the current level;
-- otherwise, GNAT.Directory_Operations.Directory_Error will be raised
-- It is assumed that a directory is opened at the current level.
-- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
-- at the first call to Read.
loop
@ -162,7 +162,7 @@ package body GNAT.Command_Line is
if Last = 0 then
Close (It.Levels (Current).Dir);
-- If we are at level 1, we are finished; return an empty string.
-- If we are at level 1, we are finished; return an empty string
if Current = 1 then
return String'(1 .. 0 => ' ');

11
gcc/ada/g-comver.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002 Ada Core Technologies --
-- Copyright (C) 2002-2005, 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- --
@ -35,7 +35,7 @@
-- GNAT compiler used to compile the program. It relies on the generated
-- constant in the binder generated package that records this information.
-- Note: to use this package you must first instantiate it, e.g.
-- Note: to use this package you must first instantiate it, for example:
-- package CVer is new GNAT.Compiler_Version;
@ -44,13 +44,12 @@
-- to import the necessary variable from the binder file causes trouble when
-- building a shared library, since the symbol is not available.
-- Note: this unit is only useable if the main program is written
-- in Ada. It cannot be used if the main program is written in a
-- foreign language.
-- Note: this unit is only useable if the main program is written in Ada.
-- It cannot be used if the main program is written in foreign language.
generic
package GNAT.Compiler_Version is
pragma Pure (Compiler_Version);
pragma Pure;
function Version return String;
-- This function returns the version in the form "v.vvx (yyyyddmm)".

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -39,7 +39,7 @@
with System;
package GNAT.Debug_Utilities is
pragma Pure (Debug_Utilities);
pragma Pure;
Address_64 : constant Boolean := Standard'Address_Size = 64;
-- Set true if 64 bit addresses (assumes only 32 and 64 are possible)

12
gcc/ada/g-dirope.adb
View File

@ -105,11 +105,11 @@ package body GNAT.Directory_Operations is
Cut_Start := Cut_Start + 1;
end if;
-- Cut_End point to the last basename character.
-- Cut_End point to the last basename character
Cut_End := Path'Last;
-- If basename ends with Suffix, adjust Cut_End.
-- If basename ends with Suffix, adjust Cut_End
if Suffix /= ""
and then Path (Path'Last - Suffix'Length + 1 .. Cut_End) = Suffix
@ -279,8 +279,7 @@ package body GNAT.Directory_Operations is
procedure Double_Result_Size is
New_Result : constant OS_Lib.String_Access :=
new String (1 .. 2 * Result'Last);
new String (1 .. 2 * Result'Last);
begin
New_Result (1 .. Result_Last) := Result (1 .. Result_Last);
OS_Lib.Free (Result);
@ -306,6 +305,7 @@ package body GNAT.Directory_Operations is
procedure Read (K : in out Positive) is
P : Character;
begin
For_All_Characters : loop
if Is_Var_Prefix (Path (K)) then
@ -314,7 +314,6 @@ package body GNAT.Directory_Operations is
-- Could be a variable
if K < Path'Last then
if Path (K + 1) = P then
-- Not a variable after all, this is a double $ or %,
@ -566,7 +565,6 @@ package body GNAT.Directory_Operations is
function Get_Current_Dir return Dir_Name_Str is
Current_Dir : String (1 .. Max_Path + 1);
Last : Natural;
begin
Get_Current_Dir (Current_Dir, Last);
return Current_Dir (1 .. Last);
@ -708,11 +706,9 @@ package body GNAT.Directory_Operations is
-------------------------
function Read_Is_Thread_Safe return Boolean is
function readdir_is_thread_safe return Integer;
pragma Import
(C, readdir_is_thread_safe, "__gnat_readdir_is_thread_safe");
begin
return (readdir_is_thread_safe /= 0);
end Read_Is_Thread_Safe;

2
gcc/ada/g-dynhta.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2005 AdaCore --
-- Copyright (C) 2002-2005, 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- --

8
gcc/ada/g-dynhta.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -75,7 +75,7 @@ package GNAT.Dynamic_HTables is
generic
type Header_Num is range <>;
-- An integer type indicating the number and range of hash headers.
-- An integer type indicating the number and range of hash headers
type Element (<>) is limited private;
-- The type of element to be stored
@ -85,7 +85,7 @@ package GNAT.Dynamic_HTables is
-- type, but could be some other form of type such as an integer type).
Null_Ptr : Elmt_Ptr;
-- The null value of the Elmt_Ptr type.
-- The null value of the Elmt_Ptr type
with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
with function Next (E : Elmt_Ptr) return Elmt_Ptr;
@ -154,7 +154,7 @@ package GNAT.Dynamic_HTables is
generic
type Header_Num is range <>;
-- An integer type indicating the number and range of hash headers.
-- An integer type indicating the number and range of hash headers
type Element is private;
-- The type of element to be stored

2
gcc/ada/g-heasor.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -48,7 +48,7 @@
-- the body for exact details of the algorithm used.
package GNAT.Heap_Sort is
pragma Preelaborate (Heap_Sort);
pragma Preelaborate;
-- The data to be sorted is assumed to be indexed by integer values
-- from 1 to N, where N is the number of items to be sorted.

2
gcc/ada/g-hesora.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -43,7 +43,7 @@
-- the body for exact details of the algorithm used.
package GNAT.Heap_Sort_A is
pragma Preelaborate (Heap_Sort_A);
pragma Preelaborate;
-- The data to be sorted is assumed to be indexed by integer values from
-- 1 to N, where N is the number of items to be sorted. In addition, the

2
gcc/ada/g-hesorg.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -77,7 +77,7 @@ generic
-- zero will in this case be resolved at instantiation time.
package GNAT.Heap_Sort_G is
pragma Pure (Heap_Sort_G);
pragma Pure;
procedure Sort (N : Natural);
-- This procedures sorts items in the range from 1 to N into ascending

2
gcc/ada/g-htable.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

15
gcc/ada/g-htable.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -46,13 +46,12 @@
with System.HTable;
package GNAT.HTable is
pragma Preelaborate (HTable);
pragma Elaborate_Body;
-- The elaborate body is because we have a dummy body to deal with bootstrap
-- path problems (we used to have a real body, and now we don't need it any
-- more, but the bootstrap requires that we have a dummy body, since otherwise
-- the old body gets picked up.
pragma Preelaborate;
pragma Elaborate_Body;
-- The elaborate body is because we have a dummy body to deal with
-- bootstrap path problems (we used to have a real body, and now we don't
-- need it any more, but the bootstrap requires that we have a dummy body,
-- since otherwise the old body gets picked up.
-------------------
-- Simple_HTable --

2
gcc/ada/g-io.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --
@ -41,7 +41,7 @@
-- If such checks are needed then the regular Text_IO package must be used.
package GNAT.IO is
pragma Preelaborate (IO);
pragma Preelaborate;
type File_Type is limited private;
-- Specifies file to be used (the only possibilities are Standard_Output

2
gcc/ada/g-io_aux.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2005, 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- --

6
gcc/ada/g-locfil.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 1995-2005 Ada Core Technologies, 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- --
@ -35,7 +35,7 @@
-- purpose of providing realiable system wide locking capability.
package GNAT.Lock_Files is
pragma Preelaborate;
pragma Preelaborate;
Lock_Error : exception;
-- Exception raised if file cannot be locked
@ -62,7 +62,7 @@ pragma Preelaborate;
(Lock_File_Name : Path_Name;
Wait : Duration := 1.0;
Retries : Natural := Natural'Last);
-- See above. The full lock file path is given as one string.
-- See above. The full lock file path is given as one string
procedure Unlock_File (Directory : Path_Name; Lock_File_Name : Path_Name);
-- Unlock a file. Directory can optionally terminate with a directory

2
gcc/ada/g-memdum.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2005 AdaCore --
-- Copyright (C) 2003-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2003-2005 AdaCore --
-- Copyright (C) 2003-2005, 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- --
@ -38,7 +38,7 @@
with System;
package GNAT.Memory_Dump is
pragma Preelaborate (Memory_Dump);
pragma Preelaborate;
procedure Dump (Addr : System.Address; Count : Natural);
-- Dumps indicated number (Count) of bytes, starting at the address given

37
gcc/ada/g-semaph.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, 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- --
@ -40,7 +40,7 @@ with System;
package GNAT.Semaphores is
Default_Ceiling : constant System.Priority := System.Default_Priority;
-- A convenient value for the priority discriminants that follow.
-- A convenient value for the priority discriminants that follow
------------------------
-- Counting_Semaphore --
@ -52,19 +52,18 @@ package GNAT.Semaphores is
-- value of this counter is set by clients via the discriminant.
Ceiling : System.Priority)
-- Users must specify the ceiling priority for the object.
-- If the Real-Time Systems Annex is not in use this value
-- is not important.
-- Users must specify the ceiling priority for the object. If the
-- Real-Time Systems Annex is not in use this value is not important.
is
pragma Priority (Ceiling);
entry Seize;
-- Blocks caller until/unless the semaphore's internal counter
-- is greater than zero.
-- Decrements the semaphore's internal counter when executed.
-- Blocks caller until/unless the semaphore's internal counter is
-- greater than zero. Decrements the semaphore's internal counter when
-- executed.
procedure Release;
-- Increments the semaphore's internal counter.
-- Increments the semaphore's internal counter
private
Count : Natural := Initial_Value;
@ -75,23 +74,23 @@ package GNAT.Semaphores is
----------------------
protected type Binary_Semaphore
(Initially_Available : Boolean;
-- Binary semaphores are either available or not; there is no
-- internal count involved. The discriminant value determines
-- whether the individual object is initially available.
(Initially_Available : Boolean;
-- Binary semaphores are either available or not; there is no internal
-- count involved. The discriminant value determines whether the
-- individual object is initially available.
Ceiling : System.Priority)
-- Users must specify the ceiling priority for the object.
-- If the Real-Time Systems Annex is not in use
-- this value is not important.
-- Users must specify the ceiling priority for the object. If the
-- Real-Time Systems Annex is not in use this value is not important.
is
pragma Priority (Ceiling);
entry Seize;
-- Blocks the caller unless/until semaphore is available.
-- After execution the semaphore is no longer available.
-- Blocks the caller unless/until semaphore is available. After
-- execution the semaphore is no longer available.
procedure Release;
-- Makes the semaphore available.
-- Makes the semaphore available
private
Available : Boolean := Initially_Available;

2
gcc/ada/g-socthi-mingw.adb
View File

@ -35,7 +35,7 @@
-- layer for use by the GNAT.Sockets package (g-socket.ads). This package
-- should not be directly with'ed by an applications program.
-- This version is for NT.
-- This version is for NT
with GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
with Interfaces.C.Strings; use Interfaces.C.Strings;

8
gcc/ada/g-socthi-mingw.ads
View File

@ -49,16 +49,16 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.int;
-- So that we can declare the Failure constant below.
-- So that we can declare the Failure constant below
Success : constant C.int := 0;
Failure : constant C.int := -1;
function Socket_Errno return Integer;
-- Returns last socket error number.
-- Returns last socket error number
procedure Set_Socket_Errno (Errno : Integer);
-- Set last socket error number.
-- Set last socket error number
function Socket_Error_Message
(Errno : Integer)
@ -335,7 +335,7 @@ package GNAT.Sockets.Thin is
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set.
-- Free system-dependent socket set
procedure Get_Socket_From_Set
(Set : Fd_Set_Access;

4
gcc/ada/g-socthi-vms.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005 Ada Core Technologies, 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- --
@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- Temporary version for Alpha/VMS.
-- Temporary version for Alpha/VMS
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Task_Lock;

12
gcc/ada/g-socthi-vms.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2002-2005 Ada Core Technologies, 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- --
@ -35,7 +35,7 @@
-- layer for use by the GNAT.Sockets package (g-socket.ads). This package
-- should not be directly with'ed by an applications program.
-- This is the Alpha/VMS version.
-- This is the Alpha/VMS version
with Interfaces.C.Pointers;
@ -58,7 +58,7 @@ package GNAT.Sockets.Thin is
Failure : constant C.int := -1;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
-- Returns last socket error number
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
@ -354,7 +354,7 @@ package GNAT.Sockets.Thin is
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set.
-- Free system-dependent socket set
procedure Get_Socket_From_Set
(Set : Fd_Set_Access;
@ -369,7 +369,7 @@ package GNAT.Sockets.Thin is
procedure Insert_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Insert socket in the socket set.
-- Insert socket in the socket set
function Is_Socket_In_Set
(Set : Fd_Set_Access;
@ -396,7 +396,7 @@ package GNAT.Sockets.Thin is
procedure Remove_Socket_From_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Remove socket from the socket set.
-- Remove socket from the socket set
procedure Finalize;
procedure Initialize (Process_Blocking_IO : Boolean);

16
gcc/ada/g-socthi-vxworks.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2002-2005 Ada Core Technologies, 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- --
@ -57,11 +57,11 @@ package GNAT.Sockets.Thin is
Failure : constant C.int := -1;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
-- Returns last socket error number
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
-- Returns the error message string for the error number Errno. If Errno is
-- not known it returns "Unknown system error".
subtype Fd_Set_Access is System.Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
@ -145,25 +145,25 @@ package GNAT.Sockets.Thin is
(Sin : Sockaddr_In_Access;
Len : C.int);
pragma Inline (Set_Length);
-- Set Sin.Sin_Length to Len.
-- Set Sin.Sin_Length to Len
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int);
pragma Inline (Set_Family);
-- Set Sin.Sin_Family to Family.
-- Set Sin.Sin_Family to Family
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short);
pragma Inline (Set_Port);
-- Set Sin.Sin_Port to Port.
-- Set Sin.Sin_Port to Port
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr);
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address.
-- Set Sin.Sin_Addr to Address
type Hostent is record
H_Name : C.Strings.chars_ptr;

24
gcc/ada/g-socthi.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005 Ada Core Technologies, 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- --
@ -59,11 +59,11 @@ package GNAT.Sockets.Thin is
Failure : constant C.int := -1;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
-- Returns last socket error number
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
-- Returns the error message string for the error number Errno. If Errno is
-- not known it returns "Unknown system error".
subtype Fd_Set_Access is System.Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
@ -357,17 +357,17 @@ package GNAT.Sockets.Thin is
procedure Last_Socket_In_Set
(Set : Fd_Set_Access;
Last : Int_Access);
-- Find the largest socket in the socket set. This is needed for
-- select(). When Last_Socket_In_Set is called, parameter Last is
-- a maximum value of the largest socket. This hint is used to
-- avoid scanning very large socket sets. After the call, Last is
-- set back to the real largest socket in the socket set.
-- Find the largest socket in the socket set. This is needed for select().
-- When Last_Socket_In_Set is called, parameter Last is a maximum value of
-- the largest socket. This hint is used to avoid scanning very large
-- socket sets. After the call, Last is set back to the real largest socket
-- in the socket set.
function New_Socket_Set
(Set : Fd_Set_Access) return Fd_Set_Access;
-- Allocate a new socket set which is a system-dependent structure
-- and initialize by copying Set if it is non-null, by making it
-- empty otherwise.
-- Allocate a new socket set which is a system-dependent structure and
-- initialize by copying Set if it is non-null, by making it empty
-- otherwise.
procedure Remove_Socket_From_Set
(Set : Fd_Set_Access;

4
gcc/ada/g-table.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2005 AdaCore --
-- Copyright (C) 1998-2005, 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- --
@ -49,7 +49,7 @@ package body GNAT.Table is
-- ensures that we initially allocate the table.
Last_Val : Integer;
-- Current value of Last.
-- Current value of Last
-----------------------
-- Local Subprograms --

2
gcc/ada/g-traceb.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2000 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2005, 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- --

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2005, 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- --
@ -78,7 +78,7 @@ package GNAT.Traceback is
-- Code location used in building tracebacks
subtype Tracebacks_Array is Ada.Exceptions.Traceback.Tracebacks_Array;
-- Traceback array used to hold a generated traceback list.
-- Traceback array used to hold a generated traceback list
----------------
-- Call_Chain --

30
gcc/ada/i-cobol.adb
View File

@ -31,10 +31,10 @@
-- --
------------------------------------------------------------------------------
-- The body of Interfaces.COBOL is implementation independent (i.e. the
-- same version is used with all versions of GNAT). The specialization
-- to a particular COBOL format is completely contained in the private
-- part ot the spec.
-- The body of Interfaces.COBOL is implementation independent (i.e. the same
-- version is used with all versions of GNAT). The specialization to a
-- particular COBOL format is completely contained in the private part of
-- the spec.
with Interfaces; use Interfaces;
with System; use System;
@ -76,8 +76,7 @@ package body Interfaces.COBOL is
function Binary_To_Decimal
(Item : Byte_Array;
Format : Binary_Format)
return Integer_64;
Format : Binary_Format) return Integer_64;
-- This function converts a numeric value in the given format to its
-- corresponding integer value. This is the non-generic implementation
-- of Decimal_Conversions.To_Decimal. The generic routine does the
@ -85,8 +84,7 @@ package body Interfaces.COBOL is
function Numeric_To_Decimal
(Item : Numeric;
Format : Display_Format)
return Integer_64;
Format : Display_Format) return Integer_64;
-- This function converts a numeric value in the given format to its
-- corresponding integer value. This is the non-generic implementation
-- of Decimal_Conversions.To_Decimal. The generic routine does the
@ -94,8 +92,7 @@ package body Interfaces.COBOL is
function Packed_To_Decimal
(Item : Packed_Decimal;
Format : Packed_Format)
return Integer_64;
Format : Packed_Format) return Integer_64;
-- This function converts a packed value in the given format to its
-- corresponding integer value. This is the non-generic implementation
-- of Decimal_Conversions.To_Decimal. The generic routine does the
@ -207,7 +204,7 @@ package body Interfaces.COBOL is
-- Numeric_To_Decimal --
------------------------
-- The following assumptions are made in the coding of this routine
-- The following assumptions are made in the coding of this routine:
-- The range of COBOL_Digits is compact and the ten values
-- represent the digits 0-9 in sequence
@ -220,7 +217,7 @@ package body Interfaces.COBOL is
-- The COBOL_Minus_Digits set is disjoint from COBOL_Digits
-- These assumptions are true for all COBOL representations we know of.
-- These assumptions are true for all COBOL representations we know of
function Numeric_To_Decimal
(Item : Numeric;
@ -708,7 +705,7 @@ package body Interfaces.COBOL is
-- Note that the tests here are all compile time tests
function Length (Format : Binary_Format) return Natural is
pragma Warnings (Off, Format);
pragma Unreferenced (Format);
begin
if Num'Digits <= 2 then
return 1;
@ -743,8 +740,7 @@ package body Interfaces.COBOL is
function Length
(Format : Packed_Format) return Natural
is
pragma Warnings (Off, Format);
pragma Unreferenced (Format);
begin
case Packed_Representation is
when IBM =>
@ -847,14 +843,12 @@ package body Interfaces.COBOL is
function To_Decimal
(Item : Numeric;
Format : Display_Format)
return Num
Format : Display_Format) return Num
is
pragma Unsuppress (Range_Check);
begin
return Num'Fixed_Value (Numeric_To_Decimal (Item, Format));
exception
when Constraint_Error =>
raise Conversion_Error;

35
gcc/ada/i-cobol.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- (ASCII Version) --
-- --
-- Copyright (C) 1993-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1993-2005 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 --
@ -386,12 +386,10 @@ package Interfaces.COBOL is
function Valid
(Item : Numeric;
Format : Display_Format)
return Boolean;
Format : Display_Format) return Boolean;
function Length
(Format : Display_Format)
return Natural;
(Format : Display_Format) return Natural;
function To_Decimal
(Item : Numeric;
@ -400,36 +398,30 @@ package Interfaces.COBOL is
function To_Display
(Item : Num;
Format : Display_Format)
return Numeric;
Format : Display_Format) return Numeric;
-- Packed Formats: data values are represented as Packed_Decimal
function Valid
(Item : Packed_Decimal;
Format : Packed_Format)
return Boolean;
Format : Packed_Format) return Boolean;
function Length
(Format : Packed_Format)
return Natural;
(Format : Packed_Format) return Natural;
function To_Decimal
(Item : Packed_Decimal;
Format : Packed_Format)
return Num;
Format : Packed_Format) return Num;
function To_Packed
(Item : Num;
Format : Packed_Format)
return Packed_Decimal;
Format : Packed_Format) return Packed_Decimal;
-- Binary Formats: external data values are represented as Byte_Array
function Valid
(Item : Byte_Array;
Format : Binary_Format)
return Boolean;
Format : Binary_Format) return Boolean;
function Length
(Format : Binary_Format)
@ -441,8 +433,7 @@ package Interfaces.COBOL is
function To_Binary
(Item : Num;
Format : Binary_Format)
return Byte_Array;
Format : Binary_Format) return Byte_Array;
-- Internal Binary formats: data values are of type Binary/Long_Binary
@ -517,14 +508,14 @@ private
type Packed_Format is (U, S);
Packed_Unsigned : constant Packed_Format := U;
Packed_Signed : constant Packed_Format := S;
Packed_Unsigned : constant Packed_Format := U;
Packed_Signed : constant Packed_Format := S;
type Packed_Representation_Type is (IBM);
-- Indicator for format used for packed decimal
Packed_Representation : constant Packed_Representation_Type := IBM;
-- This version of the spec uses IBM internal format, as described above.
-- This version of the spec uses IBM internal format, as described above
-----------------------------
-- Display Decimal Formats --

12
gcc/ada/i-cstrea-vms.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2005 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- --
@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the Alpha/VMS version.
-- This is the Alpha/VMS version
with Unchecked_Conversion;
package body Interfaces.C_Streams is
@ -87,8 +87,8 @@ package body Interfaces.C_Streams is
Ch : int;
begin
-- This Fread goes with the Fwrite below.
-- The C library fread sometimes can't read fputc generated files.
-- This Fread goes with the Fwrite below. The C library fread sometimes
-- can't read fputc generated files.
for C in 1 .. count loop
for S in 1 .. size loop
@ -125,8 +125,8 @@ package body Interfaces.C_Streams is
Ch : int;
begin
-- This Fread goes with the Fwrite below.
-- The C library fread sometimes can't read fputc generated files.
-- This Fread goes with the Fwrite below. The C library fread sometimes
-- can't read fputc generated files.
for C in 1 + index .. count + index loop
for S in 1 .. size loop

14
gcc/ada/i-cstrea.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1995-2005 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- --
@ -123,16 +123,14 @@ package Interfaces.C_Streams is
(buffer : voids;
size : size_t;
count : size_t;
stream : FILEs)
return size_t;
stream : FILEs) return size_t;
function fread
(buffer : voids;
index : size_t;
size : size_t;
count : size_t;
stream : FILEs)
return size_t;
stream : FILEs) return size_t;
-- Same as normal fread, but has a parameter 'index' that indicates
-- the starting index for the read within 'buffer' (which must be the
-- address of the beginning of a whole array object with an assumed
@ -198,11 +196,11 @@ package Interfaces.C_Streams is
-- functions.
function file_exists (name : chars) return int;
-- Tests if given name corresponds to an existing file.
-- Tests if given name corresponds to an existing file
function is_regular_file (handle : int) return int;
-- Tests if given handle is for a regular file (result 1) or for
-- a non-regular file (pipe or device, result 0).
-- Tests if given handle is for a regular file (result 1) or for a
-- non-regular file (pipe or device, result 0).
---------------------------------
-- Control of Text/Binary Mode --

18
gcc/ada/i-cstrin.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
@ -38,11 +38,10 @@ with Unchecked_Conversion;
package body Interfaces.C.Strings is
-- Note that the type chars_ptr has a pragma No_Strict_Aliasing in
-- the spec, to prevent any assumptions about aliasing for values
-- of this type, since arbitrary addresses can be converted, and it
-- is quite likely that this type will in fact be used for aliasing
-- values of other types.
-- Note that the type chars_ptr has a pragma No_Strict_Aliasing in the
-- spec, to prevent any assumptions about aliasing for values of this type,
-- since arbitrary addresses can be converted, and it is quite likely that
-- this type will in fact be used for aliasing values of other types.
function To_chars_ptr is
new Unchecked_Conversion (Address, chars_ptr);
@ -116,7 +115,7 @@ package body Interfaces.C.Strings is
Index := Position_Of_Nul (Into => Chars);
Pointer := Memory_Alloc ((Index - Chars'First + 1));
-- If nul is present, transfer string up to and including it.
-- If nul is present, transfer string up to and including nul
if Index <= Chars'Last then
Update (Item => Pointer,
@ -322,8 +321,9 @@ package body Interfaces.C.Strings is
Result : char_array (0 .. Length);
begin
-- As per AI-00177, this is equivalent to
-- To_Ada (Value (Item, Length) & nul);
-- As per AI-00177, this is equivalent to:
-- To_Ada (Value (Item, Length) & nul);
if Item = Null_Ptr then
raise Dereference_Error;

6
gcc/ada/lib-sort.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
@ -43,10 +43,10 @@ procedure Sort (Tbl : in out Unit_Ref_Table) is
-- even though we have to copy Tbl back and forth.
function Lt_Uname (C1, C2 : Natural) return Boolean;
-- Comparison routine for comparing Unames. Needed by the sorting routine.
-- Comparison routine for comparing Unames. Needed by the sorting routine
procedure Move_Uname (From : Natural; To : Natural);
-- Move routine needed by the sorting routine below.
-- Move routine needed by the sorting routine below
--------------
-- Lt_Uname --

2
gcc/ada/sem_ch7.adb
View File

@ -1939,7 +1939,7 @@ package body Sem_Ch7 is
Next_Elmt (Priv_Elmt);
end loop;
-- Now restore the type itself to its private view.
-- Now restore the type itself to its private view
Exchange_Declarations (Id);

6
gcc/ada/sem_maps.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2005 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- --
@ -48,7 +48,7 @@ package body Sem_Maps is
procedure Write_Map (E : Entity_Id);
pragma Warnings (Off, Write_Map);
-- For debugging purposes.
-- For debugging purposes
---------------------
-- Add_Association --
@ -72,7 +72,7 @@ package body Sem_Maps is
if Headers_Table.Table (Offh + J) /= No_Assoc then
-- Place new association at head of chain.
-- Place new association at head of chain
Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
end if;