Changeset 2628

Show
Ignore:
Timestamp:
02/21/08 15:14:22 (11 months ago)
Author:
ogorod
Message:

fully implemented Semantic_Dependence_Order

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

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

    r2626 r2628  
    2727with Asis.Expressions; 
    2828with Asis.Iterator; 
     29with Ada.Wide_Text_IO; 
    2930 
    3031package body Asis.Compilation_Units.Relations is 
    …… 
    6768      type Tree_Node_Access is access all Tree_Node; 
    6869 
     70      --  Tree_Node_Array  -- 
    6971      type Tree_Node_Array is array (Positive range <>) of Tree_Node_Access; 
    7072      type Tree_Node_Array_Access is access all Tree_Node_Array; 
    …… 
    8587         return Boolean; 
    8688 
    87       function Append_Parent 
    88         (This : in Tree_Node_Access; 
    89          Unit : in Compilation_Unit) 
    90          return Tree_Node_Access; 
    91  
    92       procedure Add_Thread 
    93         (This      : in     Tree_Node_Access; 
    94          To_Node   : in     Tree_Node_Access; 
    95          From_Tree : in out Tree_Node_Access); 
     89      --  Tree_Node  -- 
     90 
     91      type Orders is (Ascending, Descending); 
     92 
     93      procedure Dependence_Order 
     94        (This  : in Tree_Node_Access; 
     95         Order : in Orders); 
    9696 
    9797      function Add_Child 
    …… 
    101101         return Tree_Node_Access; 
    102102 
    103       function Add_Child_Body 
     103      function Add_Child 
    104104        (This      : in Tree_Node_Access; 
    105105         Node      : in Tree_Node_Access; 
    …… 
    119119         To_Node : in Tree_Node_Access); 
    120120 
     121      procedure Add_Body_Dependents 
     122        (This    : in Tree_Node_Access; 
     123         To_Node : in Tree_Node_Access); 
     124 
     125      function Is_Child 
     126        (This : in Tree_Node_Access; 
     127         Node : in Tree_Node_Access) 
     128        return Boolean; 
     129 
     130      procedure Set_Parent 
     131        (This   : in Tree_Node_Access; 
     132         Node   : in Tree_Node_Access; 
     133         Parent : in Tree_Node_Access); 
     134 
    121135      procedure Clear 
    122136        (This : in out Tree_Node); 
    …… 
    127141         return Tree_Node_Access; 
    128142 
    129       type Orders is (Ascending, Descending); 
    130  
    131143      procedure Check 
    132144        (This        : in Tree_Node_Access; 
    133          Order       : in Orders; 
    134145         The_Context : in Asis.Context); 
    135146 
    …… 
    137148        (This       : in Tree_Node_Access; 
    138149         Limit_List : in Utils.Compilation_Unit_List_Access; 
    139          List_Last  : in ASIS_Integer; 
    140          Order      : in Orders) 
     150         List_Last  : in ASIS_Integer) 
    141151         return Relationship; 
    142152 
    …… 
    154164 
    155165      function Spec 
     166        (This : in Tree_Node_Access) 
     167         return Compilation_Unit; 
     168 
     169      function Get_Body 
    156170        (This : in Tree_Node_Access) 
    157171         return Compilation_Unit; 
    …… 
    173187         Self : Tree_Node_Access := Tree_Node'Unchecked_Access; 
    174188 
     189         Order : Orders := Descending; 
     190 
    175191         --  ссылка Ма преЎыЎущОй елеЌеМт 
    176192         Prev  : Tree_Node_Access := null; 
    …… 
    183199 
    184200         Added      : Boolean := False; 
    185          Consistent : Boolean := True; 
    186  
    187          --  пПслеЎующОе елеЌеМты 0-Ñ 
    188  
     201 
     202         Consistent      : Boolean := True; 
     203         Body_Consistent : Boolean := True; 
     204 
     205         --  пПслеЎующОе елеЌеМты 
    189206         Next : Tree_Node_Array_Access := null; 
    190207 
    191          --  спОсПк ПкПМчаМОя "ветвей", 
    192          --  Ўля быстрПгП ОзыЌаМОя ПМыѠ
    193  
    194          --  а Ме перебПрПЌ всеѠ
    195  Ð²ÐµÑ‚вей 
    196          --  запПлМяет тПлькП кПрМевПй елеЌеМт 
    197          Last_Nodes : Tree_Node_Array_Access := null; 
     208         -- завОсОЌПстО тела (with) 
     209         Body_Dependences : Tree_Node_Array_Access := null; 
    198210 
    199211         --  сПртОрПваММый спОсПк всеѠ
    …… 
    238250        (List : in out Tree_Node_Array_Access; 
    239251         Node : in     Tree_Node_Access); 
     252 
     253      function Remove 
     254        (List : in Tree_Node_Array_Access; 
     255         Node : in Tree_Node_Access) 
     256         return Tree_Node_Array_Access; 
    240257 
    241258      function Add_Node_Ordered 
    …… 
    291308      return Utils.Tree_Node_Access; 
    292309 
     310   function Get_Family 
     311     (List        : in Asis.Compilation_Unit_List; 
     312      The_Context : in Asis.Context) 
     313      return Utils.Tree_Node_Access; 
     314 
     315   function Get_Needed_Units 
     316     (List        : in Asis.Compilation_Unit_List; 
     317      The_Context : in Asis.Context) 
     318      return Utils.Tree_Node_Access; 
     319 
     320   procedure Get_Subunits 
     321     (Tree        : in Utils.Tree_Node_Access; 
     322      Unit        : in Compilation_Unit; 
     323      Node        : in Utils.Tree_Node_Access; 
     324      The_Context : in Asis.Context); 
     325 
    293326   function Get_Compilation_Unit 
    294      (Target : in Asis.Element) 
     327     (Unit        : in Compilation_Unit; 
     328      Target      : in Asis.Element; 
     329      Number      : in List_Index; 
     330      The_Context : in Asis.Context) 
    295331      return Asis.Compilation_Unit; 
    296332 
    297333   function Have_With 
    298      (Library : in Compilation_Unit; 
    299       Unit    : in Compilation_Unit) 
     334     (Library     : in Compilation_Unit; 
     335      Unit        : in Compilation_Unit; 
     336      The_Context : in Asis.Context) 
    300337      return Boolean; 
     338 
     339   type Check_10_1_1_26c_26b_Information is record 
     340      Exceptions : Boolean := False; 
     341      System     : Boolean := False; 
     342   end record; 
     343 
     344   function Check_10_1_1_26c_26b 
     345     (Unit        : in Compilation_Unit; 
     346      The_Context : in Asis.Context) 
     347      return Check_10_1_1_26c_26b_Information; 
    301348 
    302349   ------------------------- 
    …… 
    318365 
    319366   --------------------------------- 
    320    --  Semantic_Dependence_Order  -- * 
     367   --  Semantic_Dependence_Order  -- 
    321368   --------------------------------- 
    322369 
    …… 
    356403            Asis.Implementation.Set_Status 
    357404              (Data_Error, "Semantic_Dependence_Order " 
    358                & Message & " invalid " & Unit_Full_Name (Unit)); 
     405               & Message & " invalid unit " & Unit_Full_Name (Unit)); 
    359406 
    360407            raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; 
    …… 
    366413            Asis.Implementation.Set_Status 
    367414              (Data_Error, "Semantic_Dependence_Order " 
    368                & Message & " invalid context " & Unit_Full_Name (Unit)); 
     415               & Message & " invalid unit's context " & Unit_Full_Name (Unit)); 
    369416 
    370417            raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; 
    …… 
    458505               The_Context); 
    459506 
    460             Utils.Check (Tree, Utils.Ascending, The_Context); 
    461             declare 
    462                Relation : Relationship := Utils.Generate_Relationship 
    463                   (Tree, null, 0, Utils.Ascending); 
    464             begin 
    465                Clear; 
    466                return Relation; 
    467             end; 
    468  
    469507         when Descendants => 
    470508            Tree := Get_Descendants 
    …… 
    472510                 (1 .. Compilation_Units_Last), The_Context); 
    473511 
    474             Utils.Check (Tree, Utils.Ascending, The_Context); 
    475             declare 
    476                Relation : Relationship := Utils.Generate_Relationship 
    477                  (Tree, Normalized_Dependent_Units, 
    478                   Dependent_Units_Last, Utils.Descending); 
    479             begin 
    480                Clear; 
    481                return Relation; 
    482             end; 
    483  
    484512         when Supporters => 
    485513            Tree := Get_Supporters 
    …… 
    487515               The_Context); 
    488516 
    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; 
    498  
    499517         when Dependents => 
    500518            Tree := Get_Dependents 
    …… 
    502520               The_Context); 
    503521 
    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; 
    514  
    515522         when Family => 
    516             Clear; 
    517  
    518             Asis.Implementation.Set_Status 
    519               (Not_Implemented_Error, 
    520                "Semantic_Dependence_Order not implemented"); 
    521             raise Asis.Exceptions.ASIS_Failed; 
     523            Tree := Get_Family 
     524              (Normalized_Compilation_Units (1 .. Compilation_Units_Last), 
     525               The_Context); 
    522526 
    523527         when Needed_Units => 
    524             Clear; 
    525  
    526             Asis.Implementation.Set_Status 
    527               (Not_Implemented_Error, 
    528                "Semantic_Dependence_Order not implemented"); 
    529             raise Asis.Exceptions.ASIS_Failed; 
     528            Tree := Get_Needed_Units 
     529              (Normalized_Compilation_Units (1 .. Compilation_Units_Last), 
     530               The_Context); 
    530531      end case; 
     532 
     533      Utils.Check (Tree, The_Context); 
     534      declare 
     535         Relation : Relationship := Utils.Generate_Relationship 
     536            (Tree, Normalized_Dependent_Units, Dependent_Units_Last); 
     537      begin 
     538         Clear; 
     539         return Relation; 
     540      end; 
    531541 
    532542   exception 
    …… 
    550560      Kinds : Unit_Kinds; 
    551561 
    552       Result   : Tree_Node_Access := null; 
    553       Tmp_Tree : Tree_Node_Access := null; 
    554       Node     : Tree_Node_Access := null; 
    555  
    556       function Append_Node 
    557         (Unit : in Compilation_Unit) 
    558          return Boolean; 
    559  
    560       procedure Retrive_Declarations; 
     562      Result : Tree_Node_Access := new Tree_Node; 
     563 
     564      procedure Append_Node 
     565        (Unit : in     Compilation_Unit; 
     566         Node : in out Tree_Node_Access); 
     567 
     568      procedure Retrive 
     569        (Unit : in Compilation_Unit; 
     570         Node : in Tree_Node_Access); 
    561571 
    562572      -- Append_Node -- 
    563       function Append_Node 
    564         (Unit : in Compilation_Unit) 
    565          return Boolean 
    566       is 
    567       begin 
    568          if Result /= null then 
    569             Node := Find (Result.all, Unit); 
     573      procedure Append_Node 
     574        (Unit : in     Compilation_Unit; 
     575         Node : in out Tree_Node_Access) 
     576      is 
     577         Exist_Node : Tree_Node_Access; 
     578      begin 
     579         Exist_Node := Find (Result.all, Unit); 
     580 
     581         if Exist_Node /= null then 
     582            Glue_Nodes (Result, Node, Exist_Node); 
     583            Node := null; 
    570584         else 
    571             Node := null; 
    572          end if; 
    573  
    574          if Node /= null then 
    575             Add_Thread (Result, Node, Tmp_Tree); 
    576             return True; 
    577          else 
    578             Tmp_Tree := Append_Parent (Tmp_Tree, Unit); 
    579             return False; 
     585            Node := Add_Child (Result, Node, Unit); 
    580586         end if; 
    581587      end Append_Node; 
    582588 
    583       -- Retrive_Declarations -- 
    584       procedure Retrive_Declarations is begin 
    585          while Unit_Kind (Unit) in 
     589      -- Retrive -- 
     590      procedure Retrive 
     591        (Unit : in Compilation_Unit; 
     592         Node : in Tree_Node_Access) 
     593      is 
     594         Internal_Node : Tree_Node_Access := Node; 
     595         Internal_Unit : Compilation_Unit := Unit; 
     596      begin 
     597         while Unit_Kind (Internal_Unit) in 
    586598           A_Procedure .. A_Generic_Package_Renaming 
    587599         loop 
    588             if Append_Node (Unit) then 
     600            Append_Node (Internal_Unit, Internal_Node); 
     601            if Internal_Node = null then 
    589602               return; 
    590603            end if; 
    591604 
    592             Unit := Corresponding_Parent_Declaration (Unit); 
     605            Internal_Unit := Corresponding_Parent_Declaration (Internal_Unit); 
    593606         end loop; 
    594607 
    595          if not Is_Nil (Unit) then 
    596             if Append_Node (Unit) then 
     608         if not Is_Nil (Internal_Unit) then 
     609            Append_Node (Internal_Unit, Internal_Node); 
     610            if Internal_Node = null then 
    597611               return; 
    598612            end if; 
    599613 
    600614            --  add Standart as root 
    601             if Append_Node 
    602               (Library_Unit_Declaration ("Standard", The_Context)) 
    603             then 
    604                return; 
    605             end if; 
    606          end if; 
    607       end Retrive_Declarations; 
     615            Append_Node 
     616               (Library_Unit_Declaration ("Standard", The_Context), 
     617                Internal_Node); 
     618         end if; 
     619      end Retrive; 
    608620 
    609621   begin 
     622      Dependence_Order (Result, Ascending); 
     623 
    610624      for Index in List'Range loop 
    611          if Tmp_Tree /= null then 
    612             Asis.Implementation.Set_Status 
    613               (Asis.Errors.Internal_Error, 
    614                "Bug (or inapropriate use) detected in " 
    615                & "Asis.Compilation_Units.Relations.Semantic_Dependence_Order" 
    616                & " (Ancestors)"); 
    617  
    618             raise Asis.Exceptions.ASIS_Failed; 
    619          end if; 
    620  
    621625         Unit := List (Index); 
    622626 
    623          if Result = null 
    624            or else Find (Result.all, Unit) = null 
     627         if Find (Result.all, Unit) = null 
    625628         then 
    626629            Kinds := Unit_Kind (Unit); 
    …… 
    634637 
    635638            elsif Kinds in A_Library_Unit_Body then 
    636                Tmp_Tree := new Tree_Node; 
    637639               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; 
     640            end if; 
     641 
     642            Retrive (Unit, null); 
    648643         end if; 
    649644      end loop; 
    650645 
    651       Deallocate (Tmp_Tree); 
    652646      return Result; 
    653647   exception 
    654648      when others => 
    655          Deallocate (Tmp_Tree); 
    656649         Deallocate (Result); 
    657650         raise; 
    …… 
    683676         Node   : in Utils.Tree_Node_Access) 
    684677      is 
     678         Exist_Node : Utils.Tree_Node_Access := null; 
     679 
    685680         Children_List : Asis.Compilation_Unit_List := 
    686            Corresponding_Children (Target, The_Context); 
    687          Exist_Node : Utils.Tree_Node_Access := null; 
     681            Corresponding_Children (Target, The_Context); 
    688682 
    689683         -- Process -- 
    …… 
    693687         is 
    694688         begin 
    695             if Is_Nil (Unit) then 
    696                return False; 
    697             end if; 
    698  
    699             Kinds      := Unit_Kind (Unit); 
    700             Exist_Node := Find (Result.all, Unit); 
     689            Kinds       := Unit_Kind (Unit); 
     690            Exist_Node  := Find (Result.all, Unit); 
     691            Second_Unit := Nil_Compilation_Unit; 
    701692 
    702693            if Exist_Node /= null then 
    703694               Glue_Nodes (Result, Node, Exist_Node); 
    704                Second_Unit := Nil_Compilation_Unit; 
    705695 
    706696               if Kinds in A_Procedure .. A_Generic_Package then 
    …… 
    729719 
    730720               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  
     721                 and then not Is_Identical (Second_Unit, Unit) 
     722               then 
     723                  Exist_Node := Add_Child (Result, Node, Unit, Second_Unit); 
    735724                  Remove_From_List (Children_List, Index + 1, Second_Unit); 
    736725               else 
    …… 
    744733                  and then not Is_Identical (Second_Unit, Unit) 
    745734               then 
    746                   Exist_Node := Add_Child_Body 
    747                     (Result, Node, Second_Unit, Unit); 
     735                  Exist_Node := Add_Child (Result, Node, Second_Unit, Unit); 
    748736 
    749737                  Remove_From_List (Children_List, Index + 1, Second_Unit); 
    …… 
    785773 
    786774   begin 
     775      Dependence_Order (Result, Descending); 
     776 
    787777      Declarations_List := new Asis.Compilation_Unit_List (1 .. List'Length); 
    788778 
    …… 
    791781         Kinds := Unit_Kind (Unit); 
    792782 
    793          --  eliminate A_Subunit 
    794          if Kinds not in A_Subunit then 
    795             if Kinds in A_Library_Unit_Body then 
    796                --  get declaration (spec+body) 
    797                Unit  := Corresponding_Declaration (Unit); 
    798                Kinds := Unit_Kind (Unit); 
    799             end if; 
    800  
    801             if Kinds = A_Package 
    802               or else Kinds = A_Generic_Package 
    803               or else Kinds = A_Package_Instance 
    804             then 
    805                if not In_List 
    806                  (Declarations_List, Declarations_Last, Unit) 
    807                then 
    808                   Declarations_Last := Declarations_Last + 1; 
    809                   Declarations_List (Declarations_Last) := Unit; 
    810                end if; 
     783         if Kinds in A_Subunit then 
     784            Asis.Implementation.Set_Status 
     785              (Data_Error, "Subunit not valid for Descendants request " 
     786               & Unit_Full_Name (Unit)); 
     787         end if; 
     788 
     789         if Kinds in A_Library_Unit_Body then 
     790            Unit  := Corresponding_Declaration (Unit); 
     791            Kinds := Unit_Kind (Unit); 
     792         end if; 
     793 
     794         if Kinds = A_Package 
     795           or else Kinds = A_Generic_Package 
     796           or else Kinds = A_Package_Instance 
     797         then 
     798            if not In_List (Declarations_List, Declarations_Last, Unit) then 
     799               Declarations_Last := Declarations_Last + 1; 
     800               Declarations_List (Declarations_Last) := Unit; 
    811801            end if; 
    812802         end if; 
    …… 
    819809            Second_Unit := Corresponding_Body (Unit, The_Context); 
    820810 
    821             if not Is_Identical (Second_Unit, Unit) then 
    822                Retrive 
    823                  (Unit, Add_Child_Body (Result, null, Unit, Second_Unit)); 
     811            if not Is_Nil (Second_Unit)  
     812              and then not Is_Identical (Second_Unit, Unit) 
     813            then 
     814               Retrive (Unit, Add_Child (Result, null, Unit, Second_Unit)); 
    824815            else 
    825816               Retrive (Unit, Add_Child (Result, null, Unit)); 
    …… 
    857848      Std : Compilation_Unit := Library_Unit_Declaration ("Standard", The_Context); 
    858849 
    859       procedure Append_Standart 
    860         (Node : in Tree_Node_Access); 
     850      procedure Append_Unit 
     851        (Unit : in     Compilation_Unit; 
     852         Node : in out Tree_Node_Access); 
    861853 
    862854      procedure Retrive 
    …… 
    880872 
    881873      procedure Retrive_With_Clause 
    882         (Unit : in Compilation_Unit; 
    883          Node : in Tree_Node_Access); 
     874        (Unit     : in Compilation_Unit; 
     875         Node     : in Tree_Node_Access; 
     876         For_Body : in Boolean := False); 
    884877 
    885878      procedure Check_10_1_1_26c_26b 
    886         (Unit : in Compilation_Unit; 
    887          Node : in Tree_Node_Access); 
    888  
    889       -- Append_Standart -- 
    890       procedure Append_Standart 
    891         (Node : in Tree_Node_Access) 
     879        (Unit     : in Compilation_Unit; 
     880         Node     : in Tree_Node_Access; 
     881         For_Body : in Boolean := False); 
     882 
     883      -- Append_Unit -- 
     884      procedure Append_Unit 
     885        (Unit : in     Compilation_Unit; 
     886         Node : in out Tree_Node_Access) 
    892887      is 
    893888         Exist_Node : Tree_Node_Access; 
    894889      begin 
    895          Exist_Node := Find (Result.all, Std); 
     890         Exist_Node := Find (Result.all, Unit); 
    896891 
    897892         if Exist_Node = null then 
    898             Exist_Node := Add_Child (Result, Node, Std); 
     893            Node := Add_Child (Result, Node, Unit); 
    899894         else 
    900895            if Node /= null then 
    901896               Glue_Nodes_Checked (Result, Node, Exist_Node); 
    902             end if; 
    903          end if; 
    904       end Append_Standart; 
     897               Node := null; 
     898            end if; 
     899         end if; 
     900      end Append_Unit; 
    905901 
    906902      -- Retrive -- 
    …… 
    910906         First_Node : in Boolean := False) 
    911907      is 
     908         Internal_Node : Tree_Node_Access := Node; 
    912909      begin 
    913910         if Is_Nil (Unit) then 
    …… 
    918915 
    919916         if Kinds in A_Nonexistent_Declaration .. An_Unknown_Unit then 
    920             Append_Standart (Node); 
     917            Append_Unit (Std, Internal_Node); 
    921918 
    922919         elsif Kinds in A_Subunit then 
    …… 
    937934         First_Node : in Boolean) 
    938935      is 
    939          Parent     : Compilation_Unit; 
    940          vNode      : Tree_Node_Access := Node; 
    941          Exist_Node : Tree_Node_Access; 
     936         Parent         : Compilation_Unit; 
     937         Internal_Node  : Tree_Node_Access := Node; 
    942938      begin 
    943939         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 
     940            Append_Unit (Unit, Internal_Node); 
     941 
     942            if Internal_Node = null then 
    963943               return; 
    964944            end if; 
    965  
    966             Check_10_1_1_26c_26b (Unit, vNode); 
    967             Retrive_With_Clause (Unit, vNode); 
    968          end if; 
     945         end if; 
     946 
     947         if Is_Identical (Unit, Std) then 
     948            return; 
     949         end if; 
     950 
     951         Check_10_1_1_26c_26b (Unit, Internal_Node); 
     952         Retrive_With_Clause (Unit, Internal_Node); 
    969953 
    970954         Parent := Corresponding_Parent_Declaration (Unit, The_Context); 
    …… 
    973957           A_Procedure .. A_Generic_Package_Renaming 
    974958         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; 
     959            Append_Unit (Parent, Internal_Node); 
     960 
     961            if Internal_Node = null 
     962               or else Is_Identical (Unit, Std) 
     963            then 
     964               return; 
     965            end if; 
     966 
     967            Check_10_1_1_26c_26b (Parent, Internal_Node); 
     968            Retrive_With_Clause (Parent, Internal_Node); 
    987969 
    988970            Parent := Corresponding_Parent_Declaration (Parent, The_Context); 
    989971         end loop; 
    990972 
    991          Retrive (Parent, vNode); 
     973         Retrive (Parent, Internal_Node); 
    992974      end Retrive_Declarations; 
    993975 
    …… 
    998980         First_Node : in Boolean) 
    999981      is 
    1000          Exist_Node : Tree_Node_Access := Node; 
     982         Internal_Node : Tree_Node_Access := Node; 
    1001983      begin 
    1002984         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; 
     985            Append_Unit (Unit, Internal_Node); 
     986 
     987            if Internal_Node = null then 
     988               return; 
     989            end if; 
     990         end if; 
     991 
     992         Check_10_1_1_26c_26b (Unit, Internal_Node, True); 
     993         Retrive_With_Clause (Unit, Internal_Node, True); 
    1019994 
    1020995         Retrive 
    1021996           (Corresponding_Parent_Declaration (Unit, The_Context), 
    1022             Exist_Node); 
     997            Internal_Node); 
    1023998      end Retrive_Body; 
    1024999 
    …… 
    10281003         Node : in Tree_Node_Access) 
    10291004      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); 
     1005         Parent : Compilation_Unit; 
     1006         vNode  : Tree_Node_Access := Node; 
     1007      begin 
     1008         Check_10_1_1_26c_26b (Unit, null, True); 
     1009         Retrive_With_Clause (Unit, null, True); 
     1010 
    10361011         Parent := Corresponding_Subunit_Parent_Body (Unit); 
    10371012 
    10381013         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; 
     1014            Append_Unit (Unit, vNode); 
     1015 
     1016            if vNode = null then 
     1017               return; 
     1018            end if; 
     1019 
     1020            Check_10_1_1_26c_26b (Parent, vNode, True); 
     1021            Retrive_With_Clause (Parent, vNode, True); 
    10511022 
    10521023            Parent := Corresponding_Subunit_Parent_Body (Parent); 
    …… 
    10581029      -- Retrive_With_Clause -- 
    10591030      procedure Retrive_With_Clause 
    1060         (Unit : in Compilation_Unit; 
    1061          Node : in Tree_Node_Access) 
     1031        (Unit     : in Compilation_Unit; 
     1032         Node     : in Tree_Node_Access; 
     1033         For_Body : in Boolean := False) 
    10621034      is 
    10631035         With_List : constant Asis.Context_Clause_List := 
    …… 
    10651037 
    10661038         Internal_Unit : Compilation_Unit; 
     1039         Exist_Node    : Tree_Node_Access; 
    10671040      begin 
    10681041         for Index in With_List'Range loop 
    10691042            if Clause_Kind (With_List (Index).all) = A_With_Clause then 
    10701043 
    1071                Internal_Unit := Get_Compilation_Unit (With_List (Index)); 
    1072  
    1073                --  Send warning if null !!! 
     1044               Internal_Unit := Get_Compilation_Unit 
     1045                  (Unit, With_List (Index), Index, The_Context); 
     1046 
    10741047               if not Is_Nil (Internal_Unit) then 
    1075                   Retrive (Internal_Unit, Node); 
     1048                  if not For_Body then 
     1049                     Retrive (Internal_Unit, Node); 
     1050                  else 
     1051                     Exist_Node := Find (Result.all, Internal_Unit); 
     1052 
     1053                     if Exist_Node = null then 
     1054                        Exist_Node := Add_Child (Result, null, Internal_Unit); 
     1055 
     1056                        if Node /= null then 
     1057                          Add_Body_Dependents (Exist_Node, Node); 
     1058                        end if; 
     1059 
     1060                        Retrive (Internal_Unit, Exist_Node, True); 
     1061                     else 
     1062                        if Node /= null then 
     1063                          Add_Body_Dependents (Exist_Node, Node); 
     1064                        end if; 
     1065                     end if; 
     1066                  end if; 
    10761067               end if; 
    10771068            end if; 
    …… 
    10811072      -- Check_10_1_1_26c_26b -- 
    10821073      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  
     1074        (Unit     : in Compilation_Unit; 
     1075         Node     : in Tree_Node_Access; 
     1076         For_Body : in Boolean := False) 
     1077      is 
    10891078         Except : Compilation_Unit := Library_Unit_Declaration 
    10901079            ("Ada.Exceptions", The_Context); 
    …… 
    10931082            ("System", The_Context); 
    10941083 
    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) 
     1084         State : Check_10_1_1_26c_26b_Information; 
     1085 
     1086         --  Retrive_For_Body  -- 
     1087         procedure Retrive_For_Body 
     1088           (Unit : in Compilation_Unit) 
    11101089         is 
    1111             use Asis.Elements; 
     1090            Exist_Node : Tree_Node_Access; 
    11121091         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); 
     1092            Exist_Node := Find (Result.all, Unit); 
     1093 
     1094            if Exist_Node = null then 
     1095               Exist_Node := Add_Child (Result, null, Unit); 
     1096 
     1097               if Node /= null then 
     1098                  Add_Body_Dependents (Exist_Node, Node); 
     1099               end if; 
     1100 
     1101               Retrive (Unit, Exist_Node, True); 
     1102            else 
     1103               if Node /= null then 
     1104                  Add_Body_Dependents (Exist_Node, Node); 
     1105               end if; 
     1106            end if; 
     1107         end Retrive_For_Body; 
     1108 
     1109      begin 
     1110         State := Check_10_1_1_26c_26b (Unit, The_Context); 
    11471111 
    11481112         if State.Exceptions then 
    1149             Retrive (Except, Node); 
     1113            if not For_Body then 
     1114               Retrive (Except, Node); 
     1115            else 
     1116               Retrive_For_Body (Except); 
     1117            end if; 
    11501118         end if; 
    11511119 
    11521120         if State.System then 
    1153             Retrive (Sys, Node); 
     1121            if not For_Body then 
     1122               Retrive (Sys, Node); 
     1123            else 
     1124               Retrive_For_Body (Sys); 
     1125            end if; 
    11541126         end if; 
    11551127      end Check_10_1_1_26c_26b; 
    11561128 
    11571129   begin 
     1130      Dependence_Order (Result, Ascending); 
     1131 
    11581132      for Index in List'Range loop 
    11591133         Unit := List (Index); 
    …… 
    12071181         if Kinds in A_Procedure .. A_Generic_Package then 
    12081182            if Exist_Node /= null then 
    1209                Glue_Nodes_Checked (Result, Node, Exist_Node); 
     1183               if Is_Child (Result, Exist_Node) then 
     1184                  Set_Parent (Result, Exist_Node, Node); 
     1185               else 
     1186                  Glue_Nodes_Checked (Result, Node, Exist_Node); 
     1187               end if; 
    12101188 
    12111189               if not Is_Skip_Spec (Exist_Node) then 
    …… 
    12161194            else 
    12171195               Second_Unit := Corresponding_Body (Unit, The_Context); 
    1218                Exist_Node  := Add_Child_Body (Result, Node, Unit, Second_Unit); 
     1196               Exist_Node  := Add_Child (Result, Node, Unit, Second_Unit); 
    12191197            end if; 
    12201198 
    12211199         elsif Kinds in A_Library_Unit_Body then 
    12221200            if Exist_Node /= null then 
    1223                Glue_Nodes_Checked (Result, Node, Exist_Node); 
    1224