1----------------------------------------------------------------------- 2-- files.tests -- Unit tests for files 3-- Copyright (C) 2009, 2010, 2011, 2012, 2013 Stephane Carrez 4-- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5-- 6-- Licensed under the Apache License, Version 2.0 (the "License"); 7-- you may not use this file except in compliance with the License. 8-- You may obtain a copy of the License at 9-- 10-- http://www.apache.org/licenses/LICENSE-2.0 11-- 12-- Unless required by applicable law or agreed to in writing, software 13-- distributed under the License is distributed on an "AS IS" BASIS, 14-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15-- See the License for the specific language governing permissions and 16-- limitations under the License. 17----------------------------------------------------------------------- 18 19with Ada.Directories; 20with Util.Test_Caller; 21package body Util.Files.Tests is 22 23 use Util.Tests; 24 25 package Caller is new Util.Test_Caller (Test, "Files"); 26 27 procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is 28 begin 29 Caller.Add_Test (Suite, "Test Util.Files.Read_File", 30 Test_Read_File'Access); 31 Caller.Add_Test (Suite, "Test Util.Files.Read_File (missing)", 32 Test_Read_File_Missing'Access); 33 Caller.Add_Test (Suite, "Test Util.Files.Read_File (truncate)", 34 Test_Read_File'Access); 35 Caller.Add_Test (Suite, "Test Util.Files.Write_File", 36 Test_Write_File'Access); 37 Caller.Add_Test (Suite, "Test Util.Files.Iterate_Path", 38 Test_Iterate_Path'Access); 39 Caller.Add_Test (Suite, "Test Util.Files.Find_File_Path", 40 Test_Find_File_Path'Access); 41 Caller.Add_Test (Suite, "Test Util.Files.Compose_Path", 42 Test_Compose_Path'Access); 43 Caller.Add_Test (Suite, "Test Util.Files.Get_Relative_Path", 44 Test_Get_Relative_Path'Access); 45 end Add_Tests; 46 47 -- ------------------------------ 48 -- Test reading a file into a string 49 -- Reads this ada source file and checks we have read it correctly 50 -- ------------------------------ 51 procedure Test_Read_File (T : in out Test) is 52 Result : Unbounded_String; 53 begin 54 Read_File (Path => "regtests/util-files-tests.adb", Into => Result); 55 T.Assert (Index (Result, "Util.Files.Tests") > 0, 56 "Content returned by Read_File is not correct"); 57 T.Assert (Index (Result, "end Util.Files.Tests;") > 0, 58 "Content returned by Read_File is not correct"); 59 end Test_Read_File; 60 61 procedure Test_Read_File_Missing (T : in out Test) is 62 Result : Unbounded_String; 63 64 pragma Unreferenced (Result); 65 begin 66 Read_File (Path => "regtests/files-test--util.adb", Into => Result); 67 T.Assert (False, "No exception raised"); 68 exception 69 when others => 70 null; 71 end Test_Read_File_Missing; 72 73 procedure Test_Read_File_Truncate (T : in out Test) is 74 Result : Unbounded_String; 75 begin 76 Read_File (Path => "regtests/util-files-tests.adb", Into => Result, 77 Max_Size => 50); 78 Assert_Equals (T, Length (Result), 50, 79 "Read_File did not truncate correctly"); 80 T.Assert (Index (Result, "Apache License") > 0, 81 "Content returned by Read_File is not correct"); 82 end Test_Read_File_Truncate; 83 84 -- ------------------------------ 85 -- Check writing a file 86 -- ------------------------------ 87 procedure Test_Write_File (T : in out Test) is 88 Path : constant String := Util.Tests.Get_Test_Path ("test-write.txt"); 89 Content : constant String := "Testing Util.Files.Write_File" & ASCII.LF; 90 Result : Unbounded_String; 91 begin 92 Write_File (Path => Path, Content => Content); 93 Read_File (Path => Path, Into => Result); 94 Assert_Equals (T, To_String (Result), Content, 95 "Invalid content written or read"); 96 end Test_Write_File; 97 98 -- ------------------------------ 99 -- Check Find_File_Path 100 -- ------------------------------ 101 procedure Test_Find_File_Path (T : in out Test) is 102 Dir : constant String := Util.Tests.Get_Path ("regtests"); 103 Paths : constant String := ".;" & Dir; 104 begin 105 declare 106 P : constant String := Util.Files.Find_File_Path ("test.properties", Paths); 107 begin 108 Assert_Equals (T, Dir & "/test.properties", P, 109 "Invalid path returned"); 110 end; 111 Assert_Equals (T, "blablabla.properties", 112 Util.Files.Find_File_Path ("blablabla.properties", Paths)); 113 end Test_Find_File_Path; 114 115 -- ------------------------------ 116 -- Check Iterate_Path 117 -- ------------------------------ 118 procedure Test_Iterate_Path (T : in out Test) is 119 procedure Check_Path (Dir : in String; 120 Done : out Boolean); 121 122 Last : Unbounded_String; 123 124 procedure Check_Path (Dir : in String; 125 Done : out Boolean) is 126 begin 127 if Dir = "a" or Dir = "bc" or Dir = "de" then 128 Done := False; 129 else 130 Done := True; 131 end if; 132 Last := To_Unbounded_String (Dir); 133 end Check_Path; 134 135 begin 136 Iterate_Path ("a;bc;de;f", Check_Path'Access); 137 Assert_Equals (T, "f", Last, "Invalid last path"); 138 139 Iterate_Path ("de;bc;de;b", Check_Path'Access); 140 Assert_Equals (T, "b", Last, "Invalid last path"); 141 142 Iterate_Path ("de;bc;de;a", Check_Path'Access, Ada.Strings.Backward); 143 Assert_Equals (T, "de", Last, "Invalid last path"); 144 145 end Test_Iterate_Path; 146 147 -- ------------------------------ 148 -- Test the Compose_Path operation 149 -- ------------------------------ 150 procedure Test_Compose_Path (T : in out Test) is 151 begin 152 Assert_Equals (T, "src/os-none", 153 Compose_Path ("src;regtests", "os-none"), 154 "Invalid path composition"); 155 Assert_Equals (T, "regtests/bundles", 156 Compose_Path ("src;regtests", "bundles"), 157 "Invalid path composition"); 158 if Ada.Directories.Exists ("/usr/bin") then 159 Assert_Equals (T, "/usr/bin;/usr/local/bin;/usr/bin", 160 Compose_Path ("/usr;/usr/local;/usr", "bin"), 161 "Invalid path composition"); 162 end if; 163 end Test_Compose_Path; 164 165 -- ------------------------------ 166 -- Test the Get_Relative_Path operation. 167 -- ------------------------------ 168 procedure Test_Get_Relative_Path (T : in out Test) is 169 begin 170 Assert_Equals (T, "../util", 171 Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util"), 172 "Invalid relative path"); 173 Assert_Equals (T, "../util", 174 Get_Relative_Path ("/home/john/src/asf/", "/home/john/src/util"), 175 "Invalid relative path"); 176 Assert_Equals (T, "../util/b", 177 Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util/b"), 178 "Invalid relative path"); 179 Assert_Equals (T, "../as", 180 Get_Relative_Path ("/home/john/src/asf", "/home/john/src/as"), 181 "Invalid relative path"); 182 Assert_Equals (T, "../../", 183 Get_Relative_Path ("/home/john/src/asf", "/home/john"), 184 "Invalid relative path"); 185 Assert_Equals (T, "/usr/share/admin", 186 Get_Relative_Path ("/home/john/src/asf", "/usr/share/admin"), 187 "Invalid absolute path"); 188 Assert_Equals (T, "/home/john", 189 Get_Relative_Path ("home/john/src/asf", "/home/john"), 190 "Invalid relative path"); 191 Assert_Equals (T, "e", 192 Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/e"), 193 "Invalid relative path"); 194 Assert_Equals (T, ".", 195 Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/"), 196 "Invalid relative path"); 197 end Test_Get_Relative_Path; 198 199end Util.Files.Tests; 200