[Ada] Improve error message for .ali file version mismatch

gcc/ada/

	* bcheck.adb (Check_Versions): Add support for the case where
	the .ali file contains both a primary and a secondary version
	number, as in "GNAT Lib v22.20210809".
This commit is contained in:
Steve Baird 2021-08-10 10:33:42 -07:00 committed by Pierre-Marie de Rodat
parent aa4648eef4
commit 19ab5a56d6

View File

@ -1325,60 +1325,105 @@ package body Bcheck is
or else ALIs.Table (A).Ver (1 .. VL) /=
ALIs.Table (ALIs.First).Ver (1 .. VL)
then
declare
No_Version : constant Int := -1;
-- Version mismatch found; generate error message.
function Extract_Version (S : String) return Int;
-- Attempts to extract and return a nonnegative library
-- version number from the given string; if unsuccessful,
declare
use Gnatvsn;
Prefix : constant String :=
Verbose_Library_Version
(1 .. Verbose_Library_Version'Length
- Library_Version'Length);
type ALI_Version is record
Primary, Secondary : Int range -1 .. Int'Last;
end record;
No_Version : constant ALI_Version := (-1, -1);
function Remove_Prefix (S : String) return String is
(S (S'First + Prefix'Length .. S'Last));
function Extract_Version (S : String) return ALI_Version;
-- Attempts to extract and return a pair of nonnegative library
-- version numbers from the given string; if unsuccessful,
-- then returns No_Version.
---------------------
-- Extract_Version --
---------------------
function Extract_Version (S : String) return Int is
use Gnatvsn;
Prefix : constant String :=
Verbose_Library_Version
(1 .. Verbose_Library_Version'Length
- Library_Version'Length);
begin
function Extract_Version (S : String) return ALI_Version is
pragma Assert (S'First = 1);
function Int_Value (Img : String) return Int;
-- Using Int'Value leads to complications in
-- building the binder, so DIY.
---------------
-- Int_Value --
---------------
function Int_Value (Img : String) return Int is
Result : Nat := 0;
begin
if Img'Length in 1 .. 9
and then (for all C of Img => C in '0' .. '9')
then
for C of Img loop
Result := (10 * Result) +
(Character'Pos (C) - Character'Pos ('0'));
end loop;
return Result;
else
return -1;
end if;
end Int_Value;
begin
if S'Length > Prefix'Length
and then S (1 .. Prefix'Length) = Prefix
and then S (1 .. Prefix'Length) = Prefix
then
declare
Suffix : constant String :=
S (1 + Prefix'Length .. S'Last);
Result : Nat := 0;
Suffix : constant String := Remove_Prefix (S);
Dot_Found : Boolean := False;
Primary, Secondary : Int;
begin
if Suffix'Length < 10
and then (for all C of Suffix => C in '0' .. '9')
then
-- Using Int'Value leads to complications in
-- building the binder, so DIY.
for Dot_Index in Suffix'Range loop
if Suffix (Dot_Index) = '.' then
Dot_Found := True;
Primary :=
Int_Value (Suffix (Suffix'First
.. Dot_Index - 1));
Secondary :=
Int_Value (Suffix (Dot_Index + 1
.. Suffix'Last));
exit;
end if;
end loop;
for C of Suffix loop
Result := (10 * Result) +
(Character'Pos (C) - Character'Pos ('0'));
end loop;
return Result;
if not Dot_Found then
Primary := Int_Value (Suffix);
Secondary := 0;
end if;
if (Primary /= -1) and (Secondary /= -1) then
return (Primary => Primary,
Secondary => Secondary);
end if;
end;
end if;
return No_Version;
end Extract_Version;
-- Local constants
V1_Text : constant String :=
ALIs.Table (A).Ver (1 .. ALIs.Table (A).Ver_Len);
V2_Text : constant String :=
ALIs.Table (ALIs.First).Ver (1 .. VL);
V1 : constant Int := Extract_Version (V1_Text);
V2 : constant Int := Extract_Version (V2_Text);
V1 : constant ALI_Version := Extract_Version (V1_Text);
V2 : constant ALI_Version := Extract_Version (V2_Text);
Include_Version_Numbers_In_Message : constant Boolean :=
(V1 /= V2) and (V1 /= No_Version) and (V2 /= No_Version);
@ -1387,11 +1432,24 @@ package body Bcheck is
Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
if Include_Version_Numbers_In_Message then
Error_Msg_Nat_1 := V1;
Error_Msg_Nat_2 := V2;
Consistency_Error_Msg
("{ and { compiled with different GNAT versions"
& ", v# and v#");
if V1.Secondary = V2.Secondary then
-- Excluding equal secondary values from error
-- message text matters for generating reproducible
-- regression test outputs.
Error_Msg_Nat_1 := V1.Primary;
Error_Msg_Nat_2 := V2.Primary;
Consistency_Error_Msg
("{ and { compiled with different GNAT versions"
& ", v# and v#");
else
Consistency_Error_Msg
("{ and { compiled with different GNAT versions"
& ", v"
& Remove_Prefix (V1_Text)
& " and v"
& Remove_Prefix (V2_Text));
end if;
else
Consistency_Error_Msg
("{ and { compiled with different GNAT versions");