Fix 'value on physical types with whitespaces.

Fix style and simplify grt-values.adb.  Add tests.

6 files changed, 254 insertions, 236 deletions

diff --git a/testsuite/gna/bug7751/7751_extra_tests.vhd b/testsuite/gna/bug7751/7751_extra_tests.vhd
index 0d973bd6e..094ddbb10 100644
--- a/testsuite/gna/bug7751/7751_extra_tests.vhd
+++ b/testsuite/gna/bug7751/7751_extra_tests.vhd
@@ -1,4 +1,4 @@
-entity tb is 
+entity tb is
 end tb;
 
 architecture sim of tb is
@@ -95,6 +95,10 @@ architecture sim of tb is
   end e_img;
 
 
+  function t_val (t : string) return time is
+    begin
+      return time'value (t);
+    end t_val;
 begin
 -- At least one test for each constant, signal or function
 
@@ -134,9 +138,25 @@ begin
   Assert my_e32 = T296 report "Assertion 21 triggered ... correctly" severity NOTE;
 
   my_e32_str <= "T24" after 40 ns;
-  Assert e_val(my_e32_str) = T23 report "Assertion 19 triggered ... correctly" severity NOTE;
-  Assert e_val(my_e32_str) = T22 report "Assertion 20 triggered ... wrongly except at 40ns" severity NOTE;
-
+  Assert e_val(my_e32_str) = T23 report "Assertion 22 triggered ... correctly" severity NOTE;
+  Assert e_val(my_e32_str) = T22 report "Assertion 23 triggered ... wrongly except at 40ns" severity NOTE;
+
+  --  Check white spaces and case.
+  assert e_val(" one") = one report "assertion 31" severity failure;
+  assert e_val(" one ") = one report "assertion 32" severity failure;
+  assert e_val("one ") = one report "assertion 33" severity failure;
+  assert e_val("oNe") = one report "assertion 34" severity failure;
+
+  assert e_val(" T1") = t1 report "assertion 35" severity failure;
+  assert e_val(" t2 ") = t2 report "assertion 36" severity failure;
+  assert e_val("t3 ") = t3 report "assertion 37" severity failure;
+  assert e_val("t39") = t39 report "assertion 38" severity failure;
+
+  assert t_val("1 ns") = 1 ns report "assertion 40" severity failure;
+  assert t_val(" 1 nS") = 1 ns report "assertion 41" severity failure;
+  assert t_val(" 1 Ns ") = 1 ns report "assertion 42" severity failure;
+  assert t_val(" -1.5 ns ") = -1500 ps report "assertion 44" severity failure;
+  
 -------------- runtime image ----------------------
   -- runtime enumeration
   sig_e8 <= Two after 50 ns, Four after 60 ns;
diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb
index 5b541af1e..5238b53f1 100644
--- a/translate/grt/grt-errors.adb
+++ b/translate/grt/grt-errors.adb
@@ -194,7 +194,7 @@ package body Grt.Errors is
 --       end case;
 --    end Error_C;
 
-   procedure Error_E (Str : String) is
+   procedure Error_E (Str : String := "") is
    begin
       Put_Err (Str);
       Newline_Err;
@@ -202,12 +202,12 @@ package body Grt.Errors is
       Fatal_Error;
    end Error_E;
 
-   procedure Error_E_Std (Str : Std_String_Uncons)
+   procedure Error_C_Std (Str : Std_String_Uncons)
    is
       subtype Str_Subtype is String (1 .. Str'Length);
    begin
-      Error_E (Str_Subtype (Str));
-   end Error_E_Std;
+      Error_C (Str_Subtype (Str));
+   end Error_C_Std;
 
    procedure Error (Str : String) is
    begin
diff --git a/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads
index b83902362..d5b79a62b 100644
--- a/translate/grt/grt-errors.ads
+++ b/translate/grt/grt-errors.ads
@@ -25,9 +25,10 @@ package Grt.Errors is
    procedure Error_C (Str : String);
    procedure Error_C (N : Integer);
    procedure Error_C (Str : Ghdl_C_String);
+   procedure Error_C_Std (Str : Std_String_Uncons);
    --procedure Error_C (Inst : Ghdl_Instance_Name_Acc);
-   procedure Error_E (Str : String);
-   procedure Error_E_Std (Str : Std_String_Uncons);
+   procedure Error_E (Str : String := "");
+   -- procedure Error_E_Std (Str : Std_String_Uncons);
    pragma No_Return (Error_E);
 
    --  Multi-call report procedure.  Do not exit at end.
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index a1ce0ceb2..422775b34 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -243,7 +243,8 @@ package body Grt.Files is
 
       if Res /= Open_Ok then
          Error_C ("open: cannot open text file ");
-         Error_E_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_E;
       end if;
    end Ghdl_Text_File_Open;
 
@@ -258,7 +259,8 @@ package body Grt.Files is
 
       if Res /= Open_Ok then
          Error_C ("open: cannot open file ");
-         Error_E_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_E;
       end if;
    end Ghdl_File_Open;
 
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
index 94c13ccd6..bac177e3a 100644
--- a/translate/grt/grt-values.adb
+++ b/translate/grt/grt-values.adb
@@ -17,158 +17,138 @@
 --  02111-1307, USA.
 with Grt.Errors; use Grt.Errors;
 with Grt.Rtis_Utils;
-with System;
-with Ada.Unchecked_Conversion;
 
 package body Grt.Values is
 
    NBSP : constant Character := Character'Val (160);
    HT : constant Character := Character'Val (9);
 
-   function White (C : in Character) return Boolean is
+   --  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 White;
+   end Is_Whitespace;
 
-   procedure Remove_Whitespace(S     : in Std_String_Basep;
-                               Pos   : in out Ghdl_Index_Type;
-                               Len   : in Ghdl_Index_Type;
-                               Chars : out Ghdl_B2) is
+   --  Increase POS to skip leading whitespace characters, decrease LEN to
+   --  skip trailing whitespaces in string S.
+   procedure Remove_Whitespaces (S     : Std_String_Basep;
+                                 Len   : in out Ghdl_Index_Type;
+                                 Pos   : in out Ghdl_Index_Type) is
    begin
-      Chars := False;
       --  GHDL: allow several leading whitespace.
       while Pos < Len loop
-         if White (S (Pos)) then
-            Pos := Pos + 1;
-         else
-            Chars := True;
-            exit;
-         end if;
+         exit when not Is_Whitespace (S (Pos));
+         Pos := Pos + 1;
+      end loop;
+
+      --  GHDL: allow several leading whitespace.
+      while Len > Pos loop
+         exit when not Is_Whitespace (S (Len - 1));
+         Len := Len - 1;
       end loop;
-   end Remove_Whitespace;
+      if Pos = Len then
+         Error_E ("'value: empty string");
+      end if;
+   end Remove_Whitespaces;
 
-   function LC(C : in Character) return Character is
+   --  Convert C to lowercase.
+   function LC (C : in Character) return Character is
    begin
       if C >= 'A' and then C <= 'Z' then
-         return Character'val(Character'pos(C) + Character'pos('a')
-                                               - Character'pos('A'));
+         return Character'Val
+           (Character'Pos (C) + Character'Pos ('a') - Character'Pos ('A'));
       else
          return C;
       end if;
    end LC;
 
-   procedure Make_LC_String(S : Std_String_Basep;
-                            Pos : in out Ghdl_Index_Type;
-                            Str : out String) is
-   begin
-      for i in Str'range loop
-         Str(i) := LC(S(Pos));
-         Pos := Pos + 1;
-      end loop;
-   end Make_LC_String;
-
-   function StringMatch(Str : String; EnumStr : Ghdl_C_String) return boolean
+   --  Return TRUE iff user string S (POS .. LEN) is equal to REF. Comparaison
+   --  is case insensitive, but REF must be lowercase (REF is supposed to
+   --  come from an RTI).
+   function String_Match (S : Std_String_Basep;
+                          Pos : Ghdl_Index_Type;
+                          Len : Ghdl_Index_Type;
+                          Ref : Ghdl_C_String) return Boolean
    is
-      EnumLen : constant Natural := strlen(EnumStr);
+      P : Ghdl_Index_Type;
+      C : Character;
    begin
-      for j in Str'range loop
-         if j > EnumLen or else Str(j) /= EnumStr(j) then
-            return false;
+      P := 0;
+      loop
+         C := Ref (Natural (P + 1));
+         if Pos + P = Len then
+            --  End of string.
+            return C = ASCII.NUL;
          end if;
+         if LC (S (Pos + P)) /= C or else C = ASCII.NUL then
+            return False;
+         end if;
+         P := P + 1;
       end loop;
-      if Str'last = EnumLen then
-         return true;
-      else
-         return false;
-      end if;
-   end StringMatch;
+   end String_Match;
 
+   --  Return the value of STR for enumerated type RTI.
    function Ghdl_Value_Enum (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
       return Ghdl_Index_Type
    is
-      Val   : Ghdl_Index_Type := 0;
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
       S     : constant Std_String_Basep := Str.Base;
-      Len   : constant Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Len   : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
       Pos   : Ghdl_Index_Type := 0;
-      Chars : Ghdl_B2;
-      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
-
    begin
-      Remove_Whitespace(S, Pos, Len, Chars);
-      if Pos = Len then
-         Error_E ("'value: empty string");
-      end if;
+      Remove_Whitespaces (S, Len, Pos);
 
-      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-
-      declare
-         Str     : String(1..Natural(Len - Pos));
-         Found   : Boolean := False;
-      begin
-         Make_LC_String(S, Pos, Str);
-         for i in 0 .. Enum_Rti.Nbr - 1 loop
-            if StringMatch(Str,  Enum_Rti.Names.all(i)) then
-               Found := True;
-               Val := i;
-               exit;
-            end if;
-         end loop;
-         if not Found then
-            Error_E ("'value: " & Str & " not in enumeration " &
-                     Enum_Rti.Name.all(1..strlen(Enum_Rti.Name)));
+      for I in 0 .. Enum_Rti.Nbr - 1 loop
+         if String_Match (S, Pos, Len, Enum_Rti.Names (I)) then
+            return I;
          end if;
-      end;
-
-      Remove_Whitespace(S, Pos, Len, Chars);
-      if Chars then
-         Error_E ("'value: trailing characters after blank");
-      end if;
-      return Val;
+      end loop;
+      Error_C ("'value: '");
+      Error_C_Std (S (Pos .. Len));
+      Error_C ("' not in enumeration '");
+      Error_C (Enum_Rti.Name);
+      Error_E ("'");
    end Ghdl_Value_Enum;
 
    function Ghdl_Value_B2 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
       return Ghdl_B2
    is
    begin
-      return Ghdl_B2'Val(Ghdl_Value_Enum (Str , Rti ));
+      return Ghdl_B2'Val (Ghdl_Value_Enum (Str, Rti));
    end Ghdl_Value_B2;
 
    function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
       return Ghdl_E8
    is
    begin
-      return Ghdl_E8'Val(Ghdl_Value_Enum (Str , Rti ));
+      return Ghdl_E8'Val (Ghdl_Value_Enum (Str, Rti));
    end Ghdl_Value_E8;
 
    function Ghdl_Value_E32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
       return Ghdl_E32
    is
    begin
-      return Ghdl_E32'Val(Ghdl_Value_Enum (Str , Rti ));
+      return Ghdl_E32'Val (Ghdl_Value_Enum (Str, Rti));
    end Ghdl_Value_E32;
 
-   function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64
+   --  Convert S (INIT_POS .. LEN) to a signed integer.
+   function Ghdl_Value_I64 (S : Std_String_Basep;
+                            Len : Ghdl_Index_Type;
+                            Init_Pos : Ghdl_Index_Type)
+                           return Ghdl_I64
    is
-      S : constant Std_String_Basep := Str.Base;
-      Len : constant Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
-      Pos : Ghdl_Index_Type := 0;
+      Pos : Ghdl_Index_Type := Init_Pos;
       C : Character;
       Sep : Character;
       Val, D, Base : Ghdl_I64;
       Exp : Integer;
-      Chars : Ghdl_B2;
    begin
-      --  LRM 14.1
-      --  Leading [and trailing] whitespace is allowed and ignored.
-      --
-      --  GHDL: allow several leading whitespace.
-      Remove_Whitespace(S, Pos, Len, Chars);
-      if Pos = Len then
-         Error_E ("'value: empty string");
-      end if;
       C := S (Pos);
 
       --  Be user friendly.
+      --  FIXME: reference.
       if C = '-' or C = '+' then
          Error_E ("'value: leading sign +/- not allowed");
       end if;
@@ -310,139 +290,43 @@ package body Grt.Values is
          end loop;
       end if;
 
-      --  LRM 14.1
-      --  [Leading] and trailing whitespace is allowed and ignored.
-      --
-      --  GHDL: allow several trailing whitespace.
-      Remove_Whitespace(S, Pos, Len, Chars);
-      if Chars then
-         Error_E ("integer'value: trailing characters after blank");
+      if Pos /= Len then
+         Error_E ("'value: trailing characters after blank");
       end if;
 
       return Val;
    end Ghdl_Value_I64;
 
-   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
-   is
-   begin
-      return Ghdl_I32 (Ghdl_Value_I64 (Str));
-   end Ghdl_Value_I32;
-
-   function Ghdl_Value_Physical_Type (Str : Std_String_Ptr;
-                                      Rti : Ghdl_Rti_Access)
-      return Ghdl_I64
+   function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64
    is
-      function To_Std_String_Ptr is new Ada.Unchecked_Conversion
-         (Source => System.Address, Target => Std_String_Ptr);
-      function To_Std_String_Boundp is new Ada.Unchecked_Conversion
-         (Source => System.Address, Target => Std_String_Boundp);
-
-      S     : aliased Std_String := Str.all;
-      Bound : aliased Std_String_Bound := Str.Bounds.all;
-      Start, Finish : Ghdl_Index_Type;
-      Found_Real    : Boolean := false;
-
-      Phys_Rti : Ghdl_Rtin_Type_Physical_Acc;
-      Unit_Name : Ghdl_C_String;
-      Multiple : Ghdl_Rti_Access;
-      Mult     : Ghdl_I64;
+      S : constant Std_String_Basep := Str.Base;
+      Len : Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
+      Pos : Ghdl_Index_Type := 0;
    begin
-      Phys_Rti := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
-
-      S.Bounds := To_Std_String_Boundp (Bound'Address);
-      -- find characters at the end...
-      Finish := Bound.Dim_1.Length - 1;
-      while White (S.Base (Finish)) loop
-         Finish := Finish - 1;
-      end loop;
-      Start := Finish;
-      while not White (S.Base (Start - 1)) loop
-         Start := Start - 1;
-      end loop;
-      -- shorten Bounds to exclude non-numeric part
-      Bound.Dim_1.Right := Bound.Dim_1.Right
-                          - Std_Integer (Bound.Dim_1.Length - Start);
-      Bound.Dim_1.Length := Start;
-      -- does the string represent a Real?
-      for i in 0 .. Start loop
-         if S.Base (i) = '.' then
-            Found_Real := true;
-         end if;
-      end loop;
-
-      declare
-         Unit_Str : String (1 .. Natural (1 + Finish - Start));
-      begin
-         Make_LC_String (Str.Base, Start, Unit_Str);
-         Multiple := null;
-         for i in 0 .. Phys_Rti.Nbr - 1 loop
-            Unit_Name :=
-              Rtis_Utils.Get_Physical_Unit_Name (Phys_Rti.Units (i));
-            if StringMatch (Unit_Str, Unit_Name) then
-               Multiple := Phys_Rti.Units (i);
-               exit;
-            end if;
-         end loop;
-         if Multiple = null then
-            Error_E ("'value: Unit " & Unit_Str & " not in physical type" &
-                     Phys_Rti.Name.all (1 .. strlen (Phys_Rti.Name)));
-         end if;
-      end;
-
-      case Multiple.Kind is
-         when Ghdl_Rtik_Unit64 =>
-            Mult := To_Ghdl_Rtin_Unit64_Acc (Multiple).Value;
-         when Ghdl_Rtik_Unitptr =>
-            case Rti.Kind is
-               when Ghdl_Rtik_Type_P64 =>
-                  Mult := To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I64;
-               when Ghdl_Rtik_Type_P32 =>
-                  Mult := Ghdl_I64
-                    (To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I32);
-               when others =>
-                  Internal_Error ("values.physical_type(P32/P64-1)");
-            end case;
-         when others =>
-            Internal_Error ("values.physical_type(P32/P64-2)");
-      end case;
-
-      if Found_Real then
-         return Ghdl_I64 (Ghdl_Value_F64 (To_Std_String_Ptr (S'Address))
-                                * Ghdl_F64 (Mult));
-      else
-         return Ghdl_Value_I64 (To_Std_String_Ptr (S'Address)) * Mult;
-      end if;
-   end Ghdl_Value_Physical_Type;
+      --  LRM 14.1
+      --  Leading [and trailing] whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      Remove_Whitespaces (S, Len, Pos);
 
-   function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
-      return Ghdl_I64
-   is
-   begin
-      if Rti.Kind /= Ghdl_Rtik_Type_P64 then
-         Error_E ("Physical_Type_64'value: incorrect RTI");
-      end if;
-      return Ghdl_Value_Physical_Type (Str, Rti);
-   end Ghdl_Value_P64;
+      return Ghdl_Value_I64 (S, Len, Pos);
+   end Ghdl_Value_I64;
 
-   function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
-      return Ghdl_I32
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
    is
    begin
-      if Rti.Kind /= Ghdl_Rtik_Type_P32 then
-         Error_E ("Physical_Type_32'value: incorrect RTI");
-      end if;
-      return Ghdl_I32 (Ghdl_Value_Physical_Type (Str, Rti));
-   end Ghdl_Value_P32;
+      return Ghdl_I32 (Ghdl_Value_I64 (Str));
+   end Ghdl_Value_I32;
 
    -- From patch attached to https://gna.org/bugs/index.php?18352
    -- thanks to Christophe Curis https://gna.org/users/lobotomy
-   function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64
+   function Ghdl_Value_F64 (S : Std_String_Basep;
+                            Len : Ghdl_Index_Type;
+                            Init_Pos : Ghdl_Index_Type)
+                           return Ghdl_F64
    is
-      S       : constant Std_String_Basep := Str.Base;
-      Len     : constant Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
-      Pos     : Ghdl_Index_Type := 0;
+      Pos     : Ghdl_Index_Type := Init_Pos;
       C       : Character;
-      Chars   : Ghdl_B2;
       Is_Negative, Is_Neg_Exp : Boolean := False;
       Base    : Ghdl_F64;
       Intg    : Ghdl_I32;
@@ -450,16 +334,6 @@ package body Grt.Values is
       Sep     : Character;
       FrcExp  : Ghdl_F64;
    begin
-      --  LRM 14.1
-      --  Leading [and trailing] whitespace is allowed and ignored.
-      --
-      --  GHDL: allow several leading whitespace.
-      Remove_Whitespace(S, Pos, Len, Chars);
-
-      if Pos = Len then
-         Error_E ("'value: empty string");
-      end if;
-
       C := S (Pos);
       if C = '-' then
          Is_Negative := True;
@@ -614,12 +488,7 @@ package body Grt.Values is
          end if;
       end if;
 
-      --  LRM 14.1
-      --  [Leading] and trailing whitespace is allowed and ignored.
-      --
-      --  GHDL: allow several leading whitespace.
-      Remove_Whitespace(S, Pos, Len, Chars);
-      if Chars then
+      if Pos /= Len then
          Error_E ("'value: trailing characters after blank");
       end if;
 
@@ -630,4 +499,131 @@ package body Grt.Values is
       return Val;
    end Ghdl_Value_F64;
 
+   -- From patch attached to https://gna.org/bugs/index.php?18352
+   -- thanks to Christophe Curis https://gna.org/users/lobotomy
+   function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64
+   is
+      S       : constant Std_String_Basep := Str.Base;
+      Len     : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Pos     : Ghdl_Index_Type := 0;
+   begin
+      --  LRM 14.1
+      --  Leading and trailing whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      Remove_Whitespaces (S, Len, Pos);
+
+      return Ghdl_Value_F64 (S, Len, Pos);
+   end Ghdl_Value_F64;
+
+   function Ghdl_Value_Physical_Type (Str : Std_String_Ptr;
+                                      Rti : Ghdl_Rti_Access)
+                                     return Ghdl_I64
+   is
+      S        : constant Std_String_Basep := Str.Base;
+      Len      : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Pos      : Ghdl_Index_Type := 0;
+      Unit_Pos : Ghdl_Index_Type;
+      Lit_End  : Ghdl_Index_Type;
+
+      Found_Real : Boolean;
+
+      Phys_Rti : constant Ghdl_Rtin_Type_Physical_Acc :=
+        To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Multiple : Ghdl_Rti_Access;
+      Mult     : Ghdl_I64;
+   begin
+      --  LRM 14.1
+      --  Leading and trailing whitespace is allowed and ignored.
+      Remove_Whitespaces (S, Len, Pos);
+
+      --  Split between abstract literal (optionnal) and unit name.
+      Lit_End := Pos;
+      Found_Real := False;
+      while Lit_End < Len loop
+         exit when Is_Whitespace (S (Lit_End));
+         if S (Lit_End) = '.' then
+            Found_Real := True;
+         end if;
+         Lit_End := Lit_End + 1;
+      end loop;
+      if Lit_End = Len then
+         --  No literal
+         Unit_Pos := Pos;
+         Lit_End := 0;
+      else
+         Unit_Pos := Lit_End + 1;
+         while Unit_Pos < Len loop
+            exit when not Is_Whitespace (S (Unit_Pos));
+            Unit_Pos := Unit_Pos + 1;
+         end loop;
+      end if;
+
+      Multiple := null;
+      for i in 0 .. Phys_Rti.Nbr - 1 loop
+         Unit_Name :=
+           Rtis_Utils.Get_Physical_Unit_Name (Phys_Rti.Units (i));
+         if String_Match (S, Unit_Pos, Len, Unit_Name) then
+            Multiple := Phys_Rti.Units (i);
+            exit;
+         end if;
+      end loop;
+      if Multiple = null then
+         Error_C ("'value: unit '");
+         Error_C_Std (S (Unit_Pos .. Len));
+         Error_C ("' not in physical type '");
+         Error_C (Phys_Rti.Name);
+         Error_E ("'");
+      end if;
+
+      case Multiple.Kind is
+         when Ghdl_Rtik_Unit64 =>
+            Mult := To_Ghdl_Rtin_Unit64_Acc (Multiple).Value;
+         when Ghdl_Rtik_Unitptr =>
+            case Rti.Kind is
+               when Ghdl_Rtik_Type_P64 =>
+                  Mult := To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I64;
+               when Ghdl_Rtik_Type_P32 =>
+                  Mult := Ghdl_I64
+                    (To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I32);
+               when others =>
+                  Internal_Error ("values.physical_type(P32/P64-1)");
+            end case;
+         when others =>
+            Internal_Error ("values.physical_type(P32/P64-2)");
+      end case;
+
+      if Lit_End = 0 then
+         return Mult;
+      else
+         if Found_Real then
+            return Ghdl_I64
+              (Ghdl_Value_F64 (S, Lit_End, Pos) * Ghdl_F64 (Mult));
+         else
+            return Ghdl_Value_I64 (S, Lit_End, Pos) * Mult;
+         end if;
+      end if;
+   end Ghdl_Value_Physical_Type;
+
+   function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I64
+   is
+   begin
+      if Rti.Kind /= Ghdl_Rtik_Type_P64 then
+         Error_E ("Physical_Type_64'value: incorrect RTI");
+      end if;
+      return Ghdl_Value_Physical_Type (Str, Rti);
+   end Ghdl_Value_P64;
+
+   function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I32
+   is
+   begin
+      if Rti.Kind /= Ghdl_Rtik_Type_P32 then
+         Error_E ("Physical_Type_32'value: incorrect RTI");
+      end if;
+      return Ghdl_I32 (Ghdl_Value_Physical_Type (Str, Rti));
+   end Ghdl_Value_P32;
+
 end Grt.Values;
diff --git a/translate/translation.adb b/translate/translation.adb
index d6f85bfe0..7d5c84b17 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -26537,8 +26537,7 @@ package body Translation is
             when others =>
                raise Internal_Error;
          end case;
-         New_Record_Aggr_El
-           (List, Generate_Common_Type (Rti_Kind, 0, 0, 0));
+         New_Record_Aggr_El (List, Generate_Common_Type (Rti_Kind, 0, 0, 0));
          New_Record_Aggr_El (List, New_Name_Address (Name));
          New_Record_Aggr_El
            (List,