Constraint_Error with Gnatcoll.Json?

General
1

I’m trying to use Gnatcoll.Json to parse a JSON document. I discovered that I can do the following to parse JSON (which is pretty great) (i.e., the following parses the sPDX license list as an example):

with Gnatcoll.JSON; use Gnatcoll.JSON;
-- ...
procedure Build_License_List is new Gen_Map_JSON_Object(License_List);
procedure Build_License_List_Data is new Gen_Map_JSON_Object(License_List_Data);

Then you can parse the JSON like so:

procedure Construct_License_List_Data(data: in out License_List_Data; Name: UTF8_String; Value: Json_Value);
procedure Construct_License_List(list: in out License_List; Name: UTF8_String; Value: Json_Value) is
   Tmp_License: aliased License_List_Data;
begin
   if Name = "licenseListVersion" then
      list.Version := Value.Get;
   elsif name = "licenses" then
      Build_License_List_Data(Value, Construct_License_List_Data'Access, Tmp_License);
      list.licenses.append(tmp_license);
   else
      return;
   end if;
end Construct_License_List;

procedure Construct_License_List_Data(data: in out License_List_Data; Name: UTF8_String; Value: Json_Value) is
begin
   if name = "reference" then
      data.Reference := Value.Get;
   elsif name = "isDeprecatedLicenseId" then
      data.Deprecated := Value.Get;
   elsif name = "detailsUrl" then
      data.details_url := Value.Get;
   elsif name = "referenceNumber" then
      Data.Reference_Number := Value.Get;
   elsif name = "name" then
      data.Name := value.get;
   elsif name = "licenseId" then
      data.id := value.get;
   elsif name = "seeAlso" then
      for link in 1 .. Gnatcoll.Json.Length(value.get) loop
         data.see_also.append(get(value.get, link).get);
      end loop;
   elsif name = "isOsiApproved" then
      data.osi_approved := value.get;
   else
      return;
   end if;
end Construct_License_List_Data;

Then you build the root by calling Build_License_List(value, Construct_License_List'Access, Licenses_object). The problem is that I’m getting a constraint error when I run this app:

raised CONSTRAINT_ERROR : gnatcoll-json.adb:1802 discriminant check failed
[test.exe]
0x7ff60b0c5123 gnatcoll__json__utility__escape_string at ???
0x7ff60b64ae66 Test.Build_License_List.Internal at gnatcoll-json.adb:1833
0x7ff60b64b047 Test.Build_License_List.Internal at nvpm.adb:43
0x7ff60b64ae09 Test.Build_License_List.Internal at gnatcoll-json.adb:1829
0x7ff60b0c5003 gnatcoll__json__utility__escape_string at ???
0x7ff60b64add6 Test.B2215b at gnatcoll-json.adb:1833
0x7ff60b648ff1 Test at test.adb:88
0x7ff60b64a8dc Test at b__test.adb:1354
0x7ff60b0b133e __tmainCRTStartup at ???
0x7ff60b0b1144 mainCRTStartup at ???
[C:\Windows\System32\KERNEL32.DLL]
0x7ffe9bb77372
[C:\Windows\SYSTEM32\ntdll.dll]
0x7ffe9bcbcc8f

This is really weird, because the code looks fine to me when I look at the generic code:

   ---------------------
   -- Map_JSON_Object --
   ---------------------

   procedure Map_JSON_Object
     (Val : JSON_Value;
      CB  : access procedure (Name : UTF8_String; Value : JSON_Value))
   is
      use Object_Items_Pkg;
      C : Cursor := Val.Data.Obj_Value.Vals.First;
   begin
      while Has_Element (C) loop
         CB (To_String (Key (C)), Element (C));
         Next (C);
      end loop;
   end Map_JSON_Object;

   ---------------------
   -- Map_JSON_Object --
   ---------------------

   procedure Gen_Map_JSON_Object
     (Val         : JSON_Value;
      CB          : access procedure
        (User_Object : in out Mapped;
         Name        : UTF8_String;
         Value       : JSON_Value);
      User_Object : in out Mapped)
   is
      procedure Internal (Name : UTF8_String; Value : JSON_Value);

      --------------
      -- Internal --
      --------------

      procedure Internal (Name : UTF8_String; Value : JSON_Value) is
      begin
         CB (User_Object, Name, Value);
      end Internal;

   begin
      Map_JSON_Object (Val, Internal'Access);
   end Gen_Map_JSON_Object;

Is this a bug in Gnat, a bug in gnatcoll (I’m using version 24) or am I doing something wrong? Am I not supposed to use this API?

2

This happened to me recently. Code that had built and run just fine started crashing when I ran after rebuilding. I think it’s a change to gnat itself, probably an improvement, because looking at it now I suspect I had a hidden bug and was just lucky before. Could be that you’re facing a different issue. You certainly seem to be hitting a different function, but it’s worth a shot. I needed to check if the JSON parsing succeeded first. Basically, my code changed from this:

Read_Result : GNATCOLL.JSON.Read_Result;
-- ...
Read_Result := GNATCOLL.JSON.Read (All_Lines);
-- ...
if Read_Result.Value.Has_Field("corner_x")

to this:

-- first few lines the same, but the if changes to:
if Read_Result.Success and then Read_Result.Value.Has_Field ("corner_x")
3

I’m not really sure what I’d change my parse code to. I just called the one that returns a JSON_Value; I didn’t use the Read_Result one. I’ll try changing it to that to see if things get better.

4

So I just tried changing it to use the Read_Result API and it still breaks. So I think something might be missing or broken somewhere, either in my code or elsewhere.

It seems to work fine when it handles the licenseListVersion field, but as soon as it encounters the licenses field (an array of license objects) it just dies immediately. Doesn’t even get to printing my parsing debugging message to say what exactly it’s parsing.