------------------------------------------------------------------------------
--                                                                          --
--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
--                                                                          --
--                         A S I S T A N T . S E T                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (c) 1997-2006, Free Software Foundation, Inc.         --
--                                                                          --
-- ASIStant  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 2,  or  (at your option)  any later --
-- version.  ASIStant is  distributed  in the hope  that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;  without  even the implied warranty of MER- --
-- CHANTABILITY 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 GNAT;  see file COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- ASIStant  is an evolution of  ASIStint tool that was created by  Vasiliy --
-- Fofanov  as  part  of  a  collaboration  between  Software   Engineering --
-- Laboratory  of the  Swiss  Federal Institute of Technology in  Lausanne, --
-- Switzerland,  and the Scientific Research Computer Center of the  Moscow --
-- University, Russia,  supported by the  Swiss National Science Foundation --
-- grant #7SUPJ048247, "Development of ASIS for GNAT with industry quality" --
--                                                                          --
-- ASIStant  is  distributed as a part of the  ASIS implementation for GNAT --
-- (ASIS-for-GNAT) and is maintained by AdaCore (http://www.adacore.com).   --
--                                                                          --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--  Package for declaring and changing of ASIStant variables
------------------------------------------------------------------------------

with Ada.Strings;            use Ada.Strings;
with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;

with ASIStant.Common;        use ASIStant.Common;
with ASIStant.Evaluate;      use ASIStant.Evaluate;
with ASIStant.FuncEnum;
with ASIStant.Table;         use ASIStant.Table;
with ASIStant.XTable;        use ASIStant.XTable;

package body ASIStant.Set is

   ------------------------
   --  Local subprograms --
   ------------------------

   function Build_Var (Name : Wide_String; VI : Var_Info) return Var_Info;
   --  Generates a data structure for a variable called Name with a value VI

   function Build_Var (Name : Wide_String; VI : Var_Info) return Var_Info is

      VI1 : Var_Info;

   begin

      VI1 := VI;
      Move (Name, VI1.Name, Right);

      case VI.VType is

         when Par_Absent   =>
            Error (ERR_BADPARAM);

         when Par_CUnit   =>
            if ATICUnitFree = MAX_ATICUNITS then
               Grow_CUnit_Table;
            end if;
            ATICUnit (ATICUnitFree) := ATICUnit (VI.IValue);
            VI1.IValue := ATICUnitFree;
            ATICUnitFree := ATICUnitFree + 1;

         when Par_CUnitList =>
            if ATICUnitListFree = MAX_ATICUNITLISTS then
               Grow_CUnitList_Table;
            end if;
            ATICUnitList (ATICUnitListFree) := ATICUnitList (VI.IValue);
            ATICUnitList (0) := null;
            VI1.IValue := ATICUnitListFree;
            ATICUnitListFree := ATICUnitListFree + 1;

         when Par_Element =>
            if ATIElemFree = MAX_ATIELEMENTS then
               Grow_Elem_Table;
            end if;
            ATIElem (ATIElemFree) := ATIElem (VI.IValue);
            VI1.IValue := ATIElemFree;
            ATIElemFree := ATIElemFree + 1;

         when Par_ElemList =>
            if ATIElemListFree = MAX_ATIELEMLISTS then
               Grow_ElemList_Table;
            end if;
            ATIElemList (ATIElemListFree) := ATIElemList (VI.IValue);
            ATIElemList (0) := null;
            VI1.IValue := ATIElemListFree;
            ATIElemListFree := ATIElemListFree + 1;

         when Par_Relationship =>
            if ATIRelshipFree = MAX_ATIRELATIONSHIPS then
               Grow_Relship_Table;
            end if;
            ATIRelship (ATIRelshipFree) := ATIRelship (VI.IValue);
            ATIRelship (0) := null;
            VI1.IValue := ATIRelshipFree;
            ATIRelshipFree := ATIRelshipFree + 1;

         when Par_Span    =>
            ATISpan (ATISpanFree) := ATISpan (VI.IValue);
            VI1.IValue := ATISpanFree;
            ATISpanFree := ATISpanFree + 1;

         when Par_DDA_Array_Component =>
            if DDA_ArrCFree = MAX_DDA_ARRCOMPS then
               Grow_DDA_ArrC_Table;
            end if;
            DDA_ArrC (DDA_ArrCFree) := DDA_ArrC (VI.IValue);
            VI1.IValue := DDA_ArrCFree;
            DDA_ArrCFree := DDA_ArrCFree + 1;

         when Par_DDA_Array_Component_List =>
            if DDA_ArrCListFree = MAX_DDA_ARRCOMPLISTS then
               Grow_DDA_ArrCList_Table;
            end if;
            DDA_ArrCList (DDA_ArrCListFree) := DDA_ArrCList (VI.IValue);
            DDA_ArrCList (0) := null;
            VI1.IValue := DDA_ArrCListFree;
            DDA_ArrCListFree := DDA_ArrCListFree + 1;

         when Par_DDA_Record_Component =>
            if DDA_RecCFree = MAX_DDA_RECCOMPS then
               Grow_DDA_RecC_Table;
            end if;
            DDA_RecC (DDA_RecCFree) := DDA_RecC (VI.IValue);
            VI1.IValue := DDA_RecCFree;
            DDA_RecCFree := DDA_RecCFree + 1;

         when Par_DDA_Record_Component_List =>
            if DDA_RecCListFree = MAX_DDA_RECCOMPLISTS then
               Grow_DDA_RecCList_Table;
            end if;
            DDA_RecCList (DDA_RecCListFree) := DDA_RecCList (VI.IValue);
            DDA_RecCList (0) := null;
            VI1.IValue := DDA_RecCListFree;
            DDA_RecCListFree := DDA_RecCListFree + 1;

         when Par_Line =>
            if ATILineFree = MAX_ATILINES then
               Grow_Line_Table;
            end if;
            ATILine (ATILineFree) := ATILine (VI.IValue);
            VI1.IValue := ATILineFree;
            ATILineFree := ATILineFree + 1;

         when Par_Line_List =>
            if ATILineListFree = MAX_ATILINELISTS then
               Grow_LineList_Table;
            end if;
            ATILineList (ATILineListFree) := ATILineList (VI.IValue);
            ATILineList (0) := null;
            VI1.IValue := ATILineListFree;
            ATILineListFree := ATILineListFree + 1;

         when others => null;
      end case;

      return VI1;

      exception
         when Constraint_Error => --  ASIS types arrays overflow
            Error (ERR_TABLEFULL);

   end Build_Var;

   procedure Set (N : Node_Position) is

      NPtrV, NPtrE : Node_Position;
      VI : Var_Info;
      QR : Query_Result;

   begin

      if CurStat.Tree (N).NValue = 0 then
         Error (ERR_NEEDPARAM);
      end if;

      NPtrV := CurStat.Tree (N).NValue;

      --  Check that there is no built-in query with this name. We simply
      --  convert the name to Switch_Index, if successful query with this name
      --  exists
      declare
         use ASIStant.FuncEnum;
         NPtr  : constant Node_Position := CurStat.Tree (NPtrV).NValue;
         Name  : constant Wide_String   := CurStat.Tree (NPtr).SValue.all;
         Query : Switch_Index;
         pragma Warnings (Off, Query);
      begin
         Query := Switch_Index'Wide_Value (Name);
         Error (ERR_BADVARNAME, Name);
      exception
         when Constraint_Error =>
            --  CE raised is in fact an expected outcome!
            null;
      end;

      if CurStat.Tree (NPtrV).Next_Node = 0 then
      --  Create a Context variable
         NPtrV := CurStat.Tree (NPtrV).NValue;
         Move (CurStat.Tree (NPtrV).SValue.all, VI.Name, Right);
         VI.VType    := Par_Context;
         VI.IValue   := ATIContextFree;
         ATIContextFree := ATIContextFree + 1;
         Modify_Var (CurTable, VI);
         return;
      end if;

      NPtrE := CurStat.Tree (NPtrV).Next_Node;

      if CurStat.Tree (NPtrE).Next_Node /= 0 then
      --  Only 1 or 2 parameters allowed
         Error (ERR_TOOMANYPARAMS);
      end if;

      NPtrV := CurStat.Tree (NPtrV).NValue;   --  variable name
      NPtrE := CurStat.Tree (NPtrE).NValue;   --  expression

      if CurStat.Tree (NPtrV).NType /= NT_VARIABLE then
         Error (ERR_BADPARAM);
      end if;

      QR := Evaluate_Node (NPtrE);

      VI := Build_Var (CurStat.Tree (NPtrV).SValue.all, Store_Var_Value (QR));

      Modify_Var (CurTable, VI);

   end Set;

end ASIStant.Set;
