Changeset 2636

Show
Ignore:
Timestamp:
02/26/08 15:42:08 (11 months ago)
Author:
ogorod
Message:

some bugs fixes

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

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

    r2634 r2636  
    104104 
    105105      function Add_Child 
    106         (This      : in Root_Tree_Access; 
    107          Node      : in Tree_Node_Access; 
    108          Spec_Unit : in Compilation_Unit) 
     106        (This : in Root_Tree_Access; 
     107         Node : in Tree_Node_Access; 
     108         Unit : in Compilation_Unit) 
    109109         return Tree_Node_Access; 
    110110 
    …… 
    117117         return Tree_Node_Access; 
    118118 
     119      function Add_Subunit 
     120        (This : in Root_Tree_Access; 
     121         Node : in Tree_Node_Access; 
     122         Unit : in Compilation_Unit) 
     123         return Tree_Node_Access; 
     124 
    119125      procedure Append 
    120126        (This : in Root_Tree_Access; 
    …… 
    221227         Body_Consistent : Boolean := True; 
    222228 
    223          -- завОсОЌПстО тела (with) 
     229         -- завОсОЌПстО тела (with) 
    224230         Body_Dependences : Tree_Node_Array_Access := null; 
    225231 
    …… 
    760766         Unit := List (Index); 
    761767 
    762          if Find (Result, Unit) = null 
    763          then 
     768         if Find (Result, Unit) = null then 
    764769            Kinds := Unit_Kind (Unit); 
    765770 
    …… 
    811816         Node   : in Utils.Tree_Node_Access) 
    812817      is 
     818         function Process 
     819           (Index : in List_Index) 
     820            return Boolean; 
     821 
    813822         Exist_Node : Utils.Tree_Node_Access := null; 
    814823 
    …… 
    818827         -- Process -- 
    819828         function Process 
    820             (Index : in List_Index) 
     829           (Index : in List_Index) 
    821830            return Boolean 
    822831         is 
    …… 
    944953            Second_Unit := Corresponding_Body (Unit, The_Context); 
    945954 
    946             if not Is_Nil (Second_Unit)  
     955            if not Is_Nil (Second_Unit) 
    947956              and then not Is_Identical (Second_Unit, Unit) 
    948957            then 
    …… 
    981990      Node   : Tree_Node_Access := null; 
    982991 
    983       Std : Compilation_Unit := Library_Unit_Declaration ("Standard", The_Context); 
     992      Std : Compilation_Unit := 
     993        Library_Unit_Declaration ("Standard", The_Context); 
    984994 
    985995      procedure Append_Unit 
    …… 
    11901200 
    11911201                        if Node /= null then 
    1192                           Add_Body_Dependents (Result, Exist_Node, Node); 
     1202                          Add_Body_Dependents (Result, Exist_Node, Node); 
    11931203                        end if; 
    11941204 
    …… 
    11961206                     else 
    11971207                        if Node /= null then 
    1198                           Add_Body_Dependents (Result, Exist_Node, Node); 
     1208                          Add_Body_Dependents (Result, Exist_Node, Node); 
    11991209                        end if; 
    12001210                     end if; 
    …… 
    12111221         For_Body : in Boolean := False) 
    12121222      is 
     1223         procedure Retrive_For_Body 
     1224           (Unit : in Compilation_Unit); 
     1225 
    12131226         Except : Compilation_Unit := Library_Unit_Declaration 
    12141227            ("Ada.Exceptions", The_Context); 
    …… 
    12901303   is 
    12911304      use Utils; 
     1305 
     1306      procedure Append_To_Node 
     1307         (Unit  : in     Compilation_Unit; 
     1308          Node  : in     Tree_Node_Access; 
     1309          Glued : in out Tree_Node_Array_Access); 
     1310 
     1311      procedure Post_Operation 
     1312        (Element : in     Asis.Element; 
     1313         Control : in out Traverse_Control; 
     1314         State   : in out Boolean); 
     1315 
     1316      function Have_Except 
     1317        (Unit : in Compilation_Unit) 
     1318        return Boolean; 
     1319 
     1320      function Have_Sys 
     1321        (Unit : in Compilation_Unit) 
     1322        return Boolean; 
     1323 
     1324      procedure Retrive 
     1325        (Unit : in Compilation_Unit; 
     1326         Node : in Tree_Node_Access); 
    12921327 
    12931328      Result : Root_Tree_Access := new Root_Tree; 
    …… 
    13931428        return Boolean 
    13941429      is 
     1430         procedure Pre_Operation 
     1431           (Element : in     Asis.Element; 
     1432            Control : in out Traverse_Control; 
     1433            State   : in out Boolean); 
     1434 
    13951435         Control : Traverse_Control := Continue; 
    13961436         State   : Boolean := False; 
    …… 
    14261466        return Boolean 
    14271467      is 
     1468         procedure Pre_Operation 
     1469           (Element : in     Asis.Element; 
     1470            Control : in out Traverse_Control; 
     1471            State   : in out Boolean); 
     1472 
    14281473         Control : Traverse_Control := Continue; 
    14291474         State   : Boolean := False; 
    …… 
    16451690                       A_Procedure_Body .. A_Package_Body 
    16461691                     then 
    1647                        Get_Subunits (Result, Next_Unit, Next_Node, The_Context); 
     1692                        Get_Subunits 
     1693                          (Result, Next_Unit, Next_Node, The_Context); 
    16481694                     end if; 
    16491695                  end if; 
    …… 
    16801726 
    16811727            elsif Kinds in A_Procedure_Body .. A_Protected_Body_Subunit then 
    1682                Get_Subunits (Result, Unit, Add_Child (Result, null, Unit), The_Context); 
     1728               Get_Subunits 
     1729                 (Result, Unit, Add_Child (Result, null, Unit), The_Context); 
    16831730            end if; 
    16841731         end if; 
    …… 
    17021749   is 
    17031750      use Utils; 
     1751 
     1752      procedure Retrive 
     1753        (Unit : in Compilation_Unit; 
     1754         Node : in Tree_Node_Access); 
    17041755 
    17051756      Result : Root_Tree_Access := new Root_Tree; 
    …… 
    18281879                    A_Procedure_Body .. A_Package_Body 
    18291880                  then 
    1830                     Get_Subunits (Result, Next_Unit, Next_Node, The_Context); 
     1881                     Get_Subunits 
     1882                       (Result, Next_Unit, Next_Node, The_Context); 
    18311883                  end if; 
    18321884               end loop; 
    …… 
    18841936      Kinds : Unit_Kinds; 
    18851937 
    1886       Std : Compilation_Unit := Library_Unit_Declaration ("Standard", The_Context); 
     1938      Std : Compilation_Unit := 
     1939        Library_Unit_Declaration ("Standard", The_Context); 
    18871940 
    18881941      procedure Append_Unit 
    …… 
    19321985         if Exist_Node = null then 
    19331986            if Is_Identical (Unit, Std) then 
    1934                Node := Add_Child (Result, Node, Unit, Nil_Compilation_Unit, True); 
     1987               Node := Add_Child 
     1988                 (Result, Node, Unit, Nil_Compilation_Unit, True); 
     1989 
    19351990               Node := null; 
    19361991            else 
    …… 
    20902145               Exist_Node := Find (Result, Sub_Unit); 
    20912146               if Exist_Node = null then 
    2092                   Exist_Node := Add_Child (Result, Node, Sub_Unit); 
     2147                  Exist_Node := Add_Subunit (Result, Node, Sub_Unit); 
    20932148                  Check_10_1_1_26c_26b (Unit, Exist_Node, True); 
    20942149                  Retrive_With_Clause (Unit, Exist_Node, True); 
    …… 
    20962151                  Retrive_Subunits (Sub_Unit, Exist_Node); 
    20972152               else 
    2098                   Glue_Nodes (Result, Node, Exist_Node); 
     2153                  Glue_Nodes (Result, Exist_Node, Node); 
    20992154               end if; 
    21002155            end if; 
    …… 
    21272182 
    21282183                     if Exist_Node = null then 
    2129                         Body_Unit := Corresponding_Body (Internal_Unit, The_Context); 
     2184                        Body_Unit := Corresponding_Body 
     2185                          (Internal_Unit, The_Context); 
    21302186 
    21312187                        if not Is_Identical (Body_Unit, Internal_Unit) then 
    2132                            Exist_Node := Add_Child (Result, null, Internal_Unit, Body_Unit); 
     2188                           Exist_Node := Add_Child 
     2189                             (Result, null, Internal_Unit, Body_Unit); 
    21332190                        else 
    2134                            Exist_Node := Add_Child (Result, null, Internal_Unit); 
     2191                           Exist_Node := Add_Child 
     2192                             (Result, null, Internal_Unit); 
    21352193                        end if; 
    21362194 
    21372195                        if Node /= null then 
    2138                           Add_Body_Dependents (Result, Exist_Node, Node); 
     2196                          Add_Body_Dependents (Result, Exist_Node, Node); 
    21392197                        end if; 
    21402198 
    …… 
    21422200                     else 
    21432201                        if Node /= null then 
    2144                           Add_Body_Dependents (Result, Exist_Node, Node); 
     2202                          Add_Body_Dependents (Result, Exist_Node, Node); 
    21452203                        end if; 
    21462204                     end if; 
    …… 
    21572215         For_Body : in Boolean := False) 
    21582216      is 
     2217         procedure Retrive_For_Body 
     2218           (Unit : in Compilation_Unit); 
     2219 
    21592220         Except : Compilation_Unit := Library_Unit_Declaration 
    21602221            ("Ada.Exceptions", The_Context); 
    …… 
    22382299 
    22392300   procedure Get_Subunits 
    2240      (Tree        : in Utils.root_Tree_Access; 
     2301     (Tree        : in Utils.Root_Tree_Access; 
    22412302      Unit        : in Compilation_Unit; 
    22422303      Node        : in Utils.Tree_Node_Access; 
    …… 
    22932354 
    22942355         if Assigned (Declaration) then 
    2295             Internal_Unit := Asis.Elements.Enclosing_Compilation_Unit (Declaration); 
     2356            Internal_Unit := 
     2357              Asis.Elements.Enclosing_Compilation_Unit (Declaration); 
    22962358 
    22972359            if Unit_Kind (Internal_Unit) in 
    …… 
    23092371      if Result_List.all'Length > 1 then 
    23102372         Ada.Wide_Text_IO.Put_Line 
    2311             ("[Warning] Founded more then one unit for one with_clause in unit " 
    2312              & Unit_Full_Name (Unit) & " clause number " 
     2373            ("[Warning] Founded more then one unit for one with_clause " 
     2374             & "in unit " & Unit_Full_Name (Unit) & " clause number " 
    23132375             & List_Index'Wide_Image (Number)); 
    23142376      end if; 
    …… 
    23792441      --  10.1.1 (26.b) 
    23802442 
     2443      procedure Pre_Operation 
     2444        (Element : in     Asis.Element; 
     2445         Control : in out Traverse_Control; 
     2446         State   : in out Check_10_1_1_26c_26b_Information); 
     2447 
     2448      procedure Post_Operation 
     2449        (Element : in     Asis.Element; 
     2450         Control : in out Traverse_Control; 
     2451         State   : in out Check_10_1_1_26c_26b_Information); 
     2452 
    23812453      Except : Compilation_Unit := Library_Unit_Declaration 
    23822454         ("Ada.Exceptions", The_Context); 
    …… 
    24792551 
    24802552      function Add_Child 
    2481         (This      : in Root_Tree_Access; 
    2482          Node      : in Tree_Node_Access; 
    2483          Spec_Unit : in Compilation_Unit) 
     2553        (This : in Root_Tree_Access; 
     2554         Node : in Tree_Node_Access; 
     2555         Unit : in Compilation_Unit) 
    24842556         return Tree_Node_Access 
    24852557      is 
    2486          New_Node : Tree_Node_Access := new Tree_Node; 
    2487       begin 
    2488          New_Node.Unit := Spec_Unit; 
    2489  
    2490          if Node = null then 
    2491             This.Next := Add_Node (This.Next, New_Node.Self); 
    2492          else 
    2493             Node.Next      := Add_Node (Node.Next, New_Node.Self); 
    2494             New_Node.Prevs := Add_Node (New_Node.Prevs, Node.Self); 
    2495          end if; 
    2496  
    2497          This.Units := Add_Node_Ordered (This.Units, New_Node.Self); 
    2498          return New_Node; 
     2558         Kinds : Unit_Kinds; 
     2559      begin 
     2560         if Is_Nil (Unit) then 
     2561            return Node; 
     2562         end if; 
     2563 
     2564         declare 
     2565            New_Node : Tree_Node_Access := new Tree_Node; 
     2566         begin 
     2567            Kinds := Unit_Kind (Unit); 
     2568 
     2569            if Kinds in A_Procedure .. A_Generic_Package_Renaming 
     2570              or else Kinds = A_Nonexistent_Declaration 
     2571            then 
     2572               New_Node.Unit := Unit; 
     2573            else 
     2574               New_Node.Unit_Body := Unit; 
     2575            end if; 
     2576 
     2577            if Node = null then 
     2578               This.Next := Add_Node (This.Next, New_Node.Self); 
     2579            else 
     2580               Node.Next      := Add_Node (Node.Next, New_Node.Self); 
     2581               New_Node.Prevs := Add_Node (New_Node.Prevs, Node.Self); 
     2582            end if; 
     2583 
     2584            This.Units := Add_Node_Ordered (This.Units, New_Node.Self); 
     2585            return New_Node; 
     2586         end; 
    24992587      end Add_Child; 
    25002588 
    …… 
    25082596         return Tree_Node_Access 
    25092597      is 
    2510          New_Node : Tree_Node_Access := new Tree_Node; 
    2511       begin 
    2512          New_Node.Unit      := Spec_Unit; 
    2513          New_Node.Unit_Body := Body_Unit; 
    2514          New_Node.Skip_Spec := Skip_Spec; 
    2515  
    2516          if Node = null then 
    2517             This.Next := Add_Node (This.Next, New_Node.Self); 
    2518          else 
    2519             Node.Next      := Add_Node (Node.Next, New_Node.Self); 
    2520             New_Node.Prevs := Add_Node (New_Node.Prevs, Node.Self); 
    2521          end if; 
    2522  
    2523          This.Units := Add_Node_Ordered (This.Units, New_Node.Self); 
    2524          return New_Node; 
     2598         Kinds : Unit_Kinds; 
     2599      begin 
     2600         if Is_Nil (Spec_Unit) 
     2601           and then Is_Nil (Body_Unit) 
     2602         then 
     2603            return Node; 
     2604         end if; 
     2605 
     2606         if not Is_Nil (Spec_Unit) then 
     2607            Kinds := Unit_Kind (Spec_Unit); 
     2608 
     2609            if Kinds not in A_Procedure .. A_Generic_Package_Renaming 
     2610              and then Kinds = A_Nonexistent_Declaration 
     2611            then 
     2612               Asis.Implementation.Set_Status 
     2613                 (Data_Error, "Add_Child - " 
     2614                  & "invalid unit specification " 
     2615                  & Unit_Full_Name (Spec_Unit)); 
     2616 
     2617               raise Asis.Exceptions.ASIS_Failed; 
     2618            end if; 
     2619         end if; 
     2620 
     2621         if not Is_Identical (Spec_Unit, Body_Unit) then 
     2622            if not Is_Nil (Body_Unit) then 
     2623               Kinds := Unit_Kind (Body_Unit); 
     2624 
     2625               if Kinds in A_Procedure .. A_Generic_Package_Renaming 
     2626                 or else Kinds = A_Nonexistent_Declaration 
     2627               then 
     2628                  Asis.Implementation.Set_Status 
     2629                    (Data_Error, "Add_Child - " 
     2630                     & "invalid unit body " & Unit_Full_Name (Body_Unit)); 
     2631 
     2632                  raise Asis.Exceptions.ASIS_Failed; 
     2633               end if; 
     2634            end if; 
     2635         end if; 
     2636 
     2637         declare 
     2638            New_Node : Tree_Node_Access := new Tree_Node; 
     2639         begin 
     2640            New_Node.Unit := Spec_Unit; 
     2641 
     2642            if not Is_Identical (Spec_Unit, Body_Unit) then 
     2643               New_Node.Unit_Body := Body_Unit; 
     2644            end if; 
     2645 
     2646            New_Node.Skip_Spec := Skip_Spec; 
     2647 
     2648            if Node = null then 
     2649               This.Next := Add_Node (This.Next, New_Node.Self); 
     2650            else 
     2651               Node.Next      := Add_Node (Node.Next, New_Node.Self); 
     2652               New_Node.Prevs := Add_Node (New_Node.Prevs, Node.Self); 
     2653            end if; 
     2654 
     2655            This.Units := Add_Node_Ordered (This.Units, New_Node.Self); 
     2656            return New_Node; 
     2657         end; 
    25252658      end Add_Child; 
     2659 
     2660      ----------------- 
     2661      -- Add_Subunit -- 
     2662      ----------------- 
     2663 
     2664      function Add_Subunit 
     2665        (This : in Root_Tree_Access; 
     2666         Node : in Tree_Node_Access; 
     2667         Unit : in Compilation_Unit) 
     2668         return Tree_Node_Access 
     2669      is 
     2670         Kinds : Unit_Kinds; 
     2671      begin 
     2672         if Is_Nil (Unit) then 
     2673            return Node; 
     2674         end if; 
     2675 
     2676         Kinds := Unit_Kind (Unit); 
     2677 
     2678         if Kinds not in 
     2679           A_Procedure_Body_Subunit .. A_Protected_Body_Subunit 
     2680         then 
     2681            Asis.Implementation.Set_Status 
     2682              (Data_Error, "Add_Subunit - " 
     2683               & "invalid subunit " & Unit_Full_Name (Unit)); 
     2684 
     2685            raise Asis.Exceptions.ASIS_Failed; 
     2686         end if; 
     2687 
     2688         declare 
     2689            New_Node : Tree_Node_Access := new Tree_Node; 
     2690         begin 
     2691            New_Node.Unit_Body := Unit; 
     2692 
     2693            if Node = null then 
     2694               This.Next := Add_Node (This.Next, New_Node.Self); 
     2695            else 
     2696               Node.Prevs    := Add_Node (Node.Prevs, New_Node.Self); 
     2697               New_Node.Next := Add_Node (New_Node.Next, Node.Self); 
     2698            end if; 
     2699 
     2700            This.Units := Add_Node_Ordered (This.Units, New_Node.Self); 
     2701            return New_Node; 
     2702         end; 
     2703      end Add_Subunit; 
    25262704 
    25272705      ------------ 
    …… 
    25342712      is 
    25352713      begin 
     2714         if Is_Nil (Unit) then 
     2715            return; 
     2716         end if; 
     2717 
    25362718         if Find (This, Unit) /= null then 
    25372719            Asis.Implementation.Set_Status 
    …… 
    25432725 
    25442726         declare 
     2727            Kinds : Unit_Kinds; 
    25452728            New_Node : Tree_Node_Access := new Tree_Node; 
    25462729         begin 
    2547             New_Node.Unit := Unit; 
     2730            Kinds := Unit_Kind (Unit); 
     2731 
     2732            if Kinds in A_Procedure .. A_Generic_Package_Renaming 
     2733              or else Kinds = A_Nonexistent_Declaration 
     2734            then 
     2735               New_Node.Unit := Unit; 
     2736            else 
     2737               New_Node.Unit_Body := Unit; 
     2738            end if; 
    25482739 
    25492740            if This.Last_Node = null then 
    …… 
    26112802 
    26122803                  Node.Circular := Append (Node.Circular, Node.Unit); 
    2613                   Node.Circular := Append (Node.Circular, Circular (Circular.all'Last)); 
     2804                  Node.Circular := Append 
     2805                    (Node.Circular, Circular (Circular.all'Last)); 
    26142806 
    26152807                  Deallocate (Circular); 
    …… 
    26172809                  --  2 pair (self and parent) 
    26182810                  Node.Circular := Append 
    2619                     (Node.Circular, (Prev_Node.Unit, Node.Unit, Prev_Node.Unit)); 
     2811                    (Node.Circular, 
     2812                     (Prev_Node.Unit, Node.Unit, Prev_Node.Unit)); 
    26202813               end if; 
    26212814 
    …… 
    28093002 
    28103003            if not Is_Nil (Node.Unit) then 
    2811                Kinds        := Unit_Kind (Node.Unit); 
    2812                Parent_Kinds := Unit_Kind (Prev.Unit); 
    2813  
    2814                if Kinds in A_Procedure .. A_Generic_Package_Renaming then 
    2815                   if Parent_Kinds in 
    2816                     A_Procedure .. A_Generic_Package_Renaming 
    2817                   then 
    2818                      Node.Consistent := False; 
    2819                      Result := Append (Result, (Prev.Unit, Node.Unit)); 
    2820                   end if; 
    2821                end if; 
     3004               Node.Consistent := False; 
     3005               Result := Append (Result, (Prev.Unit, Node.Unit)); 
    28223006            end if; 
    28233007 
    …… 
    28453029            (Node : in Tree_Node_Access) 
    28463030         is 
     3031            procedure Check_Body 
     3032               (Target : in Tree_Node_Access); 
     3033 
    28473034            Prev_Unit : Compilation_Unit; 
    28483035 
    …… 
    28553042                  Prev_Unit := Target.Unit_Body; 
    28563043 
    2857                   if not Is_Inconsistent (Prev_Unit) then 
    2858                      Node.Consistent := False; 
     3044                  if not Target.Body_Consistent then 
     3045                     Node.Body_Consistent := False; 
    28593046 
    28603047                     Node.Inconsistent := Append 
    2861                         (Node.Inconsistent, (Prev_Unit, Node.Unit)); 
     3048                        (Node.Inconsistent, (Prev_Unit, Node.Unit_Body)); 
    28623049                  end if; 
    2863  
    2864                elsif not Is_Nil (Target.Unit) then 
    2865                   Prev_Unit := Target.Unit; 
    2866  
    2867                   if Unit_Kind (Prev_Unit) in 
    2868                     A_Procedure_Body .. A_Protected_Body_Subunit 
    2869                   then 
    2870                      if not Is_Inconsistent (Prev_Unit) then 
    2871                         Node.Consistent := False; 
    2872  
    2873                         Node.Inconsistent := Append 
    2874                            (Node.Inconsistent, (Prev_Unit, Node.Unit)); 
    2875                      end if; 
    2876                   end if; 
    28773050               end if; 
    28783051            end Check_Body; 
    2879  
    2880             -- Check_Spec -- 
    2881             procedure Check_Spec 
    2882                (Target : in Tree_Node_Access) 
    2883             is 
    2884             begin 
    2885                if Is_Nil (Target.Unit) then 
    2886                   return; 
    2887                end if; 
    2888  
    2889                Prev_Unit := Target.Unit; 
    2890  
    2891                if Unit_Kind (Prev_Unit) in 
    2892                  A_Procedure .. A_Generic_Package_Renaming 
    2893                then 
    2894                   if not Is_Inconsistent (Prev_Unit) then 
    2895                      Node.Consistent := False; 
    2896  
    2897                      Node.Inconsistent := Append 
    2898                         (Node.Inconsistent, (Prev_Unit, Node.Unit)); 
    2899                   end if; 
    2900                end if; 
    2901             end Check_Spec; 
    29023052 
    29033053         begin 
    …… 
    29363086               end if; 
    29373087 
    2938                return; 
    2939             end if; 
    2940  
    2941             Kinds := Unit_Kind (Node.Unit); 
    2942  
    2943             if Kinds in A_Procedure .. A_Generic_Package_Renaming then 
    2944                   return; 
    2945             end if; 
    2946  
    2947             if not Is_Inconsistent (Node.Unit) then 
    2948                Node.Consistent := False; 
    2949  
    2950                if Is_Source_Changed (Node.Unit) then 
    2951                   Node.Inconsistent := Append 
    2952                     (Node.Inconsistent, 
    2953                       (Nil_Compilation_Unit, Node.Unit)); 
    2954                else 
    2955                   Node.Inconsistent := Append 
    2956                     (Node.Inconsistent, (Node.Unit, Node.Unit)); 
    2957                end if; 
    2958             end if; 
    2959  
    2960             if Kinds in A_Procedure_Body .. A_Package_Body then 
    2961                if Order = Ascending then 
    2962                   if Node.Next /= null then 
    2963                      for Index in Node.Next.all'Range loop 
    2964                         Check_Spec (Node.Next (Index)); 
    2965                      end loop; 
     3088               if Unit_Kind (Node.Unit_Body) in A_Subunit then 
     3089                  if Order = Ascending then 
     3090                     if Node.Next /= null then 
     3091                        Check_Body (Node.Next (Node.Next'First)); 
     3092                     end if; 
     3093                  else 
     3094                     if Node.Prevs /= null then 
     3095                        Check_Body (Node.Prevs (Node.Prevs'First)); 
     3096                     end if; 
    29663097                  end if; 
    2967                else 
    2968                   if Node.Prevs /= null then 
    2969                      for Index in Node.Prevs.all'Range loop 
    2970                         Check_Spec (Node.Prevs (Index)); 
    2971                      end loop; 
    2972                   end if; 
    2973                end if; 
    2974  
    2975             elsif Kinds in A_Subunit then 
    2976                if Order = Ascending then 
    2977                   if Node.Next /= null then 
    2978                      for Index in Node.Next.all'Range loop 
    2979                         Check_Body (Node.Next (Index)); 
    2980                      end loop; 
    2981                   end if; 
    2982                else 
    2983                   if Node.Prevs /= null then 
    2984                      for Index in Node.Prevs.all'Range loop 
    2985                         Check_Body (Node.Prevs (Index)); 
    2986                      end loop; 
    2987                   end if; 
    2988                end if; 
    2989             end if; 
    2990  
    2991             if Node.Body_Dependences /= null then 
    2992                for Index in Node.Body_Dependences.all'Range loop 
    2993                   Prev_Unit := Node.Body_Dependences (Index).Unit; 
    2994  
    2995                   if not Is_Inconsistent (Prev_Unit) then 
    2996                      Node.Consistent := False; 
    2997  
    2998                      Node.Inconsistent := Append 
    2999                        (Node.Inconsistent, (Prev_Unit, Node.Unit)); 
    3000                   end if; 
    3001                end loop; 
     3098               end if; 
     3099            end if; 
     3100 
     3101            if Order = Ascending then 
     3102               if Node.Next /= null then 
     3103                  for Index in Node.Next.all'Range loop 
     3104                     Check_Body_Consistent (Node.Next.all (Index)); 
     3105                  end loop; 
     3106               end if; 
     3107            else 
     3108               if Node.Prevs /= null then 
     3109                  for Index in Node.Prevs.all'Range loop 
     3110                     Check_Body_Consistent (Node.Prevs.all (Index)); 
     3111                  end loop; 
     3112               end if; 
    30023113            end if; 
    30033114         end Check_Body_Consistent; 
    …… 
    30203131               Parent_Kinds := Unit_Kind (Target.Unit); 
    30213132 
    3022                if Parent_Kinds = A_Nonexistent_Declaration 
    3023                  or else Parent_Kinds = A_Nonexistent_Body  then 
     3133               if Parent_Kinds = A_Nonexistent_Declaration then 
    30243134                  Node.Missing := Append 
    30253135                    (Node.Missing, (Node.Unit, Target.Unit)); 
    …… 
    30463156            end if; 
    30473157 
    3048             if not Is_Nil (Node.Unit_Body) then 
    3049                if Kinds = A_Nonexistent_Declaration then 
    3050                   Node.Missing := Append 
    3051                     (Node.Missing, (Node.Unit_Body, Node.Unit)); 
    3052                end if; 
    3053  
    3054                if Node.Body_Dependences /= null then 
    3055                   for Index in Node.Body_Dependences.all'Range loop 
    3056                      Parent_Kinds := Unit_Kind (Node.Body_Dependences (Index).Unit); 
    3057  
    3058                      if Parent_Kinds = A_Nonexistent_Declaration 
    3059                        or else Parent_Kinds = A_Nonexistent_Body  then 
     3158            if Is_Nil (Node.Unit_Body) then 
     3159               return; 
     3160            end if; 
     3161 
     3162            if Unit_Kind (Node.Unit) = A_Nonexistent_Declaration then 
     3163               Node.Missing := Append 
     3164                 (Node.Missing, (Node.Unit_Body, Node.Unit)); 
     3165            end if; 
     3166 
     3167            if Node.Body_Dependences /= null then 
     3168               for Index in Node.Body_Dependences.all'Range loop 
     3169                  Parent_Kinds := 
     3170                    Unit_Kind (Node.Body_Dependences (Index).Unit); 
     3171 
     3172                  if Parent_Kinds = A_Nonexistent_Declaration then 
     3173                     Node.Missing := Append 
     3174                       (Node.Missing, 
     3175                        (Node.Unit_Body, 
     3176                         Node.Body_Dependences (Index).Unit)); 
     3177                  end if; 
     3178               end loop; 
     3179            end if; 
     3180 
     3181            if Unit_Kind (Node.Unit_Body) in A_Subunit then 
     3182               if Order = Ascending then 
     3183                  if Node.Next /= null then 
     3184                     if Unit_Kind 
     3185                       (Node.Next (Node.Next'First).Unit_Body) = 
     3186                       A_Nonexistent_Body 
     3187                     then 
    30603188                        Node.Missing := Append 
    3061                           (Node.Missing, (Node.Unit_Body, Node.Body_Dependences (Index).Unit)); 
     3189                          (Node.Missing, 
     3190                           (Node.Unit_Body, 
     3191                            Node.Next (Node.Next'First).Unit_Body)); 
    30623192                     end if; 
    3063                   end loop; 
     3193                  end if; 
     3194               else 
     3195                  if Node.Prevs /= null then 
     3196                     if Unit_Kind 
     3197                       (Node.Prevs (Node.Prevs'First).Unit_Body) = 
     3198                       A_Nonexistent_Body 
     3199                     then 
     3200                        Node.Missing := Append 
     3201                          (Node.Missing, 
     3202                           (Node.Unit_Body, 
     3203                            Node.Prevs (Node.Prevs'First).Unit_Body)); 
     3204                     end if; 
     3205                  end if; 
    30643206               end if; 
    30653207            end if; 
    …… 
    30813223 
    30823224               Check_Missing (Node); 
    3083                Check_Body_Consistent (Node); 
    30843225            end if; 
    30853226 
    …… 
    31083249 
    31093250               Check_Missing (Node); 
    3110                Check_Body_Consistent (Node); 
    31113251            end if; 
    31123252 
    …… 
    31183258         end Desc; 
    31193259 
     3260         Std_Node : Tree_Node_Access; 
    31203261      begin 
    31213262         Order := This.Order; 
    31223263 
    31233264         if This.Order = Ascending then 
    3124             Asc (Find (This, Library_Unit_Declaration 
    3125                   ("Standard", The_Context))); 
     3265            Std_Node := Find 
     3266              (This, Library_Unit_Declaration ("Standard", The_Context)); 
     3267 
     3268            if Std_Node /= null then 
     3269               if Std_Node.Next /= null then 
     3270                  for Index in Std_Node.Next.all'Range loop 
     3271                     Asc (Std_Node.Next (Index)); 
     3272                  end loop; 
     3273 
     3274                  for Index in Std_Node.Next.all'Range loop 
     3275                     Check_Body_Consistent (Std_Node.Next (Index)); 
     3276                  end loop; 
     3277               end if; 
     3278            end if; 
     3279 
    31263280         else 
    31273281            if This.Next /= null then 
    31283282               for Index in This.Next.all'Range loop 
    31293283                  Desc (This.Next (Index)); 
     3284               end loop; 
     3285 
     3286               for Index in This.Next.all'Range loop 
     3287                  Check_Body_Consistent (This.Next (Index)); 
    31303288               end loop; 
    31313289            end if; 
    …… 
    33483506         return Boolean 
    33493507      is 
     3508         function Process 
     3509           (Node : in Tree_Node_Access) 
     3510            return Boolean; 
     3511 
    33503512         Result : Boolean := False; 
    33513513 
    …… 
    34163578         procedure Elab_Body 
    34173579           (Node      : in Tree_Node_Access; 
    3418             All_Bodys : in Boolean := False); 
     3580            All_Bodys : in Boolean := False; 
     3581            Only_Body : in Boolean := True); 
    34193582 
    34203583         procedure Elab_Subunits 
    3421            (Node : in Tree_Node_Access); 
     3584           (Node      : in Tree_Node_Access; 
     3585            All_Bodys : in Boolean); 
    34223586 
    34233587         procedure Elab_Pragmed_Bodys 
    …… 
    34253589            Unit : in Compilation_Unit); 
    34263590 
     3591         procedure Append_Inconsistent 
     3592           (Node : in Tree_Node_Access); 
     3593 
    34273594         Result : Root_Tree_Access := new Root_Tree; 
    34283595 
    …… 
    34323599            Library_Unit_Declaration ("Standard", The_Context); 
    34333600 
    3434          -- for circular elaboration order 
     3601         -- for circular elaboration order 
    34353602         Elaboration_Line : Compilation_Unit_List_Access := null; 
    34363603 
    …… 
    34423609              and then Node.Consistent 
    34433610              and then not Is_Nil (Node.Unit) 
    3444               and then Unit_Kind (Node.Unit) in 
    3445                 A_Procedure .. A_Generic_Package_Renaming 
    34463611            then 
    34473612               if Elaboration_Line /= null then 
    …… 
    34813646         procedure Elab_Body 
    34823647           (Node      : in Tree_Node_Access; 
    3483             All_Bodys : in Boolean := False) 
     3648            All_Bodys : in Boolean := False; 
     3649            Only_Body : in Boolean := True) 
    34843650         is 
    3485             Unit : Compilation_Unit := Nil_Compilation_Unit; 
     3651            Unit : Compilation_Unit := Node.Unit_Body; 
    34863652         begin 
    3487             if not Node.Body_Elaborated 
     3653            if Node.Body_Elaborated then 
     3654               Elab_Subunits (Node, All_Bodys); 
     3655               return; 
     3656            end if; 
     3657 
     3658            if not Node.Body_Consistent 
     3659              or else Is_Nil (Unit) 
    34883660            then 
    3489                if not Is_Nil (Node.Unit_Body) 
    3490                  and then Node.Body_Consistent 
     3661               return; 
     3662            end if; 
     3663 
     3664            if Only_Body 
     3665              and then Unit_Kind (Unit) not in 
     3666              A_Procedure_Body .. A_Package_Body 
     3667            then 
     3668               return; 
     3669            end if; 
     3670 
     3671            if not Only_Body 
     3672              and then Unit_Kind (Unit) not in A_Subunit 
     3673            then 
     3674               Elab_Subunits (Node, All_Bodys); 
     3675               return; 
     3676            end if; 
     3677 
     3678            if Elaboration_Line /= null then 
     3679               -- test circular -- 
     3680               if In_List 
     3681                 (Elaboration_Line, Elaboration_Line.all'Last, Unit) 
    34913682               then 
    3492                   Unit := Node.Unit_Body; 
    3493  
    3494                elsif not Is_Nil (Node.Unit) 
    3495                  and then Node.Consistent 
    3496                then 
    3497                   Unit := Node.Unit; 
    3498                end if; 
    3499  
    3500                if Unit_Kind (Unit) in 
    3501                  A_Procedure_Body .. A_Protected_Body_Subunit 
    3502                then 
    3503                   if Elaboration_Line /= null then 
    3504                      -- test circular -- 
    3505                      if In_List 
    3506                         (Elaboration_Line, Elaboration_Line.all'Last, Unit) 
    3507                      then 
    3508                         Node.Circular :=  Append 
    3509                            (Node.Circular, Elaboration_Line.all); 
    3510                         return; 
    3511