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