Natools

Check-in [65c085f000]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:static_hash_maps: add support for generation of hash function test
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 65c085f000abc897e1327fb8195fdcb2cd194367
User & Date: nat on 2014-05-27 20:22:06
Other Links: manifest | tags
Context
2014-05-28
17:28
static_hash_maps-s_expressions: add S-expression bindings for the test child function generation check-in: 0d8d6300c9 user: nat tags: trunk
2014-05-27
20:22
static_hash_maps: add support for generation of hash function test check-in: 65c085f000 user: nat tags: trunk
2014-05-26
20:25
static_hash_maps-s_expressions: add binding for extra declarations in generated spec check-in: fcc23fc780 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified src/natools-static_hash_maps.adb from [014e319f2a] to [dedb598c26].

︙
47
48
49
50
51
52
53
54


55
56






57
58
59
60
61
62
63

47
48
49
50
51
52
53

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70








-
+
+


+
+
+
+
+
+








   procedure Write_Map_With
     (Map : in Map_Description;
      File : in Ada.Text_IO.File_Type);
      --  Output fragments relevant for the given map

   procedure Write_Package
     (Pkg : in Map_Package;
      Spec_File, Body_File : in Ada.Text_IO.File_Type);
      Spec_File, Body_File : in Ada.Text_IO.File_Type;
      Test : in Boolean := False);
      --  Output a complete map package

   procedure Write_Test
     (Map : in Map_Description;
      Prefix : in String;
      File : in Ada.Text_IO.File_Type);
      --  Output test loop for the hash function


   ------------------------
   -- Package Generators --
   ------------------------

   function File_Name (Package_Name : in String) return String is
      Result : String := Ada.Characters.Handling.To_Lower (Package_Name);
︙
279
280
281
282
283
284
285
286


287
288
289


290
291
292
293
294
295
296

286
287
288
289
290
291
292

293
294
295
296

297
298
299
300
301
302
303
304
305








-
+
+


-
+
+








      Ada.Text_IO.Put_Line
        (File, "with " & To_String (Map.Hash_Package_Name) & ';');
   end Write_Map_With;


   procedure Write_Package
     (Pkg : in Map_Package;
      Spec_File, Body_File : in Ada.Text_IO.File_Type)
      Spec_File, Body_File : in Ada.Text_IO.File_Type;
      Test : in Boolean := False)
   is
      type Stage is
        (Hash_Package, Public_Spec, Private_Spec, Body_With, Body_Contents);
        (Hash_Package, Public_Spec, Private_Spec, Body_With, Body_Contents,
         Test_Body);

      Current_Stage : Stage;
      Map_Pos : Natural := 0;

      procedure Process (Element : in Map_Description);
      procedure Query (Cursor : in Map_Lists.Cursor);
︙
307
308
309
310
311
312
313



314
315
316
317
318
319
320

316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332








+
+
+








               Write_Map_Private_Spec (Element, Prefix, Spec_File);
            when Body_With =>
               Write_Map_With (Element, Body_File);
            when Body_Contents =>
               Ada.Text_IO.New_Line (Body_File);
               Write_Map_Body (Element, Prefix, Body_File);
               Ada.Text_IO.New_Line (Body_File);
            when Test_Body =>
               Write_Test (Element, Prefix, Body_File);
               Ada.Text_IO.New_Line (Body_File);
         end case;
         Map_Pos := Map_Pos + 1;
      end Process;

      procedure Query (Cursor : in Map_Lists.Cursor) is
      begin
         Map_Lists.Query_Element (Cursor, Process'Access);
︙
341
342
343
344
345
346
347





























348
349
350
351
352
353
354

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








         if Description'Length > 0 then
            Ada.Text_IO.Put_Line (Spec_File, "--  " & Description);
            Ada.Text_IO.Put_Line (Body_File, "--  " & Description);
         end if;
         Ada.Text_IO.New_Line (Spec_File);
         Ada.Text_IO.New_Line (Body_File);
      end Write_Headers;

      if Test then
         declare
            Name : constant String
              := To_String (Pkg.Name)
               & '.'
               & To_String (Pkg.Test_Child);
         begin
            Ada.Text_IO.Put_Line (Spec_File, "function " & Name);
            Ada.Text_IO.Put_Line (Spec_File, "  return Boolean;");

            Current_Stage := Body_With;
            Map_Pos := 0;
            Pkg.Maps.Iterate (Query'Access);

            Ada.Text_IO.Put_Line (Body_File, "function " & Name);
            Ada.Text_IO.Put_Line (Body_File, "  return Boolean is");
            Ada.Text_IO.Put_Line (Body_File, "begin");

            Current_Stage := Test_Body;
            Map_Pos := 0;
            Pkg.Maps.Iterate (Query'Access);

            Ada.Text_IO.Put_Line (Body_File, "   return True;");
            Ada.Text_IO.Put_Line (Body_File, "end " & Name & ';');
         end;

         return;
      end if;

      if Pkg.Priv then
         Ada.Text_IO.Put (Spec_File, "private ");
      end if;
      Ada.Text_IO.Put_Line
        (Spec_File, "package " & To_String (Pkg.Name) & " is");
      Ada.Text_IO.New_Line (Spec_File);
︙
386
387
388
389
390
391
392





















393
394
395
396
397
398
399

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









      Current_Stage := Body_Contents;
      Map_Pos := 0;
      Pkg.Maps.Iterate (Query'Access);

      Ada.Text_IO.Put_Line (Body_File, "end " & To_String (Pkg.Name) & ';');
   end Write_Package;


   procedure Write_Test
     (Map : in Map_Description;
      Prefix : in String;
      File : in Ada.Text_IO.File_Type)
   is
      Key_Array_Name : constant String := Prefix & "_Keys";
   begin
      Ada.Text_IO.Put_Line (File, "   for I in "
        & Key_Array_Name & "'Range loop");
      Ada.Text_IO.Put_Line (File, "      if "
        & To_String (Map.Hash_Package_Name) & ".Hash");
      Ada.Text_IO.Put_Line (File, "           ("
        & Key_Array_Name & " (I).all) /= I");
      Ada.Text_IO.Put_Line (File, "      then");
      Ada.Text_IO.Put_Line (File, "         return False;");
      Ada.Text_IO.Put_Line (File, "      end if;");
      Ada.Text_IO.Put_Line (File, "   end loop;");
   end Write_Test;




   -------------------------------
   -- Key-Name Pair Constructor --
   -------------------------------
︙
524
525
526
527
528
529
530








531
532
533
534
535
536
537

586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607








+
+
+
+
+
+
+
+








   procedure Set_Private_Child
     (Self : in out Map_Package;
      Private_Child : in Boolean := True) is
   begin
      Self.Priv := Private_Child;
   end Set_Private_Child;


   procedure Set_Test_Child
     (Self : in out Map_Package;
      Test_Child : in String) is
   begin
      Self.Test_Child := Hold (Test_Child);
   end Set_Test_Child;


   procedure Add_Map (Self : in out Map_Package; Map : in Map_Description) is
   begin
      if To_String (Self.Name) = "" then
         raise Constraint_Error
           with "Add_Map on non-opened static hash map package";
      end if;
︙
565
566
567
568
569
570
571





















572
573
574
575
576
577
578

635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








            Name => Ada.Directories.Compose ("", Base_Name, "adb"));

         Write_Package (Self, Spec_File, Body_File);

         Ada.Text_IO.Close (Spec_File);
         Ada.Text_IO.Close (Body_File);
      end;

      if To_String (Self.Test_Child) /= "" then
         declare
            Unit_Name : constant String
              := To_String (Self.Name) & '.' & To_String (Self.Test_Child);
            Base_Name : constant String := File_Name (Unit_Name);
            Spec_File, Body_File : Ada.Text_IO.File_Type;
         begin
            Ada.Text_IO.Create
              (File => Spec_File,
               Name => Ada.Directories.Compose ("", Base_Name, "ads"));
            Ada.Text_IO.Create
              (File => Body_File,
               Name => Ada.Directories.Compose ("", Base_Name, "adb"));

            Write_Package (Self, Spec_File, Body_File, Test => True);

            Ada.Text_IO.Close (Spec_File);
            Ada.Text_IO.Close (Body_File);
         end;
      end if;
   end Commit;



   -------------------------
   -- Combined Procedures --
   -------------------------
︙

Modified src/natools-static_hash_maps.ads from [6dcc3fadc7] to [dfc823b5d2].

︙
93
94
95
96
97
98
99




100
101
102
103
104
105
106

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110








+
+
+
+








     (Self : in out Map_Package;
      Declarations : in String);

   procedure Set_Private_Child
     (Self : in out Map_Package;
      Private_Child : in Boolean := True);

   procedure Set_Test_Child
     (Self : in out Map_Package;
      Test_Child : in String);

   procedure Add_Map (Self : in out Map_Package; Map : in Map_Description);
      --  Append a new Map to Self

   procedure Commit (Self : in out Map_Package);
      --  Write accumulated package description to disk

   procedure Close (Self : in out Map_Package);
︙
149
150
151
152
153
154
155

156
157
158
159
160

153
154
155
156
157
158
159
160
161
162
163
164
165








+






   package Map_Lists is new Ada.Containers.Doubly_Linked_Lists
     (Map_Description);

   type Map_Package is record
      Name : String_Holder;
      Description : String_Holder;
      Extra_Declarations : String_Holder;
      Test_Child : String_Holder;
      Priv : Boolean;
      Maps : Map_Lists.List;
   end record;

end Natools.Static_Hash_Maps;

This page was generated in about 0.005s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47