Skip to content

R
riscv-gcc-1
Commit 598c3446 by Geert Bosch
Options

gnatmain.adb: Initial version. 

	* gnatmain.adb: Initial version.

	* gnatmain.ads: Initial version.

	* prj-attr.adb (Initialisation_Data): Add package Gnatstub.

	* snames.adb: Updated to match snames.ads.

	* snames.ads: Added Gnatstub.

	* prj-attr.adb (Initialization_Data): Change name from
	Initialisation_Data.

	* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
	+ and * applied to backslashed expressions like \r.

	* g-os_lib.ads: String_List type added, Argument_List type is now
	subtype of String_List.

	* g-os_lib.ads: Change copyright to FSF
	Add comments for String_List type

	* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
	string to the buffer).

From-SVN: r47905
parent 0d7839da
Showing with 118 additions and 25 deletions
gcc/ada/ChangeLog
2001-12-11 Vincent Celier <celier@gnat.com>
* gnatmain.adb: Initial version.
* gnatmain.ads: Initial version.
* prj-attr.adb (Initialisation_Data): Add package Gnatstub.
* snames.adb: Updated to match snames.ads.
* snames.ads: Added Gnatstub.
2001-12-11 Vincent Celier <celier@gnat.com>
* prj-attr.adb (Initialization_Data): Change name from
Initialisation_Data.
2001-12-11 Emmanuel Briot <briot@gnat.com>
* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
+ and * applied to backslashed expressions like \r.
2001-12-11 Vasiliy Fofanov <fofanov@gnat.com>
* g-os_lib.ads: String_List type added, Argument_List type is now
subtype of String_List.
2001-12-11 Robert Dewar <dewar@gnat.com>
* g-os_lib.ads: Change copyright to FSF
Add comments for String_List type
2001-12-11 Vincent Celier <celier@gnat.com>
* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
string to the buffer).
2001-12-11 Ed Schonberg <schonber@gnat.com>
* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
......
gcc/ada/g-dirope.adb
......@@ -253,8 +253,8 @@ package body GNAT.Directory_Operations is
Double_Result_Size;
end loop;
Result (Result_Last + 1 .. Result_Last + S'Length - 1) := S;
Result_Last := Result_Last + S'Length - 1;
Result (Result_Last + 1 .. Result_Last + S'Length) := S;
Result_Last := Result_Last + S'Length;
end Append;
------------------------
......
gcc/ada/g-os_lib.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.79 $
-- $Revision$
-- --
-- Copyright (C) 1995-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 1995-2001 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- --
......@@ -56,10 +56,15 @@ package GNAT.OS_Lib is
pragma Elaborate_Body (OS_Lib);
type String_Access is access all String;
-- General purpose string access type
procedure Free is new Unchecked_Deallocation
(Object => String, Name => String_Access);
type String_List is array (Positive range <>) of String_Access;
type String_List_Access is access all String_List;
-- General purpose array and pointer for list of string accesses
---------------------
-- Time/Date Stuff --
---------------------
......@@ -381,12 +386,12 @@ pragma Elaborate_Body (OS_Lib);
-- Subprocesses --
------------------
type Argument_List is array (Positive range <>) of String_Access;
subtype Argument_List is String_List;
-- Type used for argument list in call to Spawn. The lower bound
-- of the array should be 1, and the length of the array indicates
-- the number of arguments.
type Argument_List_Access is access all Argument_List;
subtype Argument_List_Access is String_List_Access;
-- Type used to return an Argument_List without dragging in secondary
-- stack.
......
gcc/ada/g-regpat.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.31 $
-- $Revision$
-- --
-- Copyright (C) 1986 by University of Toronto. --
-- Copyright (C) 1996-2001 Ada Core Technologies, Inc. --
......@@ -1563,6 +1563,7 @@ package body GNAT.Regpat is
Start_Pos : Natural := 0;
C : Character;
Length_Ptr : Pointer;
Has_Special_Operator : Boolean := False;
begin
Parse_Pos := Parse_Pos - 1; -- Look at current character
......@@ -1585,6 +1586,7 @@ package body GNAT.Regpat is
when '.' | '[' | '(' | ')' | '|' | ASCII.LF | '$' | '^' =>
if Start_Pos = 0 then
Start_Pos := Parse_Pos;
Emit (C); -- First character is always emitted
else
exit Parse_Loop; -- Else we are done
......@@ -1593,12 +1595,14 @@ package body GNAT.Regpat is
when '?' | '+' | '*' | '{' =>
if Start_Pos = 0 then
Start_Pos := Parse_Pos;
Emit (C); -- First character is always emitted
-- Are we looking at an operator, or is this
-- simply a normal character ?
elsif not Is_Mult (Parse_Pos) then
Case_Emit (C);
Start_Pos := Parse_Pos;
Case_Emit (C);
else
-- We've got something like "abc?d". Mark this as a
-- special case. What we want to emit is a first
......@@ -1606,11 +1610,12 @@ package body GNAT.Regpat is
-- ultimately be transformed with a CURLY operator, A
-- special case has to be handled for "a?", since there
-- is no initial string to emit.
Start_Pos := Natural'Last;
Has_Special_Operator := True;
exit Parse_Loop;
end if;
when '\' =>
Start_Pos := Parse_Pos;
if Parse_Pos = Parse_End then
Fail ("Trailing \");
else
......@@ -1629,12 +1634,13 @@ package body GNAT.Regpat is
Parse_Pos := Parse_Pos + 1;
end if;
when others => Case_Emit (C);
when others =>
Start_Pos := Parse_Pos;
Case_Emit (C);
end case;
exit Parse_Loop when Emit_Ptr - Length_Ptr = 254;
Start_Pos := Parse_Pos;
Parse_Pos := Parse_Pos + 1;
exit Parse_Loop when Parse_Pos > Parse_End;
......@@ -1643,11 +1649,11 @@ package body GNAT.Regpat is
-- Is the string followed by a '*+?{' operator ? If yes, and if there
-- is an initial string to emit, do it now.
if Start_Pos = Natural'Last
if Has_Special_Operator
and then Emit_Ptr >= Length_Ptr + 3
then
Emit_Ptr := Emit_Ptr - 1;
Parse_Pos := Parse_Pos - 1;
Parse_Pos := Start_Pos;
end if;
if Emit_Code then
......
gcc/ada/gnatmain.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T M A I N --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This procedure is the project-aware driver for the GNAT tools.
-- For gnatls, gnatxref, gnatfind and gnatstub, it setup the environment
-- variables ADA_INCLUDE_PATH and ADA_OBJECT_PATH and gather the switches
-- and file names from the project file (if any) and from the common line,
-- then call the non project-aware tool (gnatls, gnatxref, gnatfind or
-- gnatstub).
-- For other tools (compiler, binder, linker, gnatmake), it invokes
-- gnatmake with the proper switches.
procedure Gnatmain;
gcc/ada/prj-attr.adb
......@@ -49,7 +49,7 @@ package body Prj.Attr is
-- End is indicated by two consecutive '#'.
Initialisation_Data : constant String :=
Initialization_Data : constant String :=
-- project attributes
......@@ -121,6 +121,11 @@ package body Prj.Attr is
"Ladefault_switches#" &
"LAswitches#" &
-- package Gnatstub
"Pgnatstub#" &
"LVswitches#" &
"#";
----------------
......@@ -128,7 +133,7 @@ package body Prj.Attr is
----------------
procedure Initialize is
Start : Positive := Initialisation_Data'First;
Start : Positive := Initialization_Data'First;
Finish : Positive := Start;
Current_Package : Package_Node_Id := Empty_Package;
Current_Attribute : Attribute_Node_Id := Empty_Attribute;
......@@ -145,9 +150,9 @@ package body Prj.Attr is
Attributes.Set_Last (Attributes.First);
Package_Attributes.Set_Last (Package_Attributes.First);
while Initialisation_Data (Start) /= '#' loop
while Initialization_Data (Start) /= '#' loop
Is_An_Attribute := True;
case Initialisation_Data (Start) is
case Initialization_Data (Start) is
when 'P' =>
-- New allowed package
......@@ -155,19 +160,19 @@ package body Prj.Attr is
Start := Start + 1;
Finish := Start;
while Initialisation_Data (Finish) /= '#' loop
while Initialization_Data (Finish) /= '#' loop
Finish := Finish + 1;
end loop;
Name_Len := Finish - Start;
Name_Buffer (1 .. Name_Len) :=
To_Lower (Initialisation_Data (Start .. Finish - 1));
To_Lower (Initialization_Data (Start .. Finish - 1));
Package_Name := Name_Find;
for Index in Package_First .. Package_Attributes.Last loop
if Package_Name = Package_Attributes.Table (Index).Name then
Write_Line ("Duplicate package name """ &
Initialisation_Data (Start .. Finish - 1) &
Initialization_Data (Start .. Finish - 1) &
""" in Prj.Attr body.");
raise Program_Error;
end if;
......@@ -196,7 +201,7 @@ package body Prj.Attr is
-- New attribute
Start := Start + 1;
case Initialisation_Data (Start) is
case Initialization_Data (Start) is
when 'V' =>
Kind_2 := Single;
when 'A' =>
......@@ -210,13 +215,13 @@ package body Prj.Attr is
Start := Start + 1;
Finish := Start;
while Initialisation_Data (Finish) /= '#' loop
while Initialization_Data (Finish) /= '#' loop
Finish := Finish + 1;
end loop;
Name_Len := Finish - Start;
Name_Buffer (1 .. Name_Len) :=
To_Lower (Initialisation_Data (Start .. Finish - 1));
To_Lower (Initialization_Data (Start .. Finish - 1));
Attribute_Name := Name_Find;
Attributes.Increment_Last;
if Current_Attribute = Empty_Attribute then
......@@ -234,7 +239,7 @@ package body Prj.Attr is
if Attribute_Name =
Attributes.Table (Index).Name then
Write_Line ("Duplicate attribute name """ &
Initialisation_Data (Start .. Finish - 1) &
Initialization_Data (Start .. Finish - 1) &
""" in Prj.Attr body.");
raise Program_Error;
end if;
......
gcc/ada/snames.adb
......@@ -595,6 +595,7 @@ package body Snames is
"binder#" &
"linker#" &
"compiler#" &
"gnatstub#" &
"#";
---------------------
......
gcc/ada/snames.ads
......@@ -894,10 +894,11 @@ package Snames is
Name_Binder : constant Name_Id := N + 549;
Name_Linker : constant Name_Id := N + 550;
Name_Compiler : constant Name_Id := N + 551;
Name_Gnatstub : constant Name_Id := N + 552;
-- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 551;
Last_Predefined_Name : constant Name_Id := N + 552;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment