1------------------------------------------------------------------------------
2--                                                                          --
3--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
4--                                                                          --
5--                       A S I S T A N T . T A B L E                        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1997-2010, Free Software Foundation, Inc.         --
10--                                                                          --
11-- ASIStant  is  free  software;  you can  redistribute it and/or modify it --
12-- under terms of the  GNU General Public License  as published by the Free --
13-- Software Foundation;  either version 2,  or  (at your option)  any later --
14-- version.  ASIStant is  distributed  in the hope  that it will be useful, --
15-- but  WITHOUT  ANY  WARRANTY;  without  even the implied warranty of MER- --
16-- CHANTABILITY or  FITNESS FOR  A PARTICULAR PURPOSE.  See the GNU General --
17-- Public License for more details.  You should have received a copy of the --
18-- GNU General Public License  distributed with GNAT;  see file COPYING. If --
19-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
20-- Floor, Boston, MA 02110-1301, USA.                                       --
21--                                                                          --
22-- ASIStant  is an evolution of  ASIStint tool that was created by  Vasiliy --
23-- Fofanov  as  part  of  a  collaboration  between  Software   Engineering --
24-- Laboratory  of the  Swiss  Federal Institute of Technology in  Lausanne, --
25-- Switzerland,  and the Scientific Research Computer Center of the  Moscow --
26-- University, Russia,  supported by the  Swiss National Science Foundation --
27-- grant #7SUPJ048247, "Development of ASIS for GNAT with industry quality" --
28--                                                                          --
29-- ASIStant  is  distributed as a part of the  ASIS implementation for GNAT --
30-- (ASIS-for-GNAT) and is maintained by AdaCore (http://www.adacore.com).   --
31--                                                                          --
32------------------------------------------------------------------------------
33
34with Ada.Strings;            use  Ada.Strings;
35with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;
36
37with ASIStant.String_Handling;
38with ASIStant.XTable;        use ASIStant.XTable;
39
40package body ASIStant.Table is
41
42   -----------------------
43   -- Local subprograms --
44   -----------------------
45
46   function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural;
47   --  Scans for the variable index in table T. Returns 0 if fails.
48
49------------------------------------------------------------------------------
50--  This package provides handling of ASIStant language variable tables
51------------------------------------------------------------------------------
52
53   function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural is
54   --  Scans for the variable index in table T. Returns 0 if fails.
55      Name : Var_Name;
56   begin
57      Move (N, Name, Right);
58      ASIStant.String_Handling.To_Upper (Name);
59      for i in 1 .. T.Free - 1 loop
60         if T.Table.all (i).Name = Name then
61            return i;
62         end if;
63      end loop;
64      return 0;
65   end Get_Var_Idx;
66
67   function Get_Var (T : Var_Table; N : Wide_String) return Var_Info is
68   --  Scans for the variable in table T. Returns Var_Unknown if fails.
69      Idx : constant Integer := Get_Var_Idx (T, N);
70   begin
71      if Idx = 0 then
72         return Var_Unknown;
73      else
74         return T.Table (Idx);
75      end if;
76   end Get_Var;
77
78   function Get_Var_Value (VI : Var_Info) return Query_Result is
79      QR : Query_Result (VI.VType);
80   begin
81      case VI.VType is
82         when Par_Absent    => null;
83         when Par_String    => QR.S   := VI.SValue;
84         when Par_Boolean   => QR.B   := Boolean'Val (VI.IValue);
85         when Par_CUnit     => QR.C   := ATICUnit (VI.IValue);
86         when Par_CUnitList => QR.CL  := ATICUnitList (VI.IValue);
87         when Par_Element   => QR.E   := ATIElem (VI.IValue);
88         when Par_ElemList  => QR.EL  := ATIElemList (VI.IValue);
89         when Par_Context | Par_Integer
90                            => QR.I   := VI.IValue;
91         when Par_Line      => QR.L   := ATILine (VI.IValue);
92         when Par_Line_List  => QR.LL  := ATILineList (VI.IValue);
93         when Par_Relationship
94                            => QR.R   := ATIRelship (VI.IValue);
95         when Par_Span      => QR.Sp  := ATISpan (VI.IValue);
96         when Par_DDA_Array_Component
97                            => QR.AC  := DDA_ArrC (VI.IValue);
98         when Par_DDA_Array_Component_List
99                            => QR.ACL := DDA_ArrCList (VI.IValue);
100         when Par_DDA_Record_Component
101                            => QR.RC  := DDA_RecC (VI.IValue);
102         when Par_DDA_Record_Component_List
103                            => QR.RCL := DDA_RecCList (VI.IValue);
104
105         when others => Error (ERR_BADPARAM);
106      end case;
107      return QR;
108   exception
109      when others =>
110         Error (ERR_INTERNAL, "Get_Var_Value");
111   end Get_Var_Value;
112
113   function Store_Var_Value (QR : Query_Result) return Var_Info is
114      VI : Var_Info;
115   begin
116      VI.VType := QR.RType;
117      case QR.RType is
118         when Par_String    =>
119            VI.SValue := QR.S;
120         when Par_Boolean   =>
121            VI.IValue := Boolean'Pos (QR.B);
122         when Par_CUnit     =>
123            ATICUnit (0) := QR.C;
124            VI.IValue := 0;
125         when Par_CUnitList =>
126            ATICUnitList (0) := QR.CL;
127            VI.IValue := 0;
128         when Par_Element   =>
129            ATIElem (0) := QR.E;
130            VI.IValue := 0;
131         when Par_ElemList  =>
132            ATIElemList (0) := QR.EL;
133            VI.IValue := 0;
134         when Par_Context | Par_Integer =>
135            VI.IValue := QR.I;
136         when Par_Line      =>
137            ATILine (0) := QR.L;
138            VI.IValue := 0;
139         when Par_Line_List =>
140            ATILineList (0) := QR.LL;
141            VI.IValue := 0;
142         when Par_Relationship =>
143            ATIRelship (0) := QR.R;
144            VI.IValue := 0;
145         when Par_Span      =>
146            ATISpan (0) := QR.Sp;
147            VI.IValue := 0;
148         when Par_DDA_Array_Component =>
149            DDA_ArrC (0) := QR.AC;
150            VI.IValue := 0;
151         when Par_DDA_Array_Component_List =>
152            DDA_ArrCList (0) := QR.ACL;
153            VI.IValue := 0;
154         when Par_DDA_Record_Component =>
155            DDA_RecC (0) := QR.RC;
156            VI.IValue := 0;
157         when Par_DDA_Record_Component_List =>
158            DDA_RecCList (0) := QR.RCL;
159            VI.IValue := 0;
160
161         when others =>
162            Error (ERR_BADPARAM);
163      end case;
164
165      return VI;
166
167   exception
168      when others => Error (ERR_INTERNAL, "Store_Var_Value");
169   end Store_Var_Value;
170
171   procedure Modify_Var (T : in out Var_Table; V : Var_Info) is
172   --  Adds/changes variable
173      Idx   : constant Integer := Get_Var_Idx (T, V.Name);
174      VT    : V_TablePtr;
175      VName : Var_Name := V.Name;
176   begin
177      ASIStant.String_Handling.To_Upper (VName);
178
179      if Idx = 0 then
180
181         if T.Free > T.Max then
182            --  Increase length of var. table
183            T.Max := T.Max + MAX_VARIABLES;
184            VT := new V_Table (1 .. T.Max);
185
186            for i in 1 .. T.Free - 1 loop
187               VT (i) := T.Table (i);
188            end loop;
189
190            T.Table := VT;
191         end if;
192
193         T.Table (T.Free) := V;
194         T.Table (T.Free).Name := VName;
195         T.Free := T.Free + 1;
196      else
197         T.Table (Idx) := V;
198         T.Table (Idx).Name := VName;
199      end if;
200
201   end Modify_Var;
202
203end ASIStant.Table;
204