------------------------------------------------------------------------------
-- --
-- ASIS Tester And iNTerpreter (ASIStant) COMPONENTS --
-- --
-- A S I S T A N T . T A B L E --
-- --
-- B o d y --
-- --
-- Copyright (c) 1997-1999, 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, 59 Temple Place Suite 330, --
-- Boston, MA 02111-1307, 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 Ada Core Technologies Inc --
-- (http://www.gnat.com). --
------------------------------------------------------------------------------
with ASIStant.Common; use ASIStant.Common;
with ASIStant.String_Handling;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;
with ASIStant.XTable; use ASIStant.XTable;
package body ASIStant.Table is
-----------------------
-- Local subprograms --
-----------------------
function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural;
-- Scans for the variable index in table T. Returns 0 if fails.
------------------------------------------------------------------------------
-- This package provides handling of ASIStant language variable tables
------------------------------------------------------------------------------
function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural is
-- Scans for the variable index in table T. Returns 0 if fails.
Name : Var_Name;
begin
Move (N, Name, Right);
ASIStant.String_Handling.To_Upper (Name);
for i in 1 .. T.Free - 1 loop
if T.Table.all (i).Name = Name then
return i;
end if;
end loop;
return 0;
end Get_Var_Idx;
function Get_Var (T : Var_Table; N : Wide_String) return Var_Info is
-- Scans for the variable in table T. Returns Var_Unknown if fails.
Idx : Integer := Get_Var_Idx (T, N);
begin
if Idx = 0 then
return Var_Unknown;
else
return T.Table (Idx);
end if;
end Get_Var;
function Get_Var_Value (VI : Var_Info) return Query_Result is
QR : Query_Result (VI.VType);
begin
case VI.VType is
when Par_Absent => null;
when Par_String => QR.S := String_Ptr (VI.SValue);
when Par_Boolean => QR.B := Boolean'Val (VI.IValue);
when Par_CUnit => QR.C := ATICUnit (VI.IValue);
when Par_CUnitList => QR.CL := ATICUnitList (VI.IValue);
when Par_Element => QR.E := ATIElem (VI.IValue);
when Par_ElemList => QR.EL := ATIElemList (VI.IValue);
when Par_Context | Par_Integer
=> QR.I := VI.IValue;
when Par_Line => QR.L := ATILine (VI.IValue);
when Par_Line_List => QR.LL := ATILineList (VI.IValue);
when Par_Relationship
=> QR.R := ATIRelship (VI.IValue);
when Par_Span => QR.Sp := ATISpan (VI.IValue);
when Par_DDA_Array_Component
=> QR.AC := DDA_ArrC (VI.IValue);
when Par_DDA_Array_Component_List
=> QR.ACL := DDA_ArrCList (VI.IValue);
when Par_DDA_Record_Component
=> QR.RC := DDA_RecC (VI.IValue);
when Par_DDA_Record_Component_List
=> QR.RCL := DDA_RecCList (VI.IValue);
when others => Error (ERR_BADPARAM);
end case;
return QR;
exception
when others =>
Error (ERR_INTERNAL, "Get_Var_Value");
end Get_Var_Value;
function Store_Var_Value (QR : Query_Result) return Var_Info is
VI : Var_Info;
begin
VI.VType := QR.RType;
case QR.RType is
when Par_String =>
VI.SValue := String_Ptr (QR.S);
when Par_Boolean =>
VI.IValue := Boolean'Pos (QR.B);
when Par_CUnit =>
ATICUnit (0) := QR.C;
VI.IValue := 0;
when Par_CUnitList =>
ATICUnitList (0) := QR.CL;
VI.IValue := 0;
when Par_Element =>
ATIElem (0) := QR.E;
VI.IValue := 0;
when Par_ElemList =>
ATIElemList (0) := QR.EL;
VI.IValue := 0;
when Par_Context | Par_Integer =>
VI.IValue := QR.I;
when Par_Line =>
ATILine (0) := QR.L;
VI.IValue := 0;
when Par_Line_List =>
ATILineList (0) := QR.LL;
VI.IValue := 0;
when Par_Relationship =>
ATIRelship (0) := QR.R;
VI.IValue := 0;
when Par_Span =>
ATISpan (0) := QR.Sp;
VI.IValue := 0;
when Par_DDA_Array_Component =>
DDA_ArrC (0) := QR.AC;
VI.IValue := 0;
when Par_DDA_Array_Component_List =>
DDA_ArrCList (0) := QR.ACL;
VI.IValue := 0;
when Par_DDA_Record_Component =>
DDA_RecC (0) := QR.RC;
VI.IValue := 0;
when Par_DDA_Record_Component_List =>
DDA_RecCList (0) := QR.RCL;
VI.IValue := 0;
when others =>
Error (ERR_BADPARAM);
end case;
return VI;
exception
when others => Error (ERR_INTERNAL, "Store_Var_Value");
end Store_Var_Value;
procedure Modify_Var (T : in out Var_Table; V : Var_Info) is
-- Adds/changes variable
Idx : Integer := Get_Var_Idx (T, V.Name);
VT : V_TablePtr;
VName : Var_Name := V.Name;
begin
ASIStant.String_Handling.To_Upper (VName);
if Idx = 0 then
if T.Free > T.Max then
-- Increase length of var. table
T.Max := T.Max + MAX_VARIABLES;
VT := new V_Table (1 .. T.Max);
for i in 1 .. T.Free - 1 loop
VT (i) := T.Table (i);
end loop;
T.Table := VT;
end if;
T.Table (T.Free) := V;
T.Table (T.Free).Name := VName;
T.Free := T.Free + 1;
else
T.Table (Idx) := V;
T.Table (Idx).Name := VName;
end if;
end Modify_Var;
end ASIStant.Table;
syntax highlighted by Code2HTML, v. 0.9.1