This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Reflect ACT changes of 2001-10-31


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).

*** /dev/null	Tue Dec 11 17:47:58 2001
--- gnatmain.adb	Tue Dec 11 18:05:10 2001
***************
*** 0 ****
--- 1,594 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                            G N A T M A I N                               --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --                            $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). --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ with Csets;
+ with GNAT.Case_Util;
+ with GNAT.OS_Lib;  use GNAT.OS_Lib;
+ with Namet;        use Namet;
+ with Opt;
+ with Osint;        use Osint;
+ with Output;       use Output;
+ with Prj;          use Prj;
+ with Prj.Env;
+ with Prj.Ext;      use Prj.Ext;
+ with Prj.Pars;
+ with Prj.Util;     use Prj.Util;
+ with Snames;       use Snames;
+ with Stringt;      use Stringt;
+ with Table;
+ with Types;        use Types;
+ 
+ procedure Gnatmain is
+ 
+    Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
+    Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
+ 
+    type Tool_Type is (None, List, Xref, Find, Stub, Make, Comp, Bind, Link);
+ 
+    --  The tool that is going to be called
+ 
+    Tool : Tool_Type := None;
+ 
+    --  For each tool, Tool_Package_Names contains the name of the
+    --  corresponding package in the project file.
+ 
+    Tool_Package_Names : constant array (Tool_Type) of Name_Id :=
+      (None    => No_Name,
+       List    => Name_Gnatls,
+       Xref    => Name_Cross_Reference,
+       Find    => Name_Finder,
+       Stub    => Name_Gnatstub,
+       Comp    => No_Name,
+       Make    => No_Name,
+       Bind    => No_Name,
+       Link    => No_Name);
+ 
+    --  For each tool, Tool_Names contains the name of the executable
+    --  to be spawned.
+ 
+    Gnatmake : constant String_Access := new String'("gnatmake");
+ 
+    Tool_Names : constant array (Tool_Type) of String_Access :=
+      (None    => null,
+       List    => new String'("gnatls"),
+       Xref    => new String'("gnatxref"),
+       Find    => new String'("gnatfind"),
+       Stub    => new String'("gnatstub"),
+       Comp    => Gnatmake,
+       Make    => Gnatmake,
+       Bind    => Gnatmake,
+       Link    => Gnatmake);
+ 
+    Project_File      : String_Access;
+    Project           : Prj.Project_Id;
+    Current_Verbosity : Prj.Verbosity := Prj.Default;
+ 
+    --  This flag indicates a switch -p (for gnatxref and gnatfind) for
+    --  an old fashioned project file. -p cannot be used in conjonction
+    --  with -P.
+ 
+    Old_Project_File_Used : Boolean := False;
+ 
+    Next_Arg : Positive;
+ 
+    --  A table to keep the switches on the command line
+ 
+    package Saved_Switches is new Table.Table (
+      Table_Component_Type => String_Access,
+      Table_Index_Type     => Integer,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 20,
+      Table_Increment      => 100,
+      Table_Name           => "Gnatmain.Saved_Switches");
+ 
+    --  A table to keep the switches from the project file
+ 
+    package Switches is new Table.Table (
+      Table_Component_Type => String_Access,
+      Table_Index_Type     => Integer,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 20,
+      Table_Increment      => 100,
+      Table_Name           => "Gnatmain.Switches");
+ 
+    procedure Add_Switch (Argv : String; And_Save : Boolean);
+    --  Add a switch in one of the tables above
+ 
+    procedure Display (Program : String; Args : Argument_List);
+    --  Displays Program followed by the arguments in Args
+ 
+    function Index (Char : Character; Str : String) return Natural;
+    --  Returns the first occurence of Char in Str.
+    --  Returns 0 if Char is not in Str.
+ 
+    procedure Scan_Arg (Argv : String; And_Save : Boolean);
+    --  Scan and process arguments. Argv is a single argument.
+ 
+    procedure Usage;
+    --  Output usage
+ 
+    ----------------
+    -- Add_Switch --
+    ----------------
+ 
+    procedure Add_Switch (Argv : String; And_Save : Boolean) is
+    begin
+       if And_Save then
+          Saved_Switches.Increment_Last;
+          Saved_Switches.Table (Saved_Switches.Last) := new String'(Argv);
+ 
+       else
+          Switches.Increment_Last;
+          Switches.Table (Switches.Last) := new String'(Argv);
+       end if;
+    end Add_Switch;
+ 
+    -------------
+    -- Display --
+    -------------
+ 
+    procedure Display (Program : String; Args : Argument_List) is
+    begin
+       if not Opt.Quiet_Output then
+          Write_Str (Program);
+ 
+          for J in Args'Range loop
+             Write_Str (" ");
+             Write_Str (Args (J).all);
+          end loop;
+ 
+          Write_Eol;
+       end if;
+    end Display;
+ 
+    -----------
+    -- Index --
+    -----------
+ 
+    function Index (Char : Character; Str : String) return Natural is
+    begin
+       for Index in Str'Range loop
+          if Str (Index) = Char then
+             return Index;
+          end if;
+       end loop;
+ 
+       return 0;
+    end Index;
+ 
+    --------------
+    -- Scan_Arg --
+    --------------
+ 
+    procedure Scan_Arg (Argv : String; And_Save : Boolean) is
+    begin
+       pragma Assert (Argv'First = 1);
+ 
+       if Argv'Length = 0 then
+          return;
+       end if;
+ 
+       if Argv (1) = Switch_Character or else Argv (1) = '-' then
+ 
+          if Argv'Length = 1 then
+             Fail ("switch character cannot be followed by a blank");
+          end if;
+ 
+          --  The two style project files (-p and -P) cannot be used together
+ 
+          if (Tool = Find or else Tool = Xref)
+            and then Argv (2) = 'p'
+          then
+             Old_Project_File_Used := True;
+             if Project_File /= null then
+                Fail ("-P and -p cannot be used together");
+             end if;
+          end if;
+ 
+          --  -q Be quiet: do not output tool command
+ 
+          if Argv (2 .. Argv'Last) = "q" then
+             Opt.Quiet_Output := True;
+ 
+             --  Only gnatstub and gnatmake have a -q switch
+ 
+             if Tool = Stub or else Tool_Names (Tool) = Gnatmake then
+                Add_Switch (Argv, And_Save);
+             end if;
+ 
+          --  gnatmake will take care of the project file related switches
+ 
+          elsif Tool_Names (Tool) = Gnatmake then
+             Add_Switch (Argv, And_Save);
+ 
+          --  -vPx  Specify verbosity while parsing project files
+ 
+          elsif Argv'Length = 4 and then Argv (2 .. 3) = "vP" then
+             case Argv (4) is
+                when '0' =>
+                   Current_Verbosity := Prj.Default;
+                when '1' =>
+                   Current_Verbosity := Prj.Medium;
+                when '2' =>
+                   Current_Verbosity := Prj.High;
+                when others =>
+                   null;
+             end case;
+ 
+          --  -Pproject_file  Specify project file to be used
+ 
+          elsif Argv'Length >= 3 and then Argv (2) = 'P' then
+ 
+             --  Only one -P switch can be used
+ 
+             if Project_File /= null then
+                Fail (Argv & ": second project file forbidden (first is """ &
+                      Project_File.all & """)");
+ 
+             --  The two style project files (-p and -P) cannot be used together
+ 
+             elsif Old_Project_File_Used then
+                Fail ("-p and -P cannot be used together");
+ 
+             else
+                Project_File := new String'(Argv (3 .. Argv'Last));
+             end if;
+ 
+          --  -Xexternal=value Specify an external reference to be used
+          --                   in project files
+ 
+          elsif Argv'Length >= 5 and then Argv (2) = 'X' then
+             declare
+                Equal_Pos : constant Natural :=
+                  Index ('=', Argv (3 .. Argv'Last));
+             begin
+                if Equal_Pos >= 4 and then
+                   Equal_Pos /= Argv'Last then
+                   Add (External_Name => Argv (3 .. Equal_Pos - 1),
+                        Value => Argv (Equal_Pos + 1 .. Argv'Last));
+                else
+                   Fail (Argv & " is not a valid external assignment.");
+                end if;
+             end;
+ 
+          else
+             Add_Switch (Argv, And_Save);
+          end if;
+ 
+       else
+          Add_Switch (Argv, And_Save);
+       end if;
+ 
+    end Scan_Arg;
+ 
+    -----------
+    -- Usage --
+    -----------
+ 
+    procedure Usage is
+    begin
+       Write_Str ("Usage: ");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  list  switches [list of object files]");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  xref  switches file1 file2 ...");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  find  switches pattern[:sourcefile[:line[:column]]] " &
+                  "[file1 file2 ...]");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  stub  switches filename [directory]");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  comp  switches files");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  make  switches [files]");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  bind  switches files");
+       Write_Eol;
+ 
+       Osint.Write_Program_Name;
+       Write_Str ("  link  switches files");
+       Write_Eol;
+ 
+       Write_Eol;
+ 
+       Write_Str ("switches interpreted by ");
+       Osint.Write_Program_Name;
+       Write_Str (" for List Xref and Find:");
+       Write_Eol;
+ 
+       Write_Str ("  -q       Be quiet: do not output tool command");
+       Write_Eol;
+ 
+       Write_Str ("  -Pproj   Use GNAT Project File proj");
+       Write_Eol;
+ 
+       Write_Str ("  -vPx     Specify verbosity when parsing " &
+                  "GNAT Project Files");
+       Write_Eol;
+ 
+       Write_Str ("  -Xnm=val Specify an external reference for " &
+                  "GNAT Project Files");
+       Write_Eol;
+ 
+       Write_Eol;
+ 
+       Write_Str ("all other arguments are transmited to the tool");
+       Write_Eol;
+ 
+       Write_Eol;
+ 
+    end Usage;
+ 
+ begin
+ 
+    Osint.Initialize (Binder);
+ 
+    Namet.Initialize;
+    Csets.Initialize;
+ 
+    Snames.Initialize;
+ 
+    Prj.Initialize;
+ 
+    if Arg_Count = 1 then
+       Usage;
+       return;
+    end if;
+ 
+    --  Get the name of the tool
+ 
+    declare
+       Tool_Name : String (1 .. Len_Arg (1));
+ 
+    begin
+       Fill_Arg (Tool_Name'Address, 1);
+       GNAT.Case_Util.To_Lower (Tool_Name);
+ 
+       if Tool_Name = "list" then
+          Tool := List;
+ 
+       elsif Tool_Name = "xref" then
+          Tool := Xref;
+ 
+       elsif Tool_Name = "find" then
+          Tool := Find;
+ 
+       elsif Tool_Name = "stub" then
+          Tool := Stub;
+ 
+       elsif Tool_Name = "comp" then
+          Tool := Comp;
+ 
+       elsif Tool_Name = "make" then
+          Tool := Make;
+ 
+       elsif Tool_Name = "bind" then
+          Tool := Bind;
+ 
+       elsif Tool_Name = "link" then
+          Tool := Link;
+ 
+       else
+          Fail ("first argument needs to be ""list"", ""xref"", ""find""" &
+                ", ""stub"", ""comp"", ""make"", ""bind"" or ""link""");
+       end if;
+    end;
+ 
+    Next_Arg := 2;
+ 
+    --  Get the command line switches that follow the name of the tool
+ 
+    Scan_Args : while Next_Arg < Arg_Count loop
+       declare
+          Next_Argv : String (1 .. Len_Arg (Next_Arg));
+ 
+       begin
+          Fill_Arg (Next_Argv'Address, Next_Arg);
+          Scan_Arg (Next_Argv, And_Save => True);
+       end;
+ 
+       Next_Arg := Next_Arg + 1;
+    end loop Scan_Args;
+ 
+    --  If a switch -P was specified, parse the project file.
+    --  Project_File is always null if we are going to invoke gnatmake,
+    --  that is when Tool is Comp, Make, Bind or Link.
+ 
+    if Project_File /= null then
+ 
+       Prj.Pars.Set_Verbosity (To => Current_Verbosity);
+ 
+       Prj.Pars.Parse
+         (Project           => Project,
+          Project_File_Name => Project_File.all);
+ 
+       if Project = Prj.No_Project then
+          Fail ("""" & Project_File.all & """ processing failed");
+       end if;
+ 
+       --  Check if a package with the name of the tool is in the project file
+       --  and if there is one, get the switches, if any, and scan them.
+ 
+       declare
+          Data       : Prj.Project_Data := Prj.Projects.Table (Project);
+          Pkg        : Prj.Package_Id :=
+                         Prj.Util.Value_Of
+                           (Name        => Tool_Package_Names (Tool),
+                            In_Packages => Data.Decl.Packages);
+          Element    : Package_Element;
+          Default_Switches_Array : Array_Element_Id;
+          Switches   : Prj.Variable_Value;
+          Current    : Prj.String_List_Id;
+          The_String : String_Element;
+ 
+       begin
+          if Pkg /= No_Package then
+             Element := Packages.Table (Pkg);
+ 
+             --  Packages Gnatls and Gnatstub have a single attribute Switches,
+             --  that is not an associative array.
+ 
+             if Tool = List or else Tool = Stub then
+                Switches :=
+                  Prj.Util.Value_Of
+                    (Variable_Name => Name_Switches,
+                     In_Variables => Element.Decl.Attributes);
+ 
+                --  Packages Cross_Reference (for gnatxref) and Finder
+                --  (for gnatfind) have an attributed Default_Switches,
+                --  an associative array, indexed by the name of the
+                --  programming language.
+             else
+                Default_Switches_Array :=
+                  Prj.Util.Value_Of
+                    (Name => Name_Default_Switches,
+                     In_Arrays => Packages.Table (Pkg).Decl.Arrays);
+                Switches := Prj.Util.Value_Of
+                  (Index => Name_Ada,
+                   In_Array => Default_Switches_Array);
+ 
+             end if;
+ 
+             --  If there are switches specified in the package of the
+             --  project file corresponding to the tool, scan them.
+ 
+             case Switches.Kind is
+                when Prj.Undefined =>
+                   null;
+ 
+                when Prj.Single =>
+                   if String_Length (Switches.Value) > 0 then
+                      String_To_Name_Buffer (Switches.Value);
+                      Scan_Arg
+                        (Name_Buffer (1 .. Name_Len),
+                         And_Save => False);
+                   end if;
+ 
+                when Prj.List =>
+                   Current := Switches.Values;
+                   while Current /= Prj.Nil_String loop
+                      The_String := String_Elements.Table (Current);
+ 
+                      if String_Length (The_String.Value) > 0 then
+                         String_To_Name_Buffer (The_String.Value);
+                         Scan_Arg
+                           (Name_Buffer (1 .. Name_Len),
+                            And_Save => False);
+                      end if;
+ 
+                      Current := The_String.Next;
+                   end loop;
+             end case;
+          end if;
+       end;
+ 
+       --  Set up the environment variables ADA_INCLUDE_PATH and
+       --  ADA_OBJECTS_PATH.
+ 
+       Setenv
+         (Name  => Ada_Include_Path,
+          Value => Prj.Env.Ada_Include_Path (Project).all);
+       Setenv
+         (Name  => Ada_Objects_Path,
+          Value => Prj.Env.Ada_Objects_Path
+                        (Project, Including_Libraries => False).all);
+ 
+    end if;
+ 
+    --  Gather all the arguments, those from the project file first,
+    --  locate the tool and call it with the arguments.
+ 
+    declare
+       Args    : Argument_List (1 .. Switches.Last + Saved_Switches.Last + 4);
+       Arg_Num : Natural := 0;
+       Tool_Path : String_Access;
+       Success : Boolean;
+ 
+       procedure Add (Arg : String_Access);
+ 
+       procedure Add (Arg : String_Access) is
+       begin
+          Arg_Num := Arg_Num + 1;
+          Args (Arg_Num) := Arg;
+       end Add;
+ 
+    begin
+ 
+       case Tool is
+          when Comp =>
+             Add (new String'("-u"));
+             Add (new String'("-f"));
+ 
+          when Bind =>
+             Add (new String'("-b"));
+ 
+          when Link =>
+             Add (new String'("-l"));
+ 
+          when others =>
+             null;
+ 
+       end case;
+ 
+       for Index in 1 .. Switches.Last loop
+          Arg_Num := Arg_Num + 1;
+          Args (Arg_Num) := Switches.Table (Index);
+       end loop;
+ 
+       for Index in 1 .. Saved_Switches.Last loop
+          Arg_Num := Arg_Num + 1;
+          Args (Arg_Num) := Saved_Switches.Table (Index);
+       end loop;
+ 
+       Tool_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Tool_Names (Tool).all);
+ 
+       if Tool_Path = null then
+          Fail ("error, unable to locate " & Tool_Names (Tool).all);
+       end if;
+ 
+       Display (Tool_Names (Tool).all, Args (1 .. Arg_Num));
+ 
+       GNAT.OS_Lib.Spawn (Tool_Path.all, Args (1 .. Arg_Num), Success);
+ 
+    end;
+ 
+ end Gnatmain;

*** /dev/null	Tue Dec 11 17:47:58 2001
--- gnatmain.ads	Tue Dec 11 18:05:11 2001
***************
*** 0 ****
--- 1,38 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         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;

*** prj-attr.adb	2001/10/05 15:58:44	1.6
--- prj-attr.adb	2001/10/31 02:15:09	1.7
***************
*** 121,126 ****
--- 121,131 ----
       "Ladefault_switches#" &
       "LAswitches#" &
  
+    --  package Gnatstub
+ 
+      "Pgnatstub#" &
+      "LVswitches#" &
+ 
       "#";
  
     ----------------

*** snames.adb	2001/10/20 04:14:32	1.208
--- snames.adb	2001/10/31 02:15:11	1.209
***************
*** 595,600 ****
--- 595,601 ----
       "binder#" &
       "linker#" &
       "compiler#" &
+      "gnatstub#" &
        "#";
  
     ---------------------

*** snames.ads	2001/10/20 10:51:36	1.213
--- snames.ads	2001/10/31 02:15:15	1.214
***************
*** 894,903 ****
     Name_Binder                         : constant Name_Id := N + 549;
     Name_Linker                         : constant Name_Id := N + 550;
     Name_Compiler                       : constant Name_Id := N + 551;
  
     --  Mark last defined name for consistency check in Snames body
  
!    Last_Predefined_Name                : constant Name_Id := N + 551;
  
     subtype Any_Operator_Name is Name_Id range
       First_Operator_Name .. Last_Operator_Name;
--- 894,904 ----
     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 + 552;
  
     subtype Any_Operator_Name is Name_Id range
       First_Operator_Name .. Last_Operator_Name;

*** prj-attr.adb	2001/10/31 02:15:09	1.7
--- prj-attr.adb	2001/10/31 05:07:57	1.8
***************
*** 49,55 ****
  
     --  End is indicated by two consecutive '#'.
  
!    Initialisation_Data : constant String :=
  
     --  project attributes
  
--- 49,55 ----
  
     --  End is indicated by two consecutive '#'.
  
!    Initialization_Data : constant String :=
  
     --  project attributes
  
***************
*** 133,139 ****
     ----------------
  
     procedure Initialize is
!       Start             : Positive           := Initialisation_Data'First;
        Finish            : Positive           := Start;
        Current_Package   : Package_Node_Id    := Empty_Package;
        Current_Attribute : Attribute_Node_Id  := Empty_Attribute;
--- 133,139 ----
     ----------------
  
     procedure Initialize is
!       Start             : Positive           := Initialization_Data'First;
        Finish            : Positive           := Start;
        Current_Package   : Package_Node_Id    := Empty_Package;
        Current_Attribute : Attribute_Node_Id  := Empty_Attribute;
***************
*** 150,158 ****
        Attributes.Set_Last (Attributes.First);
        Package_Attributes.Set_Last (Package_Attributes.First);
  
!       while Initialisation_Data (Start) /= '#' loop
           Is_An_Attribute := True;
!          case Initialisation_Data (Start) is
              when 'P' =>
  
                 --  New allowed package
--- 150,158 ----
        Attributes.Set_Last (Attributes.First);
        Package_Attributes.Set_Last (Package_Attributes.First);
  
!       while Initialization_Data (Start) /= '#' loop
           Is_An_Attribute := True;
!          case Initialization_Data (Start) is
              when 'P' =>
  
                 --  New allowed package
***************
*** 160,178 ****
                 Start := Start + 1;
  
                 Finish := Start;
!                while Initialisation_Data (Finish) /= '#' loop
                    Finish := Finish + 1;
                 end loop;
  
                 Name_Len := Finish - Start;
                 Name_Buffer (1 .. Name_Len) :=
!                  To_Lower (Initialisation_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) &
                                   """ in Prj.Attr body.");
                       raise Program_Error;
                    end if;
--- 160,178 ----
                 Start := Start + 1;
  
                 Finish := Start;
!                while Initialization_Data (Finish) /= '#' loop
                    Finish := Finish + 1;
                 end loop;
  
                 Name_Len := Finish - Start;
                 Name_Buffer (1 .. Name_Len) :=
!                  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 """ &
!                                  Initialization_Data (Start .. Finish - 1) &
                                   """ in Prj.Attr body.");
                       raise Program_Error;
                    end if;
***************
*** 201,207 ****
              --  New attribute
  
              Start := Start + 1;
!             case Initialisation_Data (Start) is
                 when 'V' =>
                    Kind_2 := Single;
                 when 'A' =>
--- 201,207 ----
              --  New attribute
  
              Start := Start + 1;
!             case Initialization_Data (Start) is
                 when 'V' =>
                    Kind_2 := Single;
                 when 'A' =>
***************
*** 215,227 ****
              Start := Start + 1;
              Finish := Start;
  
!             while Initialisation_Data (Finish) /= '#' loop
                 Finish := Finish + 1;
              end loop;
  
              Name_Len := Finish - Start;
              Name_Buffer (1 .. Name_Len) :=
!               To_Lower (Initialisation_Data (Start .. Finish - 1));
              Attribute_Name := Name_Find;
              Attributes.Increment_Last;
              if Current_Attribute = Empty_Attribute then
--- 215,227 ----
              Start := Start + 1;
              Finish := Start;
  
!             while Initialization_Data (Finish) /= '#' loop
                 Finish := Finish + 1;
              end loop;
  
              Name_Len := Finish - Start;
              Name_Buffer (1 .. Name_Len) :=
!               To_Lower (Initialization_Data (Start .. Finish - 1));
              Attribute_Name := Name_Find;
              Attributes.Increment_Last;
              if Current_Attribute = Empty_Attribute then
***************
*** 239,245 ****
                    if Attribute_Name =
                      Attributes.Table (Index).Name then
                       Write_Line ("Duplicate attribute name """ &
!                                  Initialisation_Data (Start .. Finish - 1) &
                                   """ in Prj.Attr body.");
                       raise Program_Error;
                    end if;
--- 239,245 ----
                    if Attribute_Name =
                      Attributes.Table (Index).Name then
                       Write_Line ("Duplicate attribute name """ &
!                                  Initialization_Data (Start .. Finish - 1) &
                                   """ in Prj.Attr body.");
                       raise Program_Error;
                    end if;

*** g-regpat.adb	2001/09/05 17:59:33	1.31
--- g-regpat.adb	2001/10/31 09:44:18	1.32
***************
*** 1563,1568 ****
--- 1563,1569 ----
           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,1590 ****
--- 1586,1592 ----
                 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,1604 ****
                 when '?' | '+' | '*' | '{' =>
  
                    if Start_Pos = 0 then
                       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);
                    else
                       --  We've got something like "abc?d".  Mark this as a
                       --  special case. What we want to emit is a first
--- 1595,1608 ----
                 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
!                      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,1616 ****
                       --  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;
                       exit Parse_Loop;
                    end if;
  
                 when '\' =>
                    if Parse_Pos = Parse_End then
                       Fail ("Trailing \");
                    else
--- 1610,1621 ----
                       --  ultimately be transformed with a CURLY operator, A
                       --  special case has to be handled for "a?", since there
                       --  is no initial string to emit.
!                      Has_Special_Operator := True;
                       exit Parse_Loop;
                    end if;
  
                 when '\' =>
+                   Start_Pos := Parse_Pos;
                    if Parse_Pos = Parse_End then
                       Fail ("Trailing \");
                    else
***************
*** 1629,1640 ****
                       Parse_Pos := Parse_Pos + 1;
                    end if;
  
!                when others => 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;
--- 1634,1646 ----
                       Parse_Pos := Parse_Pos + 1;
                    end if;
  
!                when others =>
!                   Start_Pos := Parse_Pos;
!                   Case_Emit (C);
              end case;
  
              exit Parse_Loop when Emit_Ptr - Length_Ptr = 254;
  
              Parse_Pos := Parse_Pos + 1;
  
              exit Parse_Loop when Parse_Pos > Parse_End;
***************
*** 1643,1653 ****
           --  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
             and then Emit_Ptr >= Length_Ptr + 3
           then
              Emit_Ptr := Emit_Ptr - 1;
!             Parse_Pos := Parse_Pos - 1;
           end if;
  
           if Emit_Code then
--- 1649,1659 ----
           --  Is the string followed by a '*+?{' operator ? If yes, and if there
           --  is an initial string to emit, do it now.
  
!          if Has_Special_Operator
             and then Emit_Ptr >= Length_Ptr + 3
           then
              Emit_Ptr := Emit_Ptr - 1;
!             Parse_Pos := Start_Pos;
           end if;
  
           if Emit_Code then

*** g-os_lib.ads	2001/08/27 09:48:39	1.79
--- g-os_lib.ads	2001/10/31 17:24:29	1.80
***************
*** 60,65 ****
--- 60,69 ----
     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;
+ 
     ---------------------
     -- Time/Date Stuff --
     ---------------------
***************
*** 381,392 ****
     -- Subprocesses --
     ------------------
  
!    type Argument_List is array (Positive range <>) of String_Access;
     --  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;
     --  Type used to return an Argument_List without dragging in secondary
     --  stack.
  
--- 385,396 ----
     -- Subprocesses --
     ------------------
  
!    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.
  
!    subtype Argument_List_Access is String_List_Access;
     --  Type used to return an Argument_List without dragging in secondary
     --  stack.
  

*** g-os_lib.ads	2001/10/31 17:24:29	1.80
--- g-os_lib.ads	2001/10/31 17:33:38	1.81
***************
*** 8,14 ****
  --                                                                          --
  --                            $Revision$
  --                                                                          --
! --           Copyright (C) 1995-2001 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- --
--- 8,14 ----
  --                                                                          --
  --                            $Revision$
  --                                                                          --
! --          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,68 ****
  pragma Elaborate_Body (OS_Lib);
  
     type String_Access is access all String;
  
     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;
  
     ---------------------
     -- Time/Date Stuff --
--- 56,69 ----
  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 --

*** g-dirope.adb	2001/10/29 19:20:03	1.19
--- g-dirope.adb	2001/10/31 21:36:04	1.20
***************
*** 253,260 ****
              Double_Result_Size;
           end loop;
  
!          Result (Result_Last + 1 .. Result_Last + S'Length - 1) := S;
!          Result_Last := Result_Last + S'Length - 1;
        end Append;
  
        ------------------------
--- 253,260 ----
              Double_Result_Size;
           end loop;
  
!          Result (Result_Last + 1 .. Result_Last + S'Length) := S;
!          Result_Last := Result_Last + S'Length;
        end Append;
  
        ------------------------


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]