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