* krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target.
When True, apply VMS treatment to children of packages A, G, I and S.
For F320-016
* fname-uf.adb (Get_File_Name): Call Krunch with OpenVMS_On_Target
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118270
138bc75d-0d04-0410-961f-
82ee72b054a4
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Opt; use Opt;
with Osint; use Osint;
with Table;
+with Targparm; use Targparm;
with Uname; use Uname;
with Widechar; use Widechar;
(Name_Buffer,
Name_Len,
Integer (Maximum_File_Name_Length),
- Debug_Flag_4);
+ Debug_Flag_4,
+ OpenVMS_On_Target);
-- Replace extension
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Hostparm;
procedure Krunch
- (Buffer : in out String;
- Len : in out Natural;
- Maxlen : Natural;
- No_Predef : Boolean)
+ (Buffer : in out String;
+ Len : in out Natural;
+ Maxlen : Natural;
+ No_Predef : Boolean;
+ VMS_On_Target : Boolean := False)
is
+ pragma Assert (Buffer'First = 1);
+ -- This is a documented requirement; the assert turns off index warnings
+
B1 : Character renames Buffer (1);
Curlen : Natural;
Krlen : Natural;
-- is A, G, I, or S. In order to prevent confusion with krunched names
-- of predefined units use a tilde rather than a minus as the second
-- character of the file name. On VMS a tilde is an illegal character
- -- in a file name, so a dollar_sign is used instead.
+ -- in a file name, two consecutive underlines ("__") are used instead.
elsif Len > 1
and then Buffer (2) = '-'
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
and then Len <= Maxlen
then
- if Hostparm.OpenVMS then
- Buffer (2) := '$';
+ -- When VMS is the host, it is always also the target.
+
+ if Hostparm.OpenVMS or else VMS_On_Target then
+ Len := Len + 1;
+ Buffer (4 .. Len) := Buffer (3 .. Len - 1);
+ Buffer (2) := '_';
+ Buffer (3) := '_';
else
Buffer (2) := '~';
end if;
- return;
+ if Len <= Maxlen then
+ return;
+
+ else
+ -- Case of VMS when the buffer had exactly the length Maxlen and now
+ -- has the length Maxlen + 1: krunching after "__" is needed.
+
+ Startloc := 4;
+ Curlen := Len;
+ Krlen := Maxlen;
+ end if;
-- Normal case, not a predefined file
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- unique in the standard predefined libraries.
procedure Krunch
- (Buffer : in out String;
- Len : in out Natural;
- Maxlen : Natural;
- No_Predef : Boolean);
+ (Buffer : in out String;
+ Len : in out Natural;
+ Maxlen : Natural;
+ No_Predef : Boolean;
+ VMS_On_Target : Boolean := False);
pragma Elaborate_Body (Krunch);
-- The full file name is stored in Buffer (1 .. Len) on entry. The file
-- name is crunched in place and on return Len is updated, so that the
-- case it may be possible that Krunch does not modify Buffer. The fourth
-- parameter, No_Predef, is a switch which, if set to True, disables the
-- normal special treatment of predefined library unit file names.
+-- VMS_On_Target, when True, indicates to Krunch to apply the VMS treatment
+-- to the children of package A, G,I or S.
--
-- Note: the string Buffer must have a lower bound of 1, and may not
-- contain any blanks (in particular, it must not have leading blanks).