Testsuite: Add a test for disk partitions utility

testsuite/tests/disk_partitions/src/tc_read_partitions.adb

@@ -0,0 +1,67 @@
+with Ada.Text_IO;        use Ada.Text_IO;
+with Native.Filesystem;  use Native.Filesystem;
+with HAL.Filesystem;     use HAL.Filesystem;
+with Partitions;         use Partitions;
+with File_Block_Drivers; use File_Block_Drivers;
+with Ada.Command_Line;
+with Ada.Directories;
+
+procedure TC_Read_Partitions is
+
+   Program_Abspath : constant Pathname := Native.Filesystem.Join
+     (Ada.Directories.Current_Directory, Ada.Command_Line.Command_Name, False);
+   Test_Dir : constant Pathname := Ada.Directories.Containing_Directory
+     (Ada.Directories.Containing_Directory (Program_Abspath));
+
+   procedure List_Partitions (FS : in out FS_Driver'Class;
+                              Path_To_Disk_Image : Pathname);
+
+   ---------------------
+   -- List_Partitions --
+   ---------------------
+
+   procedure List_Partitions (FS : in out FS_Driver'Class;
+                              Path_To_Disk_Image : Pathname)
+   is
+      File : File_Handle_Ref;
+   begin
+      if FS.Open (Path_To_Disk_Image, Read_Only, File) /= Status_Ok then
+         Put_Line ("Cannot open disk image '" & Path_To_Disk_Image & "'");
+         return;
+      end if;
+
+      declare
+         Disk    : aliased File_Block_Driver (File);
+         Nbr     : Natural;
+         P_Entry : Partition_Entry;
+      begin
+         Nbr := Number_Of_Partitions (Disk'Unchecked_Access);
+         Put_Line ("Disk '" & Path_To_Disk_Image & "' has " &
+                     Nbr'Img & " parition(s)");
+
+         for Id in 1 .. Nbr loop
+            if Get_Partition_Entry (Disk'Unchecked_Access,
+                                    Id,
+                                    P_Entry) /= Status_Ok
+            then
+               Put_Line ("Cannot read partition :" & Id'Img);
+            else
+               Put_Line (" - partition :" & Id'Img);
+               Put_Line ("      Status:" & P_Entry.Status'Img);
+               Put_Line ("      Kind: " & P_Entry.Kind'Img);
+               Put_Line ("      LBA: " & P_Entry.First_Sector_LBA'Img);
+               Put_Line ("      Number of sectors: " & P_Entry.Number_Of_Sectors'Img);
+            end if;
+         end loop;
+      end;
+   end List_Partitions;
+
+   FS   : aliased Native_FS_Driver;
+begin
+   if FS.Create (Root_Dir => Test_Dir) /= Status_Ok then
+      raise Program_Error with "Cannot create native file system at '" &
+        Test_Dir & "'";
+   end if;
+
+   List_Partitions (FS, "disk_8_partitions.img");
+end TC_Read_Partitions;

testsuite/tests/disk_partitions/tc.gpr

@@ -0,0 +1,16 @@
+with "../../../boards/native";
+with "../../../boards/native/config";
+
+project TC is
+
+   for Languages use ("Ada");
+   for Source_Dirs use ("src");
+   for Main use
+       ("tc_read_partitions.adb");
+   for Object_Dir use "obj";
+   for Exec_Dir use "bin";
+
+   package Compiler renames Config.Compiler;
+   package Builder renames Config.Builder;
+
+end TC;

testsuite/tests/disk_partitions/tc_read_partitions.out

@@ -0,0 +1,41 @@
+Disk 'disk_8_partitions.img' has  8 parition(s)
+ - partition : 1
+      Status: 128
+      Kind:  1
+      LBA:  1
+      Number of sectors:  2
+ - partition : 2
+      Status: 0
+      Kind:  4
+      LBA:  3
+      Number of sectors:  2
+ - partition : 3
+      Status: 0
+      Kind:  7
+      LBA:  5
+      Number of sectors:  2
+ - partition : 4
+      Status: 0
+      Kind:  5
+      LBA:  7
+      Number of sectors:  13
+ - partition : 5
+      Status: 0
+      Kind:  6
+      LBA:  1
+      Number of sectors:  2
+ - partition : 6
+      Status: 0
+      Kind:  11
+      LBA:  1
+      Number of sectors:  2
+ - partition : 7
+      Status: 0
+      Kind:  12
+      LBA:  1
+      Number of sectors:  2
+ - partition : 8
+      Status: 0
+      Kind:  131
+      LBA:  1
+      Number of sectors:  3