------------------------------------------------------------------------------ -- GNAT SYSTEM UTILITIES -- -- -- -- C R E A T E _ A D A _ R U N T I M E _ P R O J E C T -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-2012, Free Software Foundation, Inc. -- -- -- -- This 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 3, or (at your option) any later ver- -- -- sion. This software is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY 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 this software; see file -- -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- -- of the license. -- ------------------------------------------------------------------------------ -- This utility creates the Ada runtime project file ada_runtime.gpr -- This project file resides in the parent directory of adainclude (the source -- directory) and adalib (the object directory). It is "externally built". Its -- package Naming gives the mapping of the source file names to unit names. with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.HTable; use GNAT.HTable; procedure Create_Ada_Runtime_Project is Err : exception; -- Raised to terminate execution Project_File : Ada.Text_IO.File_Type; -- The project file being created Adainclude : String_Access := new String'("adainclude"); -- The path name of the adainclude directory, given as argument of the -- utility. Dir : Dir_Type; Str : String (1 .. 1_000); Last : Natural; Gcc : constant String := "gcc"; Gcc_Path : String_Access; Args : Argument_List (1 .. 6) := (1 => new String'("-c"), 2 => new String'("-gnats"), 3 => new String'("-gnatu"), 4 => new String'("-x"), 5 => new String'("ada"), 6 => null); -- The arguments used when invoking the Ada compiler to get the name and -- kind (spec or body) of the unit contained in a source file. Success : Boolean; Return_Code : Integer; Mapping_File_Name : String_Access := new String'("gnat_runtime.mapping"); -- Location of the default mapping file. Output_File : String_Access := new String'("ada_runtime.gpr"); -- Name of the final project file being created Output_File_Name : constant String := "output.txt"; Output : Ada.Text_IO.File_Type; -- The text file where the output of the compiler invocation is stored. -- This is temporary output from gcc Line : String (1 .. 1_000); Line_Last : Natural; Spec : Boolean; Verbose_Mode : Boolean := False; -- True if switch -v is used subtype Header_Num is Natural range 0 .. 4095; function Hash (Key : String_Access) return Header_Num; function Equal (K1, K2 : String_Access) return Boolean; type Element is record Spec : Boolean := False; Unit : String_Access := null; end record; No_Element : constant Element := (False, null); package Mapping is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, Element => Element, No_Element => No_Element, Key => String_Access, Hash => Hash, Equal => Equal); -- A hash table to keep the mapping of source file names to unit names -- found in file gnat_runtime.mapping. Key : String_Access; Elem : Element; function Hash is new GNAT.HTable.Hash (Header_Num); procedure Get_Mapping (Mapping_File : String); -- Read file mapping file to get the mapping of source file names -- to unit names and populate hash table Mapping. -- If the file doesn't exist, nothing is done, but -- Create_Ada_Runtime_Project will execute more slowly procedure Fail (S : String); -- Outputs S to Standard_Error, followed by a newline and then raises the -- exception Err. procedure Help; -- Display help on using this application ----------- -- Equal -- ----------- function Equal (K1, K2 : String_Access) return Boolean is begin if K1 = null or else K2 = null then return K1 = K2; else return K1.all = K2.all; end if; end Equal; ---------- -- Fail -- ---------- procedure Fail (S : String) is begin Put_Line (Standard_Error, S); raise Err; end Fail; ----------------- -- Get_Mapping -- ----------------- procedure Get_Mapping (Mapping_File : String) is File : File_Type; Line : String (1 .. 1_000); Last : Natural; begin Open (File, In_File, Mapping_File); while not End_Of_File (File) loop Get_Line (File, Line, Last); -- Skip the line if it is a comment line if Last > 2 and then Line (1 .. 2) /= "--" then Key := new String'(Line (1 .. Last)); Get_Line (File, Line, Last); Elem.Spec := Line (1 .. Last) = "spec"; Get_Line (File, Line, Last); Elem.Unit := new String'(Line (1 .. Last)); Mapping.Set (Key, Elem); end if; end loop; Close (File); exception when others => if Is_Open (File) then Close (File); end if; if Verbose_Mode then Put_Line (Standard_Error, "Could not read " & Mapping_File); end if; end Get_Mapping; ---------- -- Hash -- ---------- function Hash (Key : String_Access) return Header_Num is begin if Key = null then return 0; else return Hash (Key.all); end if; end Hash; ---------- -- Help -- ---------- procedure Help is begin Put_Line (" -adainclude