X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fgnatkr.adb;h=a60e4548c6b15edecbba4cc24434c5875c5d95ce;hb=914796b1122e63f14d506bac0d830bdc53064abd;hp=7d8715852500339c1a50e29d3ef3f2c5ae3a048c;hpb=83cce46b47d48de4c71b02a20f5bf36296a48568;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/gnatkr.adb b/gcc/ada/gnatkr.adb index 7d871585250..a60e4548c6b 100644 --- a/gcc/ada/gnatkr.adb +++ b/gcc/ada/gnatkr.adb @@ -6,9 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.18 $ --- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2003 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- -- @@ -18,11 +16,11 @@ -- 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 COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- --- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ @@ -33,7 +31,7 @@ with Krunch; with System.IO; use System.IO; procedure Gnatkr is - pragma Ident (Gnatvsn.Gnat_Version_String); + pragma Ident (Gnatvsn.Gnat_Static_Version_String); Count : Natural; Maxlen : Integer; @@ -95,29 +93,19 @@ begin -- If extension is present, points to it (init to prevent warning) begin - -- Remove .adb or .ads extension if present (recognized only if the + -- Remove extension if present (an extension is defined as the + -- section of the file name after the last dot in the name. If + -- there is no dot in the name, then -- name is all lower case and contains no other instances of dots) - if Klen > 4 - and then Fname (Klen - 3 .. Klen - 1) = ".ad" - and then (Fname (Klen) = 's' or else Fname (Klen) = 'b') - then - Extp := True; - - for J in 1 .. Klen - 4 loop - if Is_Upper (Fname (J)) or else Fname (J) = '.' then - Extp := False; - end if; - end loop; - - if Extp then - Klen := Klen - 4; - Ext := Klen + 1; + for J in reverse 1 .. Klen loop + if Fname (J) = '.' then + Extp := True; + Ext := J; + Klen := J - 1; + exit; end if; - - else - Extp := False; - end if; + end loop; -- Fold to lower case and replace dots by dashes