aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/mlib.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2017-09-06 15:21:31 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2017-09-06 15:21:31 +0200
commitc48e0f27232aa6604b80e0d15b6ecb50604400a7 (patch)
treebfddb1ebb7a5ebb47669f302259856ea4f5a805a /gcc/ada/mlib.adb
parenta87169db7dc0667a978e3f5b63e0fca648d3b793 (diff)
downloadgcc-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.adb464
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;