grt: add grt-strings, use case insensitive compare for vpi_handle_by_name

Fixes potentialventures/cocotb#460

7 files changed, 105 insertions, 70 deletions

diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index 3c4acb215..81fa962f0 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -23,6 +23,7 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with Interfaces; use Interfaces;
+with Grt.Strings; use Grt.Strings;
 with Grt.Errors; use Grt.Errors;
 with Grt.Astdio;
 with Grt.Hooks;
@@ -210,15 +211,6 @@ package body Grt.Options is
       end loop;
    end Extract_Integer;
 
-   function To_Lower (C : Character) return Character is
-   begin
-      if C in 'A' .. 'Z' then
-         return Character'Val (Character'Pos (C) + 32);
-      else
-         return C;
-      end if;
-   end To_Lower;
-
    procedure Decode_Option
      (Option : String; Status : out Decode_Option_Status)
    is
diff --git a/src/grt/grt-sdf.adb b/src/grt/grt-sdf.adb
index 75dfefe4d..1cb04e5e1 100644
--- a/src/grt/grt-sdf.adb
+++ b/src/grt/grt-sdf.adb
@@ -1,5 +1,5 @@
 --  GHDL Run Time (GRT) - SDF parser.
---  Copyright (C) 2002 - 2014 Tristan Gingold
+--  Copyright (C) 2002 - 2016 Tristan Gingold
 --
 --  GHDL is free software; you can redistribute it and/or modify it under
 --  the terms of the GNU General Public License as published by the Free
@@ -22,17 +22,16 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
-with System.Storage_Elements; --  Work around GNAT bug.
-pragma Unreferenced (System.Storage_Elements);
+
 with Grt.Stdio; use Grt.Stdio;
 with Grt.C; use Grt.C;
+with Grt.Strings; use Grt.Strings;
 with Grt.Errors; use Grt.Errors;
-with Ada.Characters.Latin_1;
 with Ada.Unchecked_Deallocation;
 with Grt.Vital_Annotate;
 
 package body Grt.Sdf is
-   EOT : constant Character := Character'Val (4);
+   use ASCII;
 
    type Sdf_Token_Type is
      (
@@ -71,10 +70,10 @@ package body Grt.Sdf is
    function Open_Sdf (Filename : String) return Boolean
    is
       N_Filename : String (1 .. Filename'Length + 1);
-      Mode : constant String := "rt" & NUL;
+      Mode : constant String := "rt" & ASCII.NUL;
    begin
       N_Filename (1 .. Filename'Length) := Filename;
-      N_Filename (N_Filename'Last) := NUL;
+      N_Filename (N_Filename'Last) := ASCII.NUL;
       Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
       if Sdf_Stream = NULL_Stream then
          Error_C ("cannot open SDF file '");
@@ -212,7 +211,7 @@ package body Grt.Sdf is
                --  Continue to read.
                Read_Append;
                Pos := Pos - 1;
-            when NUL .. Character'Val (3)
+            when ASCII.NUL .. Character'Val (3)
               | Character'Val (5) .. Character'Val (31)
               | Character'Val (127) .. Character'Val (255) =>
                Error_Bad_Character;
@@ -295,9 +294,7 @@ package body Grt.Sdf is
       Pos := 1;
    end Refill_Buf;
 
-   procedure Skip_Spaces
-   is
-      use Ada.Characters.Latin_1;
+   procedure Skip_Spaces is
    begin
       --  Fast blanks skipping.
       while Buf (Pos) = ' ' loop
@@ -359,9 +356,7 @@ package body Grt.Sdf is
       end loop;
    end Skip_Spaces;
 
-   function Get_Token return Sdf_Token_Type
-   is
-      use Ada.Characters.Latin_1;
+   function Get_Token return Sdf_Token_Type is
    begin
       Skip_Spaces;
 
@@ -410,9 +405,7 @@ package body Grt.Sdf is
       end case;
    end Get_Token;
 
-   function Is_White_Space (C : Character) return Boolean
-   is
-      use Ada.Characters.Latin_1;
+   function Is_White_Space (C : Character) return Boolean is
    begin
       case C is
          when ' '
@@ -425,9 +418,7 @@ package body Grt.Sdf is
       end case;
    end Is_White_Space;
 
-   function Get_Edge_Token return Edge_Type
-   is
-      use Ada.Characters.Latin_1;
+   function Get_Edge_Token return Edge_Type is
    begin
       Skip_Spaces;
 
@@ -664,16 +655,6 @@ package body Grt.Sdf is
       return True;
    end Expect_Rexpr_Cp_Op_Ident;
 
-   function To_Lower (C : Character) return Character is
-   begin
-      if C >= 'A' and C <= 'Z' then
-         return Character'Val (Character'Pos (C)
-                               - Character'Pos ('A') + Character'Pos ('a'));
-      else
-         return C;
-      end if;
-   end To_Lower;
-
    function Parse_Port_Path1 (Tok : Sdf_Token_Type) return Boolean
    is
       Port_Spec : Port_Spec_Type
diff --git a/src/grt/grt-strings.adb b/src/grt/grt-strings.adb
new file mode 100644
index 000000000..38e2c6b4e
--- /dev/null
+++ b/src/grt/grt-strings.adb
@@ -0,0 +1,41 @@
+--  GHDL Run Time (GRT) - Misc subprograms for characters and strings
+--  Copyright (C) 2016 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package body Grt.Strings is
+   function Is_Whitespace (C : in Character) return Boolean is
+      use ASCII;
+   begin
+      return C = ' ' or C = NBSP or C = HT;
+   end Is_Whitespace;
+
+   function To_Lower (C : Character) return Character is
+   begin
+      if C in 'A' .. 'Z' then
+         return Character'Val (Character'Pos (C) + 32);
+      else
+         return C;
+      end if;
+   end To_Lower;
+end Grt.Strings;
diff --git a/src/grt/grt-strings.ads b/src/grt/grt-strings.ads
new file mode 100644
index 000000000..d11c799f0
--- /dev/null
+++ b/src/grt/grt-strings.ads
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - Misc subprograms for characters and strings
+--  Copyright (C) 2016 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package Grt.Strings is
+   pragma Pure;
+
+   NBSP : constant Character := Character'Val (160);
+
+   --  Return True IFF C is a whitespace character (as defined in LRM93 14.3)
+   function Is_Whitespace (C : in Character) return Boolean;
+
+   --  Convert C to lowercase.
+   function To_Lower (C : Character) return Character;
+end Grt.Strings;
diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb
index e87182791..e64e7b943 100644
--- a/src/grt/grt-values.adb
+++ b/src/grt/grt-values.adb
@@ -1,5 +1,5 @@
 --  GHDL Run Time (GRT) - 'value subprograms.
---  Copyright (C) 2002 - 2014 Tristan Gingold
+--  Copyright (C) 2002 - 2016 Tristan Gingold
 --
 --  GHDL is free software; you can redistribute it and/or modify it under
 --  the terms of the GNU General Public License as published by the Free
@@ -24,18 +24,13 @@
 --  covered by the GNU Public License.
 with Grt.Errors; use Grt.Errors;
 with Grt.Rtis_Utils;
+with Grt.Strings; use Grt.Strings;
 
 package body Grt.Values is
 
    NBSP : constant Character := Character'Val (160);
    HT : constant Character := Character'Val (9);
 
-   --  Return True IFF C is a whitespace character (as defined in LRM93 14.3)
-   function Is_Whitespace (C : in Character) return Boolean is
-   begin
-      return C = ' ' or C = NBSP or C = HT;
-   end Is_Whitespace;
-
    --  Increase POS to skip leading whitespace characters, decrease LEN to
    --  skip trailing whitespaces in string S.
    procedure Remove_Whitespaces (S     : Std_String_Basep;
@@ -58,17 +53,6 @@ package body Grt.Values is
       end if;
    end Remove_Whitespaces;
 
-   --  Convert C to lowercase.
-   function To_LC (C : in Character) return Character is
-   begin
-      if C in 'A' .. 'Z' then
-         return Character'Val
-           (Character'Pos (C) + Character'Pos ('a') - Character'Pos ('A'));
-      else
-         return C;
-      end if;
-   end To_LC;
-
    --  Return TRUE iff user string S (POS .. LEN - 1) is equal to REF.
    --  Comparaison is case insensitive, but REF must be lowercase (REF is
    --  supposed to come from an RTI).
@@ -90,7 +74,7 @@ package body Grt.Values is
          end if;
          C_S := S (Pos + P);
          if not Is_Char then
-            C_S := To_LC (C_S);
+            C_S := To_Lower (C_S);
          end if;
          if C_S /= C_Ref or else C_Ref = ASCII.NUL then
             return False;
diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads
index 5f1e5169d..ee76109d5 100644
--- a/src/grt/grt-values.ads
+++ b/src/grt/grt-values.ads
@@ -26,12 +26,6 @@ with Grt.Types; use Grt.Types;
 with Grt.Rtis; use Grt.Rtis;
 
 package Grt.Values is
-   --  Return True IFF C is a whitespace character (as defined in LRM93 14.3)
-   function Is_Whitespace (C : in Character) return Boolean;
-
-   --  Convert C to lowercase.
-   function To_LC (C : in Character) return Character;
-
    --  Extract position of numeric literal and unit in string STR.
    --  Set IS_REAL if the unit is a real number (presence of '.').
    --  Set UNIT_POS to the position of the first character of the unit name.
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb
index 90c75ef93..1a2af50d7 100644
--- a/src/grt/grt-vpi.adb
+++ b/src/grt/grt-vpi.adb
@@ -45,6 +45,7 @@ with Grt.Stdio; use Grt.Stdio;
 with Grt.C; use Grt.C;
 with Grt.Signals; use Grt.Signals;
 with Grt.Astdio; use Grt.Astdio;
+with Grt.Strings; use Grt.Strings;
 with Grt.Hooks; use Grt.Hooks;
 with Grt.Options;
 with Grt.Vcd; use Grt.Vcd;
@@ -1323,7 +1324,7 @@ package body Grt.Vpi is
             --  NUL not allowed in L.
             return False;
          end if;
-         if L (I) /= R (I - L'First + 1) then
+         if To_Lower (L (I)) /= R (I - L'First + 1) then
             return False;
          end if;
       end loop;
@@ -1353,7 +1354,7 @@ package body Grt.Vpi is
          exit when Err /= AvhpiErrorOk;
 
          El_Name := Avhpi_Get_Base_Name (Res);
-         exit when Strcmp (Name , El_Name);
+         exit when Strcmp (Name, El_Name);
       end loop;
    end Find_By_Name;
 
@@ -1561,11 +1562,17 @@ package body Grt.Vpi is
       return Err_Status;
    end vpi_chk_error;
 
-   function vpi_control (Op : Integer; Status : Integer) return Integer
-   is
-      pragma Unreferenced (Status);
+   function vpi_control (Op : Integer; Status : Integer) return Integer is
    begin
-      Vpi_Trace ("vpi_control");
+      if Flag_Trace then
+         Trace_Start ("vpi_control (");
+         Trace (Op);
+         Trace (", ");
+         Trace (Status);
+         Trace (")");
+         Trace_Newline;
+      end if;
+
       case Op is
          when vpiFinish
            | vpiStop =>