← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to src/rules-simplifiable_expressions.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-10-12 19:17:22 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061012191722-fo5bcn4k5r0iubgd
Tags: 1.5r24-1

* New upstream release.
* debian/control (Depends): add gnat-4.1.
  (Enhances): add gnat-gps.
* debian/adacontrol.gpr: build pfni.
* debian/rules: install the new gnat-gps plug-in, and pfni.
* debian/pfni.1: new.
* patches/gps-integration.patch: new.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rules-simplifiable_expressions.adb
35
35
 
36
36
-- Asis
37
37
with
38
 
  Asis,
39
38
  Asis.Declarations,
40
39
  Asis.Definitions,
41
40
  Asis.Elements,
42
 
  Asis.Expressions,
43
 
  Asis.Statements;
 
41
  Asis.Expressions;
44
42
 
45
43
-- Adalog
46
44
with
53
51
  Framework.Language,
54
52
  Framework.Rules_Manager,
55
53
  Framework.Reports;
 
54
pragma Elaborate (Framework.Language);
56
55
 
57
56
package body Rules.Simplifiable_expressions is
58
57
   use Framework, Ada.Strings.Wide_Unbounded;
60
59
   type Keywords is (K_Range, K_Logical_True, K_Logical_False, K_Parentheses, K_Logical);
61
60
   subtype To_Check is Keywords range Keywords'First .. Keywords'Pred (K_Logical);
62
61
 
 
62
   package Check_Flags_Utilities is new Framework.Language.Flag_Utilities (Keywords, "K_");
 
63
   use Check_Flags_Utilities;
 
64
 
63
65
   type Usage_Entry is
64
66
      record
65
67
         Used  : Boolean := False;
66
68
         Label : Unbounded_Wide_String;
67
 
         end record;
 
69
      end record;
68
70
   type Usages is array (To_Check) of Usage_Entry;
69
71
 
70
72
   Context   : array (Rule_Types) of Usages;
71
73
   Rule_Used : Boolean;
72
74
   Save_Used : Boolean;
73
75
 
74
 
   -----------
75
 
   -- Image --
76
 
   -----------
77
 
 
78
 
   function Image (Check : To_Check) return Wide_String is
79
 
      use Utilities;
80
 
      Img : constant Wide_String := To_Lower (To_Check'Wide_Image (Check));
81
 
   begin
82
 
      -- Remove "K_"
83
 
      return Img (3 .. Img'Last);
84
 
   end Image;
85
 
 
86
76
   ----------
87
77
   -- Help --
88
78
   ----------
90
80
   procedure Help is
91
81
      use Utilities;
92
82
   begin
93
 
      User_Message ("Rule: " & Rule_Id);
94
 
      User_Message ("Parameter(s): ranges | logical | logical_true | logical_false");
95
 
      User_Message ("              | parentheses (optional, default=all)");
96
 
      User_Message ("Control occurrence of various forms of expressions that could be made simpler:");
97
 
      User_Message ("  T'FIRST .. T'LAST that can be replaced by T'RANGE or T.");
98
 
      User_Message ("  <expression> = (/=) True/False");
99
 
      User_Message ("  if (<expression>) or case (<expression>)");
 
83
      User_Message  ("Rule: " & Rule_Id);
 
84
      Help_On_Flags (Header => "Parameter(s):", Footer => "(optional, default=all)");
 
85
      User_Message  ("Control occurrence of various forms of expressions that could be made simpler:");
 
86
      User_Message  ("  T'FIRST .. T'LAST that can be replaced by T'RANGE or T.");
 
87
      User_Message  ("  <expression> = (/=) True/False");
 
88
      User_Message  ("  Unnecessary parentheses");
100
89
   end Help;
101
90
 
102
91
   -------------
105
94
 
106
95
   procedure Add_Use (Label         : in Wide_String;
107
96
                      Rule_Use_Type : in Rule_Types) is
108
 
      use Ada.Strings.Wide_Unbounded, Framework.Language;
 
97
      use Framework.Language;
109
98
 
110
99
      Key : Keywords;
111
 
      function Get_Check_Parameter is new Get_Flag_Parameter (Flags     => Keywords,
112
 
                                                               Allow_Any => False,
113
 
                                                               Prefix    => "K_");
114
100
 
115
101
      procedure Add_Check (Check : To_Check) is
116
102
      begin
124
110
   begin
125
111
      if Parameter_Exists then
126
112
         while Parameter_Exists loop
127
 
            Key := Get_Check_Parameter;
 
113
            Key := Get_Flag_Parameter (Allow_Any => False);
128
114
            if Key = K_Logical then
129
115
               Add_Check (K_Logical_True);
130
116
               Add_Check (K_Logical_False);
171
157
   ------------------
172
158
 
173
159
   procedure Process_Call (Call : in Asis.Expression) is
174
 
      use Ada.Strings.Wide_Unbounded, Asis,
175
 
          Asis.Elements, Asis.Expressions, Framework.Reports, Thick_Queries;
 
160
      use Asis, Asis.Elements, Asis.Expressions, Framework.Reports, Thick_Queries;
176
161
 
177
162
      type Param_Kind is (Static_True, Static_False, Expr);
178
163
      function "+" (Left : Wide_String) return Unbounded_Wide_String renames To_Unbounded_Wide_String;
207
192
                 (Static_True  => +"Simplify expression '<expr> /= True' to 'not <expr>'",    -- <Expr> /= True
208
193
                  Static_False => +"Simplify expression '<expr> /= False' to just '<expr>'",  -- <Expr> /= False
209
194
                  Expr         => +"")));                                                     -- <Expr> /= <Expr>
210
 
      Op : constant Asis.Operator_Kinds := Operator_Kind (Prefix (Call));
211
195
 
212
196
      function Get_Kind (Param : Asis.Expression) return Param_Kind is
213
197
         use Utilities;
230
214
      end if;
231
215
      Rules_Manager.Enter (Rule_Id);
232
216
 
233
 
      if Op in  An_Equal_Operator .. A_Not_Equal_Operator then
234
 
         declare
235
 
            P : constant Asis.Association_List := Function_Call_Parameters (Call);
236
 
            L : constant Param_Kind := Get_Kind (Actual_Parameter (P(1)));
237
 
            R : constant Param_Kind := Get_Kind (Actual_Parameter (P(2)));
238
 
         begin
239
 
            if Message_Table (Op, L, R) /= Null_Unbounded_Wide_String then
240
 
               -- Report the highest priority from Check/Search
241
 
               if Context (Check)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
242
 
                  Report (Rule_Id,
243
 
                          To_Wide_String (Context (Check)(K_Logical_False).Label),
244
 
                          Check,
245
 
                          Get_Location (Call),
246
 
                          To_Wide_String (Message_Table (Op, L, R)));
247
 
               elsif Context (Check)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
248
 
                  Report (Rule_Id,
249
 
                          To_Wide_String (Context (Check)(K_Logical_True).Label),
250
 
                          Check,
251
 
                          Get_Location (Call),
252
 
                          To_Wide_String (Message_Table (Op, L, R)));
253
 
               elsif Context (Search)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
254
 
                  Report (Rule_Id,
255
 
                          To_Wide_String (Context (Search)(K_Logical_False).Label),
256
 
                          Search,
257
 
                          Get_Location (Call),
258
 
                          To_Wide_String (Message_Table (Op, L, R)));
259
 
               elsif Context (Search)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
260
 
                  Report (Rule_Id,
261
 
                          To_Wide_String (Context (Search) (K_Logical_True).Label),
262
 
                          Search,
263
 
                          Get_Location (Call),
264
 
                          To_Wide_String (Message_Table (Op, L, R)));
265
 
               end if;
 
217
      declare
 
218
         Op : constant Asis.Operator_Kinds := Operator_Kind (Prefix (Call));
 
219
      begin
 
220
         if Op in  An_Equal_Operator .. A_Not_Equal_Operator then
 
221
            declare
 
222
               P : constant Asis.Association_List := Function_Call_Parameters (Call);
 
223
               L : constant Param_Kind := Get_Kind (Actual_Parameter (P(1)));
 
224
               R : constant Param_Kind := Get_Kind (Actual_Parameter (P(2)));
 
225
            begin
 
226
               if Message_Table (Op, L, R) /= Null_Unbounded_Wide_String then
 
227
                  -- Report the highest priority from Check/Search
 
228
                  if Context (Check)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
 
229
                     Report (Rule_Id,
 
230
                             To_Wide_String (Context (Check)(K_Logical_False).Label),
 
231
                             Check,
 
232
                             Get_Location (Call),
 
233
                             To_Wide_String (Message_Table (Op, L, R)));
 
234
                  elsif Context (Check)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
 
235
                     Report (Rule_Id,
 
236
                             To_Wide_String (Context (Check)(K_Logical_True).Label),
 
237
                             Check,
 
238
                             Get_Location (Call),
 
239
                             To_Wide_String (Message_Table (Op, L, R)));
 
240
                  elsif Context (Search)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
 
241
                     Report (Rule_Id,
 
242
                             To_Wide_String (Context (Search)(K_Logical_False).Label),
 
243
                             Search,
 
244
                             Get_Location (Call),
 
245
                             To_Wide_String (Message_Table (Op, L, R)));
 
246
                  elsif Context (Search)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
 
247
                     Report (Rule_Id,
 
248
                             To_Wide_String (Context (Search) (K_Logical_True).Label),
 
249
                             Search,
 
250
                             Get_Location (Call),
 
251
                             To_Wide_String (Message_Table (Op, L, R)));
 
252
                  end if;
266
253
 
267
 
               -- Always report Count
268
 
               if Context (Count)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
269
 
                  Report (Rule_Id,
270
 
                          To_Wide_String (Context (Count) (K_Logical_False).Label),
271
 
                          Count,
272
 
                          Get_Location (Call),
273
 
                          To_Wide_String (Message_Table (Op, L, R)));
274
 
               elsif Context (Count)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
275
 
                  Report (Rule_Id,
276
 
                          To_Wide_String (Context (Count) (K_Logical_True).Label),
277
 
                          Count,
278
 
                          Get_Location (Call),
279
 
                          To_Wide_String (Message_Table (Op, L, R)));
 
254
                  -- Always report Count
 
255
                  if Context (Count)(K_Logical_False).Used and then (L = Static_False or R = Static_False) then
 
256
                     Report (Rule_Id,
 
257
                             To_Wide_String (Context (Count) (K_Logical_False).Label),
 
258
                             Count,
 
259
                             Get_Location (Call),
 
260
                             To_Wide_String (Message_Table (Op, L, R)));
 
261
                  elsif Context (Count)(K_Logical_True).Used and then (L = Static_True or R = Static_True) then
 
262
                     Report (Rule_Id,
 
263
                             To_Wide_String (Context (Count) (K_Logical_True).Label),
 
264
                             Count,
 
265
                             Get_Location (Call),
 
266
                             To_Wide_String (Message_Table (Op, L, R)));
 
267
                  end if;
280
268
               end if;
281
 
            end if;
282
 
         end;
283
 
      end if;
 
269
            end;
 
270
         end if;
 
271
      end;
284
272
   end Process_Call;
285
273
 
286
274
   -------------------
288
276
   -------------------
289
277
 
290
278
   procedure Process_Range (Definition : in Asis.Definition) is
291
 
      use Ada.Strings.Wide_Unbounded, Asis, Asis.Declarations, Asis.Definitions,
 
279
      use Asis, Asis.Declarations, Asis.Definitions,
292
280
        Asis.Elements, Asis.Expressions, Framework.Reports, Thick_Queries, Utilities;
293
281
 
294
282
      procedure Do_Reports (Message : Wide_String) is
355
343
                  --      and are satic integers.
356
344
                  if ALB'LENGTH /= AUB'LENGTH
357
345
                    or else (ALB'LENGTH = 1  -- Implies AUB'LENGTH = 1
358
 
                             and then Asis_Integer'Wide_Value (Value_Image (ALB (1))) /=
359
 
                             Asis_Integer'Wide_Value (Value_Image (AUB (1))))
 
346
                             and then ASIS_Integer'Wide_Value (Value_Image (ALB (1))) /=
 
347
                             ASIS_Integer'Wide_Value (Value_Image (AUB (1))))
360
348
                  then
361
349
                     return;
362
350
                  end if;
432
420
 
433
421
                                 case Expression_Kind (L_Indexers (I)) is
434
422
                                    when An_Integer_Literal =>
435
 
                                       if Asis_Integer'Wide_Value (Value_Image (L_Indexers (I)))
436
 
                                         /= Asis_Integer'Wide_Value (Value_Image (U_Indexers (I)))
 
423
                                       if ASIS_Integer'Wide_Value (Value_Image (L_Indexers (I)))
 
424
                                         /= ASIS_Integer'Wide_Value (Value_Image (U_Indexers (I)))
437
425
                                       then
438
426
                                          return;
439
427
                                       end if;
444
432
                                          return;
445
433
                                       end if;
446
434
                                    when An_Identifier =>
447
 
                                       case Declaration_Kind (Corresponding_Name_Declaration (L_Indexers (I))) is
 
435
                                       case Declaration_Kind (Corresponding_Name_Declaration (L_Indexers (I)))
 
436
                                       is
448
437
                                          when A_Constant_Declaration
449
438
                                            | A_Deferred_Constant_Declaration
450
439
                                            | A_Loop_Parameter_Specification
467
456
                           LP := Prefix (LP);
468
457
                           UP := Prefix (UP);
469
458
 
 
459
                        when An_Explicit_Dereference =>
 
460
                           -- Certainly not static
 
461
                           return;
 
462
 
470
463
                        when others =>
471
464
                          Failure ("Unexpected expression kind", LP);
472
465
                     end case;
514
507
         when A_Discrete_Range_Attribute_Reference =>
515
508
            -- We are interested only in the case where the prefix is a (sub)type
516
509
            declare
517
 
               P : Asis.Expression := Prefix (Range_Attribute (Definition));
 
510
               P    : Asis.Expression := Prefix (Range_Attribute (Definition));
518
511
               Decl : Asis.Declaration;
519
512
               Def  : Asis.Definition;
520
513
            begin
529
522
                     return;
530
523
               end case;
531
524
 
532
 
               -- Get rid of subtypes
 
525
               -- Get rid of subtypes, incomplete views...
533
526
               Decl := Corresponding_Name_Declaration (P);
534
527
               if Declaration_Kind (Decl) = A_Subtype_Declaration then
535
528
                  Decl := Corresponding_First_Subtype (Decl);
536
529
               end if;
537
530
 
 
531
               if Declaration_Kind (Decl) = A_Private_Type_Declaration
 
532
                 or Declaration_Kind (Decl) = An_Incomplete_Type_Declaration
 
533
               then
 
534
                  Decl := Corresponding_Type_Declaration (Decl);
 
535
               end if;
 
536
 
538
537
               case Declaration_Kind (Decl) is
539
538
                  when An_Ordinary_Type_Declaration
540
539
                    | A_Formal_Type_Declaration
545
544
                     Def := Type_Declaration_View (Decl);
546
545
                     loop
547
546
                        if Type_Kind (Def) in A_Derived_Type_Definition .. A_Derived_Record_Extension_Definition then
548
 
                           Def := Type_Declaration_View (Corresponding_Root_Type (Def));
 
547
                           Def := Type_Declaration_View (A4G_Bugs.Corresponding_Root_Type (Def));
549
548
                        elsif Formal_Type_Kind (Def) = A_Formal_Derived_Type_Definition then
550
549
                           Def := Type_Declaration_View (Corresponding_First_Subtype
551
550
                                                         (Corresponding_Name_Declaration
552
 
                                                          (Definitions.Subtype_Mark (Def))));
 
551
                                                          (Subtype_Simple_Name (Def))));
553
552
                        else
554
553
                           exit;
555
554
                        end if;
601
600
                    | An_Object_Renaming_Declaration
602
601
                    =>
603
602
                     null;
 
603
 
604
604
                  when others =>
605
605
                     Failure ("Unexpected Element_Kind 2: " &
606
 
                              Declaration_Kinds'Wide_Image (Declaration_Kind
607
 
                                                            (Corresponding_Name_Declaration
608
 
                                                             (P))));
 
606
                              Declaration_Kinds'Wide_Image (Declaration_Kind (Decl)));
609
607
               end case;
610
608
            end;
611
609
 
618
616
      end case;
619
617
   end Process_Range;
620
618
 
621
 
   ------------------------
622
 
   -- Process_Case_Or_If --
623
 
   ------------------------
624
 
 
625
 
   procedure Process_Case_Or_If (Stmt : in Asis.Element) is
626
 
      use Asis, Asis.Elements, Asis.Statements, Utilities, Framework.Reports;
627
 
 
628
 
      Expr : Asis.Expression;
629
 
      Message : constant Wide_String := "Unnecessary parentheses in expression of ""if"" or ""case""";
630
 
   begin
631
 
      if not Rule_Used then
632
 
         return;
633
 
      end if;
634
 
      Rules_Manager.Enter (Rule_Id);
635
 
 
636
 
      if Statement_Kind (Stmt) = A_Case_Statement then
637
 
         Expr := Case_Expression (Stmt);
638
 
      elsif Path_Kind (Stmt) in An_If_Path .. An_Elsif_Path then
639
 
         Expr := Condition_Expression (Stmt);
640
 
      else
641
 
         Failure ("Not a case or if statement");
642
 
      end if;
643
 
 
644
 
      if Expression_Kind (Expr) = A_Parenthesized_Expression then
 
619
   ---------------------------
 
620
   -- Process_Parenthesized --
 
621
   ---------------------------
 
622
 
 
623
   procedure Process_Parenthesized (Expr : in Asis.Expression) is
 
624
      use Asis, Asis.Elements, Asis.Expressions, Framework.Reports;
 
625
 
 
626
      procedure Do_Report is
 
627
         Message : constant Wide_String := "Unnecessary parentheses in expression";
 
628
      begin
645
629
         if Context (Check)(K_Parentheses).Used then
646
630
            Report (Rule_Id,
647
631
                    To_Wide_String (Context (Check)(K_Parentheses).Label),
648
632
                    Check,
649
 
                    Get_Location (Stmt),
 
633
                    Get_Location (Expr),
650
634
                    Message);
651
635
         elsif Context (Search)(K_Parentheses).Used then
652
636
            Report (Rule_Id,
653
637
                    To_Wide_String (Context (Search)(K_Parentheses).Label),
654
638
                    Search,
655
 
                    Get_Location (Stmt),
 
639
                    Get_Location (Expr),
656
640
                    Message);
657
641
         end if;
658
642
 
660
644
            Report (Rule_Id,
661
645
                    To_Wide_String (Context (Count)(K_Parentheses).Label),
662
646
                    Count,
663
 
                    Get_Location (Stmt),
 
647
                    Get_Location (Expr),
664
648
                    Message);
665
649
         end if;
666
 
      end if;
667
 
   end Process_Case_Or_If;
 
650
      end Do_Report;
 
651
 
 
652
      type Priority_Level is (Logical, Relational, Adding, Multiplying, Highest, Primary);
 
653
      Priority : constant array (Asis.Operator_Kinds) of Priority_Level
 
654
        := (Not_An_Operator                                              => Primary,
 
655
            An_And_Operator          .. An_Xor_Operator                  => Logical,
 
656
            An_Equal_Operator        .. A_Greater_Than_Or_Equal_Operator => Relational,
 
657
            A_Plus_Operator          .. A_Unary_Minus_Operator           => Adding,
 
658
            A_Multiply_Operator      .. A_Rem_Operator                   => Multiplying,
 
659
            An_Exponentiate_Operator .. A_Not_Operator                   => Highest);
 
660
 
 
661
      Enclosing : Asis.Element;
 
662
      Enclosed  : Asis.Element;
 
663
   begin
 
664
      if not Rule_Used then
 
665
         return;
 
666
      end if;
 
667
      Rules_Manager.Enter (Rule_Id);
 
668
 
 
669
      Enclosing := Enclosing_Element (Expr);
 
670
      if Element_Kind (Enclosing) = An_Association then
 
671
         Enclosing := Enclosing_Element (Enclosing);
 
672
      end if;
 
673
 
 
674
      case Expression_Kind (Enclosing) is
 
675
         when Not_An_Expression
 
676
           | A_Parenthesized_Expression
 
677
           =>
 
678
            Do_Report;
 
679
 
 
680
         when A_Function_Call =>
 
681
            if Is_Prefix_Call (Enclosing) then
 
682
               Do_Report;
 
683
            else
 
684
               Enclosed := Expression_Parenthesized (Expr);
 
685
               case Expression_Kind (Enclosed) is
 
686
                  when A_Function_Call =>
 
687
                     if Is_Prefix_Call (Enclosed)
 
688
                       or else  Priority (Operator_Kind (Prefix (Enclosing)))
 
689
                              < Priority (Operator_Kind (Prefix (Enclosed)))
 
690
                     then
 
691
                        Do_Report;
 
692
                     end if;
 
693
                  when An_And_Then_Short_Circuit .. An_Or_Else_Short_Circuit =>
 
694
                     null;
 
695
                  when others =>
 
696
                     Do_Report;
 
697
               end case;
 
698
            end if;
 
699
 
 
700
         when An_And_Then_Short_Circuit
 
701
           | An_Or_Else_Short_Circuit
 
702
           =>
 
703
            Enclosed := Expression_Parenthesized (Expr);
 
704
            case Expression_Kind (Enclosed) is
 
705
               when An_And_Then_Short_Circuit .. An_Or_Else_Short_Circuit =>
 
706
                  if Expression_Kind (Enclosing) = Expression_Kind (Enclosed) then
 
707
                     Do_Report;
 
708
                     end if;
 
709
               when A_Function_Call =>
 
710
                  if Is_Prefix_Call (Enclosed) or else Priority (Operator_Kind (Prefix (Enclosed))) > Logical then
 
711
                     Do_Report;
 
712
                  end if;
 
713
               when others =>
 
714
                  Do_Report;
 
715
            end case;
 
716
 
 
717
         when others =>
 
718
            null;
 
719
      end case;
 
720
 
 
721
   end Process_Parenthesized;
668
722
 
669
723
begin
670
 
   Framework.Rules_Manager.Register (Rule_Id,
671
 
                                     Help    => Help'Access,
672
 
                                     Add_Use => Add_Use'Access,
673
 
                                     Command => Command'Access);
 
724
   Framework.Rules_Manager.Register_Semantic (Rule_Id,
 
725
                                              Help    => Help'Access,
 
726
                                              Add_Use => Add_Use'Access,
 
727
                                              Command => Command'Access);
674
728
end Rules.Simplifiable_expressions;