with H3.Arrays; with H3.Strings; with H3.Runes; with H3.Storage; with Ada.Text_IO; with Ada.Wide_Text_IO; with Ada.Assertions; with Interfaces.C; --with Interfaces.C.Strings; with System; --use type H3.System_Size; procedure hello2 is package A is new H3.Arrays(Standard.Wide_Character, 1, Wide_Character'First, H3.Storage.Global_Pool_Box); package S is new H3.Strings(Standard.Wide_Character, H3.Storage.Global_Pool_Box); package R is new H3.Runes(Standard.Wide_Character); package C renames Interfaces.C; --package S_I is new H3.Arrays(Integer, 1, 16#FF#); Arr: A.Elastic_Array; Arr2: A.Elastic_Array; Str: S.Elastic_String; Str2: S.Elastic_String; use type S.Elastic_String; --procedure setlocale(a: C.int; b: Interfaces.C.Strings.chars_ptr); procedure setlocale(a: C.int; b: System.Address); pragma Import (C, setlocale, "setlocale"); function is_class (V: Standard.Wide_Character; Class: R.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; pragma Import (C, iswalnum, "iswalnum"); function iswblank(a: C.int) return C.int; pragma Import (C, iswblank, "iswblank"); function iswcntrl(a: C.int) return C.int; pragma Import (C, iswcntrl, "iswcntrl"); function iswdigit(a: C.int) return C.int; pragma Import (C, iswdigit, "iswdigit"); function iswgraph(a: C.int) return C.int; pragma Import (C, iswgraph, "iswgraph"); function iswlower(a: C.int) return C.int; pragma Import (C, iswlower, "iswlower"); function iswprint(a: C.int) return C.int; pragma Import (C, iswprint, "iswprint"); function iswpunct(a: C.int) return C.int; pragma Import (C, iswpunct, "iswpunct"); function iswspace(a: C.int) return C.int; pragma Import (C, iswspace, "iswspace"); function iswupper(a: C.int) return C.int; pragma Import (C, iswupper, "iswupper"); function iswxdigit(a: C.int) return C.int; pragma Import (C, iswxdigit, "iswxdigit"); use type C.int; X: C.int := Standard.Wide_Character'Pos(V); begin case Class is when R.ALPHA => return IswAlpha(X) /= 0; when R.ALNUM => return IswAlnum(X) /= 0; when R.BLANK => return IswBlank(X) /= 0; when R.CNTRL => return IswCntrl(X) /= 0; when R.DIGIT => return IswDigit(X) /= 0; when R.GRAPH => return IswGraph(X) /= 0; when R.LOWER => return IswLower(X) /= 0; when R.PRINT => return IswPrint(X) /= 0; when R.PUNCT => return IswPunct(X) /= 0; when R.SPACE => return IswSpace(X) /= 0; when R.UPPER => return IswUpper(X) /= 0; when R.XDIGIT => return IswXdigit(X) /= 0; end case; end is_class; --Empty_String: aliased Standard.String := "en_US.utf8" & Standard.Character'Val(0); Empty_String: aliased Standard.String := "" & Standard.Character'Val(0); begin --setlocale (6, Interfaces.C.Strings.To_Chars_Ptr(Empty_String'access)); setlocale (6, Empty_String'Address); A.Append (Arr, "hello"); A.Append (Arr, "world"); Arr.Append ("fantastic"); Arr2 := Arr; A.Delete (Arr2, 1, 5); Str.Append ("wonderful"); Str.Delete (2, 3); Str2 := Str; Str2.Clear; Str2.Append ("saxage"); Str := Str2; Str.Clear; Str.Append("primitive"); if Str = "savage" then ada.text_io.put_line ("is savage"); else ada.text_io.put_line ("is not savage"); end if; Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(A.To_Item_Array(Arr))); Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(A.To_Item_Array(Arr2))); -- --------------------- Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(Str.To_Item_Array)); Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(Str2.To_Item_Array)); declare --function isspace(a: Standard.Character) return C.int -- with Import => True, Convention => C, External_Name => "isspace"; ch: Standard.Wide_Character; begin for i in 0 .. 10000 loop ch := Standard.Wide_Character'Val(i); Ada.Text_IO.Put (I'img & "[" & ch'Img & "]"); for j in R.Item_Class'Range loop Ada.Text_IO.Put (" " & J'Img & ":" & R.Is_Class(ch, j)'Img); if R.Is_Class(ch, j) /= Is_Class(ch, j) then Ada.Text_IO.Put ("[X]"); --else -- Ada.Text_IO.Put ("[O]"); end if; end loop; Ada.Text_IO.Put_Line (""); end loop; Ada.Text_IO.Put_line (R.Is_Alpha('σ')'Img); end; end;