← Back to branch summary

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

« back to all changes in this revision

Viewing changes to tutorial/using_templets/style_ckecker/task_2/actuals_for_traversing-pre_op.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:
tutorial/using_templets/style_ckecker/task_2/actuals_for_traversing-pre_op.adb
 
1
------------------------------------------------------------------------------
 
2
--                                                                          --
 
3
--                       ASIS TUTORIAL COMPONENTS                           --
 
4
--                                                                          --
 
5
--           A C T U A L S _ F O R _ T R A V E R S I N G . P R E _ O P      --
 
6
--                                                                          --
 
7
--                                 B o d y                                  --
 
8
--                                                                          --
 
9
--            Copyright (c) 2000, Free Software Foundation, Inc.            --
 
10
--                                                                          --
 
11
-- ASIS  Application  Templates are  free software; you can redistribute it --
 
12
-- and/or  modify it under  terms  of the  GNU  General  Public  License as --
 
13
-- published by the Free Software Foundation; either version 2, or (at your --
 
14
-- option) any later version. ASIS Application Templates are distributed in --
 
15
-- the hope that they will be useful, but  WITHOUT  ANY  WARRANTY; without  --
 
16
-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR --
 
17
-- PURPOSE. See the GNU General Public License for more details. You should --
 
18
-- have  received a copy of the GNU General Public License distributed with --
 
19
-- distributed  with  GNAT;  see  file  COPYING. If not, write to the Free  --
 
20
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, --
 
21
-- USA.                                                                     --
 
22
--                                                                          --
 
23
-- ASIS Tutorial was developed and are now maintained by Ada Core           --
 
24
-- Technologies Inc (http://www.gnat.com).                                  --
 
25
--                                                                          --
 
26
------------------------------------------------------------------------------
 
27
 
 
28
--  This is the body of Pre_Op to be used as an example of the style
 
29
--  checker solution (Task 2) built on top of the ASIS Application Templates
 
30
--  provided in ASIS-for-GNAT. This file is supposed to replace the file with
 
31
--  the same name which is a part of the ASIS Application Templates
 
32
--
 
33
--  This Ada unit is obtained as an "extension" of the code which is the
 
34
--  solution for Task 1
 
35
 
 
36
with Ada.Wide_Text_IO;
 
37
with Ada.Characters.Handling;
 
38
with Ada.Exceptions;
 
39
 
 
40
with Asis.Exceptions;
 
41
with Asis.Errors;
 
42
with Asis.Implementation;
 
43
with Asis.Elements;
 
44
with Asis.Declarations;
 
45
with Asis.Expressions;
 
46
 
 
47
with Style_Checker_Utilities;
 
48
 
 
49
separate (Actuals_For_Traversing)
 
50
procedure Pre_Op
 
51
  (Element :        Asis.Element;
 
52
   Control : in out Asis.Traverse_Control;
 
53
   State   : in out Traversal_State)
 
54
is
 
55
   Argument_Kind             : Asis.Element_Kinds;
 
56
   Argument_Declaration_Kind : Asis.Declaration_Kinds;
 
57
 
 
58
   Argument_Association_Kind : Asis.Association_Kinds;
 
59
   --  Added for Task 2
 
60
 
 
61
begin
 
62
   --  Note, that the code below may be rewritten in more compact way (with
 
63
   --  the same functionality). But we prefer to go step-by-step,
 
64
   --  demonstrating the important ASIS queries
 
65
 
 
66
   Argument_Kind := Asis.Elements.Element_Kind (Element);
 
67
 
 
68
   case Argument_Kind is
 
69
 
 
70
      when Asis.An_Association =>
 
71
         --  The first rule added by Task 1 is about generic associations,
 
72
         --  so we have to add one more alternative to the external case
 
73
         --  statement - for An_Association Element_Kinds value.
 
74
 
 
75
         --  Inside this alternative you first have to define the exact
 
76
         --  association kind:
 
77
 
 
78
         Argument_Association_Kind := Asis.Elements.Association_Kind (Element);
 
79
 
 
80
         --  and for A_Generic_Association Element:
 
81
 
 
82
         case Argument_Association_Kind is
 
83
 
 
84
            when Asis.A_Generic_Association =>
 
85
               --  you have to check that they are in named form.
 
86
               --  In ASIS terms this means, that the result of
 
87
               --  Asis.Expressions.Formal_Parameter query applied
 
88
               --  to the association Element is not Nil
 
89
 
 
90
               if Asis.Elements.Is_Nil
 
91
                  (Asis.Expressions.Formal_Parameter (Element))
 
92
               then
 
93
                  Style_Checker_Utilities.Report_Style_Violation
 
94
                    (The_Element => Element,
 
95
                     Diagnosis   => "Positional generic association");
 
96
               end if;
 
97
 
 
98
            when others =>
 
99
               --  Nothing to do with other association kinds, so
 
100
               null;
 
101
         end case;
 
102
 
 
103
      when Asis.A_Declaration =>
 
104
 
 
105
         --  The second rule added by Task 2 is about declarations in general.
 
106
         --  Actually, it have to be checked only for declarations which can
 
107
         --  define more then one entity (such as object declarations and
 
108
         --  parameter declarations), and this rule is always true for other
 
109
         --  declarations (such as package declarations, type declarations
 
110
         --  etc.) But to simplify the code needed to check this rule, we may
 
111
         --  check it for all declaration kinds. The check itself is very
 
112
         --  simple - we have to get the list of the names defined by a
 
113
         --  given declaration (see the query Asis.Declarations.Names) and
 
114
         --  check how many they are.
 
115
 
 
116
         if Asis.Declarations.Names (Element)'Length >= 2 then
 
117
            Style_Checker_Utilities.Report_Style_Violation
 
118
              (The_Element => Element,
 
119
               Diagnosis   => "Declaration with more then one name");
 
120
         end if;
 
121
 
 
122
         --  The following check came from Task 1
 
123
         --  The rule to check is about a specific kinds of declarations
 
124
         --  only - we have to check that each subprogram body has a separate
 
125
         --  spec. So we have first to define a more specific declaration
 
126
         --  kind of the argument Element and then we have to check our rule
 
127
         --  for subprogram bodies only
 
128
 
 
129
         Argument_Declaration_Kind := Asis.Elements.Declaration_Kind (Element);
 
130
 
 
131
         case Argument_Declaration_Kind is
 
132
 
 
133
            when Asis.A_Procedure_Body_Declaration |
 
134
                 Asis.A_Function_Body_Declaration  =>
 
135
 
 
136
               if Asis.Elements.Is_Nil
 
137
                  (Asis.Declarations.Corresponding_Declaration (Element))
 
138
               then
 
139
                  Style_Checker_Utilities.Report_Style_Violation
 
140
                    (The_Element => Element,
 
141
                     Diagnosis   => "Subprogram body with no explicit spec");
 
142
               end if;
 
143
 
 
144
            when others =>
 
145
               --  For the other declaration kinds we have nothing to check,
 
146
               --  so:
 
147
               null;
 
148
         end case;
 
149
 
 
150
      when others =>
 
151
         --  Our the only rule for Task 1 is about declarations, so if
 
152
         --  we have something which is not A_Declaration, we have nothing
 
153
         --  to do
 
154
         null;
 
155
   end case;
 
156
 
 
157
exception
 
158
 
 
159
   when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
 
160
             Asis.Exceptions.ASIS_Inappropriate_Container        |
 
161
             Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
 
162
             Asis.Exceptions.ASIS_Inappropriate_Element          |
 
163
             Asis.Exceptions.ASIS_Inappropriate_Line             |
 
164
             Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
 
165
             Asis.Exceptions.ASIS_Failed                         =>
 
166
 
 
167
      Ada.Wide_Text_IO.Put ("Pre_Op : ASIS exception (");
 
168
 
 
169
      Ada.Wide_Text_IO.Put (Ada.Characters.Handling.To_Wide_String (
 
170
              Ada.Exceptions.Exception_Name (Ex)));
 
171
 
 
172
      Ada.Wide_Text_IO.Put (") is raised");
 
173
      Ada.Wide_Text_IO.New_Line;
 
174
 
 
175
      Ada.Wide_Text_IO.Put ("ASIS Error Status is ");
 
176
 
 
177
      Ada.Wide_Text_IO.Put
 
178
        (Asis.Errors.Error_Kinds'Wide_Image (Asis.Implementation.Status));
 
179
 
 
180
      Ada.Wide_Text_IO.New_Line;
 
181
 
 
182
      Ada.Wide_Text_IO.Put ("ASIS Diagnosis is ");
 
183
      Ada.Wide_Text_IO.New_Line;
 
184
      Ada.Wide_Text_IO.Put (Asis.Implementation.Diagnosis);
 
185
      Ada.Wide_Text_IO.New_Line;
 
186
 
 
187
      Asis.Implementation.Set_Status;
 
188
 
 
189
   when Ex : others =>
 
190
 
 
191
      Ada.Wide_Text_IO.Put ("Pre_Op : ");
 
192
 
 
193
      Ada.Wide_Text_IO.Put (Ada.Characters.Handling.To_Wide_String (
 
194
              Ada.Exceptions.Exception_Name (Ex)));
 
195
 
 
196
      Ada.Wide_Text_IO.Put (" is raised (");
 
197
 
 
198
      Ada.Wide_Text_IO.Put (Ada.Characters.Handling.To_Wide_String (
 
199
              Ada.Exceptions.Exception_Information (Ex)));
 
200
 
 
201
      Ada.Wide_Text_IO.Put (")");
 
202
      Ada.Wide_Text_IO.New_Line;
 
203
 
 
204
end Pre_Op;
 
 
b'\\ No newline at end of file'