diff --git a/lib2/h3-cc.adb b/lib2/h3-cc.adb index 5018efc..1bc98c6 100644 --- a/lib2/h3-cc.adb +++ b/lib2/h3-cc.adb @@ -84,9 +84,9 @@ package body H3.CC is return Item_Type'Val(UC.UTF_32_To_Upper_Case(Item_Type'Pos(V))); end To_Upper; - function Is_Class (V: in Item_Type; Cls: in Class) return Boolean is + function Is_Class (V: in Item_Type; Class: in Item_Class) return Boolean is begin - case Cls is + case Class is when ALPHA => return Is_Alpha(V); when ALNUM => return Is_Alnum(V); when BLANK => return Is_Blank(V); diff --git a/lib2/h3-cc.ads b/lib2/h3-cc.ads index c2aad1f..d15c429 100644 --- a/lib2/h3-cc.ads +++ b/lib2/h3-cc.ads @@ -7,15 +7,15 @@ package H3.CC is subtype Item_Code is H3.Natural; Colon: constant Item_Code := System_Character'Pos(':'); - SemicoloN: constant Item_Code := System_Character'Pos(';'); + Semicolon: constant Item_Code := System_Character'Pos(';'); Tilde: constant Item_Code := System_Character'Pos('~'); Underline: constant Item_Code := System_Character'Pos('_'); Equal: constant Item_Code := System_Character'Pos('='); L_Arrow: constant Item_Code := System_Character'Pos('<'); R_Arrow: constant Item_Code := System_Character'Pos('>'); - type Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT); - function Is_Class (V: in Item_Type; Cls: in Class) return Boolean; + type Item_Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT); + function Is_Class (V: in Item_Type; Class: in Item_Class) return Boolean; function Is_Alpha (V: in Item_Type) return Boolean; function Is_Alnum (V: in Item_Type) return Boolean; diff --git a/lib2/h3-limited_pool.adb b/lib2/h3-limited_pool.adb index ed53693..23cf7fe 100644 --- a/lib2/h3-limited_pool.adb +++ b/lib2/h3-limited_pool.adb @@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; package body H3.Limited_Pool is - + function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is P: Storage_Pool_Pointer; @@ -24,7 +24,7 @@ package body H3.Limited_Pool is begin Tmp := new Normal_Type; return To_Pointer_Type(Tmp); - end; + end; end if; end Allocate; @@ -53,7 +53,7 @@ package body H3.Limited_Pool is Tmp: Pooled_Pointer := To_Pooled_Pointer(Target); begin Dealloc (Tmp); - Target := null; + Target := null; end; end if; end Deallocate; diff --git a/lib2/h3-mm.adb b/lib2/h3-mm.adb index 927f3bb..32e6a8c 100644 --- a/lib2/h3-mm.adb +++ b/lib2/h3-mm.adb @@ -8,7 +8,7 @@ package body H3.MM is R.Data.Refs := 1; --System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1 end Create; - + procedure Create (R: in out Ref_Counted; V: in Item_Type) is begin Create (R); @@ -46,14 +46,14 @@ package body H3.MM is procedure Finalize (R: in out Ref_Counted) is procedure Dealloc is new Ada.Unchecked_Deallocation(Ref_Counted_Record, Ref_Counted_Pointer); begin - if R.Data /= null then + if R.Data /= null then --if System.Atomic_Counters.Decrement(R.Data.Ref_Count) then -- -- The reference count reached 0 - -- Dealloc (R.Data); + -- Dealloc (R.Data); -- -- R.DAta must be null here --end if; if R.Data.Refs = 1 then - Dealloc (R.Data); + Dealloc (R.Data); else R.Data.Refs := R.Data.Refs - 1; end if; diff --git a/lib2/h3-mm.ads b/lib2/h3-mm.ads index d062795..e71d770 100644 --- a/lib2/h3-mm.ads +++ b/lib2/h3-mm.ads @@ -30,5 +30,5 @@ package H3.MM is overriding procedure Initialize (R: in out Ref_Counted); overriding procedure Adjust (R: in out Ref_Counted); overriding procedure Finalize (R: in out Ref_Counted); - + end H3.MM; diff --git a/lib2/h3-pool.adb b/lib2/h3-pool.adb index ee48e60..9f2d220 100644 --- a/lib2/h3-pool.adb +++ b/lib2/h3-pool.adb @@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; package body H3.Pool is - + function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is P: Storage_Pool_Pointer; @@ -24,11 +24,11 @@ package body H3.Pool is begin Tmp := new Normal_Type; return To_Pointer_Type(Tmp); - end; + end; end if; end Allocate; --- function Allocate (Source: in Normal_Type; +-- function Allocate (Source: in Normal_Type; -- Pool: in Storage_Pool_Pointer := null) return Pointer_Type is -- V: Pointer_Type; -- begin @@ -37,7 +37,7 @@ package body H3.Pool is -- return V; -- end Allocate; - function Allocate (Source: in Normal_Type; + function Allocate (Source: in Normal_Type; Pool: in Storage_Pool_Pointer := null) return Pointer_Type is P: Storage_Pool_Pointer; begin @@ -58,7 +58,7 @@ package body H3.Pool is begin Tmp := new Normal_Type'(Source); return To_Pointer_Type(Tmp); - end; + end; end if; end Allocate; diff --git a/lib2/h3-pool.ads b/lib2/h3-pool.ads index 2b8fd01..b384b89 100644 --- a/lib2/h3-pool.ads +++ b/lib2/h3-pool.ads @@ -18,7 +18,7 @@ package H3.Pool is function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type; - function Allocate (Source: in Normal_Type; + function Allocate (Source: in Normal_Type; Pool: in Storage_Pool_Pointer := null) return Pointer_Type; procedure Deallocate (Target: in out Pointer_Type; diff --git a/lib2/hello2.adb b/lib2/hello2.adb index d33ba7c..8e04642 100644 --- a/lib2/hello2.adb +++ b/lib2/hello2.adb @@ -29,9 +29,7 @@ procedure hello2 is procedure setlocale(a: C.int; b: System.Address); pragma Import (C, setlocale, "setlocale"); - function is_class (V: Standard.Wide_Character; Cls: CC.Class) return Standard.Boolean is - - + function is_class (V: Standard.Wide_Character; Class: CC.Item_Class) return Standard.Boolean is function iswalpha(a: C.int) return C.int; pragma Import (C, iswalpha, "iswalpha"); function iswalnum(a: C.int) return C.int; @@ -60,7 +58,7 @@ procedure hello2 is use type C.int; X: C.int := Standard.Wide_Character'Pos(V); begin - case Cls is + case Class is when CC.ALPHA => return IswAlpha(X) /= 0; when CC.ALNUM => return IswAlnum(X) /= 0; when CC.BLANK => return IswBlank(X) /= 0; @@ -122,7 +120,7 @@ begin ch := Standard.Wide_Character'Val(i); Ada.Text_IO.Put (I'img & "[" & ch'Img & "]"); - for j in CC.Class'Range loop + for j in CC.Item_Class'Range loop Ada.Text_IO.Put (" " & J'Img & ":" & CC.Is_Class(ch, j)'Img); if CC.Is_Class(ch, j) /= Is_Class(ch, j) then Ada.Text_IO.Put ("[X]");