binde.adb, [...]: Remove VMS handling.
2014-08-01 Arnaud Charlet <charlet@adacore.com> * binde.adb, bindgen.adb, butil.adb, clean.adb, gnatbind.adb, gnatchop.adb, gnatcmd.adb, gnatls.adb, gnatname.adb, krunch.adb, make.adb, makeutl.adb, memtrack.adb, mlib-prj.adb, mlib.adb, mlib.ads, tempdir.adb: Remove VMS handling. From-SVN: r213413
This commit is contained in:
parent
148c744a17
commit
62883e6b17
|
@ -1,3 +1,10 @@
|
||||||
|
2014-08-01 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
|
* binde.adb, bindgen.adb, butil.adb, clean.adb, gnatbind.adb,
|
||||||
|
gnatchop.adb, gnatcmd.adb, gnatls.adb, gnatname.adb, krunch.adb,
|
||||||
|
make.adb, makeutl.adb, memtrack.adb, mlib-prj.adb, mlib.adb,
|
||||||
|
mlib.ads, tempdir.adb: Remove VMS handling.
|
||||||
|
|
||||||
2014-08-01 Pascal Obry <obry@adacore.com>
|
2014-08-01 Pascal Obry <obry@adacore.com>
|
||||||
|
|
||||||
* adaint.h, adaint.c (__gnat_file_length): Returns an __int64.
|
* adaint.h, adaint.c (__gnat_file_length): Returns an __int64.
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -31,7 +31,6 @@ with Namet; use Namet;
|
||||||
with Opt; use Opt;
|
with Opt; use Opt;
|
||||||
with Osint;
|
with Osint;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
with Targparm; use Targparm;
|
|
||||||
|
|
||||||
with System.Case_Util; use System.Case_Util;
|
with System.Case_Util; use System.Case_Util;
|
||||||
|
|
||||||
|
@ -1089,12 +1088,7 @@ package body Binde is
|
||||||
if Pessimistic_Elab_Order
|
if Pessimistic_Elab_Order
|
||||||
and not Dynamic_Elaboration_Checks_Specified
|
and not Dynamic_Elaboration_Checks_Specified
|
||||||
then
|
then
|
||||||
if OpenVMS_On_Target then
|
Error_Msg ("?use of -p switch questionable");
|
||||||
Error_Msg ("?use of /PESSIMISTIC_ELABORATION questionable");
|
|
||||||
else
|
|
||||||
Error_Msg ("?use of -p switch questionable");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Error_Msg ("?since all units compiled with static elaboration model");
|
Error_Msg ("?since all units compiled with static elaboration model");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -52,10 +52,6 @@ package body Bindgen is
|
||||||
Last : Natural := 0;
|
Last : Natural := 0;
|
||||||
-- Last location in Statement_Buffer currently set
|
-- Last location in Statement_Buffer currently set
|
||||||
|
|
||||||
With_DECGNAT : Boolean := False;
|
|
||||||
-- Flag which indicates whether the program uses the DECGNAT library
|
|
||||||
-- (presence of the unit DEC).
|
|
||||||
|
|
||||||
With_GNARL : Boolean := False;
|
With_GNARL : Boolean := False;
|
||||||
-- Flag which indicates whether the program uses the GNARL library
|
-- Flag which indicates whether the program uses the GNARL library
|
||||||
-- (presence of the unit System.OS_Interface)
|
-- (presence of the unit System.OS_Interface)
|
||||||
|
@ -325,9 +321,7 @@ package body Bindgen is
|
||||||
-- Move routine for sorting linker options
|
-- Move routine for sorting linker options
|
||||||
|
|
||||||
procedure Resolve_Binder_Options;
|
procedure Resolve_Binder_Options;
|
||||||
-- Set the value of With_GNARL and With_DECGNAT. The latter only on VMS
|
-- Set the value of With_GNARL.
|
||||||
-- since it tests for a package named "dec" which might cause a conflict
|
|
||||||
-- on non-VMS systems.
|
|
||||||
|
|
||||||
procedure Set_Char (C : Character);
|
procedure Set_Char (C : Character);
|
||||||
-- Set given character in Statement_Buffer at the Last + 1 position
|
-- Set given character in Statement_Buffer at the Last + 1 position
|
||||||
|
@ -659,36 +653,6 @@ package body Bindgen is
|
||||||
"""__gnat_finalize_library_objects"");");
|
"""__gnat_finalize_library_objects"");");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Import entry point for environment feature enable/disable
|
|
||||||
-- routine, and indication that it's been called previously.
|
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
WBI ("");
|
|
||||||
WBI (" procedure Set_Features;");
|
|
||||||
WBI (" pragma Import (C, Set_Features, " &
|
|
||||||
"""__gnat_set_features"");");
|
|
||||||
WBI ("");
|
|
||||||
WBI (" Features_Set : Integer;");
|
|
||||||
WBI (" pragma Import (C, Features_Set, " &
|
|
||||||
"""__gnat_features_set"");");
|
|
||||||
|
|
||||||
if Opt.Heap_Size /= 0 then
|
|
||||||
WBI ("");
|
|
||||||
WBI (" Heap_Size : Integer;");
|
|
||||||
WBI (" pragma Import (C, Heap_Size, " &
|
|
||||||
"""__gl_heap_size"");");
|
|
||||||
|
|
||||||
Write_Statement_Buffer;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
WBI ("");
|
|
||||||
WBI (" Float_Format : Character;");
|
|
||||||
WBI (" pragma Import (C, Float_Format, " &
|
|
||||||
"""__gl_float_format"");");
|
|
||||||
|
|
||||||
Write_Statement_Buffer;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Initialize stack limit variable of the environment task if the
|
-- Initialize stack limit variable of the environment task if the
|
||||||
-- stack check method is stack limit and stack check is enabled.
|
-- stack check method is stack limit and stack check is enabled.
|
||||||
|
|
||||||
|
@ -886,44 +850,6 @@ package body Bindgen is
|
||||||
WBI (" Install_Handler;");
|
WBI (" Install_Handler;");
|
||||||
WBI (" end if;");
|
WBI (" end if;");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Generate call to Set_Features
|
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
|
|
||||||
-- Set_Features will call IEEE$SET_FP_CONTROL appropriately
|
|
||||||
-- depending on the setting of Float_Format.
|
|
||||||
|
|
||||||
WBI ("");
|
|
||||||
Set_String (" Float_Format := '");
|
|
||||||
|
|
||||||
if Float_Format_Specified = 'G'
|
|
||||||
or else
|
|
||||||
Float_Format_Specified = 'D'
|
|
||||||
then
|
|
||||||
Set_Char ('V');
|
|
||||||
else
|
|
||||||
Set_Char ('I');
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Set_String ("';");
|
|
||||||
Write_Statement_Buffer;
|
|
||||||
|
|
||||||
WBI ("");
|
|
||||||
WBI (" if Features_Set = 0 then");
|
|
||||||
WBI (" Set_Features;");
|
|
||||||
WBI (" end if;");
|
|
||||||
|
|
||||||
-- Features_Set may twiddle the heap size according to a logical
|
|
||||||
-- name, but the binder switch must override.
|
|
||||||
|
|
||||||
if Opt.Heap_Size /= 0 then
|
|
||||||
Set_String (" Heap_Size := ");
|
|
||||||
Set_Int (Opt.Heap_Size);
|
|
||||||
Set_Char (';');
|
|
||||||
Write_Statement_Buffer;
|
|
||||||
end if;
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Generate call to set Initialize_Scalar values if active
|
-- Generate call to set Initialize_Scalar values if active
|
||||||
|
@ -2138,18 +2064,6 @@ package body Bindgen is
|
||||||
|
|
||||||
WBI (" -- " & Name_Buffer (1 .. Name_Len));
|
WBI (" -- " & Name_Buffer (1 .. Name_Len));
|
||||||
|
|
||||||
if With_DECGNAT then
|
|
||||||
Name_Len := 0;
|
|
||||||
|
|
||||||
if Opt.Shared_Libgnat then
|
|
||||||
Add_Str_To_Name_Buffer (Shared_Lib ("decgnat"));
|
|
||||||
else
|
|
||||||
Add_Str_To_Name_Buffer ("-ldecgnat");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Write_Linker_Option;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if With_GNARL then
|
if With_GNARL then
|
||||||
Name_Len := 0;
|
Name_Len := 0;
|
||||||
|
|
||||||
|
@ -3025,12 +2939,6 @@ package body Bindgen is
|
||||||
|
|
||||||
Check_Package (With_GNARL, "system.os_interface%s");
|
Check_Package (With_GNARL, "system.os_interface%s");
|
||||||
|
|
||||||
-- Ditto for declib and the "dec" package
|
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
Check_Package (With_DECGNAT, "dec%s");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Ditto for the use of restricted tasking
|
-- Ditto for the use of restricted tasking
|
||||||
|
|
||||||
Check_Package
|
Check_Package
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -23,8 +23,7 @@
|
||||||
-- --
|
-- --
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
with Targparm; use Targparm;
|
|
||||||
|
|
||||||
package body Butil is
|
package body Butil is
|
||||||
|
|
||||||
|
@ -41,14 +40,7 @@ package body Butil is
|
||||||
or else (Name_Len > 4
|
or else (Name_Len > 4
|
||||||
and then (Name_Buffer (1 .. 5) = "gnat%"
|
and then (Name_Buffer (1 .. 5) = "gnat%"
|
||||||
or else
|
or else
|
||||||
Name_Buffer (1 .. 5) = "gnat."))
|
Name_Buffer (1 .. 5) = "gnat."));
|
||||||
or else
|
|
||||||
(OpenVMS_On_Target
|
|
||||||
and then Name_Len > 3
|
|
||||||
and then (Name_Buffer (1 .. 4) = "dec%"
|
|
||||||
or else
|
|
||||||
Name_Buffer (1 .. 4) = "dec."));
|
|
||||||
|
|
||||||
end Is_Internal_Unit;
|
end Is_Internal_Unit;
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
|
|
|
@ -64,15 +64,12 @@ package body Clean is
|
||||||
ALI_Suffix : constant String := ".ali";
|
ALI_Suffix : constant String := ".ali";
|
||||||
Tree_Suffix : constant String := ".adt";
|
Tree_Suffix : constant String := ".adt";
|
||||||
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
|
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
|
||||||
Debug_Suffix : String := ".dg";
|
Debug_Suffix : constant String := ".dg";
|
||||||
-- Changed to "_dg" for VMS in the body of the package
|
Repinfo_Suffix : constant String := ".rep";
|
||||||
|
-- Suffix of representation info files.
|
||||||
|
|
||||||
Repinfo_Suffix : String := ".rep";
|
B_Start : constant String := "b~";
|
||||||
-- Changed to "_rep" for VMS in the body of the package
|
|
||||||
|
|
||||||
B_Start : String_Ptr := new String'("b~");
|
|
||||||
-- Prefix of binder generated file, and number of actual characters used.
|
-- Prefix of binder generated file, and number of actual characters used.
|
||||||
-- Changed to "b__" for VMS in the body of the package.
|
|
||||||
|
|
||||||
Project_Tree : constant Project_Tree_Ref :=
|
Project_Tree : constant Project_Tree_Ref :=
|
||||||
new Project_Tree_Data (Is_Root_Tree => True);
|
new Project_Tree_Data (Is_Root_Tree => True);
|
||||||
|
@ -1266,27 +1263,7 @@ package body Clean is
|
||||||
or else Is_Writable_File (Full_Name (1 .. Last))
|
or else Is_Writable_File (Full_Name (1 .. Last))
|
||||||
or else Is_Symbolic_Link (Full_Name (1 .. Last))
|
or else Is_Symbolic_Link (Full_Name (1 .. Last))
|
||||||
then
|
then
|
||||||
-- On VMS, we have to delete all versions of the file
|
Delete_File (Full_Name (1 .. Last), Success);
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
declare
|
|
||||||
Host_Full_Name : constant String_Access :=
|
|
||||||
To_Host_File_Spec (Full_Name (1 .. Last));
|
|
||||||
begin
|
|
||||||
if Host_Full_Name = null
|
|
||||||
or else Host_Full_Name'Length = 0
|
|
||||||
then
|
|
||||||
Success := False;
|
|
||||||
else
|
|
||||||
Delete_File (Host_Full_Name.all & ";*", Success);
|
|
||||||
end if;
|
|
||||||
end;
|
|
||||||
|
|
||||||
-- Otherwise just delete the specified file
|
|
||||||
|
|
||||||
else
|
|
||||||
Delete_File (Full_Name (1 .. Last), Success);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Here if no deletion required
|
-- Here if no deletion required
|
||||||
|
|
||||||
|
@ -1327,7 +1304,7 @@ package body Clean is
|
||||||
|
|
||||||
-- Build the file name (before the extension)
|
-- Build the file name (before the extension)
|
||||||
|
|
||||||
File_Name (1 .. B_Start'Length) := B_Start.all;
|
File_Name (1 .. B_Start'Length) := B_Start;
|
||||||
File_Name (B_Start'Length + 1 .. Last) := Source_Name;
|
File_Name (B_Start'Length + 1 .. Last) := Source_Name;
|
||||||
|
|
||||||
-- Spec
|
-- Spec
|
||||||
|
@ -1590,16 +1567,7 @@ package body Clean is
|
||||||
Prj.Tree.Initialize (Project_Node_Tree);
|
Prj.Tree.Initialize (Project_Node_Tree);
|
||||||
|
|
||||||
Prj.Initialize (Project_Tree);
|
Prj.Initialize (Project_Tree);
|
||||||
|
|
||||||
-- Check if the platform is VMS and, if it is, change some variables
|
|
||||||
|
|
||||||
Targparm.Get_Target_Parameters;
|
Targparm.Get_Target_Parameters;
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
Debug_Suffix (Debug_Suffix'First) := '_';
|
|
||||||
Repinfo_Suffix (Repinfo_Suffix'First) := '_';
|
|
||||||
B_Start := new String'("b__");
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Reset global variables
|
-- Reset global variables
|
||||||
|
|
|
@ -77,8 +77,6 @@ procedure Gnatbind is
|
||||||
Output_File_Name_Seen : Boolean := False;
|
Output_File_Name_Seen : Boolean := False;
|
||||||
Output_File_Name : String_Ptr := new String'("");
|
Output_File_Name : String_Ptr := new String'("");
|
||||||
|
|
||||||
L_Switch_Seen : Boolean := False;
|
|
||||||
|
|
||||||
Mapping_File : String_Ptr := null;
|
Mapping_File : String_Ptr := null;
|
||||||
|
|
||||||
package Closure_Sources is new Table.Table
|
package Closure_Sources is new Table.Table
|
||||||
|
@ -338,12 +336,6 @@ procedure Gnatbind is
|
||||||
elsif Argv (2) = 'L' then
|
elsif Argv (2) = 'L' then
|
||||||
if Argv'Length >= 3 then
|
if Argv'Length >= 3 then
|
||||||
|
|
||||||
-- Remember that the -L switch was specified, so that if this
|
|
||||||
-- is on OpenVMS, the export names are put in uppercase.
|
|
||||||
-- This is not known before the target parameters are read.
|
|
||||||
|
|
||||||
L_Switch_Seen := True;
|
|
||||||
|
|
||||||
Opt.Bind_For_Library := True;
|
Opt.Bind_For_Library := True;
|
||||||
Opt.Ada_Init_Name :=
|
Opt.Ada_Init_Name :=
|
||||||
new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
|
new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
|
||||||
|
@ -642,17 +634,6 @@ begin
|
||||||
|
|
||||||
Cumulative_Restrictions := Targparm.Restrictions_On_Target;
|
Cumulative_Restrictions := Targparm.Restrictions_On_Target;
|
||||||
|
|
||||||
-- On OpenVMS, when -L is used, all external names used in pragmas Export
|
|
||||||
-- are in upper case. The reason is that on OpenVMS, the macro-assembler
|
|
||||||
-- MACASM-32, used to build Stand-Alone Libraries, only understands
|
|
||||||
-- uppercase.
|
|
||||||
|
|
||||||
if L_Switch_Seen and then OpenVMS_On_Target then
|
|
||||||
To_Upper (Opt.Ada_Init_Name.all);
|
|
||||||
To_Upper (Opt.Ada_Final_Name.all);
|
|
||||||
To_Upper (Opt.Ada_Main_Name.all);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Acquire configurable run-time mode
|
-- Acquire configurable run-time mode
|
||||||
|
|
||||||
if Configurable_Run_Time_On_Target then
|
if Configurable_Run_Time_On_Target then
|
||||||
|
|
|
@ -36,7 +36,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||||
with GNAT.Heap_Sort_G;
|
with GNAT.Heap_Sort_G;
|
||||||
with GNAT.Table;
|
with GNAT.Table;
|
||||||
|
|
||||||
with Hostparm;
|
|
||||||
with Switch; use Switch;
|
with Switch; use Switch;
|
||||||
with Types;
|
with Types;
|
||||||
|
|
||||||
|
@ -273,10 +272,7 @@ procedure Gnatchop is
|
||||||
Success : out Boolean);
|
Success : out Boolean);
|
||||||
-- Reads file associated with FS into the newly allocated
|
-- Reads file associated with FS into the newly allocated
|
||||||
-- string Contents.
|
-- string Contents.
|
||||||
-- [VMS] Success is true iff the number of bytes read is less than or
|
-- Success is true iff the number of bytes read is equal to the file size.
|
||||||
-- equal to the file size.
|
|
||||||
-- [Other] Success is true iff the number of bytes read is equal to
|
|
||||||
-- the file size.
|
|
||||||
|
|
||||||
function Report_Duplicate_Units return Boolean;
|
function Report_Duplicate_Units return Boolean;
|
||||||
-- Output messages about duplicate units in the input files in Unit.Table
|
-- Output messages about duplicate units in the input files in Unit.Table
|
||||||
|
@ -387,15 +383,8 @@ procedure Gnatchop is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Is_Writable_File (Info.File_Name.all) then
|
if Is_Writable_File (Info.File_Name.all) then
|
||||||
if Hostparm.OpenVMS then
|
Error_Msg (Info.File_Name.all
|
||||||
Error_Msg
|
& " already exists, use -w to overwrite");
|
||||||
(Info.File_Name.all
|
|
||||||
& " already exists, use /OVERWRITE to overwrite");
|
|
||||||
else
|
|
||||||
Error_Msg (Info.File_Name.all
|
|
||||||
& " already exists, use -w to overwrite");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Exists := True;
|
Exists := True;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
@ -1018,15 +1007,7 @@ procedure Gnatchop is
|
||||||
Free (Buffer);
|
Free (Buffer);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Things aren't simple on VMS due to the plethora of file types and
|
Success := Read_Ptr = Length + 1;
|
||||||
-- organizations. It seems clear that there shouldn't be more bytes
|
|
||||||
-- read than are contained in the file though.
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS then
|
|
||||||
Success := Read_Ptr <= Length + 1;
|
|
||||||
else
|
|
||||||
Success := Read_Ptr = Length + 1;
|
|
||||||
end if;
|
|
||||||
end Read_File;
|
end Read_File;
|
||||||
|
|
||||||
----------------------------
|
----------------------------
|
||||||
|
@ -1083,12 +1064,7 @@ procedure Gnatchop is
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
if Duplicates and not Overwrite_Files then
|
if Duplicates and not Overwrite_Files then
|
||||||
if Hostparm.OpenVMS then
|
Put_Line ("use -w to overwrite files and keep last version");
|
||||||
Put_Line
|
|
||||||
("use /OVERWRITE to overwrite files and keep last version");
|
|
||||||
else
|
|
||||||
Put_Line ("use -w to overwrite files and keep last version");
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
return Duplicates;
|
return Duplicates;
|
||||||
|
@ -1136,23 +1112,13 @@ procedure Gnatchop is
|
||||||
if Param.all /= "" then
|
if Param.all /= "" then
|
||||||
for J in Param'Range loop
|
for J in Param'Range loop
|
||||||
if Param (J) not in '0' .. '9' then
|
if Param (J) not in '0' .. '9' then
|
||||||
if Hostparm.OpenVMS then
|
Error_Msg ("-k# requires numeric parameter");
|
||||||
Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn" &
|
|
||||||
" requires numeric parameter");
|
|
||||||
else
|
|
||||||
Error_Msg ("-k# requires numeric parameter");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
else
|
else
|
||||||
if Hostparm.OpenVMS then
|
Param := new String'("8");
|
||||||
Param := new String'("39");
|
|
||||||
else
|
|
||||||
Param := new String'("8");
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Gnat_Args :=
|
Gnat_Args :=
|
||||||
|
@ -1273,13 +1239,7 @@ procedure Gnatchop is
|
||||||
return False;
|
return False;
|
||||||
|
|
||||||
when Invalid_Parameter =>
|
when Invalid_Parameter =>
|
||||||
if Hostparm.OpenVMS then
|
Error_Msg ("-k switch requires numeric parameter");
|
||||||
Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn qualifier" &
|
|
||||||
" requires numeric parameter");
|
|
||||||
else
|
|
||||||
Error_Msg ("-k switch requires numeric parameter");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return False;
|
return False;
|
||||||
end Scan_Arguments;
|
end Scan_Arguments;
|
||||||
|
|
||||||
|
@ -1770,33 +1730,30 @@ procedure Gnatchop is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Add the directory where gnatchop is invoked in front of the path, if
|
-- Add the directory where gnatchop is invoked in front of the path, if
|
||||||
-- gnatchop is invoked with directory information. Only do this if the
|
-- gnatchop is invoked with directory information.
|
||||||
-- platform is not VMS, where the notion of path does not really exist.
|
|
||||||
|
|
||||||
if not Hostparm.OpenVMS then
|
declare
|
||||||
declare
|
Command : constant String := Command_Name;
|
||||||
Command : constant String := Command_Name;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
for Index in reverse Command'Range loop
|
for Index in reverse Command'Range loop
|
||||||
if Command (Index) = Directory_Separator then
|
if Command (Index) = Directory_Separator then
|
||||||
declare
|
declare
|
||||||
Absolute_Dir : constant String :=
|
Absolute_Dir : constant String :=
|
||||||
Normalize_Pathname
|
Normalize_Pathname
|
||||||
(Command (Command'First .. Index));
|
(Command (Command'First .. Index));
|
||||||
PATH : constant String :=
|
PATH : constant String :=
|
||||||
Absolute_Dir
|
Absolute_Dir
|
||||||
& Path_Separator
|
& Path_Separator
|
||||||
& Getenv ("PATH").all;
|
& Getenv ("PATH").all;
|
||||||
begin
|
begin
|
||||||
Setenv ("PATH", PATH);
|
Setenv ("PATH", PATH);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
exit;
|
exit;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
end;
|
end;
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Process command line options and initialize global variables
|
-- Process command line options and initialize global variables
|
||||||
|
|
||||||
|
|
|
@ -26,7 +26,6 @@
|
||||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||||
|
|
||||||
with Csets;
|
with Csets;
|
||||||
with Hostparm; use Hostparm;
|
|
||||||
with Makeutl; use Makeutl;
|
with Makeutl; use Makeutl;
|
||||||
with MLib.Tgt; use MLib.Tgt;
|
with MLib.Tgt; use MLib.Tgt;
|
||||||
with MLib.Utl;
|
with MLib.Utl;
|
||||||
|
@ -66,8 +65,8 @@ procedure GNATCmd is
|
||||||
Current_Verbosity : Prj.Verbosity := Prj.Default;
|
Current_Verbosity : Prj.Verbosity := Prj.Default;
|
||||||
Tool_Package_Name : Name_Id := No_Name;
|
Tool_Package_Name : Name_Id := No_Name;
|
||||||
|
|
||||||
B_Start : String_Ptr := new String'("b~");
|
B_Start : constant String := "b~";
|
||||||
-- Prefix of binder generated file, changed to b__ for VMS
|
-- Prefix of binder generated file, changed to b__ for gprbuild
|
||||||
|
|
||||||
Project_Tree : constant Project_Tree_Ref :=
|
Project_Tree : constant Project_Tree_Ref :=
|
||||||
new Project_Tree_Data (Is_Root_Tree => True);
|
new Project_Tree_Data (Is_Root_Tree => True);
|
||||||
|
@ -192,8 +191,7 @@ procedure GNATCmd is
|
||||||
-- The index of the command in the arguments of the GNAT driver
|
-- The index of the command in the arguments of the GNAT driver
|
||||||
|
|
||||||
My_Exit_Status : Exit_Status := Success;
|
My_Exit_Status : Exit_Status := Success;
|
||||||
-- The exit status of the spawned tool. Used to set the correct VMS
|
-- The exit status of the spawned tool.
|
||||||
-- exit status.
|
|
||||||
|
|
||||||
Current_Work_Dir : constant String := Get_Current_Dir;
|
Current_Work_Dir : constant String := Get_Current_Dir;
|
||||||
-- The path of the working directory
|
-- The path of the working directory
|
||||||
|
@ -203,9 +201,6 @@ procedure GNATCmd is
|
||||||
-- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
|
-- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
|
||||||
-- should be invoked for all sources of all projects.
|
-- should be invoked for all sources of all projects.
|
||||||
|
|
||||||
Max_OpenVMS_Logical_Length : constant Integer := 255;
|
|
||||||
-- The maximum length of OpenVMS logicals
|
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
-- Local Subprograms --
|
-- Local Subprograms --
|
||||||
-----------------------
|
-----------------------
|
||||||
|
@ -452,7 +447,7 @@ procedure GNATCmd is
|
||||||
Add_To_Response_File
|
Add_To_Response_File
|
||||||
(Get_Name_String
|
(Get_Name_String
|
||||||
(Proj.Project.Object_Directory.Name) &
|
(Proj.Project.Object_Directory.Name) &
|
||||||
B_Start.all &
|
B_Start &
|
||||||
MLib.Fil.Ext_To
|
MLib.Fil.Ext_To
|
||||||
(Get_Name_String
|
(Get_Name_String
|
||||||
(Project_Tree.Shared.String_Elements.Table
|
(Project_Tree.Shared.String_Elements.Table
|
||||||
|
@ -465,7 +460,6 @@ procedure GNATCmd is
|
||||||
-- such files.
|
-- such files.
|
||||||
|
|
||||||
if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
|
if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
|
||||||
and then B_Start.all /= "b__"
|
|
||||||
then
|
then
|
||||||
Add_To_Response_File
|
Add_To_Response_File
|
||||||
(Get_Name_String
|
(Get_Name_String
|
||||||
|
@ -491,7 +485,7 @@ procedure GNATCmd is
|
||||||
Add_To_Response_File
|
Add_To_Response_File
|
||||||
(Get_Name_String
|
(Get_Name_String
|
||||||
(Proj.Project.Object_Directory.Name) &
|
(Proj.Project.Object_Directory.Name) &
|
||||||
B_Start.all &
|
B_Start &
|
||||||
Get_Name_String (Proj.Project.Library_Name) &
|
Get_Name_String (Proj.Project.Library_Name) &
|
||||||
".ci");
|
".ci");
|
||||||
|
|
||||||
|
@ -501,7 +495,6 @@ procedure GNATCmd is
|
||||||
-- such files.
|
-- such files.
|
||||||
|
|
||||||
if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
|
if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
|
||||||
and then B_Start.all /= "b__"
|
|
||||||
then
|
then
|
||||||
Add_To_Response_File
|
Add_To_Response_File
|
||||||
(Get_Name_String
|
(Get_Name_String
|
||||||
|
@ -1429,179 +1422,154 @@ begin
|
||||||
Add_Str_To_Name_Buffer (Argument (J));
|
Add_Str_To_Name_Buffer (Argument (J));
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
-- On OpenVMS, setenv creates a logical whose length is limited to
|
|
||||||
-- 255 bytes.
|
|
||||||
|
|
||||||
if OpenVMS and then Name_Len > Max_OpenVMS_Logical_Length then
|
|
||||||
Name_Buffer (Max_OpenVMS_Logical_Length - 2
|
|
||||||
.. Max_OpenVMS_Logical_Length) := "...";
|
|
||||||
Name_Len := Max_OpenVMS_Logical_Length;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
|
Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
|
||||||
|
|
||||||
-- Add the directory where the GNAT driver is invoked in front of the path,
|
-- Add the directory where the GNAT driver is invoked in front of the path,
|
||||||
-- if the GNAT driver is invoked with directory information. Do not do this
|
-- if the GNAT driver is invoked with directory information.
|
||||||
-- for VMS, where the notion of path does not really exist.
|
|
||||||
|
|
||||||
if not OpenVMS then
|
|
||||||
declare
|
|
||||||
Command : constant String := Command_Name;
|
|
||||||
|
|
||||||
begin
|
|
||||||
for Index in reverse Command'Range loop
|
|
||||||
if Command (Index) = Directory_Separator then
|
|
||||||
declare
|
|
||||||
Absolute_Dir : constant String :=
|
|
||||||
Normalize_Pathname
|
|
||||||
(Command (Command'First .. Index));
|
|
||||||
|
|
||||||
PATH : constant String :=
|
|
||||||
Absolute_Dir & Path_Separator & Getenv ("PATH").all;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Setenv ("PATH", PATH);
|
|
||||||
end;
|
|
||||||
|
|
||||||
exit;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
end;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
|
|
||||||
-- filenames and pathnames to Unix style.
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS
|
|
||||||
or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
|
|
||||||
then
|
|
||||||
VMS_Conversion (The_Command);
|
|
||||||
|
|
||||||
B_Start := new String'("b__");
|
|
||||||
|
|
||||||
-- If not on VMS, scan the command line directly
|
|
||||||
|
|
||||||
else
|
|
||||||
-- First, scan to detect --version and/or --help
|
|
||||||
|
|
||||||
Check_Version_And_Help ("GNAT", "1996");
|
|
||||||
|
|
||||||
begin
|
|
||||||
loop
|
|
||||||
if Command_Arg <= Argument_Count
|
|
||||||
and then Argument (Command_Arg) = "-v"
|
|
||||||
then
|
|
||||||
Verbose_Mode := True;
|
|
||||||
Command_Arg := Command_Arg + 1;
|
|
||||||
|
|
||||||
elsif Command_Arg <= Argument_Count
|
|
||||||
and then Argument (Command_Arg) = "-dn"
|
|
||||||
then
|
|
||||||
Keep_Temporary_Files := True;
|
|
||||||
Command_Arg := Command_Arg + 1;
|
|
||||||
|
|
||||||
else
|
|
||||||
exit;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
-- If there is no command, just output the usage
|
|
||||||
|
|
||||||
if Command_Arg > Argument_Count then
|
|
||||||
Non_VMS_Usage;
|
|
||||||
return;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
|
|
||||||
|
|
||||||
if Command_List (The_Command).VMS_Only then
|
|
||||||
Non_VMS_Usage;
|
|
||||||
Fail
|
|
||||||
("command """
|
|
||||||
& Command_List (The_Command).Cname.all
|
|
||||||
& """ can only be used on VMS");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
exception
|
|
||||||
when Constraint_Error =>
|
|
||||||
|
|
||||||
-- Check if it is an alternate command
|
|
||||||
|
|
||||||
|
declare
|
||||||
|
Command : constant String := Command_Name;
|
||||||
|
begin
|
||||||
|
for Index in reverse Command'Range loop
|
||||||
|
if Command (Index) = Directory_Separator then
|
||||||
declare
|
declare
|
||||||
Alternate : Alternate_Command;
|
Absolute_Dir : constant String :=
|
||||||
|
Normalize_Pathname
|
||||||
|
(Command (Command'First .. Index));
|
||||||
|
|
||||||
|
PATH : constant String :=
|
||||||
|
Absolute_Dir & Path_Separator & Getenv ("PATH").all;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Alternate := Alternate_Command'Value
|
Setenv ("PATH", PATH);
|
||||||
(Argument (Command_Arg));
|
|
||||||
The_Command := Corresponding_To (Alternate);
|
|
||||||
|
|
||||||
exception
|
|
||||||
when Constraint_Error =>
|
|
||||||
Non_VMS_Usage;
|
|
||||||
Fail ("unknown command: " & Argument (Command_Arg));
|
|
||||||
end;
|
end;
|
||||||
end;
|
|
||||||
|
|
||||||
-- Get the arguments from the command line and from the eventual
|
exit;
|
||||||
-- argument file(s) specified on the command line.
|
end if;
|
||||||
|
end loop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
-- Scan the command line
|
||||||
|
|
||||||
|
-- First, scan to detect --version and/or --help
|
||||||
|
|
||||||
|
Check_Version_And_Help ("GNAT", "1996");
|
||||||
|
|
||||||
|
begin
|
||||||
|
loop
|
||||||
|
if Command_Arg <= Argument_Count
|
||||||
|
and then Argument (Command_Arg) = "-v"
|
||||||
|
then
|
||||||
|
Verbose_Mode := True;
|
||||||
|
Command_Arg := Command_Arg + 1;
|
||||||
|
|
||||||
|
elsif Command_Arg <= Argument_Count
|
||||||
|
and then Argument (Command_Arg) = "-dn"
|
||||||
|
then
|
||||||
|
Keep_Temporary_Files := True;
|
||||||
|
Command_Arg := Command_Arg + 1;
|
||||||
|
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end if;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
-- If there is no command, just output the usage
|
||||||
|
|
||||||
|
if Command_Arg > Argument_Count then
|
||||||
|
Non_VMS_Usage;
|
||||||
|
return;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
|
||||||
|
|
||||||
|
if Command_List (The_Command).VMS_Only then
|
||||||
|
Non_VMS_Usage;
|
||||||
|
Fail
|
||||||
|
("command """
|
||||||
|
& Command_List (The_Command).Cname.all
|
||||||
|
& """ can only be used on VMS");
|
||||||
|
end if;
|
||||||
|
|
||||||
|
exception
|
||||||
|
when Constraint_Error =>
|
||||||
|
|
||||||
|
-- Check if it is an alternate command
|
||||||
|
|
||||||
for Arg in Command_Arg + 1 .. Argument_Count loop
|
|
||||||
declare
|
declare
|
||||||
The_Arg : constant String := Argument (Arg);
|
Alternate : Alternate_Command;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Check if an argument file is specified
|
Alternate := Alternate_Command'Value
|
||||||
|
(Argument (Command_Arg));
|
||||||
|
The_Command := Corresponding_To (Alternate);
|
||||||
|
|
||||||
if The_Arg (The_Arg'First) = '@' then
|
exception
|
||||||
declare
|
when Constraint_Error =>
|
||||||
Arg_File : Ada.Text_IO.File_Type;
|
Non_VMS_Usage;
|
||||||
Line : String (1 .. 256);
|
Fail ("unknown command: " & Argument (Command_Arg));
|
||||||
Last : Natural;
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
-- Get the arguments from the command line and from the eventual
|
||||||
|
-- argument file(s) specified on the command line.
|
||||||
|
|
||||||
|
for Arg in Command_Arg + 1 .. Argument_Count loop
|
||||||
|
declare
|
||||||
|
The_Arg : constant String := Argument (Arg);
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Check if an argument file is specified
|
||||||
|
|
||||||
|
if The_Arg (The_Arg'First) = '@' then
|
||||||
|
declare
|
||||||
|
Arg_File : Ada.Text_IO.File_Type;
|
||||||
|
Line : String (1 .. 256);
|
||||||
|
Last : Natural;
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Open the file and fail if the file cannot be found
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Open the file and fail if the file cannot be found
|
Open
|
||||||
|
(Arg_File, In_File,
|
||||||
|
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
||||||
|
|
||||||
begin
|
exception
|
||||||
Open
|
when others =>
|
||||||
(Arg_File, In_File,
|
Put (Standard_Error, "Cannot open argument file """);
|
||||||
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
Put (Standard_Error,
|
||||||
|
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
||||||
exception
|
Put_Line (Standard_Error, """");
|
||||||
when others =>
|
raise Error_Exit;
|
||||||
Put (Standard_Error, "Cannot open argument file """);
|
|
||||||
Put (Standard_Error,
|
|
||||||
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
|
||||||
Put_Line (Standard_Error, """");
|
|
||||||
raise Error_Exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
-- Read line by line and put the content of each non-
|
|
||||||
-- empty line in the Last_Switches table.
|
|
||||||
|
|
||||||
while not End_Of_File (Arg_File) loop
|
|
||||||
Get_Line (Arg_File, Line, Last);
|
|
||||||
|
|
||||||
if Last /= 0 then
|
|
||||||
Last_Switches.Increment_Last;
|
|
||||||
Last_Switches.Table (Last_Switches.Last) :=
|
|
||||||
new String'(Line (1 .. Last));
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
Close (Arg_File);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
else
|
-- Read line by line and put the content of each non-
|
||||||
-- It is not an argument file; just put the argument in
|
-- empty line in the Last_Switches table.
|
||||||
-- the Last_Switches table.
|
|
||||||
|
|
||||||
Last_Switches.Increment_Last;
|
while not End_Of_File (Arg_File) loop
|
||||||
Last_Switches.Table (Last_Switches.Last) :=
|
Get_Line (Arg_File, Line, Last);
|
||||||
new String'(The_Arg);
|
|
||||||
end if;
|
if Last /= 0 then
|
||||||
end;
|
Last_Switches.Increment_Last;
|
||||||
end loop;
|
Last_Switches.Table (Last_Switches.Last) :=
|
||||||
end if;
|
new String'(Line (1 .. Last));
|
||||||
|
end if;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
Close (Arg_File);
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
-- It is not an argument file; just put the argument in
|
||||||
|
-- the Last_Switches table.
|
||||||
|
|
||||||
|
Last_Switches.Increment_Last;
|
||||||
|
Last_Switches.Table (Last_Switches.Last) :=
|
||||||
|
new String'(The_Arg);
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
end loop;
|
||||||
|
|
||||||
declare
|
declare
|
||||||
Program : String_Access;
|
Program : String_Access;
|
||||||
|
@ -2618,20 +2586,6 @@ begin
|
||||||
if ASIS_Main /= null then
|
if ASIS_Main /= null then
|
||||||
Get_Closure;
|
Get_Closure;
|
||||||
|
|
||||||
-- On VMS, set up the env var again for source dirs file. This is
|
|
||||||
-- because the call to gnatmake has set this env var to another
|
|
||||||
-- file that has now been deleted.
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS then
|
|
||||||
|
|
||||||
-- First make sure that the recorded file names are empty
|
|
||||||
|
|
||||||
Prj.Env.Initialize (Project_Tree);
|
|
||||||
|
|
||||||
Prj.Env.Set_Ada_Paths
|
|
||||||
(Project, Project_Tree, Including_Libraries => False);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- For gnat check, gnat sync, gnat pretty, gnat metric, gnat list,
|
-- For gnat check, gnat sync, gnat pretty, gnat metric, gnat list,
|
||||||
-- and gnat stack, if no file has been put on the command line, call
|
-- and gnat stack, if no file has been put on the command line, call
|
||||||
-- tool with all the sources of the main project.
|
-- tool with all the sources of the main project.
|
||||||
|
@ -2726,14 +2680,5 @@ exception
|
||||||
Delete_Temp_Config_Files;
|
Delete_Temp_Config_Files;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Since GNATCmd is normally called from DCL (the VMS shell), it must
|
Set_Exit_Status (My_Exit_Status);
|
||||||
-- return an understandable VMS exit status. However the exit status
|
|
||||||
-- returned *to* GNATCmd is a Posix style code, so we test it and return
|
|
||||||
-- just a simple success or failure on VMS.
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS and then My_Exit_Status /= Success then
|
|
||||||
Set_Exit_Status (Failure);
|
|
||||||
else
|
|
||||||
Set_Exit_Status (My_Exit_Status);
|
|
||||||
end if;
|
|
||||||
end GNATCmd;
|
end GNATCmd;
|
||||||
|
|
|
@ -191,9 +191,9 @@ procedure Gnatls is
|
||||||
-- Returns the capitalized image of Restriction
|
-- Returns the capitalized image of Restriction
|
||||||
|
|
||||||
function Normalize (Path : String) return String;
|
function Normalize (Path : String) return String;
|
||||||
-- Returns a normalized path name, except on VMS where the argument Path
|
-- Returns a normalized path name.
|
||||||
-- is returned, to keep the host pathname syntax. On Windows, the directory
|
-- On Windows, the directory separators are set to '\' in
|
||||||
-- separators are set to '\' in Normalize_Pathname.
|
-- Normalize_Pathname.
|
||||||
|
|
||||||
------------------------------------------
|
------------------------------------------
|
||||||
-- GNATDIST specific output subprograms --
|
-- GNATDIST specific output subprograms --
|
||||||
|
@ -839,11 +839,7 @@ procedure Gnatls is
|
||||||
|
|
||||||
function Normalize (Path : String) return String is
|
function Normalize (Path : String) return String is
|
||||||
begin
|
begin
|
||||||
if OpenVMS_On_Target then
|
return Normalize_Pathname (Path);
|
||||||
return Path;
|
|
||||||
else
|
|
||||||
return Normalize_Pathname (Path);
|
|
||||||
end if;
|
|
||||||
end Normalize;
|
end Normalize;
|
||||||
|
|
||||||
--------------------------------
|
--------------------------------
|
||||||
|
@ -1632,8 +1628,8 @@ begin
|
||||||
|
|
||||||
Osint.Add_Default_Search_Dirs;
|
Osint.Add_Default_Search_Dirs;
|
||||||
|
|
||||||
-- Get the target parameters to know if the target is OpenVMS, but only if
|
-- Get the target parameters, but only if switch -nostdinc was not
|
||||||
-- switch -nostdinc was not specified.
|
-- specified. Likely not strictly needed now that VMS is baselined???
|
||||||
|
|
||||||
if not Opt.No_Stdinc then
|
if not Opt.No_Stdinc then
|
||||||
Get_Target_Parameters;
|
Get_Target_Parameters;
|
||||||
|
|
|
@ -30,7 +30,6 @@ with GNAT.Command_Line; use GNAT.Command_Line;
|
||||||
with GNAT.Dynamic_Tables;
|
with GNAT.Dynamic_Tables;
|
||||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||||
|
|
||||||
with Hostparm;
|
|
||||||
with Opt;
|
with Opt;
|
||||||
with Osint; use Osint;
|
with Osint; use Osint;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
|
@ -549,35 +548,30 @@ procedure Gnatname is
|
||||||
begin
|
begin
|
||||||
-- Add the directory where gnatname is invoked in front of the
|
-- Add the directory where gnatname is invoked in front of the
|
||||||
-- path, if gnatname is invoked with directory information.
|
-- path, if gnatname is invoked with directory information.
|
||||||
-- Only do this if the platform is not VMS, where the notion of path
|
|
||||||
-- does not really exist.
|
|
||||||
|
|
||||||
if not Hostparm.OpenVMS then
|
declare
|
||||||
declare
|
Command : constant String := Command_Name;
|
||||||
Command : constant String := Command_Name;
|
begin
|
||||||
|
for Index in reverse Command'Range loop
|
||||||
|
if Command (Index) = Directory_Separator then
|
||||||
|
declare
|
||||||
|
Absolute_Dir : constant String :=
|
||||||
|
Normalize_Pathname
|
||||||
|
(Command (Command'First .. Index));
|
||||||
|
|
||||||
begin
|
PATH : constant String :=
|
||||||
for Index in reverse Command'Range loop
|
Absolute_Dir &
|
||||||
if Command (Index) = Directory_Separator then
|
Path_Separator &
|
||||||
declare
|
Getenv ("PATH").all;
|
||||||
Absolute_Dir : constant String :=
|
|
||||||
Normalize_Pathname
|
|
||||||
(Command (Command'First .. Index));
|
|
||||||
|
|
||||||
PATH : constant String :=
|
begin
|
||||||
Absolute_Dir &
|
Setenv ("PATH", PATH);
|
||||||
Path_Separator &
|
end;
|
||||||
Getenv ("PATH").all;
|
|
||||||
|
|
||||||
begin
|
exit;
|
||||||
Setenv ("PATH", PATH);
|
end if;
|
||||||
end;
|
end loop;
|
||||||
|
end;
|
||||||
exit;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
end;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Initialize tables
|
-- Initialize tables
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -29,8 +29,6 @@
|
||||||
-- --
|
-- --
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
with Hostparm;
|
|
||||||
|
|
||||||
procedure Krunch
|
procedure Krunch
|
||||||
(Buffer : in out String;
|
(Buffer : in out String;
|
||||||
Len : in out Natural;
|
Len : in out Natural;
|
||||||
|
@ -128,9 +126,7 @@ begin
|
||||||
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
|
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
|
||||||
and then Len <= Maxlen
|
and then Len <= Maxlen
|
||||||
then
|
then
|
||||||
-- When VMS is the host, it is always also the target
|
if VMS_On_Target then
|
||||||
|
|
||||||
if Hostparm.OpenVMS or else VMS_On_Target then
|
|
||||||
Len := Len + 1;
|
Len := Len + 1;
|
||||||
Buffer (4 .. Len) := Buffer (3 .. Len - 1);
|
Buffer (4 .. Len) := Buffer (3 .. Len - 1);
|
||||||
Buffer (2) := '_';
|
Buffer (2) := '_';
|
||||||
|
|
110
gcc/ada/make.adb
110
gcc/ada/make.adb
|
@ -2256,6 +2256,7 @@ package body Make is
|
||||||
Is_Main_Source : Boolean;
|
Is_Main_Source : Boolean;
|
||||||
Args : Argument_List)
|
Args : Argument_List)
|
||||||
is
|
is
|
||||||
|
pragma Unreferenced (Is_Main_Source);
|
||||||
begin
|
begin
|
||||||
Arguments_Project := No_Project;
|
Arguments_Project := No_Project;
|
||||||
Last_Argument := 0;
|
Last_Argument := 0;
|
||||||
|
@ -2424,29 +2425,6 @@ package body Make is
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- For VMS, when compiling the main source, add switch
|
|
||||||
-- -mdebug-main=_ada_ so that the executable can be debugged
|
|
||||||
-- by the standard VMS debugger.
|
|
||||||
|
|
||||||
if not No_Main_Subprogram
|
|
||||||
and then Targparm.OpenVMS_On_Target
|
|
||||||
and then Is_Main_Source
|
|
||||||
then
|
|
||||||
-- First, check if compilation will be invoked with -g
|
|
||||||
|
|
||||||
for J in 1 .. Last_Argument loop
|
|
||||||
if Arguments (J)'Length >= 2
|
|
||||||
and then Arguments (J) (1 .. 2) = "-g"
|
|
||||||
and then (Arguments (J)'Length < 5
|
|
||||||
or else Arguments (J) (1 .. 5) /= "-gnat")
|
|
||||||
then
|
|
||||||
Add_Arguments
|
|
||||||
((1 => new String'("-mdebug-main=_ada_")));
|
|
||||||
exit;
|
|
||||||
end if;
|
|
||||||
end loop;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Set Output_Is_Object, depending if there is a -S switch.
|
-- Set Output_Is_Object, depending if there is a -S switch.
|
||||||
-- If the bind step is not performed, and there is a -S switch,
|
-- If the bind step is not performed, and there is a -S switch,
|
||||||
-- then we will not check for a valid object file.
|
-- then we will not check for a valid object file.
|
||||||
|
@ -2650,8 +2628,8 @@ package body Make is
|
||||||
-- The loop here is a work-around for a problem on VMS; in some
|
-- The loop here is a work-around for a problem on VMS; in some
|
||||||
-- circumstances (shared library and several executables, for
|
-- circumstances (shared library and several executables, for
|
||||||
-- example), there are child processes other than compilation
|
-- example), there are child processes other than compilation
|
||||||
-- processes that are received. Until this problem is resolved,
|
-- processes that are received. ??? Revisit now that VMS is no
|
||||||
-- we will ignore such processes.
|
-- longer supported.
|
||||||
|
|
||||||
loop
|
loop
|
||||||
Wait_Process (Pid, OK);
|
Wait_Process (Pid, OK);
|
||||||
|
@ -4231,9 +4209,7 @@ package body Make is
|
||||||
if
|
if
|
||||||
Library_Projs.Table (Index).Extended_By = No_Project
|
Library_Projs.Table (Index).Extended_By = No_Project
|
||||||
then
|
then
|
||||||
if Library_Projs.Table (Index).Library_Kind = Static
|
if Library_Projs.Table (Index).Library_Kind = Static then
|
||||||
and then not Targparm.OpenVMS_On_Target
|
|
||||||
then
|
|
||||||
Linker_Switches.Increment_Last;
|
Linker_Switches.Increment_Last;
|
||||||
Linker_Switches.Table (Linker_Switches.Last) :=
|
Linker_Switches.Table (Linker_Switches.Last) :=
|
||||||
new String'
|
new String'
|
||||||
|
@ -5826,17 +5802,6 @@ package body Make is
|
||||||
|
|
||||||
Osint.Add_Default_Search_Dirs;
|
Osint.Add_Default_Search_Dirs;
|
||||||
|
|
||||||
-- Get the target parameters, so that the correct binder generated
|
|
||||||
-- files are generated if OpenVMS is the target.
|
|
||||||
|
|
||||||
begin
|
|
||||||
Targparm.Get_Target_Parameters;
|
|
||||||
|
|
||||||
exception
|
|
||||||
when Unrecoverable_Error =>
|
|
||||||
Make_Failed ("*** make failed.");
|
|
||||||
end;
|
|
||||||
|
|
||||||
-- And bind and or link the library
|
-- And bind and or link the library
|
||||||
|
|
||||||
MLib.Prj.Build_Library
|
MLib.Prj.Build_Library
|
||||||
|
@ -6438,45 +6403,42 @@ package body Make is
|
||||||
|
|
||||||
-- Add the directory where gnatmake is invoked in front of the path,
|
-- Add the directory where gnatmake is invoked in front of the path,
|
||||||
-- if gnatmake is invoked from a bin directory or with directory
|
-- if gnatmake is invoked from a bin directory or with directory
|
||||||
-- information. Only do this if the platform is not VMS, where the
|
-- information.
|
||||||
-- notion of path does not really exist.
|
|
||||||
|
|
||||||
if not OpenVMS then
|
declare
|
||||||
declare
|
Prefix : constant String := Executable_Prefix_Path;
|
||||||
Prefix : constant String := Executable_Prefix_Path;
|
Command : constant String := Command_Name;
|
||||||
Command : constant String := Command_Name;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Prefix'Length > 0 then
|
if Prefix'Length > 0 then
|
||||||
declare
|
declare
|
||||||
PATH : constant String :=
|
PATH : constant String :=
|
||||||
Prefix & Directory_Separator & "bin" & Path_Separator &
|
Prefix & Directory_Separator & "bin" & Path_Separator &
|
||||||
Getenv ("PATH").all;
|
Getenv ("PATH").all;
|
||||||
begin
|
begin
|
||||||
Setenv ("PATH", PATH);
|
Setenv ("PATH", PATH);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
else
|
else
|
||||||
for Index in reverse Command'Range loop
|
for Index in reverse Command'Range loop
|
||||||
if Command (Index) = Directory_Separator then
|
if Command (Index) = Directory_Separator then
|
||||||
declare
|
declare
|
||||||
Absolute_Dir : constant String :=
|
Absolute_Dir : constant String :=
|
||||||
Normalize_Pathname
|
Normalize_Pathname
|
||||||
(Command (Command'First .. Index));
|
(Command (Command'First .. Index));
|
||||||
PATH : constant String :=
|
PATH : constant String :=
|
||||||
Absolute_Dir &
|
Absolute_Dir &
|
||||||
Path_Separator &
|
Path_Separator &
|
||||||
Getenv ("PATH").all;
|
Getenv ("PATH").all;
|
||||||
begin
|
begin
|
||||||
Setenv ("PATH", PATH);
|
Setenv ("PATH", PATH);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
exit;
|
exit;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Scan the switches and arguments
|
-- Scan the switches and arguments
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,6 @@ with Debug;
|
||||||
with Err_Vars; use Err_Vars;
|
with Err_Vars; use Err_Vars;
|
||||||
with Errutil;
|
with Errutil;
|
||||||
with Fname;
|
with Fname;
|
||||||
with Hostparm;
|
|
||||||
with Osint; use Osint;
|
with Osint; use Osint;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
with Opt; use Opt;
|
with Opt; use Opt;
|
||||||
|
@ -740,12 +739,6 @@ package body Makeutl is
|
||||||
-- Beginning of Executable_Prefix_Path
|
-- Beginning of Executable_Prefix_Path
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- For VMS, the path returned is always /gnu/
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS then
|
|
||||||
return "/gnu/";
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- First determine if a path prefix was placed in front of the
|
-- First determine if a path prefix was placed in front of the
|
||||||
-- executable name.
|
-- executable name.
|
||||||
|
|
||||||
|
|
|
@ -60,7 +60,6 @@
|
||||||
-- GNU/Linux
|
-- GNU/Linux
|
||||||
-- HP-UX
|
-- HP-UX
|
||||||
-- Solaris
|
-- Solaris
|
||||||
-- Alpha OpenVMS
|
|
||||||
|
|
||||||
-- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is
|
-- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is
|
||||||
-- 64 bit. If the need arises to support architectures where this assumption
|
-- 64 bit. If the need arises to support architectures where this assumption
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2013, AdaCore --
|
-- Copyright (C) 2001-2014, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -38,7 +38,6 @@ with Sinput.P;
|
||||||
with Snames; use Snames;
|
with Snames; use Snames;
|
||||||
with Switch; use Switch;
|
with Switch; use Switch;
|
||||||
with Table;
|
with Table;
|
||||||
with Targparm; use Targparm;
|
|
||||||
with Tempdir;
|
with Tempdir;
|
||||||
with Types; use Types;
|
with Types; use Types;
|
||||||
|
|
||||||
|
@ -61,8 +60,8 @@ package body MLib.Prj is
|
||||||
|
|
||||||
ALI_Suffix : constant String := ".ali";
|
ALI_Suffix : constant String := ".ali";
|
||||||
|
|
||||||
B_Start : String_Ptr := new String'("b~");
|
B_Start : constant String := "b~";
|
||||||
-- Prefix of bind file, changed to b__ for VMS
|
-- Prefix of bind file
|
||||||
|
|
||||||
S_Osinte_Ads : File_Name_Type := No_File;
|
S_Osinte_Ads : File_Name_Type := No_File;
|
||||||
-- Name_Id for "s-osinte.ads"
|
-- Name_Id for "s-osinte.ads"
|
||||||
|
@ -310,9 +309,6 @@ package body MLib.Prj is
|
||||||
Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
|
Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
|
||||||
-- Set True if library needs to be linked with libgnarl
|
-- Set True if library needs to be linked with libgnarl
|
||||||
|
|
||||||
Libdecgnat_Needed : Boolean := False;
|
|
||||||
-- On OpenVMS, set True if library needs to be linked with libdecgnat
|
|
||||||
|
|
||||||
Object_Directory_Path : constant String :=
|
Object_Directory_Path : constant String :=
|
||||||
Get_Name_String
|
Get_Name_String
|
||||||
(For_Project.Object_Directory.Display_Name);
|
(For_Project.Object_Directory.Display_Name);
|
||||||
|
@ -367,9 +363,7 @@ package body MLib.Prj is
|
||||||
procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
|
procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
|
||||||
-- Set Libgnarl_Needed if the ALI_File indicates that there is a need
|
-- Set Libgnarl_Needed if the ALI_File indicates that there is a need
|
||||||
-- to link with -lgnarl (this is the case when there is a dependency
|
-- to link with -lgnarl (this is the case when there is a dependency
|
||||||
-- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
|
-- on s-osinte.ads).
|
||||||
-- indicates that there is a need to link with -ldecgnat (this is the
|
|
||||||
-- case when there is a dependency on dec.ads).
|
|
||||||
|
|
||||||
procedure Process (The_ALI : File_Name_Type);
|
procedure Process (The_ALI : File_Name_Type);
|
||||||
-- Check if the closure of a library unit which is or should be in the
|
-- Check if the closure of a library unit which is or should be in the
|
||||||
|
@ -503,11 +497,7 @@ package body MLib.Prj is
|
||||||
Id : ALI.ALI_Id;
|
Id : ALI.ALI_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Libgnarl_Needed /= Yes
|
if Libgnarl_Needed /= Yes then
|
||||||
or else
|
|
||||||
(Main_Project
|
|
||||||
and then OpenVMS_On_Target)
|
|
||||||
then
|
|
||||||
-- Scan the ALI file
|
-- Scan the ALI file
|
||||||
|
|
||||||
Name_Len := ALI_File'Length;
|
Name_Len := ALI_File'Length;
|
||||||
|
@ -536,11 +526,6 @@ package body MLib.Prj is
|
||||||
else
|
else
|
||||||
exit;
|
exit;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
elsif OpenVMS_On_Target then
|
|
||||||
if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
|
|
||||||
Libdecgnat_Needed := True;
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
end if;
|
end if;
|
||||||
|
@ -857,13 +842,8 @@ package body MLib.Prj is
|
||||||
Arguments (1) := No_Main;
|
Arguments (1) := No_Main;
|
||||||
Arguments (2) := Output_Switch;
|
Arguments (2) := Output_Switch;
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
B_Start := new String'("b__");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Add_Argument
|
Add_Argument
|
||||||
(B_Start.all
|
(B_Start & Get_Name_String (For_Project.Library_Name) & ".adb");
|
||||||
& Get_Name_String (For_Project.Library_Name) & ".adb");
|
|
||||||
|
|
||||||
-- Make sure that the init procedure is never "adainit"
|
-- Make sure that the init procedure is never "adainit"
|
||||||
|
|
||||||
|
@ -1220,13 +1200,8 @@ package body MLib.Prj is
|
||||||
Arguments (1) := Compile_Switch;
|
Arguments (1) := Compile_Switch;
|
||||||
Arguments (2) := No_Warning;
|
Arguments (2) := No_Warning;
|
||||||
|
|
||||||
if OpenVMS_On_Target then
|
|
||||||
B_Start := new String'("b__");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Add_Argument
|
Add_Argument
|
||||||
(B_Start.all
|
(B_Start & Get_Name_String (For_Project.Library_Name) & ".adb");
|
||||||
& Get_Name_String (For_Project.Library_Name) & ".adb");
|
|
||||||
|
|
||||||
-- If necessary, add the PIC option
|
-- If necessary, add the PIC option
|
||||||
|
|
||||||
|
@ -1429,7 +1404,7 @@ package body MLib.Prj is
|
||||||
if In_Main_Object_Directory
|
if In_Main_Object_Directory
|
||||||
or else Last < 5
|
or else Last < 5
|
||||||
or else
|
or else
|
||||||
C_Filename (1 .. B_Start'Length) /= B_Start.all
|
C_Filename (1 .. B_Start'Length) /= B_Start
|
||||||
then
|
then
|
||||||
Name_Len := 0;
|
Name_Len := 0;
|
||||||
Add_Str_To_Name_Buffer (C_Filename);
|
Add_Str_To_Name_Buffer (C_Filename);
|
||||||
|
@ -1458,7 +1433,7 @@ package body MLib.Prj is
|
||||||
(Last >= 5
|
(Last >= 5
|
||||||
and then
|
and then
|
||||||
C_Filename (1 .. B_Start'Length)
|
C_Filename (1 .. B_Start'Length)
|
||||||
= B_Start.all);
|
= B_Start);
|
||||||
|
|
||||||
if Is_Regular_File (ALI_Path) then
|
if Is_Regular_File (ALI_Path) then
|
||||||
|
|
||||||
|
@ -1624,21 +1599,6 @@ package body MLib.Prj is
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Libdecgnat_Needed then
|
|
||||||
Opts.Increment_Last;
|
|
||||||
|
|
||||||
Opts.Table (Opts.Last) :=
|
|
||||||
new String'("-L" & Lib_Directory & "/../declib");
|
|
||||||
|
|
||||||
Opts.Increment_Last;
|
|
||||||
|
|
||||||
if The_Build_Mode = Static then
|
|
||||||
Opts.Table (Opts.Last) := new String'("-ldecgnat");
|
|
||||||
else
|
|
||||||
Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat"));
|
|
||||||
end if;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Opts.Increment_Last;
|
Opts.Increment_Last;
|
||||||
|
|
||||||
if The_Build_Mode = Static then
|
if The_Build_Mode = Static then
|
||||||
|
@ -2131,10 +2091,6 @@ package body MLib.Prj is
|
||||||
Object_Dir : Dir_Type;
|
Object_Dir : Dir_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if OpenVMS_On_Target then
|
|
||||||
B_Start := new String'("b__");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- If the library file does not exist, then the time stamp will
|
-- If the library file does not exist, then the time stamp will
|
||||||
-- be Empty_Time_Stamp, earlier than any other time stamp.
|
-- be Empty_Time_Stamp, earlier than any other time stamp.
|
||||||
|
|
||||||
|
@ -2152,7 +2108,7 @@ package body MLib.Prj is
|
||||||
-- generated file.
|
-- generated file.
|
||||||
|
|
||||||
if Is_Obj (Name_Buffer (1 .. Name_Len))
|
if Is_Obj (Name_Buffer (1 .. Name_Len))
|
||||||
and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
|
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
|
||||||
then
|
then
|
||||||
-- Get the object file time stamp
|
-- Get the object file time stamp
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1999-2009, AdaCore --
|
-- Copyright (C) 1999-2014, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -27,7 +27,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||||
with Interfaces.C.Strings;
|
with Interfaces.C.Strings;
|
||||||
with System;
|
with System;
|
||||||
|
|
||||||
with Hostparm;
|
|
||||||
with Opt;
|
with Opt;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
|
|
||||||
|
@ -459,12 +458,4 @@ package body MLib is
|
||||||
return Separate_Paths;
|
return Separate_Paths;
|
||||||
end Separate_Run_Path_Options;
|
end Separate_Run_Path_Options;
|
||||||
|
|
||||||
-- Package elaboration
|
|
||||||
|
|
||||||
begin
|
|
||||||
-- Copy_Attributes always fails on VMS
|
|
||||||
|
|
||||||
if Hostparm.OpenVMS then
|
|
||||||
Preserve := None;
|
|
||||||
end if;
|
|
||||||
end MLib;
|
end MLib;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- S p e c --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1999-2009, AdaCore --
|
-- Copyright (C) 1999-2014, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -91,7 +91,6 @@ package MLib is
|
||||||
private
|
private
|
||||||
|
|
||||||
Preserve : Attribute := Time_Stamps;
|
Preserve : Attribute := Time_Stamps;
|
||||||
-- Used by Copy_ALI_Files. Changed to None for OpenVMS, because
|
-- Used by Copy_ALI_Files.
|
||||||
-- Copy_Attributes always fails on VMS.
|
|
||||||
|
|
||||||
end MLib;
|
end MLib;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2003-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 2003-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -25,7 +25,6 @@
|
||||||
|
|
||||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||||
|
|
||||||
with Hostparm; use Hostparm;
|
|
||||||
with Opt; use Opt;
|
with Opt; use Opt;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
|
|
||||||
|
@ -33,9 +32,8 @@ package body Tempdir is
|
||||||
|
|
||||||
Tmpdir_Needs_To_Be_Displayed : Boolean := True;
|
Tmpdir_Needs_To_Be_Displayed : Boolean := True;
|
||||||
|
|
||||||
Tmpdir : constant String := "TMPDIR";
|
Tmpdir : constant String := "TMPDIR";
|
||||||
Gnutmpdir : constant String := "GNUTMPDIR";
|
Temp_Dir : String_Access := new String'("");
|
||||||
Temp_Dir : String_Access := new String'("");
|
|
||||||
|
|
||||||
----------------------
|
----------------------
|
||||||
-- Create_Temp_File --
|
-- Create_Temp_File --
|
||||||
|
@ -118,21 +116,7 @@ package body Tempdir is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Status then
|
if Status then
|
||||||
|
Dir := Getenv (Tmpdir);
|
||||||
-- On VMS, if GNUTMPDIR is defined, use it
|
|
||||||
|
|
||||||
if OpenVMS then
|
|
||||||
Dir := Getenv (Gnutmpdir);
|
|
||||||
|
|
||||||
-- Otherwise, if GNUTMPDIR is not defined, try TMPDIR
|
|
||||||
|
|
||||||
if Dir'Length = 0 then
|
|
||||||
Dir := Getenv (Tmpdir);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
else
|
|
||||||
Dir := Getenv (Tmpdir);
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Free (Temp_Dir);
|
Free (Temp_Dir);
|
||||||
|
|
Loading…
Reference in New Issue