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