-- GHDL driver - xml commands -- 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. with Ada.Text_IO; use Ada.Text_IO; with GNAT.OS_Lib; use GNAT.OS_Lib; with Types; use Types; with Name_Table; use Name_Table; with Nodes_Meta; use Nodes_Meta; with Files_Map; with Disp_Tree; use Disp_Tree; with Ghdlprint; use Ghdlprint; with Libraries; with Errorout; use Errorout; with Iirs; use Iirs; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; package body Ghdlxml is procedure Disp_Iir (Id : String; N : Iir); -- Try to keep line length below that number. Max_Line_Len : constant Natural := 80; -- Number of space by indentation level. Indent_Size : constant Natural := 2; -- Current indentation level. Indent : Natural; -- Current column. Col : Natural; -- Low-level display routines. Consider line length, and handle -- indentation. Only use these routines to display content. -- Display indentation. procedure Put_Indent is Blanks : constant String (1 .. Indent_Size * Indent) := (others => ' '); begin pragma Assert (Col = 0); Put (Blanks); Col := Indent_Size * Indent; end Put_Indent; procedure Put_Stag (Name : String) is begin Put_Indent; Put ('<'); Put (Name); Col := Col + 1 + Name'Length; end Put_Stag; procedure Put_Stag_End is begin Put ('>'); New_Line; Col := 0; Indent := Indent + 1; end Put_Stag_End; procedure Put_Empty_Stag_End is begin Put ("/>"); New_Line; Col := 0; end Put_Empty_Stag_End; procedure Put_Etag (Name : String) is begin Indent := Indent - 1; Put_Indent; Put (""); New_Line; Col := 0; end Put_Etag; procedure Put_Attribute (Attr : String; Value : String) is -- Number of characters to be displayed. Len : constant Natural := 4 + Attr'Length + Value'Length; begin if Col + Len >= Max_Line_Len and then Indent * Indent_Size + Len < Max_Line_Len then New_Line; Col := 0; Put_Indent; end if; Put (' '); Put (Attr); Put ("="""); Put (Value); Put ('"'); Col := Col + Len; end Put_Attribute; -- Espace special characters for XML. -- -- According to: http://www.w3.org/TR/REC-xml/#NT-AttValue -- -- [10] AttValue ::= '"' ([^<&"] | Reference)* '"' -- | "'" ([^<&'] | Reference)* "'" -- [67] Reference ::= EntityRef | CharRef -- [66] CharRef ::= '&#' [0-9]+ ';' -- | '&#x' [0-9a-fA-F]+ ';' function To_XML (Str : String) return String is To_Hex : constant array (0 .. 15) of Character := "0123456789abcdef"; -- The escape sequence uses 6 characters. Res : String (1 .. 6 * Str'Length); Idx : Positive; C : Character; C_Pos : Natural; begin Idx := Res'First; for I in Str'Range loop C := Str (I); case C is when '<' | '

from pathod import utils

from mitmproxy.test import tutils


def test_membool():
    m = utils.MemBool()
    assert not m.v
    assert m(1)
    assert m.v == 1
    assert m(2)
    assert m.v == 2


def test_data_path():
    tutils.raises(ValueError, utils.data.path, "nonexistent")

mage_Tri_State_Type (Get_Tri_State_Type (N, F))); when Type_Iir_Pure_State => Put_Field (F, Image_Iir_Pure_State (Get_Iir_Pure_State (N, F))); when Type_Iir_Delay_Mechanism => Put_Field (F, Image_Iir_Delay_Mechanism (Get_Iir_Delay_Mechanism (N, F))); when Type_Iir_Predefined_Functions => Put_Field (F, Image_Iir_Predefined_Functions (Get_Iir_Predefined_Functions (N, F))); when Type_Iir_Direction => Put_Field (F, Image_Iir_Direction (Get_Iir_Direction (N, F))); when Type_Iir_Int32 => Put_Field (F, Strip (Iir_Int32'Image (Get_Iir_Int32 (N, F)))); when Type_Int32 => Put_Field (F, Strip (Int32'Image (Get_Int32 (N, F)))); when Type_Iir_Fp64 => Put_Field (F, Iir_Fp64'Image (Get_Iir_Fp64 (N, F))); when Type_Time_Stamp_Id => Put_Field (F, Image_Time_Stamp_Id (Get_Time_Stamp_Id (N, F))); when Type_File_Checksum_Id => Put_Field (F, Image_File_Checksum_Id (Get_File_Checksum_Id (N, F))); when Type_Token_Type => Put_Field (F, Image_Token_Type (Get_Token_Type (N, F))); when Type_Name_Id => Put_Field (F, XML_Image (Get_Name_Id (N, F))); end case; end loop; Put_Stag_End; for I in Fields'Range loop F := Fields (I); case Get_Field_Type (F) is when Type_Iir => declare V : constant Iir := Get_Iir (N, F); Img : constant String := Get_Field_Image (F); begin case Get_Field_Attribute (F) is when Attr_None => Disp_Iir (Img, V); when Attr_Ref | Attr_Forward_Ref | Attr_Maybe_Forward_Ref => Disp_Iir_Ref (Img, V); when Attr_Maybe_Ref => if Get_Is_Ref (N) then Disp_Iir_Ref (Img, V); else Disp_Iir (Img, V); end if; when Attr_Chain => Disp_Iir_Chain (Img, V); when Attr_Chain_Next => null; when Attr_Of_Ref | Attr_Of_Maybe_Ref => raise Internal_Error; end case; end; when Type_Iir_List => declare L : constant Iir_List := Get_Iir_List (N, F); Img : constant String := Get_Field_Image (F); begin case Get_Field_Attribute (F) is when Attr_None => Disp_Iir_List (Img, L, False); when Attr_Of_Ref => Disp_Iir_List (Img, L, True); when Attr_Of_Maybe_Ref => Disp_Iir_List (Img, L, Get_Is_Ref (N)); when Attr_Ref => Disp_Iir_List_Ref (Img, L); when others => raise Internal_Error; end case; end; when Type_Iir_Flist => declare L : constant Iir_Flist := Get_Iir_Flist (N, F); Img : constant String := Get_Field_Image (F); begin case Get_Field_Attribute (F) is when Attr_None => Disp_Iir_Flist (Img, L, False); when Attr_Of_Ref => Disp_Iir_Flist (Img, L, True); when Attr_Of_Maybe_Ref => Disp_Iir_Flist (Img, L, Get_Is_Ref (N)); when Attr_Ref => Disp_Iir_Flist_Ref (Img, L); when others => raise Internal_Error; end case; end; when Type_String8_Id => -- Special handling for strings declare Len : constant Int32 := Get_String_Length (N); begin Put_Stag (Get_Field_Image (F)); Put_Attribute ("length", Strip (Int32'Image (Len))); Put_Attribute ("content", To_XML (Image_String8 (N))); Put_Empty_Stag_End; end; when others => null; end case; end loop; end; Put_Etag (Id); end Disp_Iir; -- Command --file-to-xml type Command_File_To_Xml is new Command_Lib with null record; function Decode_Command (Cmd : Command_File_To_Xml; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_File_To_Xml) return String; procedure Perform_Action (Cmd : in out Command_File_To_Xml; Files_Name : Argument_List); function Decode_Command (Cmd : Command_File_To_Xml; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--file-to-xml"; end Decode_Command; function Get_Short_Help (Cmd : Command_File_To_Xml) return String is pragma Unreferenced (Cmd); begin return "--file-to-xml FILEs Dump AST in XML"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_File_To_Xml; Files_Name : Argument_List) is pragma Unreferenced (Cmd); use Files_Map; Id : Name_Id; File : Source_File_Entry; type File_Data is record Fe : Source_File_Entry; Design_File : Iir; end record; type File_Data_Array is array (Files_Name'Range) of File_Data; Files : File_Data_Array; begin -- Load work library. Setup_Libraries (True); -- Parse all files. for I in Files'Range loop Id := Get_Identifier (Files_Name (I).all); File := Read_Source_File (Libraries.Local_Directory, Id); if File = No_Source_File_Entry then Error ("cannot open " & Image (Id)); return; end if; Files (I).Fe := File; Files (I).Design_File := Libraries.Load_File (File); if Files (I).Design_File = Null_Iir then return; end if; -- Put units in library. -- Note: design_units stay while design_file get empty. Libraries.Add_Design_File_Into_Library (Files (I).Design_File); end loop; -- Analyze all files. for I in Files'Range loop Analyze_Design_File_Units (Files (I).Design_File); end loop; Indent := 0; Col := 0; Put_Line (""); Put_Stag ("root"); Put_Attribute ("version", "0.13"); Put_Stag_End; Disp_Iir_Chain_Elements (Libraries.Get_Libraries_Chain); Put_Etag ("root"); exception when Compilation_Error => Error ("xml dump failed due to compilation error"); end Perform_Action; procedure Register_Commands is begin Register_Command (new Command_File_To_Xml); end Register_Commands; end Ghdlxml;