Changeset 2626

Show
Ignore:
Timestamp:
02/19/08 18:03:33 (11 months ago)
Author:
ogorod
Message:

implemented supporters|dependents semantic_dependence_order

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/tendra/src/producers/ada/asis/asis-compilation_units-relations.adb

    r2620 r2626  
    1515------------------------------------------------------------------------------ 
    1616 
     17with Ada.Finalization; 
     18with Ada.Unchecked_Deallocation; 
     19with System; 
     20 
    1721with Asis.Errors;             use Asis.Errors; 
    1822with Asis.Exceptions; 
    1923with Asis.Implementation; 
     24with Asis.Elements; 
    2025with Asis.Ada_Environments; 
    21  
    22 with Ada.Finalization; 
    23 with Ada.Unchecked_Deallocation; 
    24 with System; 
     26with Asis.Clauses; 
     27with Asis.Expressions; 
     28with Asis.Iterator; 
    2529 
    2630package body Asis.Compilation_Units.Relations is 
    …… 
    6367      type Tree_Node_Access is access all Tree_Node; 
    6468 
    65       function Is_Empty 
    66         (This : in Tree_Node) 
     69      type Tree_Node_Array is array (Positive range <>) of Tree_Node_Access; 
     70      type Tree_Node_Array_Access is access all Tree_Node_Array; 
     71 
     72      procedure Deallocate is 
     73        new Ada.Unchecked_Deallocation 
     74          (Tree_Node_Array, Tree_Node_Array_Access); 
     75 
     76      function Append 
     77        (List : in Tree_Node_Array_Access; 
     78         Node : in Tree_Node_Access) 
     79         return Tree_Node_Array_Access; 
     80 
     81      function In_List 
     82        (List : in Tree_Node_Array_Access; 
     83         Last : in Natural; 
     84         Node : in Tree_Node_Access) 
    6785         return Boolean; 
    6886 
    …… 
    8098        (This      : in Tree_Node_Access; 
    8199         Node      : in Tree_Node_Access; 
     100         Spec_Unit : in Compilation_Unit) 
     101         return Tree_Node_Access; 
     102 
     103      function Add_Child_Body 
     104        (This      : in Tree_Node_Access; 
     105         Node      : in Tree_Node_Access; 
    82106         Spec_Unit : in Compilation_Unit; 
    83          Body_Unit : in Compilation_Unit) 
     107         Body_Unit : in Compilation_Unit; 
     108         Skip_Spec : in Boolean := False) 
    84109         return Tree_Node_Access; 
    85110 
    …… 
    89114         To_Node : in Tree_Node_Access); 
    90115 
     116      procedure Glue_Nodes_Checked 
     117        (This    : in Tree_Node_Access; 
     118         Node    : in Tree_Node_Access; 
     119         To_Node : in Tree_Node_Access); 
     120 
    91121      procedure Clear 
    92122        (This : in out Tree_Node); 
    …… 
    100130 
    101131      procedure Check 
    102         (This  : in Tree_Node_Access; 
    103          Order : in Orders); 
     132        (This        : in Tree_Node_Access; 
     133         Order       : in Orders; 
     134         The_Context : in Asis.Context); 
    104135 
    105136      function Generate_Relationship 
    …… 
    110141         return Relationship; 
    111142 
     143      function Is_Skip_Spec 
     144        (This : in Tree_Node_Access) 
     145         return Boolean; 
     146 
     147      procedure Skip_Spec 
     148        (This  : in Tree_Node_Access; 
     149         Value : in Boolean); 
     150 
     151      function Nexts 
     152        (This : in Tree_Node_Access) 
     153         return Tree_Node_Array_Access; 
     154 
     155      function Spec 
     156        (This : in Tree_Node_Access) 
     157         return Compilation_Unit; 
     158 
    112159      Use_Error : exception; 
    113160 
    114161   private 
    115  
    116       type Tree_Node_Array is array (Positive range <>) of Tree_Node_Access; 
    117       type Tree_Node_Array_Access is access all Tree_Node_Array; 
    118162 
    119163      type Unit_Node is record 
    …… 
    130174 
    131175         --  ссылка Ма преЎыЎущОй елеЌеМт 
    132          Prev : Tree_Node_Access := null; 
     176         Prev  : Tree_Node_Access := null; 
     177         Prevs : Tree_Node_Array_Access := null; 
    133178 
    134179         --  ЌПЎуль_кПЌпОляцОО 
    135180         Unit      : Compilation_Unit := Nil_Compilation_Unit; 
    136181         Unit_Body : Compilation_Unit := Nil_Compilation_Unit; 
     182         Skip_Spec : Boolean := False; 
    137183 
    138184         Added      : Boolean := False; 
    …… 
    178224        (This : in out Tree_Node); 
    179225 
    180       function Set_Inconsistent 
    181         (This  : in Tree_Node_Access; 
    182          List  : in Compilation_Unit_List_Access; 
    183          Order : in Orders) 
    184          return Compilation_Unit_List_Access; 
    185  
    186226      procedure Deallocate is 
    187227        new Ada.Unchecked_Deallocation 
    …… 
    194234         Node : in Tree_Node_Access) 
    195235         return Tree_Node_Array_Access; 
     236 
     237      procedure Remove 
     238        (List : in out Tree_Node_Array_Access; 
     239         Node : in     Tree_Node_Access); 
    196240 
    197241      function Add_Node_Ordered 
    …… 
    241285      The_Context : in Asis.Context) 
    242286      return Utils.Tree_Node_Access; 
     287 
     288   function Get_Dependents 
     289     (List        : in Asis.Compilation_Unit_List; 
     290      The_Context : in Asis.Context) 
     291      return Utils.Tree_Node_Access; 
     292 
     293   function Get_Compilation_Unit 
     294     (Target : in Asis.Element) 
     295      return Asis.Compilation_Unit; 
     296 
     297   function Have_With 
     298     (Library : in Compilation_Unit; 
     299      Unit    : in Compilation_Unit) 
     300      return Boolean; 
    243301 
    244302   ------------------------- 
    …… 
    272330      Current_Unit_Kind : Asis.Unit_Kinds; 
    273331 
     332      procedure Check_Compilation_Unit 
     333         (Unit    : in Compilation_Unit; 
     334          Message : in Wide_String); 
     335 
     336      procedure Normalize 
     337         (List   : in     Asis.Compilation_Unit_List; 
     338          Result : in     Utils.Compilation_Unit_List_Access; 
     339          Last   :    out ASIS_Integer); 
     340 
     341      procedure Clear; 
     342 
    274343      -- Check_Compilation_Unit -- 
    275344      procedure Check_Compilation_Unit 
    …… 
    287356            Asis.Implementation.Set_Status 
    288357              (Data_Error, "Semantic_Dependence_Order " 
    289                & Message & " invalid"); 
     358               & Message & " invalid " & Unit_Full_Name (Unit)); 
    290359 
    291360            raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; 
    …… 
    297366            Asis.Implementation.Set_Status 
    298367              (Data_Error, "Semantic_Dependence_Order " 
    299                & Message & " invalid context"); 
     368               & Message & " invalid context " & Unit_Full_Name (Unit)); 
    300369 
    301370            raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; 
    …… 
    339408      Tree : Utils.Tree_Node_Access := null; 
    340409 
    341       procedure Clear is 
    342       begin 
     410      procedure Clear is begin 
    343411         Deallocate (Tree); 
    344412         Utils.Deallocate (Normalized_Compilation_Units); 
    …… 
    367435      --  Dependent_Units are ignored unless the Relation 
    368436      --  is Descendants or Dependents 
    369       if Relation = Descendants 
    370          or else Relation = Dependents 
     437      if (Relation = Descendants or else Relation = Dependents) 
     438         and then Dependent_Units /= Nil_Compilation_Unit_List 
    371439      then 
    372440         for Index in Dependent_Units'Range loop 
    …… 
    390458               The_Context); 
    391459 
    392             Utils.Check (Tree, Utils.Ascending); 
     460            Utils.Check (Tree, Utils.Ascending, The_Context); 
    393461            declare 
    394462               Relation : Relationship := Utils.Generate_Relationship 
    …… 
    401469         when Descendants => 
    402470            Tree := Get_Descendants 
    403               (Normalized_Compilation_Units (1 .. Compilation_Units_Last), The_Context); 
    404  
    405             Utils.Check (Tree, Utils.Ascending); 
     471              (Normalized_Compilation_Units 
     472                 (1 .. Compilation_Units_Last), The_Context); 
     473 
     474            Utils.Check (Tree, Utils.Ascending, The_Context); 
    406475            declare 
    407476               Relation : Relationship := Utils.Generate_Relationship 
    408                   (Tree, Normalized_Dependent_Units, Dependent_Units_Last, Utils.Descending); 
     477                 (Tree, Normalized_Dependent_Units, 
     478                  Dependent_Units_Last, Utils.Descending); 
    409479            begin 
    410480               Clear; 
    …… 
    417487               The_Context); 
    418488 
    419             Asis.Implementation.Set_Status 
    420               (Not_Implemented_Error, 
    421                "Semantic_Dependence_Order not implemented"); 
    422  
    423             raise Asis.Exceptions.ASIS_Failed; 
     489            Utils.Check (Tree, Utils.Descending, The_Context); 
     490 
     491            declare 
     492               Relation : Relationship := Utils.Generate_Relationship 
     493                 (Tree, null, 0, Utils.Descending); 
     494            begin 
     495               Clear; 
     496               return Relation; 
     497            end; 
    424498 
    425499         when Dependents => 
    426             Asis.Implementation.Set_Status 
    427               (Not_Implemented_Error, 
    428                "Semantic_Dependence_Order not implemented"); 
    429  
    430             raise Asis.Exceptions.ASIS_Failed; 
     500            Tree := Get_Dependents 
     501              (Normalized_Compilation_Units (1 .. Compilation_Units_Last), 
     502               The_Context); 
     503 
     504            Utils.Check (Tree, Utils.Ascending, The_Context); 
     505 
     506            declare 
     507               Relation : Relationship := Utils.Generate_Relationship 
     508                 (Tree, Normalized_Dependent_Units, 
     509                  Dependent_Units_Last, Utils.Descending); 
     510            begin 
     511               Clear; 
     512               return Relation; 
     513            end; 
    431514 
    432515         when Family => 
     516            Clear; 
     517 
    433518            Asis.Implementation.Set_Status 
    434519              (Not_Implemented_Error, 
    …… 
    437522 
    438523         when Needed_Units => 
     524            Clear; 
     525 
    439526            Asis.Implementation.Set_Status 
    440527              (Not_Implemented_Error, 
    …… 
    442529            raise Asis.Exceptions.ASIS_Failed; 
    443530      end case; 
    444  
    445       Clear; 
    446       return Nil_Relationship; 
    447531 
    448532   exception 
    …… 
    470554      Node     : Tree_Node_Access := null; 
    471555 
     556      function Append_Node 
     557        (Unit : in Compilation_Unit) 
     558         return Boolean; 
     559 
     560      procedure Retrive_Declarations; 
     561 
    472562      -- Append_Node -- 
    473563      function Append_Node 
    …… 
    492582 
    493583      -- Retrive_Declarations -- 
    494       procedure Retrive_Declarations is 
    495       begin 
    496          while Unit_Kind (Unit) in A_Procedure .. A_Generic_Package_Renaming loop 
     584      procedure Retrive_Declarations is begin 
     585         while Unit_Kind (Unit) in 
     586           A_Procedure .. A_Generic_Package_Renaming 
     587         loop 
    497588            if Append_Node (Unit) then 
    498589               return; 
    …… 
    515606         end if; 
    516607      end Retrive_Declarations; 
    517  
    518       --  Retrive_Subunit  -- 
    519 --      procedure Retrive_Subunit is 
    520 --      begin 
    521 --         if Append_Node (Unit) then 
    522 --            return; 
    523 --         end if; 
    524  
    525 --         loop 
    526 --            Unit := Corresponding_Subunit_Parent_Body (Unit); 
    527  
    528 --            if Append_Node (Unit) then 
    529 --               return; 
    530 --            end if; 
    531  
    532 --            exit when Unit_Kind (Unit) not in A_Subunit; 
    533 --         end loop; 
    534  
    535 --         if Unit_Kind (Unit) /= A_Nonexistent_Body then 
    536 --            Unit := Corresponding_Parent_Declaration (Unit, The_Context); 
    537 --            Retrive_Declarations; 
    538 --         else 
    539             --  add Standart as root 
    540 --            if Append_Node 
    541 --              (Library_Unit_Declaration ("Standard", The_Context)) 
    542 --            then 
    543 --               return; 
    544 --            end if; 
    545 --         end if; 
    546 --      end Retrive_Subunit; 
    547608 
    548609   begin 
    …… 
    552613              (Asis.Errors.Internal_Error, 
    553614               "Bug (or inapropriate use) detected in " 
    554                 & "Asis.Compilation_Units.Relations.Semantic_Dependence_Order(Ancestors)"); 
     615               & "Asis.Compilation_Units.Relations.Semantic_Dependence_Order" 
     616               & " (Ancestors)"); 
    555617 
    556618            raise Asis.Exceptions.ASIS_Failed; 
    557619         end if; 
    558620 
    559          Tmp_Tree := new Tree_Node; 
    560  
    561          Unit  := List (Index); 
    562          Kinds := Unit_Kind (Unit); 
    563  
    564          if Kinds in A_Subunit then 
    565 --            Retrive_Subunit; 
    566             null; 
    567  
    568          elsif Kinds in A_Library_Unit_Body then 
    569             Unit := Corresponding_Parent_Declaration (Unit, The_Context); 
    570             Retrive_Declarations; 
    571  
    572          else 
    573             Retrive_Declarations; 
    574          end if; 
    575  
    576          if Result = null then 
    577             Result   := Tmp_Tree; 
    578             Tmp_Tree := null; 
     621         Unit := List (Index); 
     622 
     623         if Result = null 
     624           or else Find (Result.all, Unit) = null 
     625         then 
     626            Kinds := Unit_Kind (Unit); 
     627 
     628            if Kinds in A_Subunit then 
     629               Asis.Implementation.Set_Status 
     630                 (Data_Error, "Subunit not valid for Ancestors request " 
     631                  & Unit_Full_Name (Unit)); 
     632 
     633               raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; 
     634 
     635            elsif Kinds in A_Library_Unit_Body then 
     636               Tmp_Tree := new Tree_Node; 
     637               Unit := Corresponding_Parent_Declaration (Unit, The_Context); 
     638               Retrive_Declarations; 
     639            else 
     640               Tmp_Tree := new Tree_Node; 
     641               Retrive_Declarations; 
     642            end if; 
     643 
     644            if Result = null then 
     645               Result   := Tmp_Tree; 
     646               Tmp_Tree := null; 
     647            end if; 
    579648         end if; 
    580649      end loop; 
    …… 
    605674      Kinds       : Unit_Kinds; 
    606675 
     676      procedure Retrive 
     677        (Target : in Compilation_Unit; 
     678         Node   : in Utils.Tree_Node_Access); 
     679 
    607680      -- Retrive -- 
    608681      procedure Retrive 
    …… 
    624697            end if; 
    625698 
     699            Kinds      := Unit_Kind (Unit); 
    626700            Exist_Node := Find (Result.all, Unit); 
    627701 
    628702            if Exist_Node /= null then 
    629703               Glue_Nodes (Result, Node, Exist_Node); 
     704               Second_Unit := Nil_Compilation_Unit; 
     705 
     706               if Kinds in A_Procedure .. A_Generic_Package then 
     707                  Second_Unit := Corresponding_Body (Unit, The_Context); 
     708 
     709               elsif Kinds in A_Library_Unit_Body then 
     710                  Second_Unit := Corresponding_Declaration (Unit, The_Context); 
     711               end if; 
     712 
     713               if not Is_Nil (Second_Unit) 
     714                 and then not Is_Identical (Second_Unit, Unit) 
     715               then 
     716                  Remove_From_List (Children_List, Index + 1, Second_Unit); 
     717               end if; 
     718 
    630719               return False; 
    631720            end if; 
    632  
    633             Kinds := Unit_Kind (Unit); 
    634721 
    635722            if Kinds in 
    636723              A_Procedure_Instance .. A_Generic_Package_Renaming 
    637724            then 
    638                Exist_Node := Add_Child (Result, Node, Unit, null); 
     725               Exist_Node := Add_Child (Result, Node, Unit); 
    639726 
    640727            elsif Kinds in A_Procedure .. A_Generic_Package then 
    641728               Second_Unit := Corresponding_Body (Unit, The_Context); 
    642729 
    643                if not Is_Identical (Second_Unit, Nil_Compilation_Unit) 
     730               if not Is_Nil (Second_Unit) 
     731                 and then not Is_Identical (Second_Unit, Unit) then 
     732                  Exist_Node := Add_Child_Body 
     733                    (Result, Node, Unit, Second_Unit); 
     734 
     735                  Remove_From_List (Children_List, Index + 1, Second_Unit); 
     736               else 
     737                  Exist_Node := Add_Child (Result, Node, Unit); 
     738               end if; 
     739 
     740            elsif Kinds in A_Library_Unit_Body then 
     741               Second_Unit := Corresponding_Declaration (Unit, The_Context); 
     742 
     743               if not Is_Nil (Second_Unit) 
    644744                  and then not Is_Identical (Second_Unit, Unit) 
    645745               then 
    646                   Exist_Node := Add_Child (Result, Node, Unit, Second_Unit); 
    647                   Remove_From_List (Children_List, Index + 1, Second_Unit); 
    648                else 
    649                   Exist_Node := Add_Child (Result, Node, Unit, null); 
    650                end if; 
    651  
    652             elsif Kinds in A_Library_Unit_Body then 
    653                Second_Unit := Corresponding_Declaration (Unit, The_Context); 
    654  
    655                if not Is_Identical (Second_Unit, Nil_Compilation_Unit) 
    656                   and then not Is_Identical (Second_Unit, Unit) 
    657                then 
    658                   Exist_Node := Add_Child (Result, Node, Second_Unit, Unit); 
     746                  Exist_Node := Add_Child_Body 
     747                    (Result, Node, Second_Unit, Unit); 
     748 
    659749                  Remove_From_List (Children_List, Index + 1, Second_Unit); 
    660750                  Unit := Second_Unit; 
    661751               else 
    662                   Exist_Node := Add_Child (Result, Node, Unit, null); 
     752                  Exist_Node := Add_Child (Result, Node, Unit); 
    663753               end if; 
    664754 
    665755            else 
    666                Exist_Node := Add_Child (Result, Node, Unit, null); 
     756               Exist_Node := Add_Child (Result, Node, Unit); 
    667757            end if; 
    668758 
    …… 
    674764            Unit := Children_List (Index); 
    675765 
    676             if Process (Index) then 
    677                Kinds := Unit_Kind (Unit); 
    678  
    679                if Kinds = A_Package 
    680                   or else Kinds = A_Generic_Package 
    681                   or else Kinds = A_Package_Instance 
    682                then 
    683                   Retrive (Unit, Exist_Node); 
     766            if not Is_Nil (Unit) then 
     767               if Process (Index) then 
     768                  Kinds := Unit_Kind (Unit); 
     769 
     770                  if Kinds = A_Package 
     771                    or else Kinds = A_Generic_Package 
     772                    or else Kinds = A_Package_Instance 
     773                  then 
     774                     Retrive (Unit, Exist_Node); 
     775                  end if; 
    684776               end if; 
    685777            end if; 
    …… 
    688780 
    689781      Declarations_List : 
    690          Utils.Compilation_Unit_List_Access := null; 
     782        Utils.Compilation_Unit_List_Access := null; 
     783 
    691784      Declarations_Last : ASIS_Integer := 0; 
    692785 
    …… 
    701794         if Kinds not in A_Subunit then 
    702795            if Kinds in A_Library_Unit_Body then 
    703                --  get declaration 
     796               --  get declaration (spec+body) 
    704797               Unit  := Corresponding_Declaration (Unit); 
    705798               Kinds := Unit_Kind (Unit); 
    …… 
    726819            Second_Unit := Corresponding_Body (Unit, The_Context); 
    727820 
    728             if not Is_Identical (Second_Unit, Nil_Compilation_Unit) 
    729                and then not Is_Identical (Second_Unit, Unit) 
    730             then 
    731                Retrive (Unit, Add_Child (Result, null, Unit, Second_Unit)); 
     821            if not Is_Identical (Second_Unit, Unit) then 
     822               Retrive 
     823                 (Unit, Add_Child_Body (Result, null, Unit, Second_Unit)); 
    732824            else 
    733                Retrive (Unit, Add_Child (Result, null, Unit, null)); 
     825               Retrive (Unit, Add_Child (Result, null, Unit)); 
    734826            end if; 
    735827         end if; 
    …… 
    757849      use Utils; 
    758850 
    759 --      Unit  : Compilation_Unit; 
    760 --      Kinds : Unit_Kinds; 
     851      Unit  : Compilation_Unit; 
     852      Kinds : Unit_Kinds; 
    761853 
    762854      Result : Tree_Node_Access := new Tree_Node; 
    763 --      Node   : Tree_Node_Access := null; 
     855      Node   : Tree_Node_Access := null; 
     856 
     857      Std : Compilation_Unit := Library_Unit_Declaration ("Standard", The_Context); 
     858 
     859      procedure Append_Standart 
     860        (Node : in Tree_Node_Access); 
     861 
     862      procedure Retrive 
     863        (Unit       : in Compilation_Unit; 
     864         Node       : in Tree_Node_Access; 
     865         First_Node : in Boolean := False); 
     866 
     867      procedure Retrive_Declarations 
     868        (Unit       : in Compilation_Unit; 
     869         Node       : in Tree_Node_Access; 
     870         First_Node : in Boolean); 
     871 
     872      procedure Retrive_Body 
     873        (Unit       : in Compilation_Unit; 
     874         Node       : in Tree_Node_Access; 
     875         First_Node : in Boolean); 
     876 
     877      procedure Retrive_Subunit 
     878        (Unit : in Compilation_Unit; 
     879         Node : in Tree_Node_Access); 
     880 
     881      procedure Retrive_With_Clause 
     882        (Unit : in Compilation_Unit; 
     883         Node : in Tree_Node_Access); 
     884 
     885      procedure Check_10_1_1_26c_26b 
     886        (Unit : in Compilation_Unit; 
     887         Node : in Tree_Node_Access); 
    764888 
    765889      -- Append_Standart -- 
    766 --      procedure Append_Standart 
    767 --        (Node : in Tree_Node_Access) 
    768 --      is 
    769 --         Std : Compilation_Unit := Library_Unit_Declaration 
    770 --           ("Standard", The_Context); 
    771  
    772 --         Exist_Node : Tree_Node_Access; 
    773 --      begin 
    774 --         Exist_Node := Find (Result.all, Std); 
    775  
    776 --         if Exist_Node = null then 
    777 --            Exist_Node := Add_Child (Result, Node, Unit); 
    778 --         else 
    779 --            if Node /= null then 
    780 --               Glue_Nodes (Result, Node, Exist_Node); 
    781 --            end if; 
    782 --         end if; 
    783 --      end Append_Standart; 
    784  
    785       -- Reorder -- 
    786 --      procedure Reorder 
    787 --        (Unit : in Compilation_Unit; 
    788 --         Node : in Tree_Node_Access) 
    789 --      is 
    790 --      begin 
    791 --         Kinds := Unit_Kind (Unit); 
    792  
    793 --         if Is_Nill (Unit) 
    794 --           or else Kinds in A_Nonexistent_Declaration .. An_Unknown_Unit 
    795 --         then 
    796 --            Append_Standart (Node); 
    797  
    798 --         elsif Kinds in A_Subunit then 
    799 --            Retrive_Subunit (Unit, Node); 
    800  
    801 --         elsif Kinds = A_Package_Body then 
    802 --            Retrive_Body (Unit, Node); 
    803  
    804 --         elsif Kinds in A_Subprogram_Body then 
    805 --            Retrive_Subprogram_Body (Get_Package_Body (Unit), Node); 
    806  
    807 --         else 
    808 --            Retrive_Declarations (Unit, Node); 
    809 --         end if; 
    810 --      end Reorder; 
     890      procedure Append_Standart 
     891        (Node : in Tree_Node_Access) 
     892      is 
     893         Exist_Node : Tree_Node_Access; 
     894      begin 
     895         Exist_Node := Find (Result.all, Std); 
     896 
     897         if Exist_Node = null then 
     898            Exist_Node := Add_Child (Result, Node, Std); 
     899         else 
     900            if Node /= null then 
     901               Glue_Nodes_Checked (Result, Node, Exist_Node); 
     902            end if; 
     903         end if; 
     904      end Append_Standart; 
     905 
     906      -- Retrive -- 
     907      procedure Retrive 
     908        (Unit       : in Compilation_Unit; 
     909         Node       : in Tree_Node_Access; 
     910         First_Node : in Boolean := False) 
     911      is 
     912      begin 
     913         if Is_Nil (Unit) then 
     914            return; 
     915         end if; 
     916 
     917         Kinds := Unit_Kind (Unit); 
     918 
     919         if Kinds in A_Nonexistent_Declaration .. An_Unknown_Unit then 
     920            Append_Standart (Node); 
     921 
     922         elsif Kinds in A_Subunit then 
     923            Retrive_Subunit (Unit, Node); 
     924 
     925         elsif Kinds in A_Procedure_Body .. A_Package_Body then 
     926            Retrive_Body (Unit, Node, First_Node); 
     927 
     928         else 
     929            Retrive_Declarations (Unit, Node, First_Node); 
     930         end if; 
     931      end Retrive; 
     932 
     933      -- Retrive_Declarations -- 
     934      procedure Retrive_Declarations 
     935        (Unit       : in Compilation_Unit; 
     936         Node       : in Tree_Node_Access; 
     937         First_Node : in Boolean) 
     938      is 
     939         Parent     : Compilation_Unit; 
     940         vNode      : Tree_Node_Access := Node; 
     941         Exist_Node : Tree_Node_Access; 
     942      begin 
     943         if not First_Node then 
     944            Exist_Node := Find (Result.all, Unit); 
     945 
     946            if Exist_Node = null then 
     947               vNode := Add_Child (Result, vNode, Unit); 
     948 
     949               if Is_Identical (Unit, Std) then 
     950                  return; 
     951               end if; 
     952 
     953               Check_10_1_1_26c_26b (Unit, vNode); 
     954               Retrive_With_Clause (Unit, vNode); 
     955            else 
     956               if vNode /= null then 
     957                  Glue_Nodes_Checked (Result, vNode, Exist_Node); 
     958                  return; 
     959               end if; 
     960            end if; 
     961         else 
     962            if Is_Identical (Unit, Std) then 
     963               return; 
     964            end if; 
     965 
     966            Check_10_1_1_26c_26b (Unit, vNode); 
     967            Retrive_With_Clause (Unit, vNode); 
     968         end if; 
     969 
     970         Parent := Corresponding_Parent_Declaration (Unit, The_Context); 
     971 
     972         while Unit_Kind (Parent) in 
     973           A_Procedure .. A_Generic_Package_Renaming 
     974         loop 
     975            Exist_Node := Find (Result.all, Parent); 
     976 
     977            if Exist_Node = null then 
     978               vNode := Add_Child (Result, vNode, Parent); 
     979               Check_10_1_1_26c_26b (Parent, vNode); 
     980               Retrive_With_Clause (Parent, vNode); 
     981            else 
     982               if vNode /= null then 
     983                  Glue_Nodes_Checked (Result, vNode, Exist_Node); 
     984                  return; 
     985               end if; 
     986            end if; 
     987 
     988            Parent := Corresponding_Parent_Declaration (Parent, The_Context); 
     989         end loop; 
     990 
     991         Retrive (Parent, vNode); 
     992      end Retrive_Declarations; 
     993 
     994      -- Retrive_Body -- 
     995      procedure Retrive_Body 
     996        (Unit       : in Compilation_Unit; 
     997         Node       : in Tree_Node_Access; 
     998         First_Node : in Boolean) 
     999      is 
     1000         Exist_Node : Tree_Node_Access := Node; 
     1001      begin 
     1002         if not First_Node then 
     1003            Exist_Node := Find (Result.all, Unit); 
     1004 
     1005            if Exist_Node = null then 
     1006               Exist_Node := Add_Child (Result, Node, Unit); 
     1007               Check_10_1_1_26c_26b (Unit, Exist_Node); 
     1008               Retrive_With_Clause (Unit, Exist_Node); 
     1009            else 
     1010               if Node /= null then 
     1011                  Glue_Nodes_Checked (Result, Node, Exist_Node); 
     1012                  return; 
     1013               end if; 
     1014            end if; 
     1015         else 
     1016            Check_10_1_1_26c_26b (Unit, Node); 
     1017            Retrive_With_Clause (Unit, Node); 
     1018         end if; 
     1019 
     1020         Retrive 
     1021           (Corresponding_Parent_Declaration (Unit, The_Context), 
     1022            Exist_Node); 
     1023      end Retrive_Body; 
    8111024 
    8121025      --  Retrive_Subunit  -- 
    813 --      procedure Retrive_Subunit 
    814 --        (Unit : in Compilation_Unit; 
    815 --         Node : in Tree_Node_Access) 
    816 --      is 
    817 --         Parent     : Compilation_Unit; 
    818 --         Exist_Node : Tree_Node_Access := Node; 
    819 --      begin 
    820 --         Parent := Corresponding_Subunit_Parent_Body (Unit); 
    821  
    822 --         while Unit_Kind (Parent) in A_Subunit loop 
    823 --            Exist_Node := Find (Result.all, Parent); 
    824  
    825 --            if Exist_Node = null then 
    826 --               Exist_Node := Add_Child (Result, Node, Unit); 
    827 --            else 
    828 --               if Node /= null then 
    829 --                  Glue_Nodes (Result, Node, Exist_Node); 
    830 --                  return; 
    831 --               end if; 
    832 --            end if; 
    833  
    834 --            Parent := Corresponding_Subunit_Parent_Body (Unit); 
    835 --         end loop; 
    836  
    837 --         Reorder (Parent, Exist_Node); 
    838 --      end Retrive_Subunit; 
     1026      procedure Retrive_Subunit 
     1027        (Unit : in Compilation_Unit; 
     1028         Node : in Tree_Node_Access) 
     1029      is 
     1030         Parent     : Compilation_Unit; 
     1031         vNode      : Tree_Node_Access := Node; 
     1032         Exist_Node : Tree_Node_Access; 
     1033      begin 
     1034         Check_10_1_1_26c_26b (Unit, null); 
     1035         Retrive_With_Clause (Unit, null); 
     1036         Parent := Corresponding_Subunit_Parent_Body (Unit); 
     1037 
     1038         while Unit_Kind (Parent) in A_Subunit loop 
     1039            Exist_Node := Find (Result.all, Parent); 
     1040 
     1041            if Exist_Node = null then 
     1042               vNode := Add_Child (Result, vNode, Parent); 
     1043               Check_10_1_1_26c_26b (Parent, vNode); 
     1044               Retrive_With_Clause (Parent, vNode); 
     1045            else 
     1046               if vNode /= null then 
     1047                  Glue_Nodes_Checked (Result, vNode, Exist_Node); 
     1048                  return; 
     1049               end if; 
     1050            end if; 
     1051 
     1052            Parent := Corresponding_Subunit_Parent_Body (Parent); 
     1053         end loop; 
     1054 
     1055         Retrive (Parent, vNode); 
     1056      end Retrive_Subunit; 
     1057 
     1058      -- Retrive_With_Clause -- 
     1059      procedure Retrive_With_Clause 
     1060        (Unit : in Compilation_Unit; 
     1061         Node : in Tree_Node_Access) 
     1062      is 
     1063         With_List : constant Asis.Context_Clause_List := 
     1064           Asis.Elements.Context_Clause_Elements (Unit); 
     1065 
     1066         Internal_Unit : Compilation_Unit; 
     1067      begin 
     1068         for Index in With_List'Range loop 
     1069            if Clause_Kind (With_List (Index).all) = A_With_Clause then 
     1070 
     1071               Internal_Unit := Get_Compilation_Unit (With_List (Index)); 
     1072 
     1073               --  Send warning if null !!! 
     1074               if not Is_Nil (Internal_Unit) then 
     1075                  Retrive (Internal_Unit, Node); 
     1076               end if; 
     1077            end if; 
     1078         end loop; 
     1079      end Retrive_With_Clause; 
     1080 
     1081      -- Check_10_1_1_26c_26b -- 
     1082      procedure Check_10_1_1_26c_26b 
     1083        (Unit : in Compilation_Unit; 
     1084         Node : in Tree_Node_Access) 
     1085      is 
     1086         --  10.1.1 (26.c) 
     1087         --  10.1.1 (26.b) 
     1088 
     1089         Except : Compilation_Unit := Library_Unit_Declaration 
     1090            ("Ada.Exceptions", The_Context); 
     1091 
     1092         Sys : Compilation_Unit := Library_Unit_Declaration 
     1093            ("System", The_Context); 
     1094 
     1095         Is_Except : Boolean; 
     1096         Is_Sys    : Boolean; 
     1097 
     1098         type State_Information is record 
     1099            Exceptions : Boolean := False; 
     1100            System     : Boolean := False; 
     1101         end record; 
     1102 
     1103         Control : Traverse_Control := Continue; 
     1104         State   : State_Information; 
     1105 
     1106         procedure Pre_Operation 
     1107           (Element : in     Asis.Element; 
     1108            Control : in out Traverse_Control; 
     1109            State   : in out State_Information) 
     1110         is 
     1111            use Asis.Elements; 
     1112         begin 
     1113            if not Is_Except 
     1114              and then Declaration_Kind (Element) = 
     1115              A_Choice_Parameter_Specification 
     1116            then 
     1117               State.Exceptions := True; 
     1118            end if; 
     1119 
     1120            if not Is_Sys 
     1121              and then Expression_Kind (Element) = An_Attribute_Reference 
     1122              and then Attribute_Kind (Element) = An_Address_Attribute 
     1123            then 
     1124               State.System := True; 
     1125            end if; 
     1126         end Pre_Operation; 
     1127 
     1128         procedure Post_Operation 
     1129           (Element : in     Asis.Element; 
     1130            Control : in out Traverse_Control; 
     1131            State   : in out State_Information) 
     1132         is 
     1133         begin 
     1134            null; 
     1135         end Post_Operation; 
     1136 
     1137         procedure Check_Choice_Iterator is new 
     1138           Asis.Iterator.Traverse_Element 
     1139             (State_Information, Pre_Operation, Post_Operation); 
     1140 
     1141      begin 
     1142         Is_Except := Is_Identical (Unit, Except); 
     1143         Is_Sys    := Is_Identical (Unit, Sys); 
     1144 
     1145         Check_Choice_Iterator 
     1146           (Asis.Elements.Unit_Declaration (Unit), Control, State); 
     1147 
     1148         if State.Exceptions then 
     1149            Retrive (Except, Node); 
     1150         end if; 
     1151 
     1152         if State.System then 
     1153            Retrive (Sys, Node); 
     1154         end if; 
     1155      end Check_10_1_1_26c_26b; 
    8391156 
    8401157   begin 
    841 --      for Index in List'Range loop 
    842 --         Unit := List (Index); 
    843 --         Reorder (List (Index), null); 
    844 --      end loop; 
     1158      for Index in List'Range loop 
     1159         Unit := List (Index); 
     1160 
     1161         if Find (Result.all, Unit) = null then 
     1162            Retrive (Unit, null, True); 
     1163         end if; 
     1164      end loop; 
    8451165 
    8461166      return Result; 
    …… 
    8511171   end Get_Supporters; 
    8521172 
     1173   -------------------- 
     1174   -- Get_Dependents -- 
     1175   -------------------- 
     1176 
     1177   function Get_Dependents 
     1178     (List        : in Asis.Compilation_Unit_List; 
     1179      The_Context : in Asis.Context) 
     1180      return Utils.Tree_Node_Access 
     1181   is 
     1182      use Utils; 
     1183 
     1184      Result : Tree_Node_Access := new Tree_Node; 
     1185 
     1186      Unit, Body_Unit : Compilation_Unit; 
     1187 
     1188      Kinds : Unit_Kinds; 
     1189 
     1190      Except : Compilation_Unit := Library_Unit_Declaration 
     1191         ("Ada.Exceptions", The_Context); 
     1192 
     1193      Sys : Compilation_Unit := Library_Unit_Declaration 
     1194         ("System", The_Context); 
     1195 
     1196      procedure Append_To_Node 
     1197         (Unit  : in     Compilation_Unit; 
     1198          Node  : in     Tree_Node_Access; 
     1199          Glued : in out Tree_Node_Array_Access) 
     1200      is 
     1201         Exist_Node  : Tree_Node_Access := null; 
     1202         Second_Unit : Compilation_Unit; 
     1203      begin 
     1204         Exist_Node := Find (Result.all, Unit); 
     1205         Kinds      := Unit_Kind (Unit); 
     1206 
     1207         if Kinds in A_Procedure .. A_Generic_Package then 
     1208            if Exist_Node /= null then 
     1209               Glue_Nodes_Checked (Result, Node, Exist_Node); 
     1210 
     1211               if not Is_Skip_Spec (Exist_Node) then 
     1212                  Glued := Append (Glued, Exist_Node); 
     1213               else 
     1214                  Skip_Spec (Exist_Node, False); 
     1215               end if; 
     1216            else 
     1217               Second_Unit := Corresponding_Body (Unit, The_Context); 
     1218               Exist_Node  := Add_Child_Body (Result, Node, Unit, Second_Unit); 
     1219            end if; 
     1220 
     1221         elsif Kinds in A_Library_Unit_Body then 
     1222            if Exist_Node /= null then 
     1223               Glue_Nodes_Checked (Result, Node, Exist_Node); 
     1224               Glued := Append (Glued, Exist_Node); 
     1225            else 
     1226               Second_Unit := Corresponding_Declaration (Unit, The_Context); 
     1227 
     1228               if not Is_Nil (Sec