vtools_vpatch 1 with Bits; use Bits;
vtools_vpatch 2 with Ada.Text_IO; use Ada.Text_IO;
vtools_vpatch 3 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
vtools_vpatch_new... 4 with Character_IO; use Character_IO;
vtools_vpatch 5 with Ada.Strings.Fixed;
vtools_vpatch 6 with Ada.Directories;
vtools_vpatch 7 with Ada.Characters;
vtools_vpatch 8 with Ada.Characters.Handling;
vtools_vpatch 9 with Ada.Characters.Latin_1;
vtools_vpatch 10 with Ada.Sequential_IO;
vtools_vpatch 11 with SMG_Keccak; use SMG_Keccak;
vtools_tempfile_s... 12 with Temporary_File; use Temporary_File;
vtools_vpatch 13
vtools_vpatch 14 procedure VPatch is
vtools_vpatch 15 package Latin_1 renames Ada.Characters.Latin_1;
vtools_vpatch 16 package Dirs renames Ada.Directories;
vtools_vpatch_new... 17 package CIO renames Character_IO.Character_IO;
vtools_vpatch 18
vtools_vpatch 19
vtools_vpatch 20
vtools_vpatch 21 function Starts_With(S: String; Prefix: String) return Boolean is
vtools_vpatch 22 begin
vtools_vpatch 23 if S'Length < Prefix'Length then
vtools_vpatch 24 return False;
vtools_vpatch 25 end if;
vtools_vpatch 26 return S(S'First..S'First+Prefix'Length-1) = Prefix;
vtools_vpatch 27 end;
vtools_vpatch 28
vtools_vpatch 29 function Path_Prefix(Pathname: String;
vtools_vpatch 30 Suffix: Positive) return String is
vtools_vpatch 31 Pos: Natural := Pathname'Last;
vtools_vpatch 32 begin
vtools_vpatch 33 for I in 1..Suffix loop
vtools_vpatch 34 Pos := Ada.Strings.Fixed.Index(Pathname, "/",
vtools_vpatch 35 From => Pos,
vtools_vpatch 36 Going => Ada.Strings.Backward);
vtools_vpatch 37 if Pos = 0 then
vtools_vpatch 38 return Pathname;
vtools_vpatch 39 end if;
vtools_vpatch 40 Pos := Pos - 1;
vtools_vpatch 41 end loop;
vtools_vpatch 42 return Pathname(Pathname'First .. Pos);
vtools_vpatch 43 end;
vtools_vpatch 44
vtools_vpatch 45 function Path_Without_Prefix(Pathname: String;
vtools_vpatch 46 Prefix: Positive) return String is
vtools_vpatch 47 Pos: Natural := 1;
vtools_vpatch 48 begin
vtools_vpatch 49 for I in 1..Prefix loop
vtools_vpatch 50 Pos := Ada.Strings.Fixed.Index(Pathname, "/", From => Pos);
vtools_vpatch 51 if Pos = 0 then
vtools_vpatch 52 return Pathname;
vtools_vpatch 53 end if;
vtools_vpatch 54 Pos := Pos + 1;
vtools_vpatch 55 end loop;
vtools_vpatch 56 return Pathname(Pos .. Pathname'Last);
vtools_vpatch 57 end;
vtools_vpatch 58
vtools_vpatch 59
vtools_vpatch 60
vtools_vpatch 61 procedure Create_Temp(File : in out File_Type;
vtools_vpatch 62 Mode : in File_Mode := Out_File;
vtools_tempfile_s... 63 Prefix : in String;
vtools_tempfile_s... 64 Seed : in String := "";
vtools_vpatch 65 Form : in String := "") is
vtools_tempfile_s... 66 Name: String := Temporary_File.Temporary_File(Prefix, Seed);
vtools_vpatch 67 begin
vtools_vpatch 68 Create(File, Mode, Name, Form);
vtools_vpatch 69 end;
vtools_vpatch 70
vtools_vpatch_new... 71 procedure Create_Temp(File : in out CIO.File_Type;
vtools_vpatch_new... 72 Mode : in CIO.File_Mode := CIO.Out_File;
vtools_tempfile_s... 73 Prefix : in String;
vtools_tempfile_s... 74 Seed : in String := "";
vtools_vpatch_new... 75 Form : in String := "") is
vtools_tempfile_s... 76 Name: String := Temporary_File.Temporary_File(Prefix, Seed);
vtools_vpatch_new... 77 begin
vtools_vpatch_new... 78 Create(File, Mode, Name, Form);
vtools_vpatch_new... 79 end;
vtools_vpatch_new... 80
vtools_vpatch 81
vtools_vpatch 82
vtools_vpatch 83 type Patch_Op is (Op_Create, Op_Delete, Op_Patch);
vtools_vpatch 84
vtools_vpatch 85 Hash_Length: constant Positive := 128;
vtools_vpatch 86 type Hash_Type is (Empty, Value);
vtools_vpatch 87 type Hash(The_Type: Hash_Type := Empty) is record
vtools_vpatch 88 case The_Type is
vtools_vpatch 89 when Value =>
vtools_vpatch 90 Value: String(1..Hash_Length);
vtools_vpatch 91 when Empty =>
vtools_vpatch 92 null;
vtools_vpatch 93 end case;
vtools_vpatch 94 end record;
vtools_vpatch 95
vtools_vpatch 96 function "=" (Left, Right: in Hash) return Boolean is
vtools_vpatch 97 begin
vtools_vpatch 98 if Left.The_Type = Empty and Right.The_Type = Empty then
vtools_vpatch 99 return True;
vtools_vpatch 100 elsif Left.The_Type = Empty or Right.The_Type = Empty then
vtools_vpatch 101 return False;
vtools_vpatch 102 elsif Left.Value /= Right.Value then
vtools_vpatch 103 return False;
vtools_vpatch 104 else
vtools_vpatch 105 return True;
vtools_vpatch 106 end if;
vtools_vpatch 107 end "=";
vtools_vpatch 108
vtools_vpatch 109 type Header (From_L, To_L: Natural) Is record
vtools_vpatch 110 From_Hash: Hash;
vtools_vpatch 111 From_File: String(1..From_L);
vtools_vpatch 112 To_Hash: Hash;
vtools_vpatch 113 To_File: String(1..To_L);
vtools_vpatch 114 end record;
vtools_vpatch 115
vtools_vpatch 116 function Operation(A_Header: Header) return Patch_Op is
vtools_vpatch 117 begin
vtools_vpatch 118 if A_Header.From_Hash.The_Type = Empty then
vtools_vpatch 119 return Op_Create;
vtools_vpatch 120 elsif A_Header.To_Hash.The_Type = Empty then
vtools_vpatch 121 return Op_Delete;
vtools_vpatch 122 else
vtools_vpatch 123 return Op_Patch;
vtools_vpatch 124 end if;
vtools_vpatch 125 end;
vtools_vpatch 126
vtools_vpatch 127 function Press_Name(A_Header: Header) return String is
vtools_vpatch 128 begin
vtools_vpatch 129 return Path_Without_Prefix(A_Header.From_File, 1);
vtools_vpatch 130 end;
vtools_vpatch 131
vtools_vpatch 132 type Line_Numbers is record
vtools_vpatch 133 Start: Natural;
vtools_vpatch 134 Count: Natural;
vtools_vpatch 135 end record;
vtools_vpatch 136
vtools_vpatch 137 type Hunk is record
vtools_vpatch 138 From_File_Line_Numbers: Line_Numbers;
vtools_vpatch 139 To_File_Line_Numbers: Line_Numbers;
vtools_vpatch 140 end record;
vtools_vpatch 141
vtools_vpatch 142
vtools_vpatch 143
vtools_vpatch 144 procedure Put(A_Line_Numbers: Line_Numbers) is
vtools_vpatch 145 begin
vtools_vpatch 146 Put(A_Line_Numbers.Start);
vtools_vpatch 147 Put(A_Line_Numbers.Count);
vtools_vpatch 148 end;
vtools_vpatch 149
vtools_vpatch 150 procedure Put(A_Hash: Hash) is
vtools_vpatch 151 begin
vtools_vpatch 152 case A_Hash.The_Type is
vtools_vpatch 153 when Value =>
vtools_vpatch 154 Put(A_Hash.Value);
vtools_vpatch 155 when Empty =>
vtools_vpatch 156 Put("no value");
vtools_vpatch 157 end case;
vtools_vpatch 158 end;
vtools_vpatch 159
vtools_vpatch 160 procedure Put(A_Header: Header) is
vtools_vpatch 161 begin
vtools_vpatch 162 Put("from file: ");
vtools_vpatch 163 Put(A_Header.From_File);
vtools_vpatch 164 New_Line;
vtools_vpatch 165 Put("to file: ");
vtools_vpatch 166 Put(A_Header.To_File);
vtools_vpatch 167 New_Line;
vtools_vpatch 168 Put("from hash: ");
vtools_vpatch 169 Put(A_Header.From_Hash);
vtools_vpatch 170 New_Line;
vtools_vpatch 171 Put("to hash: ");
vtools_vpatch 172 Put(A_Header.To_Hash);
vtools_vpatch 173 New_Line;
vtools_vpatch 174 end;
vtools_vpatch 175
vtools_vpatch 176 procedure Put(A_Hunk: Hunk) is
vtools_vpatch 177 begin
vtools_vpatch 178 Put("from file line numbers: ");
vtools_vpatch 179 Put(A_Hunk.From_File_Line_Numbers);
vtools_vpatch 180 New_Line;
vtools_vpatch 181 Put("to file line numbers: ");
vtools_vpatch 182 Put(A_Hunk.To_File_Line_Numbers);
vtools_vpatch 183 New_Line;
vtools_vpatch 184 end;
vtools_vpatch 185
vtools_vpatch 186
vtools_vpatch 187
vtools_vpatch 188 Parse, State: exception;
vtools_vpatch 189
vtools_vpatch 190 procedure Skip_Whitespace is
vtools_vpatch 191 EOL: Boolean;
vtools_vpatch 192 C: Character;
vtools_vpatch 193 begin
vtools_vpatch 194 Skip_Loop:
vtools_vpatch 195 loop
vtools_vpatch 196 Look_Ahead(C, EOL);
vtools_vpatch 197 exit Skip_Loop when EOL;
vtools_vpatch 198 exit Skip_Loop when
vtools_vpatch 199 C /= Latin_1.Space and
vtools_vpatch 200 C /= Latin_1.HT;
vtools_vpatch 201 Get(C);
vtools_vpatch 202 end loop Skip_Loop;
vtools_vpatch 203 end;
vtools_vpatch 204
vtools_vpatch 205 procedure Looking_At(Expected: String) is
vtools_vpatch 206 Actual: String(Expected'Range);
vtools_vpatch 207 begin
vtools_vpatch 208 Get(Actual);
vtools_vpatch 209 if Expected /= Actual then
vtools_vpatch 210 raise Parse with "expected " & Expected & ", got " & Actual;
vtools_vpatch 211 end if;
vtools_vpatch 212 end;
vtools_vpatch 213
vtools_vpatch 214 procedure Next_Line is
vtools_vpatch 215 begin
vtools_vpatch 216 if not End_Of_Line then
vtools_vpatch 217 raise Parse with "expected end of line";
vtools_vpatch 218 end if;
vtools_vpatch 219 Skip_Line;
vtools_vpatch 220 end;
vtools_vpatch 221
vtools_vpatch 222 procedure Get(A_Hash: out Hash) is
vtools_vpatch 223 No_Hash_Label: constant String := "false";
vtools_vpatch 224 V: String(1..Hash_Length);
vtools_vpatch 225 begin
vtools_vpatch 226 Get(V(1..No_Hash_Label'Length));
vtools_vpatch 227 if V(1..No_Hash_Label'Length) = No_Hash_Label then
vtools_vpatch 228 A_Hash := (The_Type => Empty);
vtools_vpatch 229 return;
vtools_vpatch 230 end if;
vtools_vpatch 231 Get(V(No_Hash_Label'Length + 1..V'Last));
vtools_vpatch 232 A_Hash := (The_Type => Value,
vtools_vpatch 233 Value => V);
vtools_vpatch 234 end;
vtools_vpatch 235
vtools_vpatch 236 procedure Get(A_Line_Numbers: out Line_Numbers) is
vtools_vpatch 237 C: Character;
vtools_vpatch 238 Eol: Boolean;
vtools_vpatch 239 begin
vtools_vpatch 240 Get(A_Line_Numbers.Start);
vtools_vpatch 241 Look_Ahead(C, Eol);
vtools_vpatch 242 if Eol then
vtools_vpatch 243 raise Parse;
vtools_vpatch 244 end if;
vtools_vpatch 245 case C is
vtools_vpatch 246 when ' ' =>
vtools_vpatch 247
vtools_vpatch 248
vtools_vpatch 249 A_Line_Numbers.Count := 1;
vtools_vpatch 250 when ',' =>
vtools_vpatch 251
vtools_vpatch 252
vtools_vpatch 253
vtools_vpatch 254 Get(C);
vtools_vpatch 255 Get(A_Line_Numbers.Count);
vtools_vpatch 256 when others =>
vtools_vpatch 257 raise Parse;
vtools_vpatch 258 end case;
vtools_vpatch 259 end;
vtools_vpatch 260
vtools_vpatch 261 function Get_Header_Filename return String is
vtools_vpatch 262 EOL: Boolean;
vtools_vpatch 263 Buffer: String(1..1000);
vtools_vpatch 264 C: Character;
vtools_vpatch 265 I: Natural := 0;
vtools_vpatch 266 begin
vtools_vpatch 267 Read_Loop:
vtools_vpatch 268 loop
vtools_vpatch 269 Look_Ahead(C, EOL);
vtools_vpatch 270 exit Read_Loop when EOL;
vtools_vpatch 271 exit Read_Loop when
vtools_vpatch 272 C = Latin_1.Space or C = Latin_1.HT;
vtools_vpatch 273 Get(C);
vtools_vpatch 274 I := I + 1;
vtools_vpatch 275 Buffer(I) := C;
vtools_vpatch 276 end loop Read_Loop;
vtools_vpatch 277 return Buffer(1..I);
vtools_vpatch 278 end;
vtools_vpatch 279
vtools_vpatch 280 function Get_Header return Header is
vtools_vpatch 281 From_Hash: Hash;
vtools_vpatch 282 To_Hash: Hash;
vtools_vpatch 283 begin
vtools_vpatch 284 Looking_At("--- ");
vtools_vpatch 285 declare
vtools_vpatch 286 From_File: String := Get_Header_Filename;
vtools_vpatch 287 begin
vtools_vpatch 288 Skip_Whitespace;
vtools_vpatch 289 Get(From_Hash);
vtools_vpatch 290 Looking_At("+++ ");
vtools_vpatch 291 declare
vtools_vpatch 292 To_File: String := Get_Header_Filename;
vtools_vpatch 293 begin
vtools_vpatch 294 Skip_Whitespace;
vtools_vpatch 295 Get(To_Hash);
vtools_vpatch 296 Next_Line;
vtools_vpatch 297 declare
vtools_vpatch 298 H: Header := (From_L => From_File'Length,
vtools_vpatch 299 To_L => To_File'Length,
vtools_vpatch 300 From_File => From_File,
vtools_vpatch 301 To_File => To_File,
vtools_vpatch 302 From_Hash => From_Hash,
vtools_vpatch 303 To_Hash => To_Hash);
vtools_vpatch 304 begin
vtools_vpatch 305 return H;
vtools_vpatch 306 end;
vtools_vpatch 307 end;
vtools_vpatch 308 end;
vtools_vpatch 309 end;
vtools_vpatch 310
vtools_vpatch 311 procedure Get(A_Hunk: out Hunk) is
vtools_vpatch 312 begin
vtools_vpatch 313 Looking_At("@@ -");
vtools_vpatch 314 Get(A_Hunk.From_File_Line_Numbers);
vtools_vpatch 315 Looking_At(" +");
vtools_vpatch 316 Get(A_Hunk.To_File_Line_Numbers);
vtools_vpatch 317 Looking_At(" @@");
vtools_vpatch 318 Next_Line;
vtools_vpatch 319 end;
vtools_vpatch 320
vtools_vpatch 321 procedure Process_Hunks_For_Header(A_Header: Header) Is
vtools_vpatch 322 EOL: Boolean;
vtools_vpatch 323 C: Character;
vtools_vpatch 324 A_Hunk: Hunk;
vtools_vpatch 325
vtools_vpatch 326 From_Count: Natural := 0;
vtools_vpatch 327 To_Count: Natural := 0;
vtools_vpatch 328 Has_Input_File: Boolean;
vtools_vpatch_new... 329 In_F: CIO.File_Type;
vtools_vpatch_new... 330 To_F: CIO.File_Type;
vtools_vpatch 331 Line: Positive := 1;
vtools_vpatch 332 In_Ctx: Keccak_Context;
vtools_vpatch 333 To_Ctx: Keccak_Context;
vtools_vpatch 334 In_Hash: Bitstream(1..64*8);
vtools_vpatch 335 To_Hash: Bitstream(1..64*8);
vtools_vpatch 336 To_F_Name: constant String := Press_Name(A_Header);
vtools_vpatch 337 Op: Patch_Op;
vtools_vpatch_new... 338 Newline_Directive: constant String := "\ No newline at end of file";
vtools_vpatch_new... 339
vtools_vpatch_new... 340 procedure Hash_Line(Ctx: in out Keccak_Context;
vtools_vpatch_new... 341 S: String;
vtools_vpatch_new... 342 New_Line: Boolean := True) is
vtools_vpatch 343 B: Bitstream(1..S'Length*8);
vtools_vpatch 344 LF_B: constant Bitstream(1..8) := (0, 1, 0, 1, 0, 0, 0, 0);
vtools_vpatch 345 begin
vtools_vpatch 346 ToBitstream(S, B);
vtools_vpatch 347 KeccakHash(Ctx, B);
vtools_vpatch_new... 348 if New_Line then
vtools_vpatch_new... 349 KeccakHash(Ctx, LF_B);
vtools_vpatch_new... 350 end if;
vtools_vpatch 351 end;
vtools_vpatch_new... 352
vtools_vpatch_new... 353 Check_Input_File_Hash_Pending: Boolean := True;
vtools_vpatch 354 procedure Check_Input_File_Hash is
vtools_vpatch 355 begin
vtools_vpatch_new... 356 if Has_Input_File and Is_Open(In_F)
vtools_vpatch_new... 357 and Check_Input_File_Hash_Pending then
vtools_vpatch 358 begin
vtools_vpatch_new... 359 Check_Input_File_Hash_Pending := False;
vtools_vpatch 360 Catch_Up_Loop:
vtools_vpatch 361 loop
vtools_vpatch 362 declare
vtools_vpatch_new... 363 New_Line: Boolean;
vtools_vpatch_new... 364 In_Line: String := Get_Line(In_F, New_Line);
vtools_vpatch 365 begin
vtools_vpatch_new... 366 Put_Line(To_F, In_Line, New_Line);
vtools_vpatch_new... 367 Hash_Line(In_Ctx, In_Line, New_Line);
vtools_vpatch_new... 368 Hash_Line(To_Ctx, In_Line, New_Line);
vtools_vpatch 369 end;
vtools_vpatch 370 end loop Catch_Up_Loop;
vtools_vpatch 371 exception
vtools_vpatch 372 when End_Error =>
vtools_vpatch 373 null;
vtools_vpatch 374 end;
vtools_vpatch 375 KeccakEnd(In_Ctx, In_Hash);
vtools_vpatch 376
vtools_vpatch 377 declare
vtools_vpatch 378 Hex_Hash: String := ToHex(In_Hash);
vtools_vpatch 379 H: Hash := (Value => Hex_Hash,
vtools_vpatch 380 The_Type => Value);
vtools_vpatch 381 begin
vtools_vpatch_new... 382 if A_Header.From_Hash /= H then
vtools_vpatch 383 raise State with "from hash doesn't match";
vtools_vpatch 384 end if;
vtools_vpatch 385 end;
vtools_vpatch 386 end if;
vtools_vpatch 387 end Check_Input_File_Hash;
vtools_vpatch 388
vtools_vpatch 389 procedure Check_Output_File_Hash is
vtools_vpatch 390 begin
vtools_vpatch 391 KeccakEnd(To_Ctx, To_Hash);
vtools_vpatch 392 declare
vtools_vpatch 393 H_Hex: String := ToHex(To_Hash);
vtools_vpatch 394 H: Hash;
vtools_vpatch 395 begin
vtools_vpatch 396 case Op is
vtools_vpatch 397 when Op_Create | Op_Patch =>
vtools_vpatch 398 H := (Value => H_Hex,
vtools_vpatch 399 The_Type => Value);
vtools_vpatch 400 when Op_Delete =>
vtools_vpatch 401 H := (The_Type => Empty);
vtools_vpatch 402 end case;
vtools_vpatch 403 if A_Header.To_Hash /= H then
vtools_vpatch 404 raise State with "to hash doesn't match";
vtools_vpatch 405 end if;
vtools_vpatch 406 end;
vtools_vpatch 407 end Check_Output_File_Hash;
vtools_vpatch 408
vtools_vpatch 409 procedure Cleanup is
vtools_vpatch 410 begin
vtools_vpatch 411 if Is_Open(To_F) then
vtools_vpatch 412 Dirs.Delete_File(Name(To_F));
vtools_vpatch 413 end if;
vtools_vpatch 414 end Cleanup;
vtools_vpatch_new... 415
vtools_vpatch_new... 416 function Has_No_Newline_Directive return Boolean is
vtools_vpatch_new... 417 C: Character;
vtools_vpatch_new... 418 begin
vtools_vpatch_new... 419 Look_Ahead(C, EOL);
vtools_vpatch_new... 420 if C = '\' then
vtools_vpatch_new... 421 Looking_At(Newline_Directive);
vtools_vpatch_new... 422 Next_Line;
vtools_vpatch_new... 423 return True;
vtools_vpatch_new... 424 end if;
vtools_vpatch_new... 425 return False;
vtools_vpatch_new... 426 end;
vtools_vpatch_new... 427
vtools_vpatch 428 begin
vtools_vpatch 429 Op := Operation(A_Header);
vtools_vpatch 430
vtools_vpatch 431
vtools_vpatch 432 case Op is
vtools_vpatch 433 when Op_Create => Put_Line("creating " & To_F_Name);
vtools_vpatch 434 when Op_Delete => Put_Line("deleting " & To_F_Name);
vtools_vpatch 435 when Op_Patch => Put_Line("patching " & To_F_Name);
vtools_vpatch 436 end case;
vtools_vpatch 437
vtools_vpatch 438
vtools_vpatch 439 case Op is
vtools_vpatch 440 when Op_Delete | Op_Patch =>
vtools_vpatch 441 if not Dirs.Exists(To_F_Name) then
vtools_vpatch 442 raise State with "attempt to "
vtools_vpatch 443 & Patch_Op'Image(Op)
vtools_vpatch 444 & " non existing file " & To_F_Name;
vtools_vpatch 445 end if;
vtools_vpatch 446 when Op_Create =>
vtools_vpatch 447 if Dirs.Exists(To_F_Name) then
vtools_vpatch 448 raise State with "attempt to create a file, but file already exists";
vtools_vpatch 449 end if;
vtools_vpatch 450 end case;
vtools_vpatch 451
vtools_vpatch 452
vtools_vpatch 453 KeccakBegin(To_Ctx);
vtools_tempfile_s... 454 Create_Temp(To_F, Prefix => "vpatch-", Seed => To_F_Name);
vtools_vpatch 455 case Op is
vtools_vpatch 456 when Op_Create =>
vtools_vpatch 457 Has_Input_File := False;
vtools_vpatch 458 when Op_Delete | Op_Patch =>
vtools_vpatch 459 Has_Input_File := True;
vtools_vpatch 460 KeccakBegin(In_Ctx);
vtools_vpatch_new... 461 Open(In_F, CIO.In_File, To_F_Name);
vtools_vpatch 462 end case;
vtools_vpatch 463
vtools_vpatch 464 Hunk_Loop:
vtools_vpatch 465 loop
vtools_vpatch 466 Look_Ahead(C, EOL);
vtools_vpatch 467 exit Hunk_Loop when EOL;
vtools_vpatch 468 exit Hunk_Loop when C /= '@';
vtools_vpatch 469 Get(A_Hunk);
vtools_vpatch 470 From_Count := A_Hunk.From_File_Line_Numbers.Count;
vtools_vpatch 471 To_Count := A_Hunk.To_File_Line_Numbers.Count;
vtools_vpatch 472
vtools_vpatch 473
vtools_vpatch 474 if Line < A_Hunk.From_File_Line_Numbers.Start then
vtools_vpatch 475 if not Has_Input_File then
vtools_vpatch 476 raise State with "hunk requires before context lines, "
vtools_vpatch 477 & "but there's no input file";
vtools_vpatch 478 end if;
vtools_vpatch 479 while Line < A_Hunk.From_File_Line_Numbers.Start loop
vtools_vpatch 480 if End_Of_File(In_F) then
vtools_vpatch 481 raise State with "hunk requires before context lines, "
vtools_vpatch 482 & "but the file has ended";
vtools_vpatch 483 end if;
vtools_vpatch 484 declare
vtools_vpatch_new... 485 New_Line: Boolean;
vtools_vpatch_new... 486 In_Line: String := Get_Line(In_F, New_Line);
vtools_vpatch 487 begin
vtools_vpatch_new... 488 Hash_Line(In_Ctx, In_Line, New_Line);
vtools_vpatch_new... 489 Hash_Line(To_Ctx, In_Line, New_Line);
vtools_vpatch_new... 490 Put_Line(To_F, In_Line, New_Line);
vtools_vpatch 491 Line := Line + 1;
vtools_vpatch 492 end;
vtools_vpatch 493 end loop;
vtools_vpatch 494 end if;
vtools_vpatch 495 Hunk_Body_Loop:
vtools_vpatch 496 loop
vtools_vpatch 497 exit Hunk_Body_Loop when From_Count = 0 and To_Count = 0;
vtools_vpatch 498 Look_Ahead(C, EOL);
vtools_vpatch 499 if EOL then
vtools_vpatch 500 raise Parse with "blank line in hunk";
vtools_vpatch 501 end if;
vtools_vpatch 502 case C is
vtools_vpatch_new... 503
vtools_vpatch 504 when '+' =>
vtools_vpatch 505 Get(C);
vtools_vpatch 506 case Op is
vtools_vpatch 507 when Op_Create | Op_Patch => null;
vtools_vpatch 508 when Op_Delete => raise State with "hunk trying to add lines, "
vtools_vpatch 509 & "but the operation is deletion";
vtools_vpatch 510 end case;
vtools_vpatch 511 if To_Count = 0 then
vtools_vpatch 512 raise State with "hunk trying to add lines, "
vtools_vpatch 513 & "but the line count is not valid";
vtools_vpatch 514 end if;
vtools_vpatch_new... 515
vtools_vpatch 516 declare
vtools_vpatch_new... 517 New_Line: Boolean := True;
vtools_vpatch 518 Patch_Line: String := Get_Line;
vtools_vpatch 519 begin
vtools_vpatch_new... 520
vtools_vpatch_new... 521 if To_Count = 1 then
vtools_vpatch_new... 522 New_Line := not Has_No_Newline_Directive;
vtools_vpatch_new... 523 end if;
vtools_vpatch_new... 524 Put_Line(To_F, Patch_Line, New_Line);
vtools_vpatch_new... 525 Hash_Line(To_Ctx, Patch_Line, New_Line);
vtools_vpatch 526 end;
vtools_vpatch 527 To_Count := To_Count - 1;
vtools_vpatch_new... 528
vtools_vpatch 529 when '-' =>
vtools_vpatch 530 Get(C);
vtools_vpatch 531 case Op is
vtools_vpatch 532 when Op_Delete | Op_Patch => null;
vtools_vpatch 533 when Op_Create => raise State;
vtools_vpatch 534 end case;
vtools_vpatch 535 if not Has_Input_File then
vtools_vpatch 536 raise State with "hunk trying to remove lines, "
vtools_vpatch 537 & "but the input file doesn't exist";
vtools_vpatch 538 end if;
vtools_vpatch 539 if From_Count = 0 then
vtools_vpatch 540 raise State with "hunk trying to remove lines, "
vtools_vpatch 541 & "when the input file already ended";
vtools_vpatch 542 end if;
vtools_vpatch_new... 543
vtools_vpatch 544 declare
vtools_vpatch_new... 545 New_Line: Boolean;
vtools_vpatch_new... 546 In_Line: String := Get_Line(In_F, New_Line);
vtools_vpatch 547 Patch_Line: String := Get_Line;
vtools_vpatch 548 begin
vtools_vpatch_new... 549
vtools_vpatch_new... 550 if From_Count = 1 then
vtools_vpatch_new... 551 if Has_No_Newline_Directive and New_Line then
vtools_vpatch_new... 552 raise State with "input file has newline, "
vtools_vpatch_new... 553 & "while hunk claims it doesn't";
vtools_vpatch_new... 554 end if;
vtools_vpatch_new... 555 end if;
vtools_vpatch_new... 556
vtools_vpatch 557 if In_Line /= Patch_Line then
vtools_vpatch 558 raise State with "lines don't match";
vtools_vpatch 559 end if;
vtools_vpatch_new... 560 Hash_Line(In_Ctx, In_Line, New_Line);
vtools_vpatch 561 end;
vtools_vpatch 562 Line := Line + 1;
vtools_vpatch 563 From_Count := From_Count - 1;
vtools_vpatch_new... 564
vtools_vpatch 565 when ' ' =>
vtools_vpatch 566 Get(C);
vtools_vpatch 567 if not Has_Input_File then
vtools_vpatch 568 raise State with "hunk claims identical lines, "
vtools_vpatch 569 & "but the input file doesn't exist";
vtools_vpatch 570 end if;
vtools_vpatch 571 if End_Of_File(In_F) then
vtools_vpatch 572 raise State with "hunk claims identical lines, "
vtools_vpatch 573 & "but the input file has ended";
vtools_vpatch 574 end if;
vtools_vpatch 575 if From_Count = 0 then
vtools_vpatch 576 raise State with "hunk claims identical lines, "
vtools_vpatch 577 & "when input file already ended";
vtools_vpatch 578 end if;
vtools_vpatch_new... 579
vtools_vpatch 580 declare
vtools_vpatch_new... 581 New_Line: Boolean;
vtools_vpatch_new... 582 In_Line: String := Get_Line(In_F, New_Line);
vtools_vpatch 583 Patch_Line: String := Get_Line;
vtools_vpatch 584 begin
vtools_vpatch 585 if In_Line /= Patch_Line then
vtools_vpatch 586 raise State with "lines don't match";
vtools_vpatch 587 end if;
vtools_vpatch_new... 588 if From_Count = 1 then
vtools_vpatch_new... 589 if Has_No_Newline_Directive and New_Line then
vtools_vpatch_new... 590 raise State with "input file has newline, "
vtools_vpatch_new... 591 & "while hunk claims it doesn't";
vtools_vpatch_new... 592 end if;
vtools_vpatch_new... 593 end if;
vtools_vpatch_new... 594
vtools_vpatch_new... 595 Put_Line(To_F, Patch_Line, New_Line);
vtools_vpatch_new... 596 Hash_Line(In_Ctx, In_Line, New_Line);
vtools_vpatch_new... 597 Hash_Line(To_Ctx, In_Line, New_Line);
vtools_vpatch 598 end;
vtools_vpatch 599 Line := Line + 1;
vtools_vpatch 600 From_Count := From_Count - 1;
vtools_vpatch 601 To_Count := To_Count - 1;
vtools_vpatch_new... 602
vtools_vpatch_new... 603 when '\' =>
vtools_vpatch_new... 604 Looking_At(Newline_Directive);
vtools_vpatch_new... 605 raise State with "invalid line count in hunk";
vtools_vpatch_new... 606
vtools_vpatch 607 when others =>
vtools_vpatch 608 raise Parse with "unexpected character "
vtools_vpatch 609 & Character'Image(C)
vtools_vpatch 610 & " at beginning of line in hunk body";
vtools_vpatch 611 end case;
vtools_vpatch 612 end loop Hunk_Body_Loop;
vtools_vpatch 613 end loop Hunk_Loop;
vtools_vpatch 614
vtools_vpatch 615 Check_Input_File_Hash;
vtools_vpatch 616 Check_Output_File_Hash;
vtools_vpatch 617
vtools_vpatch 618 declare
vtools_vpatch 619 Tmp_Name: String := Name(To_F);
vtools_vpatch 620 begin
vtools_vpatch 621 Close(To_F);
vtools_vpatch 622 if Has_Input_File then
vtools_vpatch 623 Close(In_F);
vtools_vpatch 624 Dirs.Delete_File(To_F_Name);
vtools_vpatch 625 else
vtools_vpatch 626 if not Dirs.Exists(Path_Prefix(To_F_Name, 1)) then
vtools_vpatch 627 Dirs.Create_Path(Path_Prefix(To_F_Name, 1));
vtools_vpatch 628 end if;
vtools_vpatch 629 end if;
vtools_vpatch 630 case Op is
vtools_vpatch 631 when Op_Create | Op_Patch =>
vtools_vpatch 632 Dirs.Rename(Tmp_Name, To_F_Name);
vtools_vpatch 633 when Op_Delete =>
vtools_vpatch 634 Dirs.Delete_File(Tmp_Name);
vtools_vpatch 635 end case;
vtools_vpatch 636 end;
vtools_vpatch 637
vtools_vpatch 638 exception
vtools_vpatch 639 when E : State =>
vtools_vpatch 640
vtools_vpatch 641
vtools_vpatch 642 Cleanup;
vtools_vpatch 643 Check_Input_File_Hash;
vtools_vpatch 644 raise;
vtools_vpatch 645
vtools_vpatch 646 when E : others =>
vtools_vpatch 647 Cleanup;
vtools_vpatch 648 raise;
vtools_vpatch 649 end Process_Hunks_For_Header;
vtools_vpatch 650
vtools_vpatch 651 begin
vtools_vpatch 652 Read_Loop:
vtools_vpatch 653 loop
vtools_vpatch 654 declare
vtools_vpatch 655 S: String := Get_Line;
vtools_vpatch 656 begin
vtools_vpatch 657 if Starts_With(S, "diff ") then
vtools_vpatch 658 declare
vtools_vpatch 659 H: Header := Get_Header;
vtools_vpatch 660 begin
vtools_vpatch 661 Process_Hunks_For_Header(H);
vtools_vpatch 662 exit Read_Loop when End_Of_File;
vtools_vpatch 663 end;
vtools_vpatch 664 else
vtools_vpatch 665 Put_Line("Prelude: " & S);
vtools_vpatch 666 end if;
vtools_vpatch 667 end;
vtools_vpatch 668 end loop Read_Loop;
vtools_vpatch 669 end;