Merge pull request #2942 from koenmeersman/masatake-ada-generic-in-package

Ada : Improve formal parameter tags in generic function/procedure

Author: masatake

Units/parser-ada.r/ada-generic-in-package.d/args.ctags

@@ -0,0 +1,2 @@
+--sort=no
+--kinds-Ada=+{formal}

Units/parser-ada.r/ada-generic-in-package.d/expected.tags-e

@@ -6,3 +6,39 @@ package My_Package isMy_Package/s
2,48
     type Num is digits <>;Num
5,81
   type Missing_Tag is recordMissing_Tag/t
10,208
     Num : Integer;Num
11,237
+
+input_1.adb,1666
+procedure Input_1 isInput_1/p
1,0
+  procedure Generic_Reverse_Array (X : in out Array_T);Generic_Reverse_Array/p
9,200
+    type T is private;T
4,32
+    type Index is range <>;Index
5,55
+    type Array_T is array (Index range <>) of T;Array_T
6,83
+    with function Img (A, B: T) return boolean;Img
8,152
+  procedure Generic_Reverse_Array (X : in out Array_T) isGeneric_Reverse_Array/p
11,257
+	Tmp     : T;Tmp
15,389
+	X_Left  : T renames X (I);X_Left
16,403
+	X_Right : T renames X (X'Last + X'First - I);X_Right
17,431
+  type Color is (None, Black, Red, Green, Blue, White);Color/t
26,603
+  type Color is (None, Black, Red, Green, Blue, White);None
26,603
+  type Color is (None, Black, Red, Green, Blue, White);Black
26,603
+  type Color is (None, Black, Red, Green, Blue, White);Red
26,603
+  type Color is (None, Black, Red, Green, Blue, White);Green
26,603
+  type Color is (None, Black, Red, Green, Blue, White);Blue
26,603
+  type Color is (None, Black, Red, Green, Blue, White);White
26,603
+  type Color_Array is array (Integer range <>) of Color;Color_Array/t
27,659
+  procedure Reverse_Color_Array is new Generic_Reverse_ArrayReverse_Color_Array/p
28,716
+  type Shape is (None, Circle, Triangle, Square);Shape/t
31,859
+  type Shape is (None, Circle, Triangle, Square);None
31,859
+  type Shape is (None, Circle, Triangle, Square);Circle
31,859
+  type Shape is (None, Circle, Triangle, Square);Triangle
31,859
+  type Shape is (None, Circle, Triangle, Square);Square
31,859
+  type Shape_Array is array (Integer range <>) of Shape;Shape_Array/t
32,909
+  procedure Reverse_Shape_Array is new Generic_Reverse_ArrayReverse_Shape_Array/p
33,966
+
+input_2.ads,301
+package input_2 isinput_2/s
1,0
+  type Generator is null record;Generator/t
3,20
+    type Unsigned is mod <>;Unsigned
5,63
+    type Real is digits <>;Real
6,92
+    with function Random (G: Generator) return Unsigned is <>;Random
7,120
+  function Random (G: Generator) return Real;Random/f
8,183

Units/parser-ada.r/ada-generic-in-package.d/input_1.adb

@@ -0,0 +1,38 @@
+procedure Input_1 is
+
+  generic
+    type T is private;
+    type Index is range <>;
+    type Array_T is array (Index range <>) of T;
+    Null_Value : T;
+    with function Img (A, B: T) return boolean;
+  procedure Generic_Reverse_Array (X : in out Array_T);
+
+  procedure Generic_Reverse_Array (X : in out Array_T) is
+  begin
+    for I in X'First .. (X'Last + X'First) / 2 loop
+      declare
+	Tmp     : T;
+	X_Left  : T renames X (I);
+	X_Right : T renames X (X'Last + X'First - I);
+      begin
+	Tmp     := X_Left;
+	X_Left  := X_Right;
+	X_Right := Tmp;
+      end;
+    end loop;
+  end Generic_Reverse_Array;
+
+  type Color is (None, Black, Red, Green, Blue, White);
+  type Color_Array is array (Integer range <>) of Color;
+  procedure Reverse_Color_Array is new Generic_Reverse_Array
+     (T => Color, Index => Integer, Array_T => Color_Array, Null_Value => None);
+
+  type Shape is (None, Circle, Triangle, Square);
+  type Shape_Array is array (Integer range <>) of Shape;
+  procedure Reverse_Shape_Array is new Generic_Reverse_Array
+     (T => Shape, Index => Integer, Array_T => Shape_Array, Null_Value => None);
+
+begin
+  null;
+end Input_1;

Units/parser-ada.r/ada-generic-in-package.d/input_2.ads

@@ -0,0 +1,10 @@
+package input_2 is
+
+  type Generator is null record;
+  generic
+    type Unsigned is mod <>;
+    type Real is digits <>;
+    with function Random (G: Generator) return Unsigned is <>;
+  function Random (G: Generator) return Real;
+
+end input_2;

parsers/ada.c

@@ -1589,11 +1589,14 @@ static adaTokenInfo *adaParse(adaParseMode mode, adaTokenInfo *parent)
       continue;
     }
     else if(adaKeywordCmp(ADA_KEYWORD_PRAGMA) ||
-            adaKeywordCmp(ADA_KEYWORD_WITH) ||
+            ((mode != ADA_GENERIC) && adaKeywordCmp(ADA_KEYWORD_WITH)) ||
             adaKeywordCmp(ADA_KEYWORD_USE))
     {
       /* set the token to NULL so we accidentally don't pick up something
-       * from earlier */
+       * from earlier
+       * Do not skip lines having 'with' when 'mode == ADA_GENERIC'
+       * this to intercept 'formal subprograms' of a generic declaration.
+       * see: ARM 12.1(22) */
       skipPast(";");
       continue;
     }
@@ -1693,11 +1696,23 @@ static adaTokenInfo *adaParse(adaParseMode mode, adaTokenInfo *parent)
         if(adaKeywordCmp(ADA_KEYWORD_PACKAGE))
         {
           token = adaParseBlock(parent, ADA_KIND_PACKAGE);
+
+          /* The above 'adaParseBlock' has read the end of a 'generic package declaration',
+           * reset the mode back to the original mode.
+           * see: ARM 12.1(24) */
+          Assert (parent);
+          mode = (parent->parent)? ADA_DECLARATIONS: ADA_ROOT;
         }
         else if(adaKeywordCmp(ADA_KEYWORD_PROCEDURE) ||
                 adaKeywordCmp(ADA_KEYWORD_FUNCTION))
         {
           token = adaParseSubprogram(parent, ADA_KIND_SUBPROGRAM);
+
+          /* The above 'adaParseBlock' as read the end of a 'generic function/procedure declaration',
+           * reset the mode back to the original mode.
+           * see: ARM 12.1(21/22) */
+          Assert (parent);
+          mode = (parent->parent)? ADA_DECLARATIONS: ADA_ROOT;
         }
         else if(adaKeywordCmp(ADA_KEYWORD_TASK))
         {
@@ -1770,10 +1785,8 @@ static adaTokenInfo *adaParse(adaParseMode mode, adaTokenInfo *parent)
         if(token != NULL)
         {
           /* if any generic params have been gathered, attach them to
-           * token, and set the mode back to ADA_ROOT or ADA_DECLARATIONS */
+           * token. */
           appendAdaTokenList(token, &genericParamsRoot.children);
-          Assert (parent);
-          mode = (parent->parent)? ADA_DECLARATIONS: ADA_ROOT;
         } /* if(token != NULL) */
 
         break;