adagsl_335d13f0/toolkit/adalib/src/values.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
with Interfaces.C ; use Interfaces.C ;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
package body values is
    use Interfaces ;
   function sscanf
     (v : Interfaces.C.char_array ;
      f : Interfaces.C.char_array ;
      val : access Interfaces.C.int) return Interfaces.C.int
     with Import,
       Convention    => C_Variadic_2,
     External_Name => "sscanf";

    function Value( format : String ; value : String ) return Integer is
        ival : aliased Interfaces.C.int ;
        status : Interfaces.C.int ;
    begin
        status := sscanf
          (Interfaces.C.To_C (value),
           f   => Interfaces.C.To_C(format),
           val => ival'access );
        if status /= 1
        then
            raise FORMAT_ERROR ;
        end if ;

        return Integer(ival) ;
    end Value ;


   function sscanf
     (v : Interfaces.C.char_array ;
      f : Interfaces.C.char_array ;
      val : access Interfaces.C.unsigned) return Interfaces.C.int
     with Import,
       Convention    => C_Variadic_2,
     External_Name => "sscanf";

    function Value( format : String ; value : String ) return Interfaces.Unsigned_32 is
        uval : aliased Interfaces.C.unsigned ;
        status : Interfaces.C.int ;
    begin
        status := sscanf
          (Interfaces.C.To_C (value),
           f   => Interfaces.C.To_C(format),
           val => uval'access );
        if status /= 1
        then
            raise FORMAT_ERROR ;
        end if ;
        return Unsigned_32(uval) ;
    end Value ;

   function sscanf
     (v : Interfaces.C.char_array ;
      f : Interfaces.C.char_array ;
      val : access Interfaces.C.C_Float) return Interfaces.C.int
     with Import,
       Convention    => C_Variadic_2,
     External_Name => "sscanf";

    function Value( format : String ; value : String ) return Float is
        fval : aliased Interfaces.C.C_Float ;
        status : Interfaces.C.int ;
    begin
        status := sscanf
          (Interfaces.C.To_C (value),
           f   => Interfaces.C.To_C(format),
           val => fval'access );
        if status /= 1
        then
            raise FORMAT_ERROR ;
        end if ;

        return Float(fval) ;
    end Value ;

    function Value( format : String ; value : String ) return Long_Float is
        fval : aliased Interfaces.C.C_Float ;
        status : Interfaces.C.int ;
    begin
        status := sscanf
          (Interfaces.C.To_C (value),
           f   => Interfaces.C.To_C(format),
           val => fval'access );
        if status /= 1
        then
            raise FORMAT_ERROR ;
        end if ;

        return Long_Float(fval) ;
    end Value ;


    function Value( format : String ; value : String ) return Interfaces.C.double is
        fval : aliased Interfaces.C.C_Float ;
        status : Interfaces.C.int ;
    begin
        status := sscanf
          (Interfaces.C.To_C (value),
           f   => Interfaces.C.To_C(format),
           val => fval'access );
        if status /= 1
        then
            raise FORMAT_ERROR ;
        end if ;

        return Interfaces.C.double(fval) ;
    end Value ;

    type struct_tm is
    record
        tm_sec : Int ;
        tm_min : Int ;
        tm_hour : Int ;
        tm_mday : Int ;
        tm_mon : Int ;
        tm_year : Int ;
        tm_wday : Int ;
        tm_yday : Int ;
        tm_isdst : Int ;
    end record ;

    function strftime
     (str : Interfaces.C.char_array ;
      maxsize : size_t ;
      format :  Interfaces.C.char_array ;
      timptr : access struct_tm ) return size_t 
     with Import,
       Convention    => C ,
        External_Name => "strftime";


end values ;