Removed 25 and 80 character column limits Opt_Parse V214-030

Fixed warnings about Ada.Unchecked_Conversion not being referenced.

Added tests for new --help whitespace behavior.

Change-Id: I384b7c0f6e8f5d6a58b3d245c9d20e08dd88e962

Author: rowan-walshe

src/gnatcoll-opt_parse.adb

@@ -60,9 +60,6 @@ package body GNATCOLL.Opt_Parse is
    end record;
    --  Simple abstract type to help with formatting of the outputted help text.
 
-   subtype Col_Type is Integer range -2 .. Integer'Last;
-   --  Type for a column in the text wrapper.
-
    Current_Col : constant Col_Type := -1;
    --  Constant to represent a magic value that represents the current column
 
@@ -1213,7 +1210,9 @@ package body GNATCOLL.Opt_Parse is
    ----------------------------
 
    function Create_Argument_Parser
-     (Help : String; Command_Name : String := "") return Argument_Parser
+     (Help              : String;
+      Command_Name      : String := "";
+      Help_Column_Limit : Col_Type := 80) return Argument_Parser
    is
       XCommand_Name : constant XString :=
         +(if Command_Name = ""
@@ -1237,6 +1236,7 @@ package body GNATCOLL.Opt_Parse is
          Parser.Data.Opts_Parsers.Append (Parser.Data.Help_Flag);
          Parser.Data.All_Parsers.Append (Parser.Data.Help_Flag);
          Parser.Data.Help_Flag.Position := Parser.Data.All_Parsers.Last_Index;
+         Parser.Data.Help_Column_Limit := Help_Column_Limit;
       end return;
    end Create_Argument_Parser;
 
@@ -1245,8 +1245,45 @@ package body GNATCOLL.Opt_Parse is
    ----------
 
    function Help (Self : Argument_Parser) return String is
-      Ret : Text_Wrapper;
+      Ret         : Text_Wrapper;
+      Length      : Col_Type;
+      Pos_Arg_Col : Col_Type := 0;
+      Opt_Arg_Col : Col_Type := 0;
    begin
+
+      Ret.Wrap_Col := Self.Data.Help_Column_Limit;
+
+      --  Set column for help text relative to the max length of Help_Name
+      for Parser of Self.Data.Positional_Args_Parsers loop
+         Length := Parser.Help_Name'Length;
+         if Length > Pos_Arg_Col then
+            Pos_Arg_Col := Length;
+         end if;
+      end loop;
+
+      for Parser of Self.Data.Opts_Parsers loop
+         Length := Parser.Help_Name'Length;
+         if Length > Opt_Arg_Col then
+            Opt_Arg_Col := Length;
+         end if;
+      end loop;
+
+      --  Plus 5, 2 for padding, 3 because Help_Name is Starts at Col 3
+      Pos_Arg_Col := Pos_Arg_Col + 5;
+      Opt_Arg_Col := Opt_Arg_Col + 5;
+
+      --  Check that Pos_Arg_Col doesn't cause the starting position of help
+      --  text to exceed the limit at which all text is wrapped. If it does
+      --  exceed this limit, then choose some default value (25) for help text
+      --  to begin at.
+      if Pos_Arg_Col >= Ret.Wrap_Col then
+         Pos_Arg_Col := 25;
+      end if;
+
+      if Opt_Arg_Col >= Ret.Wrap_Col then
+         Opt_Arg_Col := 25;
+      end if;
+
       --  Usage
 
       Ret.Append_Text ("usage: " & (+Self.Data.Command_Name));
@@ -1271,7 +1308,7 @@ package body GNATCOLL.Opt_Parse is
 
       for Parser of Self.Data.Positional_Args_Parsers loop
          Ret.Append_Text (Parser.Help_Name);
-         Ret.Set_Column (25);
+         Ret.Set_Column (Pos_Arg_Col);
 
          Ret.Append_Line (+Parser.Help, Col_After => 3);
       end loop;
@@ -1281,7 +1318,7 @@ package body GNATCOLL.Opt_Parse is
 
       for Parser of Self.Data.Opts_Parsers loop
          Ret.Append_Text (Parser.Help_Name);
-         Ret.Set_Column (25);
+         Ret.Set_Column (Opt_Arg_Col);
 
          Ret.Append_Line (+Parser.Help, Col_After => 3);
       end loop;

src/gnatcoll-opt_parse.ads

@@ -122,11 +122,14 @@ package GNATCOLL.Opt_Parse is
    --  you will be able to access argument values directly via the generic Get
    --  functions.
 
+   subtype Col_Type is Integer range -2 .. Integer'Last;
+   --  Type for a column in the text wrapper.
+
    No_Arguments : constant XString_Array (1 .. 0) := (others => <>);
-   --  Constant for the absence of command line arguments
+   --  Constant for the absence of command line arguments.
 
    No_Parsed_Arguments : constant Parsed_Arguments;
-   --  Constant for a null Parsed_Arguments value
+   --  Constant for a null Parsed_Arguments value.
 
    function Parse
      (Self      : in out Argument_Parser;
@@ -140,7 +143,9 @@ package GNATCOLL.Opt_Parse is
    --  Parse command line arguments for Self. Return arguments explicitly.
 
    function Create_Argument_Parser
-     (Help : String; Command_Name : String := "") return Argument_Parser;
+     (Help              : String;
+      Command_Name      : String := "";
+      Help_Column_Limit : Col_Type := 80) return Argument_Parser;
    --  Create an argument parser with the provided help string.
 
    function Help (Self : Argument_Parser) return String;
@@ -511,6 +516,7 @@ private
 
       Mutex : aliased Mutual_Exclusion;
       --  Mutex used to make Get_Result thread safe
+      Help_Column_Limit                     : Col_Type := 80;
    end record;
 
    type Parser_Result is abstract tagged record

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/mylib.gpr

@@ -0,0 +1,10 @@
+with "gnatcoll";
+
+library project Mylib is
+   for Source_Dirs use ("src-mylib");
+   for Object_Dir use "obj-mylib";
+   for Library_Dir use "lib-mylib";
+   for Library_Name use "mylib";
+
+   for Interfaces use ("mylib.ads", "mylib.adb");
+end Mylib;

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/src-mylib/mylib.adb

@@ -0,0 +1,9 @@
+package body Mylib is
+
+   procedure Run is
+      Dummy : constant Boolean := Args.Parser.Parse;
+   begin
+      null;
+   end Run;
+
+end Mylib;

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/src-mylib/mylib.ads

@@ -0,0 +1,27 @@
+with Ada.Containers.Vectors;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;
+
+package Mylib is
+
+   package Args is
+      Parser : Argument_Parser :=
+         Create_Argument_Parser (Help => "Test program",
+                                 Help_Column_Limit => 120);
+
+      package Charset_Option1 is new Parse_Option
+         (Parser      => Parser,
+         Short       => "-C",
+         Long        => "--char",
+         Arg_Type    => Unbounded_String,
+         Help        =>
+            "A long help message that exceeds the default 80"
+             & " character limit but does not exceed a 120 limit",
+         Default_Val => To_Unbounded_String ("latin-1"));
+
+   end Args;
+
+   procedure Run;
+
+end Mylib;

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/test.adb

@@ -0,0 +1,6 @@
+with Mylib;
+
+procedure Test is
+begin
+   Mylib.Run;
+end Test;

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/test.gpr

@@ -0,0 +1,7 @@
+with "mylib";
+
+project Test is
+   for Object_Dir use "obj-test";
+   for Exec_Dir use ".";
+   for Main use ("test.adb");
+end Test;

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/test.out

@@ -0,0 +1 @@
+Help text doesn't wrap at 80 characters when permitted, as expected

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/test.sh

@@ -0,0 +1,10 @@
+STDOUT=stdout.log
+
+./test --help > $STDOUT
+
+# Check that the help message is structured as expected
+if grep -q -P ".{81,}" $STDOUT; then
+    # Confirm that when permitted, the help text can exceed the previous 80
+    # character limit without wrapping.
+    echo "Help text doesn't wrap at 80 characters when permitted, as expected"
+fi

testsuite/tests/opt_parse/help_whitespace/help_120_wrap/test.yaml

@@ -0,0 +1,2 @@
+driver: build_run_diff
+description: Check that a long help message can exceed the default 80 character limit when permitted