1------------------------------------------------------------------------------ 2-- -- 3-- GPR TECHNOLOGY -- 4-- -- 5-- Copyright (C) 2015-2016, AdaCore -- 6-- -- 7-- This is free software; you can redistribute it and/or modify it under -- 8-- terms of the GNU General Public License as published by the Free Soft- -- 9-- ware Foundation; either version 3, or (at your option) any later ver- -- 10-- sion. This software is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 13-- License for more details. You should have received a copy of the GNU -- 14-- General Public License distributed with GNAT; see file COPYING. If not, -- 15-- see <http://www.gnu.org/licenses/>. -- 16-- -- 17------------------------------------------------------------------------------ 18 19with Ada.Text_IO; use Ada.Text_IO; 20 21with GPR.Err; 22with GPR.Names; use GPR.Names; 23with GPR.Opt; use GPR.Opt; 24with GPR.Scans; 25with GPR.Sinput; 26 27package body Gprls is 28 29 No_Obj : aliased String := "<no_obj>"; 30 31 use GPR.Stamps; 32 33 procedure Find_Status 34 (Source : GPR.Source_Id; 35 Stamp : Time_Stamp_Type; 36 Checksum : Word; 37 Status : out File_Status); 38 -- Determine the file status (Status) of the file represented by FS with 39 -- the expected Stamp and checksum given as argument. FS will be updated 40 -- to the full file name if available. 41 42 use Rident; 43 44 ------------- 45 -- Add_ALI -- 46 ------------- 47 48 procedure Add_ALI 49 (ALI_Name : File_Name_Type; 50 Spec : Boolean; 51 Source : GPR.Source_Id) 52 is 53 A : constant ALI_Kind := (File => ALI_Name, Spec => Spec); 54 begin 55 ALI_Names.Set (A, Source); 56 end Add_ALI; 57 58 -------------- 59 -- Add_File -- 60 -------------- 61 62 procedure Add_File 63 (File_Name : String; Source : GPR.Source_Id := No_Source) 64 is 65 begin 66 if Current_Verbosity = High then 67 Put_Line ("adding file """ & File_Name & '"'); 68 end if; 69 70 Number_File_Names := Number_File_Names + 1; 71 72 -- As Add_File may be called for mains specified inside a project file, 73 -- File_Names may be too short and needs to be extended. 74 75 if Number_File_Names > File_Names'Last then 76 File_Names := new File_Name_Array'(File_Names.all & File_Names.all); 77 end if; 78 79 File_Names (Number_File_Names) := 80 (new String'(File_Name), Source, No_ALI_Id); 81 end Add_File; 82 83 ------------------------------ 84 -- Corresponding_Sdep_Entry -- 85 ------------------------------ 86 87 function Corresponding_Sdep_Entry 88 (A : ALI_Id; 89 U : Unit_Id) return Sdep_Id 90 is 91 begin 92 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 93 if Sdep.Table (D).Sfile = Units.Table (U).Sfile then 94 return D; 95 end if; 96 end loop; 97 98 return No_Sdep_Id; 99 end Corresponding_Sdep_Entry; 100 101 -------------- 102 -- Find_ALI -- 103 -------------- 104 105 function Find_ALI (Source : GPR.Source_Id) return ALI_Id is 106 Text : Text_Buffer_Ptr; 107 Result : ALI_Id; 108 begin 109 Text := Osint.Read_Library_Info (File_Name_Type (Source.Dep_Path)); 110 111 if Text /= null then 112 Result := Scan_ALI 113 (F => File_Name_Type (Source.Dep_Path), 114 T => Text, 115 Ignore_ED => False, 116 Err => True, 117 Read_Lines => "WD"); 118 Free (Text); 119 return Result; 120 121 else 122 return No_ALI_Id; 123 end if; 124 end Find_ALI; 125 126 ----------------- 127 -- Find_Source -- 128 ----------------- 129 130 function Find_Source 131 (ALI_Name : File_Name_Type; 132 Spec : Boolean) 133 return GPR.Source_Id 134 is 135 A : constant ALI_Kind := (File => ALI_Name, Spec => Spec); 136 begin 137 return ALI_Names.Get (A); 138 end Find_Source; 139 140 ----------------- 141 -- Find_Status -- 142 ----------------- 143 144 procedure Find_Status 145 (Source : GPR.Source_Id; 146 ALI : ALI_Id; 147 Status : out File_Status) 148 is 149 U : Unit_Id; 150 begin 151 if ALI = No_ALI_Id then 152 Status := Not_Found; 153 else 154 if Source.Kind = Spec then 155 U := ALIs.Table (ALI).Last_Unit; 156 else 157 U := ALIs.Table (ALI).First_Unit; 158 end if; 159 160 Find_Status (Source, ALI, U, Status); 161 end if; 162 end Find_Status; 163 164 procedure Find_Status 165 (Source : GPR.Source_Id; 166 ALI : ALI_Id; 167 U : Unit_Id; 168 Status : out File_Status) 169 is 170 use GPR.Scans; 171 Stamp : constant Time_Stamp_Type := File_Stamp (Source.Path.Name); 172 SD : constant Sdep_Id := Corresponding_Sdep_Entry (ALI, U); 173 Source_Index : Source_File_Index; 174 Checksums_Match : Boolean; 175 begin 176 if Stamp = Sdep.Table (SD).Stamp then 177 Status := OK; 178 179 else 180 Checksums_Match := False; 181 Source_Index := 182 Sinput.Load_File (Get_Name_String (Source.Path.Name)); 183 184 if Source_Index /= No_Source_File then 185 186 Err.Scanner.Initialize_Scanner 187 (Source_Index, Err.Scanner.Ada); 188 189 -- Scan the complete file to compute its 190 -- checksum. 191 192 loop 193 Err.Scanner.Scan; 194 exit when Token = Tok_EOF; 195 end loop; 196 197 if Scans.Checksum = Sdep.Table (SD).Checksum then 198 Checksums_Match := True; 199 end if; 200 end if; 201 202 if Checksums_Match then 203 Status := Checksum_OK; 204 205 else 206 Status := Not_Same; 207 end if; 208 end if; 209 end Find_Status; 210 211 procedure Find_Status 212 (Source : GPR.Source_Id; 213 Stamp : Time_Stamp_Type; 214 Checksum : Word; 215 Status : out File_Status) 216 is 217 Source_Index : Source_File_Index; 218 Checksums_Match : Boolean; 219 use GPR.Scans; 220 221 begin 222 if Source = No_Source then 223 Status := Not_Found; 224 225 elsif File_Stamp (Source.Path.Name) = Stamp then 226 Status := OK; 227 228 else 229 Checksums_Match := False; 230 Source_Index := 231 Sinput.Load_File (Get_Name_String (Source.Path.Name)); 232 233 if Source_Index /= No_Source_File then 234 235 Err.Scanner.Initialize_Scanner 236 (Source_Index, Err.Scanner.Ada); 237 238 -- Scan the complete file to compute its 239 -- checksum. 240 241 loop 242 Err.Scanner.Scan; 243 exit when Token = Tok_EOF; 244 end loop; 245 246 if Scans.Checksum = Checksum then 247 Checksums_Match := True; 248 end if; 249 end if; 250 251 if Checksums_Match then 252 Status := Checksum_OK; 253 254 else 255 Status := Not_Same; 256 end if; 257 end if; 258 end Find_Status; 259 260 ---------- 261 -- Hash -- 262 ---------- 263 264 function Hash (A : ALI_Kind) return GPR.Header_Num is 265 begin 266 return GPR.Hash (A.File); 267 end Hash; 268 269 ------------------- 270 -- Output_Object -- 271 ------------------- 272 273 procedure Output_Object (O : File_Name_Type) is 274 Object_Name : String_Access; 275 276 begin 277 if Print_Object then 278 if O /= No_File then 279 Get_Name_String (O); 280 Object_Name := new String'(Name_Buffer (1 .. Name_Len)); 281 else 282 Object_Name := No_Obj'Unchecked_Access; 283 end if; 284 285 Put_Line (Object_Name.all); 286 287 end if; 288 end Output_Object; 289 290 ------------------- 291 -- Output_Source -- 292 ------------------- 293 294 procedure Output_Source 295 (Source : GPR.Source_Id; Sdep_I : Sdep_Id) 296 is 297 Stamp : GPR.Stamps.Time_Stamp_Type; 298 Checksum : Word; 299 Status : File_Status; 300 begin 301 if Sdep_I = No_Sdep_Id then 302 return; 303 end if; 304 305 Stamp := Sdep.Table (Sdep_I).Stamp; 306 Checksum := Sdep.Table (Sdep_I).Checksum; 307 308 if Print_Source then 309 Find_Status (Source, Stamp, Checksum, Status); 310 311 if Verbose_Mode then 312 Put (" Source => "); 313 Put (Get_Name_String (Source.Path.Display_Name)); 314 Output_Status (Status, True); 315 New_Line; 316 317 else 318 if not Selective_Output then 319 Put (" "); 320 Output_Status (Status, Verbose => False); 321 end if; 322 323 Put_Line (Get_Name_String (Source.Path.Display_Name)); 324 end if; 325 end if; 326 end Output_Source; 327 328 procedure Output_Source (Sdep_I : Sdep_Id) is 329 Stamp : GPR.Stamps.Time_Stamp_Type; 330 Checksum : Word; 331 Source : GPR.Source_Id; 332 FS : File_Name_Type; 333 Status : File_Status; 334 Source_Name : String_Access; 335 336 begin 337 if Sdep_I = No_Sdep_Id then 338 return; 339 end if; 340 341 Stamp := Sdep.Table (Sdep_I).Stamp; 342 Checksum := Sdep.Table (Sdep_I).Checksum; 343 FS := Sdep.Table (Sdep_I).Sfile; 344 345 Source := Source_Files_Htable.Get (Project_Tree.Source_Files_HT, FS); 346 347 if Print_Source then 348 Find_Status (Source, Stamp, Checksum, Status); 349 Get_Name_String (FS); 350 351 Source_Name := new String'(Name_Buffer (1 .. Name_Len)); 352 353 if Verbose_Mode then 354 Put (" Source => "); 355 Put (Source_Name.all); 356 357 Output_Status (Status, Verbose => True); 358 New_Line; 359 360 else 361 if not Selective_Output then 362 Put (" "); 363 Output_Status (Status, Verbose => False); 364 end if; 365 366 Put_Line (Source_Name.all); 367 end if; 368 end if; 369 end Output_Source; 370 371 ------------------- 372 -- Output_Status -- 373 ------------------- 374 375 procedure Output_Status (FS : File_Status; Verbose : Boolean) is 376 begin 377 if Verbose then 378 case FS is 379 when OK => 380 Put (" unchanged"); 381 382 when Checksum_OK => 383 Put (" slightly modified"); 384 385 when Not_Found => 386 Put (" dependency file not found"); 387 388 when Not_Same => 389 Put (" modified"); 390 end case; 391 392 else 393 case FS is 394 when OK => 395 Put (" OK "); 396 397 when Checksum_OK => 398 Put (" MOK "); 399 400 when Not_Found => 401 Put (" ??? "); 402 403 when Not_Same => 404 Put (" DIF "); 405 end case; 406 end if; 407 end Output_Status; 408 409 ----------------- 410 -- Output_Unit -- 411 ----------------- 412 413 procedure Output_Unit (U_Id : Unit_Id) is 414 Kind : Character; 415 U : Unit_Record renames Units.Table (U_Id); 416 417 begin 418 Get_Name_String (U.Uname); 419 Kind := Name_Buffer (Name_Len); 420 Name_Len := Name_Len - 2; 421 422 if not Verbose_Mode then 423 Put_Line (" " & Name_Buffer (1 .. Name_Len)); 424 425 else 426 Put (" Unit => "); 427 New_Line; 428 Put (" Name => "); 429 Put (Name_Buffer (1 .. Name_Len)); 430 New_Line; 431 Put (" Kind => "); 432 433 if Units.Table (U_Id).Unit_Kind = 'p' then 434 Put ("package "); 435 else 436 Put ("subprogram "); 437 end if; 438 439 if Kind = 's' then 440 Put ("spec"); 441 else 442 Put ("body"); 443 end if; 444 end if; 445 446 if Verbose_Mode then 447 if U.Preelab or else 448 U.No_Elab or else 449 U.Pure or else 450 U.Dynamic_Elab or else 451 U.Has_RACW or else 452 U.Remote_Types or else 453 U.Shared_Passive or else 454 U.RCI or else 455 U.Predefined or else 456 U.Internal or else 457 U.Is_Generic or else 458 U.Init_Scalars or else 459 U.SAL_Interface or else 460 U.Body_Needed_For_SAL or else 461 U.Elaborate_Body 462 then 463 New_Line; 464 Put (" Flags =>"); 465 466 if U.Preelab then 467 Put (" Preelaborable"); 468 end if; 469 470 if U.No_Elab then 471 Put (" No_Elab_Code"); 472 end if; 473 474 if U.Pure then 475 Put (" Pure"); 476 end if; 477 478 if U.Dynamic_Elab then 479 Put (" Dynamic_Elab"); 480 end if; 481 482 if U.Has_RACW then 483 Put (" Has_RACW"); 484 end if; 485 486 if U.Remote_Types then 487 Put (" Remote_Types"); 488 end if; 489 490 if U.Shared_Passive then 491 Put (" Shared_Passive"); 492 end if; 493 494 if U.RCI then 495 Put (" RCI"); 496 end if; 497 498 if U.Predefined then 499 Put (" Predefined"); 500 end if; 501 502 if U.Internal then 503 Put (" Internal"); 504 end if; 505 506 if U.Is_Generic then 507 Put (" Is_Generic"); 508 end if; 509 510 if U.Init_Scalars then 511 Put (" Init_Scalars"); 512 end if; 513 514 if U.SAL_Interface then 515 Put (" SAL_Interface"); 516 end if; 517 518 if U.Body_Needed_For_SAL then 519 Put (" Body_Needed_For_SAL"); 520 end if; 521 522 if U.Elaborate_Body then 523 Put (" Elaborate Body"); 524 end if; 525 526 if U.Remote_Types then 527 Put (" Remote_Types"); 528 end if; 529 530 if U.Shared_Passive then 531 Put (" Shared_Passive"); 532 end if; 533 534 if U.Predefined then 535 Put (" Predefined"); 536 end if; 537 538 New_Line; 539 end if; 540 end if; 541 end Output_Unit; 542 543 ----------------- 544 -- Reset_Print -- 545 ----------------- 546 547 procedure Reset_Print is 548 begin 549 if not Selective_Output then 550 Selective_Output := True; 551 Print_Source := False; 552 Print_Object := False; 553 Print_Unit := False; 554 end if; 555 end Reset_Print; 556 557end Gprls; 558