libgpr2_25.0.0_70fe0fcf/src/lib/gpr2-source_reference.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
--
--  Copyright (C) 2019-2024, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception
--

with Ada.Directories;
with Ada.Strings.Fixed;
with GNAT.Formatted_String;

package body GPR2.Source_Reference is

   ------------
   -- Column --
   ------------

   function Column (Self : Object) return Positive is
   begin
      return Self.Column;
   end Column;

   ------------
   -- Create --
   ------------

   function Create
     (Filename     : Path_Name.Full_Name;
      Line, Column : Natural) return Object'Class is
   begin
      return Object'(Line, Column, +Filename);
   end Create;

   --------------
   -- Filename --
   --------------

   function Filename (Self : Object) return Path_Name.Full_Name is
   begin
      return -Self.Filename;
   end Filename;

   ------------
   -- Format --
   ------------

   function Format (Self : Object; Full_Path_Name : Boolean := False)
     return String is

      use GNAT.Formatted_String;

      function Simple_Name (S : String) return String;
      --  Handle possible pseudo files

      -----------------
      -- Simple_Name --
      -----------------

      function Simple_Name (S : String) return String is
         Start : Natural := Ada.Strings.Fixed.Index (S, "<ram>");
      begin
         if Start = 0 then
            Start := S'First;
         else
            Start := Start + 5;
         end if;

         return Directories.Simple_Name (S (Start .. S'Last));
      end Simple_Name;

      Filename : constant String :=
                   (if Full_Path_Name
                    then To_String (Self.Filename)
                    else Simple_Name (To_String (Self.Filename)));

   begin

      if Self.Has_Source_Reference then
         declare
            Format : constant Formatted_String := +"%s:%d:%02d";
         begin
            return -(Format & Filename & Self.Line & Self.Column);
         end;

      else
         declare
            Format : constant Formatted_String := +"%s";
         begin
            return -(Format & Filename);
         end;
      end if;
   end Format;

   ----------
   -- Line --
   ----------

   function Line (Self : Object) return Positive is
   begin
      return Self.Line;
   end Line;

end GPR2.Source_Reference;