Fix incorrect free calls in FTP/HTTP responses

The memory is inside the object and has to be freed using destroy instead. New FTP test/example (to be used in RosettaCode.org)
mgrojo · May 31, 2024 · 2462019 · 2462019
1 parent 52ca4a2
commit 2462019
Show file tree

Hide file tree

Showing 10 changed files with 91 additions and 19 deletions.
diff --git a/doc/docs/sf__network__ftp___listingresponse___spec.js b/doc/docs/sf__network__ftp___listingresponse___spec.js
@@ -652,7 +652,7 @@ GNATdoc.Documentation = {
                   "children": [
                     {
                       "kind": "span",
-                      "text": "Index of the name to get (in range [0 .. getCount])\n"
+                      "text": "Index of the name to get (in range [0 .. getCount-1])\n"
                     }
                   ]
                 }

diff --git a/doc/index.js b/doc/index.js
@@ -1,4 +1,4 @@
 GNATdoc.Index = {
   "project": "ASFML",
-  "timestamp": "2024-05-25 18:48:10"
+  "timestamp": "2024-05-31 22:38:31"
 };
diff --git a/doc/srcs/sf-network-ftp.ads.js b/doc/srcs/sf-network-ftp.ads.js
@@ -5719,7 +5719,7 @@ GNATdoc.SourceFile = {
         {
           "kind": "span",
           "cssClass": "comment",
-          "text": "--/ @param index              Index of the name to get (in range [0 .. getCount])"
+          "text": "--/ @param index              Index of the name to get (in range [0 .. getCount-1])"
         }
       ]
     },

diff --git a/include/sf-network-ftp.adb b/include/sf-network-ftp.adb
@@ -43,10 +43,9 @@ package body Sf.Network.Ftp is
       function GetMessage (FtpListingResponse : sfFtpListingResponse_Ptr) return String is
          function Internal (FtpListingResponse : sfFtpListingResponse_Ptr) return chars_ptr;
          pragma Import (C, Internal, "sfFtpListingResponse_getMessage");
-         Temp : chars_ptr := Internal (FtpListingResponse);
+         Temp : constant chars_ptr := Internal (FtpListingResponse);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetMessage;
 
@@ -62,10 +61,9 @@ package body Sf.Network.Ftp is
       function GetName (FtpListingResponse : sfFtpListingResponse_Ptr; Index : sfSize_t) return String is
          function Internal (FtpListingResponse : sfFtpListingResponse_Ptr; Index : sfSize_t) return chars_ptr;
          pragma Import (C, Internal, "sfFtpListingResponse_getName");
-         Temp : chars_ptr := Internal (FtpListingResponse, Index);
+         Temp : constant chars_ptr := Internal (FtpListingResponse, Index);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetName;
 
@@ -84,10 +82,9 @@ package body Sf.Network.Ftp is
       function GetMessage (FtpDirectoryResponse : sfFtpDirectoryResponse_Ptr) return String is
          function Internal (FtpDirectoryResponse : sfFtpDirectoryResponse_Ptr) return chars_ptr;
          pragma Import (C, Internal, "sfFtpDirectoryResponse_getMessage");
-         Temp : chars_ptr := Internal (FtpDirectoryResponse);
+         Temp : constant chars_ptr := Internal (FtpDirectoryResponse);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetMessage;
 
@@ -102,10 +99,9 @@ package body Sf.Network.Ftp is
       function GetDirectory (FtpDirectoryResponse : sfFtpDirectoryResponse_Ptr) return String is
          function Internal (FtpDirectoryResponse : sfFtpDirectoryResponse_Ptr) return chars_ptr;
          pragma Import (C, Internal, "sfFtpDirectoryResponse_getDirectory");
-         Temp : chars_ptr := Internal (FtpDirectoryResponse);
+         Temp : constant chars_ptr := Internal (FtpDirectoryResponse);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetDirectory;
 
@@ -124,10 +120,9 @@ package body Sf.Network.Ftp is
       function GetMessage (FtpResponse : sfFtpResponse_Ptr) return String is
          function Internal (FtpResponse : sfFtpResponse_Ptr) return chars_ptr;
          pragma Import (C, Internal, "sfFtpResponse_getMessage");
-         Temp : chars_ptr := Internal (FtpResponse);
+         Temp : constant chars_ptr := Internal (FtpResponse);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetMessage;
 

diff --git a/include/sf-network-ftp.ads b/include/sf-network-ftp.ads
@@ -156,7 +156,7 @@ package Sf.Network.Ftp is
       --/ @brief Return a directory/file name contained in a FTP listing response
       --/
       --/ @param ftpListingResponse Ftp listing response
-      --/ @param index              Index of the name to get (in range [0 .. getCount])
+      --/ @param index              Index of the name to get (in range [0 .. getCount-1])
       --/
       --/ @return The requested name
       --/

diff --git a/include/sf-network-http.adb b/include/sf-network-http.adb
@@ -103,11 +103,10 @@ package body Sf.Network.Http is
          function Internal (HttpResponse : sfHttpResponse_Ptr; Field : chars_ptr) return chars_ptr;
          pragma Import (C, Internal, "sfHttpResponse_getField");
          Temp1 : chars_ptr := New_String (Field);
-         Temp2 : chars_ptr := Internal (HttpResponse, Temp1);
+         Temp2 : constant chars_ptr := Internal (HttpResponse, Temp1);
          R     : constant String := Value (Temp2);
       begin
          Free (Temp1);
-         Free (Temp2);
          return R;
       end GetField;
 
@@ -126,10 +125,9 @@ package body Sf.Network.Http is
       function GetBody (HttpResponse : sfHttpResponse_Ptr) return String is
          function Internal (HttpResponse : sfHttpResponse_Ptr) return chars_ptr;
          pragma Import (C, Internal, "sfHttpResponse_getBody");
-         Temp : chars_ptr := Internal (HttpResponse);
+         Temp : constant chars_ptr := Internal (HttpResponse);
          R    : constant String := Value (Temp);
       begin
-         Free (Temp);
          return R;
       end GetBody;
 

diff --git a/tests/Makefile b/tests/Makefile
@@ -1,4 +1,4 @@
-SUBDIRS:=clock  example graphics  music  opengl pong  renderwindow  thread  window vulkan
+SUBDIRS:=clock example graphics  music  opengl pong  renderwindow  thread  window vulkan ftp
 
 .PHONY: all clean run
 

diff --git a/tests/ftp/Makefile b/tests/ftp/Makefile
@@ -0,0 +1,10 @@
+.PHONY: all clean run
+
+all:
+	gprbuild
+
+clean:
+	gprclean
+
+run:
+	./main
diff --git a/tests/ftp/main.adb b/tests/ftp/main.adb
@@ -0,0 +1,57 @@
+with Ada.Text_IO;
+with Sf.Network.Ftp;
+with Sf.Network.IpAddress;
+with Sf.System.Time;
+
+procedure Main is
+   use Sf; use Sf.Network; use Sf.Network.Ftp;
+   FTP_Error : exception;
+
+   FTP_Object : constant sfFtp_Ptr := create;
+
+   procedure Check_Response (FTP_Response : sfFtpResponse_Ptr) is
+      Message : constant String := Response.getMessage (FTP_Response);
+   begin
+      Response.destroy (FTP_Response);
+      if not Response.isOk (FTP_Response) then
+         raise FTP_Error with Message;
+      else
+         Ada.Text_IO.Put_Line ("OK: " & Message);
+      end if;
+   end Check_Response;
+
+   procedure List_Directory (Path : String) is
+      Response : sfFtpListingResponse_Ptr;
+   begin
+      Response := getDirectoryListing (FTP_Object, Path);
+      if ListingResponse.isOk (Response) then
+         for Index in 0 .. ListingResponse.getCount (Response) - 1 loop
+            Ada.Text_IO.Put_Line (ListingResponse.getName (Response, Index));
+         end loop;
+      else
+         Ada.Text_IO.Put_Line (ListingResponse.getMessage (Response));
+      end if;
+      ListingResponse.destroy (Response);
+   end List_Directory;
+
+begin
+
+   Check_Response
+     (connect (FTP_Object,
+               server => IpAddress.fromString ("speedtest.tele2.net"),
+               port => 21,
+               timeout => Sf.System.Time.sfSeconds (30.0)));
+
+   Check_Response (loginAnonymous (FTP_Object));
+
+   Check_Response (changeDirectory (FTP_Object, "/upload"));
+   Check_Response (changeDirectory (FTP_Object, "/"));
+
+   List_Directory (".");
+
+   Check_Response (download (FTP_Object,
+                             remoteFile => "100KB.zip",
+                             localPath => ".",
+                             mode => sfFtpBinary));
+   destroy (FTP_Object);
+end Main;
diff --git a/tests/ftp/main.gpr b/tests/ftp/main.gpr
@@ -0,0 +1,12 @@
+with "../../asfml.gpr";
+
+project Main is
+
+   for Create_Missing_Dirs use "True";
+
+   for Source_Dirs use (".");
+   for Object_Dir use "obj";
+   for Main use ("main.adb");
+   for Exec_Dir use ".";
+
+end Main;