[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:
parent
aa4648eef4
commit
19ab5a56d6
@ -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");
|
||||
|
Loading…
x
Reference in New Issue
Block a user