← Back to branch summary

~ubuntu-branches/ubuntu/karmic/asis/karmic

« back to all changes in this revision

Viewing changes to asis/asis-data_decomposition-debug.adb

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Quinot
  • Date: 2002-03-03 19:55:58 UTC
  • Revision ID: james.westby@ubuntu.com-20020303195558-g7dp4vaq1zdkf814
Tags: upstream-3.14p
Import upstream version 3.14p

Show diffs side-by-side

added added

removed removed

Lines of Context:
asis/asis-data_decomposition-debug.adb
 
1
------------------------------------------------------------------------------
 
2
--                                                                          --
 
3
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
 
4
--                                                                          --
 
5
--           A S I S . D A T A _ D E C O M P O S I T I O N . D E B U G      --
 
6
--                                                                          --
 
7
--                                 B o d y                                  --
 
8
--                                                                          --
 
9
--            Copyright (c) 1995-1999, Free Software Foundation, Inc.       --
 
10
--                                                                          --
 
11
-- ASIS-for-GNAT 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. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
 
15
-- ful, 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 ASIS-for-GNAT; see file     --
 
19
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
 
20
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
 
21
--                                                                          --
 
22
-- As a special exception,  if other files  instantiate  generics from this --
 
23
-- unit, or you link  this unit with other files  to produce an executable, --
 
24
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
 
25
-- covered  by the  GNU  General  Public  License.  This exception does not --
 
26
-- however invalidate  any other reasons why  the executable file  might be --
 
27
-- covered by the  GNU Public License.                                      --
 
28
--                                                                          --
 
29
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
 
30
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
 
31
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
 
32
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
 
33
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
 
34
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
 
35
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
 
36
-- (http://www.gnat.com).                                                   --
 
37
--                                                                          --
 
38
------------------------------------------------------------------------------
 
39
 
 
40
with Ada.Characters.Handling; use Ada.Characters.Handling;
 
41
 
 
42
with Asis.Elements;           use Asis.Elements;
 
43
with Asis.Declarations;       use Asis.Declarations;
 
44
 
 
45
with A4G.A_Output;            use A4G.A_Output;
 
46
with A4G.A_Types;
 
47
 
 
48
with Asis.Data_Decomposition.Aux;
 
49
with Asis.Data_Decomposition.Set_Get;
 
50
 
 
51
 
 
52
package body Asis.Data_Decomposition.Debug is
 
53
 
 
54
   LT : String renames A4G.A_Types.ASIS_Line_Terminator;
 
55
 
 
56
   -----------------------
 
57
   -- Local subprograms --
 
58
   -----------------------
 
59
 
 
60
   procedure Rec_Comp_Debug_String (RC : in Record_Component);
 
61
   procedure Arr_Comp_Debug_String (AC : in Array_Component);
 
62
   --  Form the Content of the Debug_Buffer
 
63
 
 
64
   ---------------------------
 
65
   -- Arr_Comp_Debug_String --
 
66
   ---------------------------
 
67
 
 
68
   procedure Arr_Comp_Debug_String (AC : in Array_Component) is
 
69
      Parent_Type_Image : String_Ptr;
 
70
   begin
 
71
      Debug_Buffer_Len := 0;
 
72
      if Is_Nil (AC) then
 
73
         Add ("This is a Nil Record Component");
 
74
         return;
 
75
      end if;
 
76
 
 
77
      Parent_Type_Image :=
 
78
         new String'(To_String (Debug_Image (AC.Parent_Array_Type)));
 
79
 
 
80
      Debug_Buffer_Len := 0;
 
81
 
 
82
      Add (LT);
 
83
 
 
84
      Add ("Parent_Array_Type");
 
85
      Add (LT);
 
86
      Add (Parent_Type_Image.all);
 
87
      Free (Parent_Type_Image);
 
88
      Add (LT);
 
89
      Add (LT);
 
90
 
 
91
      Add ("Parent_Component_Name: ");
 
92
      if Is_Nil (AC.Parent_Component_Name) then
 
93
         Add ("Is Nil");
 
94
      else
 
95
         Add (To_String (Defining_Name_Image (AC.Parent_Component_Name)));
 
96
      end if;
 
97
      Add (LT);
 
98
 
 
99
      if AC.Is_Record_Comp then
 
100
         Add (">>> IS RECORD");
 
101
         Add (LT);
 
102
      elsif AC.Is_Array_Comp then
 
103
         Add (">>> IS ARRAY");
 
104
         Add (LT);
 
105
      end if;
 
106
 
 
107
      Add ("Position      :");
 
108
      Add (ASIS_Natural'Image (AC.Position));
 
109
      Add (LT);
 
110
 
 
111
      Add ("First_Bit     :");
 
112
      Add (ASIS_Natural'Image (AC.First_Bit));
 
113
      Add (LT);
 
114
 
 
115
      Add ("Last_Bit      :");
 
116
      Add (ASIS_Natural'Image (AC.Last_Bit));
 
117
      Add (LT);
 
118
 
 
119
      Add ("Size          :");
 
120
      Add (ASIS_Natural'Image (AC.Size));
 
121
      Add (LT);
 
122
 
 
123
      Add ("Dimension     :");
 
124
      Add (ASIS_Natural'Image (AC.Dimension));
 
125
      Add (LT);
 
126
 
 
127
      for I in 1 .. AC.Dimension loop
 
128
         Add ("   Length (");
 
129
         Add (ASIS_Natural'Image (I));
 
130
         Add ("):");
 
131
         Add (ASIS_Natural'Image (AC.Length (I)));
 
132
         Add (LT);
 
133
 
 
134
      end loop;
 
135
 
 
136
   end Arr_Comp_Debug_String;
 
137
 
 
138
   -----------------
 
139
   -- Debug_Image --
 
140
   -----------------
 
141
 
 
142
   function Debug_Image (RC : in Record_Component) return Wide_String is
 
143
   begin
 
144
 
 
145
      Rec_Comp_Debug_String (RC);
 
146
 
 
147
      return To_Wide_String (
 
148
         LT & "Record Component Debug_Image: " & LT &
 
149
         Debug_Buffer (1 .. Debug_Buffer_Len));
 
150
 
 
151
   end Debug_Image;
 
152
 
 
153
   -----------------
 
154
   -- Debug_Image --
 
155
   -----------------
 
156
 
 
157
   function Debug_Image (AC : in Array_Component) return Wide_String is
 
158
   begin
 
159
 
 
160
      Arr_Comp_Debug_String (AC);
 
161
 
 
162
      return To_Wide_String (
 
163
         LT & "Array Component Debug_Image: " & LT &
 
164
         Debug_Buffer (1 .. Debug_Buffer_Len));
 
165
 
 
166
   end Debug_Image;
 
167
 
 
168
   ---------------------------
 
169
   -- Rec_Comp_Debug_String --
 
170
   ---------------------------
 
171
 
 
172
   procedure Rec_Comp_Debug_String (RC : in Record_Component) is
 
173
      Parent_Type_Image : String_Ptr;
 
174
   begin
 
175
 
 
176
      Debug_Buffer_Len := 0;
 
177
 
 
178
      if Is_Nil (RC) then
 
179
         Add ("This is a Nil Record Component");
 
180
         return;
 
181
      end if;
 
182
 
 
183
      Parent_Type_Image :=
 
184
         new String'(To_String (Debug_Image (RC.Parent_Record_Type)));
 
185
 
 
186
      Debug_Buffer_Len := 0;
 
187
 
 
188
      Add (LT);
 
189
 
 
190
      Add ("Parent_Record_Type");
 
191
      Add (LT);
 
192
      Add (Parent_Type_Image.all);
 
193
      Free (Parent_Type_Image);
 
194
      Add (LT);
 
195
      Add (LT);
 
196
 
 
197
      Add ("Component_Name: ");
 
198
      Add (To_String (Defining_Name_Image (RC.Component_Name)));
 
199
      Add (LT);
 
200
 
 
201
      if RC.Is_Record_Comp then
 
202
         Add (">>> IS RECORD");
 
203
         Add (LT);
 
204
      elsif RC.Is_Array_Comp then
 
205
         Add (">>> IS ARRAY");
 
206
         Add (LT);
 
207
 
 
208
      end if;
 
209
 
 
210
      Add ("Position      :");
 
211
      Add (ASIS_Natural'Image (RC.Position));
 
212
      Add (LT);
 
213
 
 
214
      Add ("First_Bit     :");
 
215
      Add (ASIS_Natural'Image (RC.First_Bit));
 
216
      Add (LT);
 
217
 
 
218
      Add ("Last_Bit      :");
 
219
      Add (ASIS_Natural'Image (RC.Last_Bit));
 
220
      Add (LT);
 
221
 
 
222
      Add ("Size          :");
 
223
      Add (ASIS_Natural'Image (RC.Size));
 
224
      Add (LT);
 
225
 
 
226
   end Rec_Comp_Debug_String;
 
227
 
 
228
   ---------------------------
 
229
   -- Is_Derived_From_Array --
 
230
   ----------------------------
 
231
   function Is_Derived_From_Array (TD : Element) return Boolean renames
 
232
      Asis.Data_Decomposition.Aux.Is_Derived_From_Array;
 
233
 
 
234
   ----------------------------
 
235
   -- Is_Derived_From_Record --
 
236
   -----------------------------
 
237
   function Is_Derived_From_Record (TD : Element) return Boolean renames
 
238
      Asis.Data_Decomposition.Aux.Is_Derived_From_Record;
 
239
 
 
240
   function Dimension (Comp : Array_Component) return ASIS_Natural renames
 
241
      Asis.Data_Decomposition.Set_Get.Dimension;
 
242
 
 
243
--   function Linear_Index
 
244
--     (Inds        : Dimension_Indexes;
 
245
--      D           : ASIS_Natural;
 
246
--      Ind_Lengths : Dimention_Length;
 
247
--      Conv        : Convention_Id := Convention_Ada)
 
248
--      return Asis.ASIS_Natural
 
249
--      renames Asis.Data_Decomposition.Aux.Linear_Index;
 
250
 
 
251
--   function De_Linear_Index
 
252
--     (Index       : Asis.ASIS_Natural;
 
253
--      D           : ASIS_Natural;
 
254
--      Ind_Lengths : Dimention_Length;
 
255
--      Conv        : Convention_Id := Convention_Ada)
 
256
--      return Dimension_Indexes
 
257
--      renames Asis.Data_Decomposition.Aux.De_Linear_Index;
 
258
 
 
259
end Asis.Data_Decomposition.Debug;
 
 
b'\\ No newline at end of file'