OSDN Git Service

2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 23 Jan 2012 09:39:27 +0000 (09:39 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 23 Jan 2012 09:39:27 +0000 (09:39 +0000)
* sem_ch12.adb (Analyze_Associations): Alphabetize local variables and
constants. Rename Actual_Types to Actuals_To_Freeze. Rename Next_Formal
to Saved_Formal.
Freeze all eligible subprograms which appear as actuals in
the instantiation.
(Has_Fully_Defined_Profile): New routine.
(Renames_Standard_Subprogram): New routine.
(Earlier): Add local variable N. Comment update. Do not use source
locations when trying to determine whether one node precedes another.

2012-01-23  Gary Dismukes  <dismukes@adacore.com>

* exp_ch4.adb (Expand_Concatenate): In the case
where the result of a concatentation can be null, set the to
result have both the low and high bounds of the right operand (not
just the high bound, as was the case prior to this fix). Also,
fix the saved high bound setting (Last_Opnd_High_Bound) in the
empty string literal case (should have been low bound minus one,
rather than plus one).

2012-01-23  Thomas Quinot  <quinot@adacore.com>

* scos.ads, put_scos.adb, get_scos.adb (Get_SCOs, Put_SCOs): Do not
omit statement SCOs for disabled pragmas.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183419 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/get_scos.adb
gcc/ada/put_scos.adb
gcc/ada/scos.ads
gcc/ada/sem_ch12.adb

index b1ef51c..79c5b98 100644 (file)
@@ -1,3 +1,30 @@
+2012-01-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch12.adb (Analyze_Associations): Alphabetize local variables and
+       constants. Rename Actual_Types to Actuals_To_Freeze. Rename Next_Formal
+       to Saved_Formal.
+       Freeze all eligible subprograms which appear as actuals in
+       the instantiation.
+       (Has_Fully_Defined_Profile): New routine.
+       (Renames_Standard_Subprogram): New routine.
+       (Earlier): Add local variable N. Comment update. Do not use source
+       locations when trying to determine whether one node precedes another.
+
+2012-01-23  Gary Dismukes  <dismukes@adacore.com>
+
+       * exp_ch4.adb (Expand_Concatenate): In the case
+       where the result of a concatentation can be null, set the to
+       result have both the low and high bounds of the right operand (not
+       just the high bound, as was the case prior to this fix). Also,
+       fix the saved high bound setting (Last_Opnd_High_Bound) in the
+       empty string literal case (should have been low bound minus one,
+       rather than plus one).
+
+2012-01-23  Thomas Quinot  <quinot@adacore.com>
+
+       * scos.ads, put_scos.adb, get_scos.adb (Get_SCOs, Put_SCOs): Do not
+       omit statement SCOs for disabled pragmas.
+
 2012-01-23  Matthew Heaney  <heaney@adacore.com>
 
        * a-cohase.ads, a-cihase.ads, a-cbhase.ads, a-coorse.ads,
index 8082cb0..b0a65cf 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2601,6 +2601,12 @@ package body Exp_Ch4 is
       --  This is either an integer literal node, or an identifier reference to
       --  a constant entity initialized to the appropriate value.
 
+      Last_Opnd_Low_Bound : Node_Id;
+      --  A tree node representing the low bound of the last operand. This
+      --  need only be set if the result could be null. It is used for the
+      --  special case of setting the right low bound for a null result.
+      --  This is of type Ityp.
+
       Last_Opnd_High_Bound : Node_Id;
       --  A tree node representing the high bound of the last operand. This
       --  need only be set if the result could be null. It is used for the
@@ -2811,11 +2817,14 @@ package body Exp_Ch4 is
                Result_May_Be_Null := False;
             end if;
 
-            --  Capture last operand high bound if result could be null
+            --  Capture last operand low and high bound if result could be null
 
             if J = N and then Result_May_Be_Null then
+               Last_Opnd_Low_Bound :=
+                 New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ));
+
                Last_Opnd_High_Bound :=
-                 Make_Op_Add (Loc,
+                 Make_Op_Subtract (Loc,
                    Left_Opnd  =>
                      New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
                    Right_Opnd => Make_Integer_Literal (Loc, 1));
@@ -2871,9 +2880,13 @@ package body Exp_Ch4 is
                            Result_May_Be_Null := False;
                         end if;
 
-                        --  Capture last operand bound if result could be null
+                        --  Capture last operand bounds if result could be null
 
                         if J = N and then Result_May_Be_Null then
+                           Last_Opnd_Low_Bound :=
+                             Convert_To (Ityp,
+                               Make_Integer_Literal (Loc, Expr_Value (Lo)));
+
                            Last_Opnd_High_Bound :=
                              Convert_To (Ityp,
                                Make_Integer_Literal (Loc, Expr_Value (Hi)));
@@ -2914,7 +2927,16 @@ package body Exp_Ch4 is
                      Duplicate_Subexpr (Opnd, Name_Req => True),
                    Attribute_Name => Name_First);
 
+               --  Capture last operand bounds if result could be null
+
                if J = N and Result_May_Be_Null then
+                  Last_Opnd_Low_Bound :=
+                    Convert_To (Ityp,
+                      Make_Attribute_Reference (Loc,
+                        Prefix         =>
+                          Duplicate_Subexpr (Opnd, Name_Req => True),
+                        Attribute_Name => Name_First));
+
                   Last_Opnd_High_Bound :=
                     Convert_To (Ityp,
                       Make_Attribute_Reference (Loc,
@@ -3124,6 +3146,15 @@ package body Exp_Ch4 is
       --  bounds if the last operand is super-flat).
 
       if Result_May_Be_Null then
+         Low_Bound :=
+           Make_Conditional_Expression (Loc,
+             Expressions => New_List (
+               Make_Op_Eq (Loc,
+                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
+                 Right_Opnd => Make_Artyp_Literal (0)),
+               Last_Opnd_Low_Bound,
+               Low_Bound));
+
          High_Bound :=
            Make_Conditional_Expression (Loc,
              Expressions => New_List (
index e096c23..ce662ce 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -301,7 +301,7 @@ begin
 
                      when others =>
                         Skipc;
-                        if Typ = 'P' then
+                        if Typ = 'P' or else Typ = 'p' then
                            if Nextc not in '1' .. '9' then
                               N := 1;
                               loop
index 84d4ef6..39fd04f 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -139,12 +139,6 @@ begin
                      Ctr := 0;
                      Continuation := False;
                      loop
-                        if SCO_Pragma_Disabled
-                             (SCO_Table.Table (Start).Pragma_Sloc)
-                        then
-                           goto Next_Statement;
-                        end if;
-
                         if Ctr = 0 then
                            Write_SCO_Initiate (U);
                            if not Continuation then
@@ -169,7 +163,7 @@ begin
                               Write_Info_Char (Sent.C2);
 
                               if Sent.C1 = 'S'
-                                and then Sent.C2 = 'P'
+                                and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
                                 and then Sent.Pragma_Name /= Unknown_Pragma
                               then
                                  --  Strip leading "PRAGMA_"
@@ -205,7 +199,6 @@ begin
                            Ctr := 0;
                         end if;
 
-                     <<Next_Statement>>
                         exit when SCO_Table.Table (Start).Last;
                         Start := Start + 1;
                      end loop;
index af4ebca..e0e31b6 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2009-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -157,6 +157,7 @@ package SCOs is
    --      F        FOR loop (from FOR through end of iteration scheme)
    --      I        IF statement (from IF through end of condition)
    --      P[name:] PRAGMA with the indicated name
+   --      p[name:] disabled PRAGMA with the indicated name
    --      R        extended RETURN statement
    --      W        WHILE loop statement (from WHILE through end of condition)
 
index 31c9293..3624385 100644 (file)
@@ -917,20 +917,20 @@ package body Sem_Ch12 is
       Formals : List_Id;
       F_Copy  : List_Id) return List_Id
    is
-      Actual_Types    : constant Elist_Id  := New_Elmt_List;
-      Assoc           : constant List_Id   := New_List;
-      Default_Actuals : constant Elist_Id  := New_Elmt_List;
-      Gen_Unit        : constant Entity_Id :=
-                          Defining_Entity (Parent (F_Copy));
+      Actuals_To_Freeze : constant Elist_Id  := New_Elmt_List;
+      Assoc             : constant List_Id   := New_List;
+      Default_Actuals   : constant Elist_Id  := New_Elmt_List;
+      Gen_Unit          : constant Entity_Id :=
+                            Defining_Entity (Parent (F_Copy));
 
       Actuals         : List_Id;
       Actual          : Node_Id;
-      Formal          : Node_Id;
-      Next_Formal     : Node_Id;
       Analyzed_Formal : Node_Id;
+      First_Named     : Node_Id := Empty;
+      Formal          : Node_Id;
       Match           : Node_Id;
       Named           : Node_Id;
-      First_Named     : Node_Id := Empty;
+      Saved_Formal    : Node_Id;
 
       Default_Formals : constant List_Id := New_List;
       --  If an Others_Choice is present, some of the formals may be defaulted.
@@ -958,6 +958,10 @@ package body Sem_Ch12 is
       --  to formals of formal packages by AI05-0025, and it also applies to
       --  box-initialized formals.
 
+      function Has_Fully_Defined_Profile (Subp : Entity_Id) return Boolean;
+      --  Determine whether the parameter types and the return type of Subp
+      --  are fully defined at the point of instantiation.
+
       function Matching_Actual
         (F   : Entity_Id;
          A_F : Entity_Id) return Node_Id;
@@ -966,7 +970,7 @@ package body Sem_Ch12 is
       --  are named, scan the parameter associations to find the right one.
       --  A_F is the corresponding entity in the analyzed generic,which is
       --  placed on the selector name for ASIS use.
-
+      --
       --  In Ada 2005, a named association may be given with a box, in which
       --  case Matching_Actual sets Found_Assoc to the generic association,
       --  but return Empty for the actual itself. In this case the code below
@@ -982,6 +986,10 @@ package body Sem_Ch12 is
       --  associations, and add an explicit box association for F  if there
       --  is none yet, and the default comes from an Others_Choice.
 
+      function Renames_Standard_Subprogram (Subp : Entity_Id) return Boolean;
+      --  Determine whether Subp renames one of the subprograms defined in the
+      --  generated package Standard.
+
       procedure Set_Analyzed_Formal;
       --  Find the node in the generic copy that corresponds to a given formal.
       --  The semantic information on this node is used to perform legality
@@ -1025,6 +1033,62 @@ package body Sem_Ch12 is
          end loop;
       end Check_Overloaded_Formal_Subprogram;
 
+      -------------------------------
+      -- Has_Fully_Defined_Profile --
+      -------------------------------
+
+      function Has_Fully_Defined_Profile (Subp : Entity_Id) return Boolean is
+         function Is_Fully_Defined_Type (Typ : Entity_Id) return Boolean;
+         --  Determine whethet type Typ is fully defined
+
+         ---------------------------
+         -- Is_Fully_Defined_Type --
+         ---------------------------
+
+         function Is_Fully_Defined_Type (Typ : Entity_Id) return Boolean is
+         begin
+            --  A private type without a full view is not fully defined
+
+            if Is_Private_Type (Typ)
+              and then No (Full_View (Typ))
+            then
+               return False;
+
+            --  An incomplete type is never fully defined
+
+            elsif Is_Incomplete_Type (Typ) then
+               return False;
+
+            --  All other types are fully defined
+
+            else
+               return True;
+            end if;
+         end Is_Fully_Defined_Type;
+
+         --  Local declarations
+
+         Param : Entity_Id;
+
+      --  Start of processing for Has_Fully_Defined_Profile
+
+      begin
+         --  Check the parameters
+
+         Param := First_Formal (Subp);
+         while Present (Param) loop
+            if not Is_Fully_Defined_Type (Etype (Param)) then
+               return False;
+            end if;
+
+            Next_Formal (Param);
+         end loop;
+
+         --  Check the return type
+
+         return Is_Fully_Defined_Type (Etype (Subp));
+      end Has_Fully_Defined_Profile;
+
       ---------------------
       -- Matching_Actual --
       ---------------------
@@ -1149,6 +1213,26 @@ package body Sem_Ch12 is
          end if;
       end Process_Default;
 
+      ---------------------------------
+      -- Renames_Standard_Subprogram --
+      ---------------------------------
+
+      function Renames_Standard_Subprogram (Subp : Entity_Id) return Boolean is
+         Id : Entity_Id;
+
+      begin
+         Id := Alias (Subp);
+         while Present (Id) loop
+            if Scope (Id) = Standard_Standard then
+               return True;
+            end if;
+
+            Id := Alias (Id);
+         end loop;
+
+         return False;
+      end Renames_Standard_Subprogram;
+
       -------------------------
       -- Set_Analyzed_Formal --
       -------------------------
@@ -1259,7 +1343,7 @@ package body Sem_Ch12 is
       Named := First_Named;
       while Present (Named) loop
          if Nkind (Named) /= N_Others_Choice
-           and then  No (Selector_Name (Named))
+           and then No (Selector_Name (Named))
          then
             Error_Msg_N ("invalid positional actual after named one", Named);
             Abandon_Instantiation (Named);
@@ -1293,7 +1377,7 @@ package body Sem_Ch12 is
 
          while Present (Formal) loop
             Set_Analyzed_Formal;
-            Next_Formal := Next_Non_Pragma (Formal);
+            Saved_Formal := Next_Non_Pragma (Formal);
 
             case Nkind (Formal) is
                when N_Formal_Object_Declaration =>
@@ -1335,19 +1419,24 @@ package body Sem_Ch12 is
                      Analyze (Match);
                      Append_List
                        (Instantiate_Type
-                         (Formal, Match, Analyzed_Formal, Assoc),
-                       Assoc);
+                          (Formal, Match, Analyzed_Formal, Assoc),
+                        Assoc);
 
                      --  An instantiation is a freeze point for the actuals,
                      --  unless this is a rewritten formal package, or the
                      --  formal is an Ada 2012 formal incomplete type.
 
-                     if Nkind (I_Node) /= N_Formal_Package_Declaration
-                       and then
-                         Ekind (Defining_Identifier (Analyzed_Formal)) /=
-                           E_Incomplete_Type
+                     if Nkind (I_Node) = N_Formal_Package_Declaration
+                       or else
+                         (Ada_Version >= Ada_2012
+                           and then
+                             Ekind (Defining_Identifier (Analyzed_Formal)) =
+                                                            E_Incomplete_Type)
                      then
-                        Append_Elmt (Entity (Match), Actual_Types);
+                        null;
+
+                     else
+                        Append_Elmt (Entity (Match), Actuals_To_Freeze);
                      end if;
                   end if;
 
@@ -1364,9 +1453,9 @@ package body Sem_Ch12 is
 
                when N_Formal_Subprogram_Declaration =>
                   Match :=
-                    Matching_Actual (
-                      Defining_Unit_Name (Specification (Formal)),
-                      Defining_Unit_Name (Specification (Analyzed_Formal)));
+                    Matching_Actual
+                      (Defining_Unit_Name (Specification (Formal)),
+                       Defining_Unit_Name (Specification (Analyzed_Formal)));
 
                   --  If the formal subprogram has the same name as another
                   --  formal subprogram of the generic, then a named
@@ -1384,10 +1473,9 @@ package body Sem_Ch12 is
                   --  partial parametrization, or else the formal has a default
                   --  or a box.
 
-                  if No (Match)
-                    and then  Partial_Parametrization
-                  then
+                  if No (Match) and then Partial_Parametrization then
                      Process_Default (Formal);
+
                      if Nkind (I_Node) = N_Formal_Package_Declaration then
                         Check_Overloaded_Formal_Subprogram (Formal);
                      end if;
@@ -1396,6 +1484,37 @@ package body Sem_Ch12 is
                      Append_To (Assoc,
                        Instantiate_Formal_Subprogram
                          (Formal, Match, Analyzed_Formal));
+
+                     --  An instantiation is a freeze point for the actuals,
+                     --  unless this is a rewritten formal package.
+
+                     if Nkind (I_Node) /= N_Formal_Package_Declaration
+                       and then Nkind (Match) = N_Identifier
+                       and then Is_Subprogram (Entity (Match))
+
+                       --  The actual subprogram may rename a routine defined
+                       --  in Standard. Avoid freezing such renamings because
+                       --  subprograms coming from Standard cannot be frozen.
+
+                       and then
+                         not Renames_Standard_Subprogram (Entity (Match))
+
+                       --  If the actual subprogram comes from a different
+                       --  unit, it is already frozen, either by a body in
+                       --  that unit or by the end of the declarative part
+                       --  of the unit. This check avoids the freezing of
+                       --  subprograms defined in Standard which are used
+                       --  as generic actuals.
+
+                       and then In_Same_Code_Unit (Entity (Match), I_Node)
+                       and then Has_Fully_Defined_Profile (Entity (Match))
+                     then
+                        --  Mark the subprogram as having a delayed freeze
+                        --  since this may be an out-of-order action.
+
+                        Set_Has_Delayed_Freeze (Entity (Match));
+                        Append_Elmt (Entity (Match), Actuals_To_Freeze);
+                     end if;
                   end if;
 
                   --  If this is a nested generic, preserve default for later
@@ -1459,7 +1578,7 @@ package body Sem_Ch12 is
 
             end case;
 
-            Formal := Next_Formal;
+            Formal := Saved_Formal;
             Next_Non_Pragma (Analyzed_Formal);
          end loop;
 
@@ -1484,8 +1603,12 @@ package body Sem_Ch12 is
            ("too many actuals in generic instantiation", Instantiation_Node);
       end if;
 
+      --  An instantiation freezes all generic actuals. The only exceptions
+      --  to this are incomplete types and subprograms which are not fully
+      --  defined at the point of instantiation.
+
       declare
-         Elmt : Elmt_Id := First_Elmt (Actual_Types);
+         Elmt : Elmt_Id := First_Elmt (Actuals_To_Freeze);
       begin
          while Present (Elmt) loop
             Freeze_Before (I_Node, Node (Elmt));
@@ -6818,11 +6941,6 @@ package body Sem_Ch12 is
    -------------
 
    function Earlier (N1, N2 : Node_Id) return Boolean is
-      D1 : Integer := 0;
-      D2 : Integer := 0;
-      P1 : Node_Id := N1;
-      P2 : Node_Id := N2;
-
       procedure Find_Depth (P : in out Node_Id; D : in out Integer);
       --  Find distance from given node to enclosing compilation unit
 
@@ -6840,6 +6958,13 @@ package body Sem_Ch12 is
          end loop;
       end Find_Depth;
 
+      --  Local declarations
+
+      D1 : Integer := 0;
+      D2 : Integer := 0;
+      P1 : Node_Id := N1;
+      P2 : Node_Id := N2;
+
    --  Start of processing for Earlier
 
    begin
@@ -6864,12 +6989,11 @@ package body Sem_Ch12 is
       end loop;
 
       --  At this point P1 and P2 are at the same distance from the root.
-      --  We examine their parents until we find a common declarative list,
-      --  at which point we can establish their relative placement by
-      --  comparing their ultimate slocs. If we reach the root, N1 and N2
-      --  do not descend from the same declarative list (e.g. one is nested
-      --  in the declarative part and the other is in a block in the
-      --  statement part) and the earlier one is already frozen.
+      --  We examine their parents until we find a common declarative list.
+      --  If we reach the root, N1 and N2 do not descend from the same
+      --  declarative list (e.g. one is nested in the declarative part and
+      --  the other is in a block in the statement part) and the earlier
+      --  one is already frozen.
 
       while not Is_List_Member (P1)
         or else not Is_List_Member (P2)
@@ -6891,22 +7015,99 @@ package body Sem_Ch12 is
          end if;
       end loop;
 
-      --  If the sloc positions are different the result is unambiguous. If
-      --  the slocs are identical, one of them must not come from source, which
-      --  is the case for freeze nodes, whose sloc is unrelated to the point
-      --  point at which they are inserted in the tree. The source node is the
-      --  earlier one in the tree.
+      --  Expanded code usually shares the source location of the original
+      --  construct it was generated for. This however may not necessarely
+      --  reflect the true location of the code within the tree.
 
-      if Top_Level_Location (Sloc (P1)) < Top_Level_Location (Sloc (P2)) then
-         return True;
+      --  Before comparing the slocs of the two nodes, make sure that we are
+      --  working with correct source locations. Assume that P1 is to the left
+      --  of P2. If either one does not come from source, traverse the common
+      --  list heading towards the other node and locate the first source
+      --  statement.
 
-      elsif
-        Top_Level_Location (Sloc (P1)) > Top_Level_Location (Sloc (P2))
-      then
-         return False;
+      --             P1                     P2
+      --     ----+===+===+--------------+===+===+----
+      --          expanded code          expanded code
+
+      if not Comes_From_Source (P1) then
+         while Present (P1) loop
+
+            --  Neither P2 nor a source statement were located during the
+            --  search. If we reach the end of the list, then P1 does not
+            --  occur earlier than P2.
+
+            --                     ---->
+            --   start --- P2 ----- P1 --- end
+
+            if No (Next (P1)) then
+               return False;
+
+            --  We encounter P2 while going to the right of the list. This
+            --  means that P1 does indeed appear earlier.
 
+            --             ---->
+            --    start --- P1 ===== P2 --- end
+            --                 expanded code in between
+
+            elsif P1 = P2 then
+               return True;
+
+            --  No need to look any further since we have located a source
+            --  statement.
+
+            elsif Comes_From_Source (P1) then
+               exit;
+            end if;
+
+            --  Keep going right
+
+            Next (P1);
+         end loop;
+      end if;
+
+      if not Comes_From_Source (P2) then
+         while Present (P2) loop
+
+            --  Neither P1 nor a source statement were located during the
+            --  search. If we reach the start of the list, then P1 does not
+            --  occur earlier than P2.
+
+            --            <----
+            --    start --- P2 --- P1 --- end
+
+            if No (Prev (P2)) then
+               return False;
+
+            --  We encounter P1 while going to the left of the list. This
+            --  means that P1 does indeed appear earlier.
+
+            --                     <----
+            --    start --- P1 ===== P2 --- end
+            --                 expanded code in between
+
+            elsif P2 = P1 then
+               return True;
+
+            --  No need to look any further since we have located a source
+            --  statement.
+
+            elsif Comes_From_Source (P2) then
+               exit;
+            end if;
+
+            --  Keep going left
+
+            Prev (P2);
+         end loop;
+      end if;
+
+      --  At this point either both nodes came from source or we approximated
+      --  their source locations through neighbouring source statements.
+
+      if Top_Level_Location (Sloc (P1)) < Top_Level_Location (Sloc (P2)) then
+         return True;
       else
-         return Comes_From_Source (P1);
+         return False;
       end if;
    end Earlier;