aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/krunch.adb
diff options
context:
space:
mode:
authorVincent Celier <celier@adacore.com>2006-10-31 18:57:54 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2006-10-31 18:57:54 +0100
commitac3b962ec3965793916eea80eab7f5dd42aa7570 (patch)
treed63b2085a31b18783fe0829d72ad65bbe59dc4ff /gcc/ada/krunch.adb
parent05350ac648924d81ebd552d045da2dfe71b72e24 (diff)
downloadgcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.zip
gcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.tar.gz
gcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.tar.bz2
krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target.
2006-10-31 Vincent Celier <celier@adacore.com> * 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 From-SVN: r118270
Diffstat (limited to 'gcc/ada/krunch.adb')
-rw-r--r--gcc/ada/krunch.adb37
1 files changed, 28 insertions, 9 deletions
diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb
index 53d6285..f15a7a6 100644
--- a/gcc/ada/krunch.adb
+++ b/gcc/ada/krunch.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -34,12 +34,16 @@
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;
@@ -119,20 +123,35 @@ begin
-- 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