diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-09-06 15:21:31 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-09-06 15:21:31 +0200 |
commit | c48e0f27232aa6604b80e0d15b6ecb50604400a7 (patch) | |
tree | bfddb1ebb7a5ebb47669f302259856ea4f5a805a /gcc/ada/mlib.adb | |
parent | a87169db7dc0667a978e3f5b63e0fca648d3b793 (diff) | |
download | gcc-c48e0f27232aa6604b80e0d15b6ecb50604400a7.zip gcc-c48e0f27232aa6604b80e0d15b6ecb50604400a7.tar.gz gcc-c48e0f27232aa6604b80e0d15b6ecb50604400a7.tar.bz2 |
[multiple changes]
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, sem_aux.adb, sem_res.adb: Minor reformatting.
2017-09-06 Yannick Moy <moy@adacore.com>
* sem_ch12.adb (Analyze_Instance_And_Renamings): Refactor to set
global variable Ignore_SPARK_Mode_Pragmas_In_Instance only once.
2017-09-06 Bob Duff <duff@adacore.com>
* sem_ch8.adb: Change Assert to be consistent with
other similar ones.
2017-09-06 Bob Duff <duff@adacore.com>
* binde.adb (Find_Elab_Order): Do not run Elab_Old unless
requested. Previously, the -do switch meant "run Elab_New and
Elab_Old and use the order chosen by Elab_Old, possibly with
debugging printouts comparing the two orders." Now it means
"do not run Elab_New." This is of use if there are bugs that
cause Elab_New to crash.
(Elab_Position, Num_Chosen): Change type to Nat, to avoid various
type conversions.
* ali.ads (Elab_Position): Change type to Nat, to avoid various
type conversions.
2017-09-06 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Check_Mode_Restriction_In_Enclosing_Context): Fix
reference to SPARK RM.
2017-09-06 Eric Botcazou <ebotcazou@adacore.com>
* layout.adb: Use SSU short hand consistently throughout the file.
2017-09-06 Eric Botcazou <ebotcazou@adacore.com>
* freeze.adb (Freeze_Record_Type)
<Sized_Component_Total_Round_RM_Size>: New local variable to
accumulate the rounded RM_Size of components. Update it for
every component whose RM_Size is statically known. Add missing
guard to check that bit packing is really required before issuing
the error about packing. Swap condition for clarity's sake.
* sem_prag.adb (Usage_Error): fix reference to
SPARK RM in comment
2017-09-06 Fedor Rybin <frybin@adacore.com>
* makeutl.adb, makeutl.ads, mlib.adb, mlib.ads, mlib-fil.adb,
mlib-fil.ads, mlib-prj.adb, mlib-prj.ads, mlib-tgt.adb, mlib-tgt.ads,
mlib-tgt-specific.adb, mlib-tgt-specific.ads,
mlib-tgt-specific-aix.adb, mlib-tgt-specific-darwin.adb,
mlib-tgt-specific-hpux.adb, mlib-tgt-specific-linux.adb,
mlib-tgt-specific-mingw.adb, mlib-tgt-specific-solaris.adb,
mlib-tgt-specific-vxworks.adb, mlib-tgt-specific-xi.adb, mlib-utl.adb,
mlib-utl.ads, prj.adb, prj.ads, prj-attr.adb, prj-attr.ads,
prj-attr-pm.adb, prj-attr-pm.ads, prj-com.ads, prj-conf.adb,
prj-conf.ads, prj-dect.adb, prj-dect.ads, prj-env.adb, prj-env.ads,
prj-err.adb, prj-err.ads, prj-ext.adb, prj-ext.ads, prj-makr.adb,
prj-makr.ads, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb, prj-pars.ads,
prj-part.adb, prj-part.ads, prj-pp.adb, prj-pp.ads, prj-proc.adb,
prj-proc.ads, prj-strt.adb, prj-strt.ads, prj-tree.adb, prj-tree.ads,
prj-util.adb, prj-util.ads, sinput-p.adb, sinput-p.ads: Remove obsolete
project manager sources.
2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Assigment): If the left-hand side is an
entity of a mutable type and the right-hand side is a conditional
expression, resolve the alternatives of the conditional using
the base type of the target entity, because the alternatives
may have distinct subtypes. This is particularly relevant if
the alternatives are aggregates.
From-SVN: r251797
Diffstat (limited to 'gcc/ada/mlib.adb')
-rw-r--r-- | gcc/ada/mlib.adb | 464 |
1 files changed, 0 insertions, 464 deletions
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb deleted file mode 100644 index c4faea0..0000000 --- a/gcc/ada/mlib.adb +++ /dev/null @@ -1,464 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M L I B -- --- -- --- B o d y -- --- -- --- Copyright (C) 1999-2014, 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- -- --- ware Foundation; either version 3, 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Interfaces.C.Strings; -with System; - -with Opt; -with Output; use Output; - -with MLib.Utl; use MLib.Utl; - -with Prj.Com; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; - -package body MLib is - - ------------------- - -- Build_Library -- - ------------------- - - procedure Build_Library - (Ofiles : Argument_List; - Output_File : String; - Output_Dir : String) - is - begin - if Opt.Verbose_Mode and not Opt.Quiet_Output then - Write_Line ("building a library..."); - Write_Str (" make "); - Write_Line (Output_File); - end if; - - Ar (Output_Dir & - "lib" & Output_File & ".a", Objects => Ofiles); - end Build_Library; - - ------------------------ - -- Check_Library_Name -- - ------------------------ - - procedure Check_Library_Name (Name : String) is - begin - if Name'Length = 0 then - Prj.Com.Fail ("library name cannot be empty"); - end if; - - if Name'Length > Max_Characters_In_Library_Name then - Prj.Com.Fail ("illegal library name """ - & Name - & """: too long"); - end if; - - if not Is_Letter (Name (Name'First)) then - Prj.Com.Fail ("illegal library name """ - & Name - & """: should start with a letter"); - end if; - - for Index in Name'Range loop - if not Is_Alphanumeric (Name (Index)) then - Prj.Com.Fail ("illegal library name """ - & Name - & """: should include only letters and digits"); - end if; - end loop; - end Check_Library_Name; - - -------------------- - -- Copy_ALI_Files -- - -------------------- - - procedure Copy_ALI_Files - (Files : Argument_List; - To : Path_Name_Type; - Interfaces : String_List) - is - Success : Boolean := False; - To_Dir : constant String := Get_Name_String (To); - Is_Interface : Boolean := False; - - procedure Verbose_Copy (Index : Positive); - -- In verbose mode, output a message that the indexed file is copied - -- to the destination directory. - - ------------------ - -- Verbose_Copy -- - ------------------ - - procedure Verbose_Copy (Index : Positive) is - begin - if Opt.Verbose_Mode then - Write_Str ("Copying """); - Write_Str (Files (Index).all); - Write_Str (""" to """); - Write_Str (To_Dir); - Write_Line (""""); - end if; - end Verbose_Copy; - - -- Start of processing for Copy_ALI_Files - - begin - if Interfaces'Length = 0 then - - -- If there are no Interfaces, copy all the ALI files as is - - for Index in Files'Range loop - Verbose_Copy (Index); - Set_Writable - (To_Dir & - Directory_Separator & - Base_Name (Files (Index).all)); - Copy_File - (Files (Index).all, - To_Dir, - Success, - Mode => Overwrite, - Preserve => Preserve); - - exit when not Success; - end loop; - - else - -- Copy only the interface ALI file, and put the special indicator - -- "SL" on the P line. - - for Index in Files'Range loop - - declare - File_Name : String := Base_Name (Files (Index).all); - - begin - Canonical_Case_File_Name (File_Name); - - -- Check if this is one of the interface ALIs - - Is_Interface := False; - - for Index in Interfaces'Range loop - if File_Name = Interfaces (Index).all then - Is_Interface := True; - exit; - end if; - end loop; - - -- If it is an interface ALI, copy line by line. Insert - -- the interface indication at the end of the P line. - -- Do not copy ALI files that are not Interfaces. - - if Is_Interface then - Success := False; - Verbose_Copy (Index); - Set_Writable - (To_Dir & - Directory_Separator & - Base_Name (Files (Index).all)); - - declare - FD : File_Descriptor; - Len : Integer; - Actual_Len : Integer; - S : String_Access; - Curr : Natural; - P_Line_Found : Boolean; - Status : Boolean; - - begin - -- Open the file - - Name_Len := Files (Index)'Length; - Name_Buffer (1 .. Name_Len) := Files (Index).all; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ASCII.NUL; - - FD := Open_Read (Name_Buffer'Address, Binary); - - if FD /= Invalid_FD then - Len := Integer (File_Length (FD)); - - -- ??? Why "+3" here - - S := new String (1 .. Len + 3); - - -- Read the file. This loop is probably not necessary - -- since on most (all?) targets, the whole file is - -- read in at once, but we have encountered systems - -- in the past where this was not true, and we retain - -- this loop in case we encounter that in the future. - - Curr := S'First; - while Curr <= Len loop - Actual_Len := Read (FD, S (Curr)'Address, Len); - - -- Exit if we could not read for some reason - - exit when Actual_Len = 0; - - Curr := Curr + Actual_Len; - end loop; - - -- We are done with the input file, so we close it - -- ignoring any bad status. - - Close (FD, Status); - - P_Line_Found := False; - - -- Look for the P line. When found, add marker SL - -- at the beginning of the P line. - - for Index in 1 .. Len - 3 loop - if (S (Index) = ASCII.LF - or else - S (Index) = ASCII.CR) - and then S (Index + 1) = 'P' - then - S (Index + 5 .. Len + 3) := S (Index + 2 .. Len); - S (Index + 2 .. Index + 4) := " SL"; - P_Line_Found := True; - exit; - end if; - end loop; - - if P_Line_Found then - - -- Create new modified ALI file - - Name_Len := To_Dir'Length; - Name_Buffer (1 .. Name_Len) := To_Dir; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - Name_Buffer - (Name_Len + 1 .. Name_Len + File_Name'Length) := - File_Name; - Name_Len := Name_Len + File_Name'Length + 1; - Name_Buffer (Name_Len) := ASCII.NUL; - - FD := Create_File (Name_Buffer'Address, Binary); - - -- Write the modified text and close the newly - -- created file. - - if FD /= Invalid_FD then - Actual_Len := Write (FD, S (1)'Address, Len + 3); - - Close (FD, Status); - - -- Set Success to True only if the newly - -- created file has been correctly written. - - Success := Status and then Actual_Len = Len + 3; - - if Success then - - -- Set_Read_Only is used here, rather than - -- Set_Non_Writable, so that gprbuild can - -- he compiled with older compilers. - - Set_Read_Only - (Name_Buffer (1 .. Name_Len - 1)); - end if; - end if; - end if; - end if; - end; - - -- This is not an interface ALI - - else - Success := True; - end if; - end; - - if not Success then - Prj.Com.Fail ("could not copy ALI files to library dir"); - end if; - end loop; - end if; - end Copy_ALI_Files; - - ---------------------- - -- Create_Sym_Links -- - ---------------------- - - procedure Create_Sym_Links - (Lib_Path : String; - Lib_Version : String; - Lib_Dir : String; - Maj_Version : String) - is - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - Version_Path : String_Access; - - Success : Boolean; - Result : Integer; - pragma Unreferenced (Success, Result); - - begin - Version_Path := new String (1 .. Lib_Version'Length + 1); - Version_Path (1 .. Lib_Version'Length) := Lib_Version; - Version_Path (Version_Path'Last) := ASCII.NUL; - - if Maj_Version'Length = 0 then - declare - Newpath : String (1 .. Lib_Path'Length + 1); - begin - Newpath (1 .. Lib_Path'Length) := Lib_Path; - Newpath (Newpath'Last) := ASCII.NUL; - Delete_File (Lib_Path, Success); - Result := Symlink (Version_Path (1)'Address, Newpath'Address); - end; - - else - declare - Newpath1 : String (1 .. Lib_Path'Length + 1); - Maj_Path : constant String := - Lib_Dir & Directory_Separator & Maj_Version; - Newpath2 : String (1 .. Maj_Path'Length + 1); - Maj_Ver : String (1 .. Maj_Version'Length + 1); - - begin - Newpath1 (1 .. Lib_Path'Length) := Lib_Path; - Newpath1 (Newpath1'Last) := ASCII.NUL; - - Newpath2 (1 .. Maj_Path'Length) := Maj_Path; - Newpath2 (Newpath2'Last) := ASCII.NUL; - - Maj_Ver (1 .. Maj_Version'Length) := Maj_Version; - Maj_Ver (Maj_Ver'Last) := ASCII.NUL; - - Delete_File (Maj_Path, Success); - - Result := Symlink (Version_Path (1)'Address, Newpath2'Address); - - Delete_File (Lib_Path, Success); - - Result := Symlink (Maj_Ver'Address, Newpath1'Address); - end; - end if; - end Create_Sym_Links; - - -------------------------------- - -- Linker_Library_Path_Option -- - -------------------------------- - - function Linker_Library_Path_Option return String_Access is - - Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); - -- Pointer to string representing the native linker option which - -- specifies the path where the dynamic loader should find shared - -- libraries. Equal to null string if this system doesn't support it. - - S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr); - - begin - if S'Length = 0 then - return null; - else - return new String'(S); - end if; - end Linker_Library_Path_Option; - - ------------------- - -- Major_Id_Name -- - ------------------- - - function Major_Id_Name - (Lib_Filename : String; - Lib_Version : String) - return String - is - Maj_Version : constant String := Lib_Version; - Last_Maj : Positive; - Last : Positive; - Ok_Maj : Boolean := False; - - begin - Last_Maj := Maj_Version'Last; - while Last_Maj > Maj_Version'First loop - if Maj_Version (Last_Maj) in '0' .. '9' then - Last_Maj := Last_Maj - 1; - - else - Ok_Maj := Last_Maj /= Maj_Version'Last and then - Maj_Version (Last_Maj) = '.'; - - if Ok_Maj then - Last_Maj := Last_Maj - 1; - end if; - - exit; - end if; - end loop; - - if Ok_Maj then - Last := Last_Maj; - while Last > Maj_Version'First loop - if Maj_Version (Last) in '0' .. '9' then - Last := Last - 1; - - else - Ok_Maj := Last /= Last_Maj and then - Maj_Version (Last) = '.'; - - if Ok_Maj then - Last := Last - 1; - Ok_Maj := - Maj_Version (Maj_Version'First .. Last) = Lib_Filename; - end if; - - exit; - end if; - end loop; - end if; - - if Ok_Maj then - return Maj_Version (Maj_Version'First .. Last_Maj); - else - return ""; - end if; - end Major_Id_Name; - - ------------------------------- - -- Separate_Run_Path_Options -- - ------------------------------- - - function Separate_Run_Path_Options return Boolean is - Separate_Paths : Boolean; - for Separate_Paths'Size use Character'Size; - pragma Import (C, Separate_Paths, "__gnat_separate_run_path_options"); - begin - return Separate_Paths; - end Separate_Run_Path_Options; - -end MLib; |