gcc/ada/ali-util.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             A L I . U T I L                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Debug;   use Debug;
  27 with Binderr; use Binderr;
  28 with Opt;     use Opt;
  29 with Output;  use Output;
  30 with Osint;   use Osint;
  31 with Scans;   use Scans;
  32 with Scng;
  33 with Sinput.C;
  34 with Snames;  use Snames;
  35 with Stringt;
  36 with Styleg;
  37
  38 with System.OS_Lib; use System.OS_Lib;
  39
  40 package body ALI.Util is
  41
  42    --  Empty procedures needed to instantiate Scng. Error procedures are
  43    --  empty, because we don't want to report any errors when computing
  44    --  a source checksum.
  45
  46    procedure Post_Scan;
  47
  48    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
  49
  50    procedure Error_Msg_S (Msg : String);
  51
  52    procedure Error_Msg_SC (Msg : String);
  53
  54    procedure Error_Msg_SP (Msg : String);
  55
  56    --  Instantiation of Styleg, needed to instantiate Scng
  57
  58    package Style is new Styleg
  59      (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
  60
  61    --  A Scanner is needed to get checksum of a source (procedure
  62    --  Get_File_Checksum).
  63
  64    package Scanner is new Scng
  65      (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
  66
  67    type Header_Num is range 0 .. 1_000;
  68
  69    function Hash (F : File_Name_Type) return Header_Num;
  70    --  Function used to compute hash of ALI file name
  71
  72    package Interfaces is new Simple_HTable (
  73      Header_Num => Header_Num,
  74      Element    => Boolean,
  75      No_Element => False,
  76      Key        => File_Name_Type,
  77      Hash       => Hash,
  78      Equal      => "=");
  79
  80    ---------------------
  81    -- Checksums_Match --
  82    ---------------------
  83
  84    function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
  85    begin
  86       return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
  87    end Checksums_Match;
  88
  89    ---------------
  90    -- Error_Msg --
  91    ---------------
  92
  93    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
  94       pragma Warnings (Off, Msg);
  95       pragma Warnings (Off, Flag_Location);
  96    begin
  97       null;
  98    end Error_Msg;
  99
 100    -----------------
 101    -- Error_Msg_S --
 102    -----------------
 103
 104    procedure Error_Msg_S (Msg : String) is
 105       pragma Warnings (Off, Msg);
 106    begin
 107       null;
 108    end Error_Msg_S;
 109
 110    ------------------
 111    -- Error_Msg_SC --
 112    ------------------
 113
 114    procedure Error_Msg_SC (Msg : String) is
 115       pragma Warnings (Off, Msg);
 116    begin
 117       null;
 118    end Error_Msg_SC;
 119
 120    ------------------
 121    -- Error_Msg_SP --
 122    ------------------
 123
 124    procedure Error_Msg_SP (Msg : String) is
 125       pragma Warnings (Off, Msg);
 126    begin
 127       null;
 128    end Error_Msg_SP;
 129
 130    -----------------------
 131    -- Get_File_Checksum --
 132    -----------------------
 133
 134    function Get_File_Checksum (Fname : File_Name_Type) return Word is
 135       Full_Name    : File_Name_Type;
 136       Source_Index : Source_File_Index;
 137
 138    begin
 139       Full_Name := Find_File (Fname, Osint.Source);
 140
 141       --  If we cannot find the file, then return an impossible checksum,
 142       --  impossible because checksums have the high order bit zero, so
 143       --  that checksums do not match.
 144
 145       if Full_Name = No_File then
 146          return Checksum_Error;
 147       end if;
 148
 149       Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
 150
 151       if Source_Index = No_Source_File then
 152          return Checksum_Error;
 153       end if;
 154
 155       Scanner.Initialize_Scanner (Source_Index);
 156
 157       --  Make sure that the project language reserved words are not
 158       --  recognized as reserved words, but as identifiers. The byte info for
 159       --  those names have been set if we are in gnatmake.
 160
 161       Set_Name_Table_Byte (Name_Project,          0);
 162       Set_Name_Table_Byte (Name_Extends,          0);
 163       Set_Name_Table_Byte (Name_External,         0);
 164       Set_Name_Table_Byte (Name_External_As_List, 0);
 165
 166       --  Scan the complete file to compute its checksum
 167
 168       loop
 169          Scanner.Scan;
 170          exit when Token = Tok_EOF;
 171       end loop;
 172
 173       return Scans.Checksum;
 174    end Get_File_Checksum;
 175
 176    ----------
 177    -- Hash --
 178    ----------
 179
 180    function Hash (F : File_Name_Type) return Header_Num is
 181    begin
 182       return Header_Num (Int (F) rem Header_Num'Range_Length);
 183    end Hash;
 184
 185    ---------------------------
 186    -- Initialize_ALI_Source --
 187    ---------------------------
 188
 189    procedure Initialize_ALI_Source is
 190    begin
 191       --  When (re)initializing ALI data structures the ALI user expects to
 192       --  get a fresh set of data structures. Thus we first need to erase the
 193       --  marks put in the name table by the previous set of ALI routine calls.
 194       --  This loop is empty and harmless the first time in.
 195
 196       for J in Source.First .. Source.Last loop
 197          Set_Name_Table_Info (Source.Table (J).Sfile, 0);
 198          Source.Table (J).Source_Found := False;
 199       end loop;
 200
 201       Source.Init;
 202       Interfaces.Reset;
 203    end Initialize_ALI_Source;
 204
 205    ---------------
 206    -- Post_Scan --
 207    ---------------
 208
 209    procedure Post_Scan is
 210    begin
 211       null;
 212    end Post_Scan;
 213
 214    ----------------------
 215    -- Read_Withed_ALIs --
 216    ----------------------
 217
 218    procedure Read_Withed_ALIs
 219      (Id            : ALI_Id;
 220       Ignore_Errors : Boolean := False)
 221    is
 222       Afile  : File_Name_Type;
 223       Text   : Text_Buffer_Ptr;
 224       Idread : ALI_Id;
 225
 226    begin
 227       --  Process all dependent units
 228
 229       for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
 230          for
 231            W in Units.Table (U).First_With .. Units.Table (U).Last_With
 232          loop
 233             Afile := Withs.Table (W).Afile;
 234
 235             --  Only process if not a generic (Afile /= No_File) and if
 236             --  file has not been processed already.
 237
 238             if Afile /= No_File
 239               and then Get_Name_Table_Info (Afile) = 0
 240             then
 241                Text := Read_Library_Info (Afile);
 242
 243                --  Unless Ignore_Errors is true, return with an error if source
 244                --  cannot be found. We used to skip this check when we did not
 245                --  compile library generics separately, but we now always do,
 246                --  so there is no special case here anymore.
 247
 248                if Text = null then
 249
 250                   if not Ignore_Errors then
 251                      Error_Msg_File_1 := Afile;
 252                      Error_Msg_File_2 := Withs.Table (W).Sfile;
 253                      Error_Msg ("{ not found, { must be compiled");
 254                      Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 255                      return;
 256                   end if;
 257
 258                else
 259                   --  Enter in ALIs table
 260
 261                   Idread :=
 262                     Scan_ALI
 263                       (F         => Afile,
 264                        T         => Text,
 265                        Ignore_ED => False,
 266                        Err       => False);
 267
 268                   Free (Text);
 269
 270                   if ALIs.Table (Idread).Compile_Errors
 271                     and then not Ignore_Errors
 272                   then
 273                      Error_Msg_File_1 := Withs.Table (W).Sfile;
 274                      Error_Msg ("{ had errors, must be fixed, and recompiled");
 275                      Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 276
 277                   --  In GNATprove mode, object files are never generated, so
 278                   --  No_Object=True is not considered an error.
 279
 280                   elsif ALIs.Table (Idread).No_Object
 281                     and then not GNATprove_Mode
 282                     and then not Ignore_Errors
 283                   then
 284                      Error_Msg_File_1 := Withs.Table (W).Sfile;
 285                      Error_Msg ("{ must be recompiled");
 286                      Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 287                   end if;
 288
 289                   --  If the Unit is an Interface to a Stand-Alone Library,
 290                   --  set the Interface flag in the Withs table, so that its
 291                   --  dependant are not considered for elaboration order.
 292
 293                   if ALIs.Table (Idread).SAL_Interface then
 294                      Withs.Table (W).SAL_Interface := True;
 295                      Interface_Library_Unit := True;
 296
 297                      --  Set the entry in the Interfaces hash table, so that
 298                      --  other units that import this unit will set the flag
 299                      --  in their entry in the Withs table.
 300
 301                      Interfaces.Set (Afile, True);
 302
 303                   else
 304                      --  Otherwise, recurse to get new dependents
 305
 306                      Read_Withed_ALIs (Idread);
 307                   end if;
 308                end if;
 309
 310             --  If the ALI file has already been processed and is an interface,
 311             --  set the flag in the entry of the Withs table.
 312
 313             elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
 314                Withs.Table (W).SAL_Interface := True;
 315             end if;
 316          end loop;
 317       end loop;
 318    end Read_Withed_ALIs;
 319
 320    ----------------------
 321    -- Set_Source_Table --
 322    ----------------------
 323
 324    procedure Set_Source_Table (A : ALI_Id) is
 325       F     : File_Name_Type;
 326       S     : Source_Id;
 327       Stamp : Time_Stamp_Type;
 328
 329    begin
 330       Sdep_Loop : for D in
 331         ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 332       loop
 333          F := Sdep.Table (D).Sfile;
 334
 335          if F /= No_File then
 336
 337             --  If this is the first time we are seeing this source file,
 338             --  then make a new entry in the source table.
 339
 340             if Get_Name_Table_Info (F) = 0 then
 341                Source.Increment_Last;
 342                S := Source.Last;
 343                Set_Name_Table_Info (F, Int (S));
 344                Source.Table (S).Sfile := F;
 345                Source.Table (S).All_Timestamps_Match := True;
 346
 347                --  Initialize checksum fields
 348
 349                Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 350                Source.Table (S).All_Checksums_Match := True;
 351
 352                --  In check source files mode, try to get time stamp from file
 353
 354                if Opt.Check_Source_Files then
 355                   Stamp := Source_File_Stamp (F);
 356
 357                   --  If we got the stamp, then set the stamp in the source
 358                   --  table entry and mark it as set from the source so that
 359                   --  it does not get subsequently changed.
 360
 361                   if Stamp (Stamp'First) /= ' ' then
 362                      Source.Table (S).Stamp := Stamp;
 363                      Source.Table (S).Source_Found := True;
 364                      Source.Table (S).Stamp_File := F;
 365
 366                   --  If we could not find the file, then the stamp is set
 367                   --  from the dependency table entry (to be possibly reset
 368                   --  if we find a later stamp in subsequent processing)
 369
 370                   else
 371                      Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 372                      Source.Table (S).Source_Found := False;
 373                      Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
 374
 375                      --  In All_Sources mode, flag error of file not found
 376
 377                      if Opt.All_Sources then
 378                         Error_Msg_File_1 := F;
 379                         Error_Msg ("cannot locate {");
 380                      end if;
 381                   end if;
 382
 383                --  First time for this source file, but Check_Source_Files
 384                --  is off, so simply initialize the stamp from the Sdep entry
 385
 386                else
 387                   Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 388                   Source.Table (S).Source_Found := False;
 389                   Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
 390                end if;
 391
 392             --  Here if this is not the first time for this source file,
 393             --  so that the source table entry is already constructed.
 394
 395             else
 396                S := Source_Id (Get_Name_Table_Info (F));
 397
 398                --  Update checksum flag
 399
 400                if not Checksums_Match
 401                         (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
 402                then
 403                   Source.Table (S).All_Checksums_Match := False;
 404                end if;
 405
 406                --  Check for time stamp mismatch
 407
 408                if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
 409                   Source.Table (S).All_Timestamps_Match := False;
 410
 411                   --  When we have a time stamp mismatch, we go look for the
 412                   --  source file even if Check_Source_Files is false, since
 413                   --  if we find it, then we can use it to resolve which of the
 414                   --  two timestamps in the ALI files is likely to be correct.
 415                   --  We only look in the current directory, because when
 416                   --  Check_Source_Files is false, other search directories are
 417                   --  likely to be incorrect.
 418
 419                   if not Check_Source_Files
 420                     and then Is_Regular_File (Get_Name_String (F))
 421                   then
 422                      Stamp := Source_File_Stamp (F);
 423
 424                      if Stamp (Stamp'First) /= ' ' then
 425                         Source.Table (S).Stamp := Stamp;
 426                         Source.Table (S).Source_Found := True;
 427                         Source.Table (S).Stamp_File := F;
 428                      end if;
 429                   end if;
 430
 431                   --  If the stamp in the source table entry was set from the
 432                   --  source file, then we do not change it (the stamp in the
 433                   --  source file is always taken as the "right" one).
 434
 435                   if Source.Table (S).Source_Found then
 436                      null;
 437
 438                   --  Otherwise, we have no source file available, so we guess
 439                   --  that the later of the two timestamps is the right one.
 440                   --  Note that this guess only affects which error messages
 441                   --  are issued later on, not correct functionality.
 442
 443                   else
 444                      if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
 445                         Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 446                         Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
 447                      end if;
 448                   end if;
 449                end if;
 450             end if;
 451
 452             --  Set the checksum value in the source table
 453
 454             S := Source_Id (Get_Name_Table_Info (F));
 455             Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 456          end if;
 457
 458       end loop Sdep_Loop;
 459    end Set_Source_Table;
 460
 461    ----------------------
 462    -- Set_Source_Table --
 463    ----------------------
 464
 465    procedure Set_Source_Table is
 466    begin
 467       for A in ALIs.First .. ALIs.Last loop
 468          Set_Source_Table (A);
 469       end loop;
 470    end Set_Source_Table;
 471
 472    -------------------------
 473    -- Time_Stamp_Mismatch --
 474    -------------------------
 475
 476    function Time_Stamp_Mismatch
 477      (A         : ALI_Id;
 478       Read_Only : Boolean := False) return File_Name_Type
 479    is
 480       Src : Source_Id;
 481       --  Source file Id for the current Sdep entry
 482
 483    begin
 484       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 485          Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
 486
 487          if Opt.Minimal_Recompilation
 488            and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 489          then
 490             --  If minimal recompilation is in action, replace the stamp
 491             --  of the source file in the table if checksums match.
 492
 493             --  ??? It is probably worth updating the ALI file with a new
 494             --  field to avoid recomputing it each time. In any case we ensure
 495             --  that we don't gobble up string table space by doing a mark
 496             --  release around this computation.
 497
 498             Stringt.Mark;
 499
 500             if Checksums_Match
 501                  (Get_File_Checksum (Sdep.Table (D).Sfile),
 502                   Source.Table (Src).Checksum)
 503             then
 504                if Verbose_Mode then
 505                   Write_Str ("   ");
 506                   Write_Str (Get_Name_String (Sdep.Table (D).Sfile));
 507                   Write_Str (": up to date, different timestamps " &
 508                              "but same checksum");
 509                   Write_Eol;
 510                end if;
 511
 512                Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
 513             end if;
 514
 515             Stringt.Release;
 516          end if;
 517
 518          if (not Read_Only) or else Source.Table (Src).Source_Found then
 519             if not Source.Table (Src).Source_Found
 520               or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 521             then
 522                --  If -dt debug flag set, output time stamp found/expected
 523
 524                if Source.Table (Src).Source_Found and then Debug_Flag_T then
 525                   Write_Str ("Source: """);
 526                   Get_Name_String (Sdep.Table (D).Sfile);
 527                   Write_Str (Name_Buffer (1 .. Name_Len));
 528                   Write_Line ("""");
 529
 530                   Write_Str ("   time stamp expected: ");
 531                   Write_Line (String (Sdep.Table (D).Stamp));
 532
 533                   Write_Str ("      time stamp found: ");
 534                   Write_Line (String (Source.Table (Src).Stamp));
 535                end if;
 536
 537                --  Return the source file
 538
 539                return Source.Table (Src).Sfile;
 540             end if;
 541          end if;
 542       end loop;
 543
 544       return No_File;
 545    end Time_Stamp_Mismatch;
 546
 547 end ALI.Util;