------------------------------------------------------------------------------
--                                                                          --
--                            GNAT2WHY COMPONENTS                           --
--                                                                          --
--                      G N A T 2 W H Y - C E _ U T I L S                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2018-2025, AdaCore                     --
--                                                                          --
-- gnat2why is  free  software;  you can redistribute  it and/or  modify it --
-- under terms of the  GNU General Public License as published  by the Free --
-- Software  Foundation;  either version 3,  or (at your option)  any later --
-- version.  gnat2why is distributed  in the hope that  it will be  useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHAN- --
-- TABILITY 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  gnat2why;  see file COPYING3. --
-- If not,  go to  http://www.gnu.org/licenses  for a complete  copy of the --
-- license.                                                                 --
--                                                                          --
-- gnat2why is maintained by AdaCore (http://www.adacore.com)               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;
with Ada.Numerics.Big_Numbers.Big_Integers;
use Ada.Numerics.Big_Numbers.Big_Integers;
with Ada.Numerics.Big_Numbers.Big_Reals;
use Ada.Numerics.Big_Numbers.Big_Reals;
with Ada.Strings.UTF_Encoding.Strings;
use Ada.Strings.UTF_Encoding.Strings;
with Ada.Strings.Fixed;                     use Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Atree;
with CE_RAC;                                use CE_RAC;
with Einfo.Entities;
with Gnat2Why.Tables;                       use Gnat2Why.Tables;
with Gnat2Why.Util;                         use Gnat2Why.Util;
with Namet;
with Nlists;                                use Nlists;
with Sinput;                                use Sinput;
with SPARK_Definition.Annotate;             use SPARK_Definition.Annotate;
with SPARK_Util;                            use SPARK_Util;

package body CE_Utils is

   function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
   --  Similar to Compile_Time_Known_Value, but also returns True if the value
   --  is a compile-time-known aggregate, i.e. an aggregate all of whose
   --  constituent expressions are either compile-time-known values (based on
   --  calling Compile_Time_Known_Value) or compile-time-known aggregates.
   --  Note that the aggregate could still involve run-time checks that might
   --  fail (such as for subtype checks in component associations), but the
   --  evaluation of the expressions themselves will not raise an exception.
   --
   --  ??? This routine was originally reused from the frontend, but it
   --  was a relic VMS utility; it is highly unlikely we should use it for
   --  counterexamples.

   --------------------------------------
   -- Compile_Time_Known_Value_Or_Aggr --
   --------------------------------------

   function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean is
   begin
      --  If we have an entity name, then see if it is the name of a constant
      --  and if so, test the corresponding constant value, or the name of
      --  an enumeration literal, which is always a constant.

      if Is_Entity_Name (Op) then
         declare
            E : constant Entity_Id := Entity (Op);
            V : Node_Id;

         begin
            if Ekind (E) = E_Enumeration_Literal then
               return True;

            elsif Ekind (E) /= E_Constant then
               return False;

            else
               V := Constant_Value (E);
               return
                 Present (V) and then Compile_Time_Known_Value_Or_Aggr (V);
            end if;
         end;

      --  We have a value, see if it is compile-time-known

      else
         if Compile_Time_Known_Value (Op) then
            return True;

         elsif Nkind (Op) = N_Aggregate then

            if Present (Expressions (Op)) then
               declare
                  Expr : Node_Id;
               begin
                  Expr := First (Expressions (Op));
                  while Present (Expr) loop
                     if not Compile_Time_Known_Value_Or_Aggr (Expr) then
                        return False;
                     else
                        Next (Expr);
                     end if;
                  end loop;
               end;
            end if;

            if Present (Component_Associations (Op)) then
               declare
                  Cass : Node_Id;

               begin
                  Cass := First (Component_Associations (Op));
                  while Present (Cass) loop
                     if not Compile_Time_Known_Value_Or_Aggr
                              (Expression (Cass))
                     then
                        return False;
                     end if;

                     Next (Cass);
                  end loop;
               end;
            end if;

            return True;

         elsif Nkind (Op) = N_Qualified_Expression then
            return Compile_Time_Known_Value_Or_Aggr (Expression (Op));

         --  All other types of values are not known at compile time

         else
            return False;
         end if;

      end if;
   end Compile_Time_Known_Value_Or_Aggr;

   -------------------------------------
   -- Compile_Time_Known_And_Constant --
   -------------------------------------

   function Compile_Time_Known_And_Constant (E : Entity_Id) return Boolean is
   begin
      if Ekind (E) = E_Constant then
         declare
            Decl : constant Node_Id := Enclosing_Declaration (E);
            Expr : constant Node_Id := Expression (Decl);
         begin
            return
              Present (Expr) and then Compile_Time_Known_Value_Or_Aggr (Expr);
         end;
      end if;

      return False;
   end Compile_Time_Known_And_Constant;

   ----------------------------------
   -- Component_Is_Removed_In_Type --
   ----------------------------------

   function Component_Is_Removed_In_Type
     (Ty : Entity_Id; Comp : Entity_Id; Vals : Entity_To_Value_Maps.Map)
      return Boolean
   is

      function Eval_Discrete_Choices
        (Choices : List_Id; Discr : Big_Integer) return Boolean;
      --  Evaluate Discr in Choices assuming Choices contains only static
      --  values.

      function Eval_Others_Choice
        (Info : Component_Info; Discr : Big_Integer) return Boolean;
      --  Return True is Discr in Choices returns True for all Choices in
      --  Info.Parent_Var_Part, assuming all the choices contains only static
      --  values.

      ---------------------------
      -- Eval_Discrete_Choices --
      ---------------------------

      function Eval_Discrete_Choices
        (Choices : List_Id; Discr : Big_Integer) return Boolean
      is
         Choice : Node_Id := First (Choices);
      begin
         while Present (Choice) loop
            pragma Assert (Nkind (Choice) /= N_Others_Choice);

            --  When the choice denotes a subtype with a predicate, check the
            --  expression against the predicate values.

            if (Nkind (Choice) = N_Subtype_Indication
                or else
                  (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice))))
              and then Has_Predicates (Etype (Choice))
            then
               pragma Assert (Has_Static_Predicate (Etype (Choice)));
               if Eval_Discrete_Choices
                    (Static_Discrete_Predicate (Etype (Choice)), Discr)
               then
                  return True;
               end if;

            --  The bounds of the range should be compile time known as only
            --  static choices are allowed in variant parts.

            elsif Nkind (Choice) in N_Subtype_Indication | N_Range
              or else
                (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
            then
               declare
                  Range_Node : constant Node_Id := Get_Range (Choice);
                  Low        : constant Node_Id := Low_Bound (Range_Node);
                  High       : constant Node_Id := High_Bound (Range_Node);
                  Fst, Lst   : Big_Integer;
               begin
                  pragma
                    Assert
                      (Compile_Time_Known_Value (Low)
                       and then Compile_Time_Known_Value (High));
                  Fst := From_String (UI_Image (Expr_Value (Low)));
                  Lst := From_String (UI_Image (Expr_Value (High)));

                  if Discr >= Fst and then Lst >= Discr then
                     return True;
                  end if;
               end;

            --  Single value choices should be compile time known as only
            --  static choices are allowed in variant parts.

            else
               declare
                  Val : Big_Integer;
               begin
                  pragma Assert (Compile_Time_Known_Value (Choice));
                  Val := From_String (UI_Image (Expr_Value (Choice)));
                  if Discr = Val then
                     return True;
                  end if;
               end;
            end if;

            Next (Choice);
         end loop;

         return False;
      end Eval_Discrete_Choices;

      ------------------------
      -- Eval_Others_Choice --
      ------------------------

      function Eval_Others_Choice
        (Info : Component_Info; Discr : Big_Integer) return Boolean
      is
         Var_Part : constant Node_Id := Info.Parent_Var_Part;
         Var      : Node_Id := First (Variants (Var_Part));

      begin
         while Present (Var) loop
            if not Is_Others_Choice (Discrete_Choices (Var))
              and then Eval_Discrete_Choices (Discrete_Choices (Var), Discr)
            then
               return False;
            end if;
            Next (Var);
         end loop;

         return True;
      end Eval_Others_Choice;

      use Entity_To_Value_Maps;
      Comp_Info : constant Component_Info_Map := Get_Variant_Info (Ty);
      Info      : Component_Info;

      --  Start of processing for Component_Is_Removed_In_Type

   begin
      --  If Comp is not a component, it cannot be discriminant dependant

      if Ekind (Comp) /= E_Component then
         return False;
      end if;

      --  Go through the enclosing variant parts if any to check the value of
      --  the corresponding discriminants.

      Info := Get_Component_Info (Comp_Info, Comp);

      while Present (Info.Parent_Variant) loop
         declare
            Discr   : constant Node_Id := Entity (Name (Info.Parent_Var_Part));
            Cur     : constant Entity_To_Value_Maps.Cursor :=
              Vals.Find (Discr);
            Val     : Value_Type;
            Int_Val : Big_Integer;

         begin
            --  If we do not have a counterexample value for Discr, the
            --  component cannot be removed. Go to the next variant part in
            --  case it uses another discriminant.

            if Cur = No_Element then
               goto Next_Variant;
            end if;

            Val := Element (Cur).all;
            pragma Assert (Val.K = Scalar_K);

            if Val.Scalar_Content = null then
               goto Next_Variant;
            end if;

            --  Transform the counterexample value of Discr into a big integer

            case Val.Scalar_Content.K is
               when Integer_K =>
                  Int_Val := Val.Scalar_Content.Integer_Content;

               when Char_K    =>
                  declare
                     N : constant Node_Id := Val.Scalar_Content.Char_Node;
                  begin
                     pragma Assert (Nkind (N) = N_Character_Literal);
                     Int_Val :=
                       From_String (UI_Image (Char_Literal_Value (N)));
                  end;

               when Enum_K    =>
                  declare
                     Ent : constant Entity_Id :=
                       Val.Scalar_Content.Enum_Entity;
                  begin
                     pragma Assert (Ekind (Ent) = E_Enumeration_Literal);
                     Int_Val := From_String (UI_Image (Enumeration_Pos (Ent)));
                  end;

               when others    =>
                  raise Program_Error;
            end case;

            --  Check the necessary contraint on Discr for Comp to be defined.
            --  If it is False, the component can be removed.

            declare
               Cond : constant Boolean :=
                 (if Is_Others_Choice (Discrete_Choices (Info.Parent_Variant))
                  then Eval_Others_Choice (Info, Int_Val)
                  else
                    Eval_Discrete_Choices
                      (Discrete_Choices (Info.Parent_Variant), Int_Val));
            begin
               if not Cond then
                  return True;
               end if;
            end;

            --  The component could not be excluded looking at the value of the
            --  first enclosing variant part. Go to the enclosing one if any.

            <<Next_Variant>>
            Info := Get_Component_Info (Comp_Info, Info.Parent_Var_Part);
         end;
      end loop;

      return False;
   end Component_Is_Removed_In_Type;

   -------------------------------
   -- Compute_Filename_Previous --
   -------------------------------

   function Compute_Filename_Previous
     (Filename : String; Is_Previous : out Boolean; Ada_Node : in out Node_Id)
      return String
   is

      Match : constant String := "'@Loop";
   begin
      if Filename'Length >= Match'Length
        and then
          Filename (Filename'First .. Filename'First + Match'Length - 1)
          = Match
      then
         declare
            Number_At_Tick : constant Natural :=
              Index
                (Source  =>
                   Filename (Filename'First + Match'Length .. Filename'Last),
                 Pattern => "'");
         begin
            Ada_Node :=
              Get_Entity_Id
                (False,
                 Filename
                   (Filename'First + Match'Length .. Number_At_Tick - 2));
            Is_Previous := True;
            return Filename (Number_At_Tick + 1 .. Filename'Last);
         end;
      else
         Is_Previous := False;
         return Filename;
      end if;
   end Compute_Filename_Previous;

   ------------------
   -- Convert_Node --
   ------------------

   function Convert_Node (N : Integer) return Node_Id is
   begin
      return Node_Id (N);
   exception
      when others =>
         return Empty;
   end Convert_Node;

   -----------------------------
   -- Find_First_Static_Range --
   -----------------------------

   procedure Find_First_Static_Range
     (N : Node_Id; Fst : out Uint; Lst : out Uint)
   is
      Fst_Found, Lst_Found : Boolean := False;
      Current              : Node_Id := N;

   begin
      --  Initialize outputs with dummy values that will be rewritten in the
      --  loop, to facilitate static analysis.

      Fst := Uint_0;
      Lst := Uint_0;

      loop
         declare
            Rng  : constant Node_Id := Get_Range (Current);
            Low  : constant Node_Id := Low_Bound (Rng);
            High : constant Node_Id := High_Bound (Rng);
         begin
            if not Fst_Found and then Compile_Time_Known_Value (Low) then
               Fst := Expr_Value (Low);
               Fst_Found := True;
            end if;
            if not Lst_Found and then Compile_Time_Known_Value (High) then
               Lst := Expr_Value (High);
               Lst_Found := True;
            end if;
         end;
         exit when Fst_Found and Lst_Found;

         Current := Retysp (Etype (Current));
      end loop;
   end Find_First_Static_Range;

   -------------------
   -- Get_Entity_Id --
   -------------------

   function Get_Entity_Id (Is_Record : Boolean; S : String) return Entity_Id is
      I : constant Integer := (if Is_Record then 1 else 0);
   begin
      if S'First + I > S'Last then
         return Empty;
      else
         return Entity_Id'Value (S (S'First + I .. S'Last));
      end if;
   exception
      when Constraint_Error =>
         return Empty;
   end Get_Entity_Id;

   ----------------------
   -- Get_Id_From_Name --
   ----------------------

   function Get_Id_From_Name
     (E : Callable_Kind_Id; Name : String) return Entity_Id
   is
      use Ada.Characters.Handling;
      Id : Entity_Id := First_Formal (E);
   begin
      while To_Upper (Short_Name (Id)) /= To_Upper (Name) loop
         Id := Next_Formal (Id);
      end loop;
      return Id;
   end Get_Id_From_Name;

   ------------------------
   -- Is_Visible_In_Type --
   ------------------------

   --  Body intentionally hidden from spec file
   function Is_Visible_In_Type
     (Rec : Entity_Id; Comp : Entity_Id) return Boolean
   is (Ekind (Comp) = E_Discriminant
       or else
         (not Is_Type (Comp)
          and then
            Component_Is_Present_In_Type
              (Rec, Search_Component_In_Type (Rec, Comp))));

   ---------------------
   -- Prefix_Elements --
   ---------------------

   function Prefix_Elements
     (Elems : S_String_List.List; Pref : String) return S_String_List.List
   is
      use Ada.Strings.Unbounded;
      L : S_String_List.List;
   begin
      for E of Elems loop
         L.Append (Pref & E);
      end loop;
      return L;
   end Prefix_Elements;

   -----------------
   -- Remove_Vars --
   -----------------

   package body Remove_Vars is

      function Get_Line_Encapsulating_Function (A : Node_Id) return Natural
      with Pre => Nkind (A) = N_Pragma;
      --  Get the line of the definition of the function in which a
      --  Loop_Invariant is defined.

      function Get_Line_Encapsulating_Loop (A : Node_Id) return Natural
      with Pre => Nkind (A) = N_Pragma;
      --  Get the line of the definition of the directly encapsulating loop of
      --  a Loop_Invariant.

      procedure Eliminate_Between
        (Other_Lines   : out Cntexample_Line_Maps.Map;
         Previous_Line : Cntexample_Elt_Lists.List;
         Node          : Integer);
      --  Eliminate the counterexamples variables that are present in
      --  Previous_Line from Other_Lines. These should have a location between
      --  the encapsulating function of Node and the encapsulating loop of
      --  Node. These are known to be duplicates of the Previous_Line.

      ---------------------------------
      -- Get_Line_Encapsulating_Loop --
      ---------------------------------

      function Get_Line_Encapsulating_Loop (A : Node_Id) return Natural is

         function Is_Loop_Stmt (N : Node_Id) return Boolean
         is (Nkind (N) = N_Loop_Statement);

         function Enclosing_Loop_Stmt is new
           First_Parent_With_Property (Is_Loop_Stmt);

         --  Parent_Node should point to the loop statement
         Parent_Node : constant Node_Id := Enclosing_Loop_Stmt (A);
      begin
         if Nlists.Is_List_Member (Parent_Node) then
            declare
               Prev_Parent : constant Node_Id := Nlists.Prev (Parent_Node);
            begin
               if Present (Prev_Parent) then
                  return
                    Natural (Get_Logical_Line_Number (Sloc (Prev_Parent)));
               else
                  --  Loop is the first statement so we try to return just
                  --  before the N_Handled_Sequence_Of_Statements (to avoid
                  --  removing data from the loop).
                  return
                    Natural
                      (Get_Logical_Line_Number
                         (Sloc (Atree.Parent (Parent_Node))))
                    - 1;
               end if;
            end;
         else
            return
              Natural
                (Get_Logical_Line_Number (Sloc (Atree.Parent (Parent_Node))));
         end if;
      exception
         when others =>
            return 0;
      end Get_Line_Encapsulating_Loop;

      -------------------------------------
      -- Get_Line_Encapsulating_Function --
      -------------------------------------

      function Get_Line_Encapsulating_Function (A : Node_Id) return Natural is
      begin
         return
           Natural
             (Get_Logical_Line_Number
                (Sloc (Directly_Enclosing_Subprogram_Or_Entry (A))));
      exception
         when others =>
            return 0;
      end Get_Line_Encapsulating_Function;

      -----------------------
      -- Eliminate_Between --
      -----------------------

      procedure Eliminate_Between
        (Other_Lines   : out Cntexample_Line_Maps.Map;
         Previous_Line : Cntexample_Elt_Lists.List;
         Node          : Integer)
      is
         Node_LI   : constant Node_Id := Convert_Node (Node);
         B         : constant Natural :=
           Get_Line_Encapsulating_Function (Node_LI);
         E         : constant Natural := Get_Line_Encapsulating_Loop (Node_LI);
         use Cntexample_Elt_Lists;
         use Cntexample_Line_Maps;
         New_Lines : Cntexample_Line_Maps.Map := Empty_Map;
      begin
         for C in Other_Lines.Iterate loop
            declare
               Line_Variables : Cntexample_Elt_Lists.List := Element (C);
               Line_Number    : Natural renames Key (C);
            begin
               if Line_Number >= B and then Line_Number <= E then
                  for V in Previous_Line.Iterate loop
                     declare
                        Cur : Cntexample_Elt_Lists.Cursor :=
                          Cntexample_Elt_Lists.Find
                            (Line_Variables, Element (V));
                     begin
                        if Has_Element (Cur) then
                           Line_Variables.Delete (Cur);
                        end if;
                     end;
                  end loop;
               end if;
               if not Is_Empty (Line_Variables) then
                  New_Lines.Include (Line_Number, Line_Variables);
               end if;
            end;
         end loop;
         Other_Lines := New_Lines;
      end Eliminate_Between;

      -----------------------
      -- Remove_Extra_Vars --
      -----------------------

      procedure Remove_Extra_Vars (Cntexmp : in out Cntexample_File_Maps.Map)
      is
         --  Here we assume that Create_Pretty_Cntexmp just was used. So, there
         --  is a complete counterexample with, in particular, Previous_Lines
         --  filled and other lines all filled.
      begin
         for Fcur in Cntexmp.Iterate loop
            declare
               File         : Cntexample_Lines :=
                 Cntexample_File_Maps.Element
                   (Cntexmp, Cntexample_File_Maps.Key (Fcur));
               Previous_Loc : Previous_Line_Maps.Map renames
                 File.Previous_Lines;

            begin
               for C in Previous_Loc.Iterate loop
                  declare
                     Previous_Elt : constant Previous_Line :=
                       Previous_Loc.Element (Previous_Line_Maps.Key (C));
                     Node_LI      : constant Integer := Previous_Elt.Ada_Node;
                  begin
                     Eliminate_Between
                       (File.Other_Lines, Previous_Elt.Line_Cnt, Node_LI);
                  end;
               end loop;
               Cntexmp.Replace_Element (Fcur, File);
            end;
         end loop;
      end Remove_Extra_Vars;

   end Remove_Vars;

   ---------------------
   -- To_Value_Access --
   ---------------------

   function To_Value_Access
     (Entity : Entity_Id; JSON_Data : GNATCOLL.JSON.JSON_Value)
      return CE_Values.Value_Access
   is

      ------------------------
      -- Create_Float_Value --
      ------------------------

      function Create_Float_Value
        (T : Type_Kind_Id; Input : String) return CE_Values.Scalar_Value_Access
      with Pre => Is_Floating_Point_Type (T);

      function Create_Float_Value
        (T : Type_Kind_Id; Input : String) return CE_Values.Scalar_Value_Access
      is
         Raw : constant Big_Real := From_Quotient_String (Input);
      begin
         if Is_Single_Precision_Floating_Point_Type (T) then
            declare
               package Float_32_Conversions is new
                 Float_Conversions (Num => Float);
            begin
               return
                 new CE_Values.Scalar_Value_Type'
                   (K             => Float_K,
                    Float_Content =>
                      CE_Values.Float_Value'
                        (K          => Float_32_K,
                         Content_32 =>
                           Float_32_Conversions.From_Big_Real (Raw)));
            end;
         elsif Is_Double_Precision_Floating_Point_Type (T) then
            declare
               package Float_64_Conversions is new
                 Float_Conversions (Num => Long_Float);
            begin
               return
                 new CE_Values.Scalar_Value_Type'
                   (K             => Float_K,
                    Float_Content =>
                      CE_Values.Float_Value'
                        (K          => Float_64_K,
                         Content_64 =>
                           Float_64_Conversions.From_Big_Real (Raw)));
            end;
         else
            declare
               package Float_Ext_Conversions is new
                 Float_Conversions (Num => Long_Long_Float);
            begin
               return
                 new CE_Values.Scalar_Value_Type'
                   (K             => Float_K,
                    Float_Content =>
                      CE_Values.Float_Value'
                        (K           => Extended_K,
                         Ext_Content =>
                           Float_Ext_Conversions.From_Big_Real (Raw)));
            end;
         end if;
      end Create_Float_Value;

      Res_Type : constant Type_Kind_Id := Retysp (Etype (Entity));
      Res      : CE_Values.Value_Access;
   begin

      if Is_Integer_Type (Res_Type) then
         if JSON_Data.Kind = GNATCOLL.JSON.JSON_String_Type then
            declare
               Val : CE_Values.Scalar_Value_Access;
            begin
               Val :=
                 new CE_Values.Scalar_Value_Type'
                   (K               => Integer_K,
                    Integer_Content =>
                      From_String (GNATCOLL.JSON.Get (JSON_Data)));

               Res :=
                 new CE_Values.Value_Type'
                   (K              => Scalar_K,
                    AST_Ty         => Res_Type,
                    Scalar_Content => Val,
                    others         => <>);
            end;
         else
            raise Program_Error with "ill-formated JSON  (integer)";
         end if;

      elsif Is_Floating_Point_Type (Res_Type) then
         if Has_Field (JSON_Data, "quotient")
           and then
             JSON_Data.Get ("value").Kind = GNATCOLL.JSON.JSON_String_Type
         then
            declare
               Str_Value : constant String :=
                 GNATCOLL.JSON.Get (JSON_Data.Get ("value"));
               Val       : constant CE_Values.Scalar_Value_Access :=
                 Create_Float_Value (Res_Type, Str_Value);
            begin
               Res :=
                 new CE_Values.Value_Type'
                   (K              => Scalar_K,
                    AST_Ty         => Res_Type,
                    Scalar_Content => Val,
                    others         => <>);
            end;
         else
            raise Program_Error with "ill-formated JSON (float)";
         end if;

      elsif Is_Character_Type (Res_Type) then
         if JSON_Data.Kind = GNATCOLL.JSON.JSON_String_Type then
            declare
               C : constant Character :=
                 Character'Value (Decode (GNATCOLL.JSON.Get (JSON_Data)));
            begin
               Res := new Value_Type'(Character_Value (C, Res_Type));
            end;
         else
            raise Program_Error with "ill-formated JSON (character)";
         end if;

      elsif Is_Enumeration_Type (Res_Type) then
         if JSON_Data.Kind = GNATCOLL.JSON.JSON_String_Type then
            declare
               use Ada.Characters.Handling;
               Enum_Name : constant String := GNATCOLL.JSON.Get (JSON_Data);
               E         : Entity_Id := First_Literal (Res_Type);
               Val       : CE_Values.Scalar_Value_Access;
            begin
               while To_Upper (Enum_Name)
                 /= To_Upper (Namet.Get_Name_String (Chars (E)))
               loop
                  E := Next_Literal (E);
               end loop;
               Val :=
                 new CE_Values.Scalar_Value_Type'
                   (K => Enum_K, Enum_Entity => E);

               Res :=
                 new CE_Values.Value_Type'
                   (K              => Scalar_K,
                    AST_Ty         => Res_Type,
                    Scalar_Content => Val,
                    others         => <>);
            end;
         end if;

      elsif Is_Array_Type (Res_Type)
        and then Has_Field (JSON_Data, "sizes")
        and then Has_Field (JSON_Data, "array")
      then
         declare
            Size_Arr : constant JSON_Array := Get (JSON_Data, "sizes");
            Size_Obj : constant JSON_Value := Get (Size_Arr, 1);
            Size     : constant Valid_Big_Integer :=
              From_String (GNATCOLL.JSON.Get (Size_Obj));
            Arr      : constant JSON_Array := Get (JSON_Data, "array");

            N : Valid_Big_Integer := 1;

            First_Attr   : Opt_Big_Integer;
            Last_Attr    : Opt_Big_Integer;
            Array_Values : Big_Integer_To_Value_Maps.Map;
         begin

            if Has_Field (JSON_Data, "dimensions") then
               --  Gnattest specifies bounds iff they are something
               --  else than (0 .. Size - 1)
               declare
                  Dimensions : constant JSON_Value :=
                    Get (Get (JSON_Data, "dimensions"), 1);
                  First      : constant Valid_Big_Integer :=
                    From_String
                      (GNATCOLL.JSON.Get (Get (Dimensions, "First")));
                  Last       : constant Valid_Big_Integer :=
                    From_String (GNATCOLL.JSON.Get (Get (Dimensions, "Last")));
               begin
                  First_Attr := (Present => True, Content => First);
                  Last_Attr := (Present => True, Content => Last);
               end;
            else
               First_Attr := (Present => True, Content => 0);
               Last_Attr := (Present => True, Content => Size - 1);
            end if;

            if Size <= 0 then
               Res :=
                 new CE_Values.Value_Type'
                   (K            => Array_K,
                    AST_Ty       => Res_Type,
                    First_Attr   => First_Attr,
                    Last_Attr    => Last_Attr,
                    Array_Values => Array_Values,
                    Array_Others => null);
            else
               N := First_Attr.Content;
               while N <= Last_Attr.Content loop
                  declare
                     --  regardless of the actual ADA array indexes,
                     --  the array within the json is always indexed
                     --  on (1 .. Size)
                     Elt : constant JSON_Value :=
                       Get (Arr, To_Integer (N - First_Attr.Content + 1));
                  begin
                     Array_Values.Include
                       (N, To_Value_Access (Component_Type (Res_Type), Elt));
                  end;
                  N := N + 1;
               end loop;

               Res :=
                 new CE_Values.Value_Type'
                   (K            => Array_K,
                    AST_Ty       => Res_Type,
                    First_Attr   => First_Attr,
                    Last_Attr    => Last_Attr,
                    Array_Values => Array_Values,
                    Array_Others => null);
            end if;
         end;

      elsif Is_Record_Type (Res_Type) then
         if Has_Field (JSON_Data, "components") then
            declare
               Components    : constant JSON_Value :=
                 Get (JSON_Data, "components");
               Discriminants : constant JSON_Value :=
                 Get (JSON_Data, "discriminants");
               Record_Fields : Entity_To_Value_Maps.Map;
               Component_Set : constant Component_Sets.Set :=
                 Get_Component_Set (Res_Type);
               Comp          : Value_Access;
            begin
               for Comp_Id of Component_Set loop
                  if Has_Field (Components, Raw_Source_Name (Comp_Id)) then
                     --  "regular" field
                     Comp :=
                       To_Value_Access
                         (Comp_Id,
                          Get (Components, Raw_Source_Name (Comp_Id)));
                     Record_Fields.Include (Comp_Id, Comp);
                  elsif Has_Field (Discriminants, Raw_Source_Name (Comp_Id))
                  then
                     --  discriminant field
                     Comp :=
                       To_Value_Access
                         (Comp_Id,
                          Get (Discriminants, Raw_Source_Name (Comp_Id)));
                     Record_Fields.Include (Comp_Id, Comp);
                  end if;
                  exit when Comp_Id = Einfo.Entities.Last_Entity (Res_Type);
               end loop;
               Res :=
                 new CE_Values.Value_Type'
                   (K             => Record_K,
                    AST_Ty        => Res_Type,
                    Record_Fields => Record_Fields,
                    others        => <>);
            end;
         else
            raise Program_Error with "ill-formated JSON (record)";
         end if;

      else
         raise Program_Error
           with "unsupported or invalid data in gnattest JSON.";
      end if;

      return Res;
   end To_Value_Access;

   --------------------
   -- UI_From_String --
   --------------------

   function UI_From_String (Val : String) return Uint is
   begin
      --  Try to cast Val to Int if it fits

      return UI_From_Int (Int'Value (Val));
   exception

      --  If it doesn't fit, cut Val in two substrings and retry

      when Constraint_Error =>

         --  Avoid looping in case of an illformed string

         if Val'Length < 2 then
            raise;
         end if;

         declare
            Cut   : constant Positive := Val'First + Val'Length / 2;
            Left  : String renames Val (Val'First .. Cut);
            Right : String renames Val (Cut + 1 .. Val'Last);
         begin
            return
              UI_From_String (Left)
              * Uint_10 ** Int (Right'Length)
              + UI_From_String (Right);
         end;
   end UI_From_String;

   --------------------------
   -- Ultimate_Cursor_Type --
   --------------------------

   function Ultimate_Cursor_Type (Typ : Entity_Id) return Entity_Id is
      Found         : Boolean;
      Iterable_Info : Iterable_Annotation;

   begin
      --  Iteration is done on the cursor type of the ultimate model for
      --  proof. Go through Iterable_For_Proof annotations to find this
      --  type.

      Retrieve_Iterable_Annotation (Typ, Found, Iterable_Info);

      if Found then

         --  Iterable annotation should be a Model annotation. Indeed, if
         --  a Contains iterable annotation is provided, no temporary
         --  should be introduced for "for of" quantification.

         pragma Assert (Iterable_Info.Kind = SPARK_Definition.Annotate.Model);

         --  Prepend the name of the Model function to the container name
         --  and refine value on model type.

         return Ultimate_Cursor_Type (Etype (Iterable_Info.Entity));
      else

         --  We have found the ultimate model type. Quantification is
         --  done on its cursor type.

         return Get_Cursor_Type (Typ);
      end if;
   end Ultimate_Cursor_Type;

end CE_Utils;
