Skip to content

Commit

Permalink
Langkit_Support.Slocs: add Value (string parsing) functions
Browse files Browse the repository at this point in the history 
For GitHub issue AdaCore#492
  • Loading branch information
@pmderodat
pmderodat committed Apr 14, 2021
1 parent 62b57ee commit 4ac75a7
Show file tree
Hide file tree
Showing 5 changed files with 153 additions and 2 deletions.
50 changes: 50 additions & 0 deletions support/langkit_support-slocs.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@
-- <http://www.gnu.org/licenses/>. --
------------------------------------------------------------------------------

with Ada.Strings.Wide_Wide_Fixed; use Ada.Strings.Wide_Wide_Fixed;

package body Langkit_Support.Slocs is

-------------
Expand Down Expand Up @@ -73,4 +75,52 @@ package body Langkit_Support.Slocs is
else Inside));
end Compare;

-----------
-- Value --
-----------

function Value (T : Text_Type) return Source_Location is
Colon_Index : constant Natural := Index (T, ":");
Line_Slice : Text_Type renames T (T'First .. Colon_Index - 1);
Column_Slice : Text_Type renames T (Colon_Index + 1 .. T'Last);
Line : Line_Number;
Column : Column_Number;
begin
if Colon_Index = 0 then
raise Constraint_Error with "invalid source location";
end if;

begin
Line := Line_Number'Wide_Wide_Value (Line_Slice);
exception
when Constraint_Error =>
raise Constraint_Error with
"invalid line number: "
& Image (Line_Slice, With_Quotes => True);
end;

begin
Column := Column_Number'Wide_Wide_Value (Column_Slice);
exception
when Constraint_Error =>
raise Constraint_Error with
"invalid column number: "
& Image (Column_Slice, With_Quotes => True);
end;

return (Line, Column);
end Value;

-----------
-- Value --
-----------

function Value (T : Text_Type) return Source_Location_Range is
Dash_Index : constant Natural := Index (T, "-");
Start_Slice : Text_Type renames T (T'First .. Dash_Index - 1);
End_Slice : Text_Type renames T (Dash_Index + 1 .. T'Last);
begin
return Make_Range (Value (Start_Slice), Value (End_Slice));
end Value;

end Langkit_Support.Slocs;
32 changes: 30 additions & 2 deletions support/langkit_support-slocs.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,10 @@ package Langkit_Support.Slocs is
No_Source_Location : constant Source_Location := (0, 0);
No_Source_Location_Range : constant Source_Location_Range := (0, 0, 0, 0);

--------------------------
-- Constructors/getters --
--------------------------

function Start_Sloc
(Sloc_Range : Source_Location_Range) return Source_Location
is ((Line => Sloc_Range.Start_Line, Column => Sloc_Range.Start_Column));
Expand All @@ -63,6 +67,10 @@ package Langkit_Support.Slocs is
Start_Column => Start_Sloc.Column,
End_Column => End_Sloc.Column));

--------------------------
-- Location comparisons --
--------------------------

function Compare
(Reference, Compared : Source_Location) return Relative_Position
with Pre => (Reference /= No_Source_Location
Expand All @@ -86,6 +94,16 @@ package Langkit_Support.Slocs is
and then Sloc /= No_Source_Location);
-- Tell where Sloc is with respect to Sloc_Range

------------------------
-- String conversions --
------------------------

-- All functions below assume that the textual representation of
-- Source_Location values have the form "L:C" (L being the line number, C
-- the column number) and Source_Location_Range have the form
-- "L1:C1-L2-C2" (L1 and C1 are numbers for the start sloc, L2 and C2 are
-- the numbers for the end sloc).

function Image (Sloc : Source_Location) return String is
(Ada.Strings.Fixed.Trim (Line_Number'Image (Sloc.Line), Left) & ':'
& Ada.Strings.Fixed.Trim (Column_Number'Image (Sloc.Column), Left));
Expand All @@ -95,7 +113,17 @@ package Langkit_Support.Slocs is
& Image (End_Sloc (Sloc_Range)));

function Image (Sloc : Source_Location) return Text_Type
is
(To_Text (Image (Sloc)));
is (To_Text (Image (Sloc)));

function Image (Sloc_Range : Source_Location_Range) return Text_Type
is (To_Text (Image (Sloc_Range)));

function Value (T : Text_Type) return Source_Location;
function Value (S : String) return Source_Location
is (Value (To_Text (S)));

function Value (T : Text_Type) return Source_Location_Range;
function Value (S : String) return Source_Location_Range
is (Value (To_Text (S)));

end Langkit_Support.Slocs;
58 changes: 58 additions & 0 deletions testsuite/tests/langkit_support/slocs/main.adb
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,58 @@
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

with Langkit_Support.Slocs; use Langkit_Support.Slocs;
with Langkit_Support.Text; use Langkit_Support.Text;

procedure Main is

procedure Check_Sloc (S : String);
procedure Check_Sloc_Range (S : String);

----------------
-- Check_Sloc --
----------------

procedure Check_Sloc (S : String) is
Sloc : Source_Location;
begin
Put ("""" & S & """ -> ");
Sloc := Value (S);
Put_Line (Image (Sloc));
exception
when Exc : Constraint_Error =>
Put_Line ("error: " & Exception_Message (Exc));
end Check_Sloc;

----------------------
-- Check_Sloc_Range --
----------------------

procedure Check_Sloc_Range (S : String) is
SR : Source_Location_Range;
begin
Put ("""" & S & """ -> ");
SR := Value (S);
Put_Line (Image (SR));
exception
when Exc : Constraint_Error =>
Put_Line ("error: " & Exception_Message (Exc));
end Check_Sloc_Range;

begin
Check_Sloc ("0:0");
Check_Sloc ("123:456");
Check_Sloc ("");
Check_Sloc ("1");
Check_Sloc (":1");
Check_Sloc ("-1:2");
Check_Sloc ("a:2");

Check_Sloc_Range ("1:2-3:4");
Check_Sloc_Range ("1:2-3:");
Check_Sloc_Range (":2-3:4");
Check_Sloc_Range ("1:-3:4");
Check_Sloc_Range ("1:2-:4");
Check_Sloc_Range ("1:2-3:");
Check_Sloc_Range ("1:2-3:-1");
end Main;
14 changes: 14 additions & 0 deletions testsuite/tests/langkit_support/slocs/test.out
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
"0:0" -> 0:0
"123:456" -> 123:456
"" -> error: invalid source location
"1" -> error: invalid source location
":1" -> error: invalid line number: ""
"-1:2" -> error: invalid line number: "-1"
"a:2" -> error: invalid line number: "a"
"1:2-3:4" -> 1:2-3:4
"1:2-3:" -> error: invalid column number: ""
":2-3:4" -> error: invalid line number: ""
"1:-3:4" -> error: invalid column number: ""
"1:2-:4" -> error: invalid line number: ""
"1:2-3:" -> error: invalid column number: ""
"1:2-3:-1" -> error: invalid column number: "-1"
1 change: 1 addition & 0 deletions testsuite/tests/langkit_support/slocs/test.yaml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
driver: langkit_support

3 comments on commit 4ac75a7

@pjljvandelaar
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does source_location_range miss a check?
source_location has

      if Colon_Index = 0 then
         raise Constraint_Error with "invalid source location";
      end if;

Should one also add this for Dash_Index?

@pmderodat
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That would be redundant with existing checks. I’ll extend the testcase to demonstrate this.

@pjljvandelaar
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note that one get
Constraint_Error with "invalid source location";
in case that a source locationrange doesn't contain a dash.

Please sign in to comment.