------------------------------------------------------------------------------
-- --
-- ASIS Tester And iNTerpreter (ASIStant) COMPONENTS --
-- --
-- A S I S T A N T . S E T --
-- --
-- B o d y --
-- --
-- Copyright (c) 1997-2002, 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). --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Package for declaring and changing of ASIStant variables
------------------------------------------------------------------------------
with Ada.Strings, Ada.Strings.Wide_Fixed;
use Ada.Strings, Ada.Strings.Wide_Fixed;
with ASIStant.FuncEnum;
with ASIStant.S_Parser; use ASIStant.S_Parser;
with ASIStant.Common; use ASIStant.Common;
with ASIStant.Table; use ASIStant.Table;
with ASIStant.XTable; use ASIStant.XTable;
with ASIStant.Evaluate; use ASIStant.Evaluate;
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 : Node_Position := CurStat.Tree (NPtrV).NValue;
Name : Wide_String := CurStat.Tree (NPtr).SValue.all;
Query : Switch_Index;
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;
syntax highlighted by Code2HTML, v. 0.9.1