Merge pull request #12 from persan/develop

Make it compile & run with gnat-21x/GCC 9.2
This commit is contained in:
flyx 2020-04-19 11:54:20 +02:00 committed by GitHub
commit d7b7c9de3a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
31 changed files with 71 additions and 53 deletions

3
.gitignore vendored
View File

@ -7,3 +7,6 @@ gnatinspect.db
*.cswi
*-loc.xml
cvg
messages.txt
*.cgpr

View File

@ -22,7 +22,7 @@ package body Lexer.Source.File is
end Finalize;
function As_Source (File_Path : String) return Pointer is
Ret : constant access Instance :=
Ret : constant Instance_Access :=
new Instance'(Source.Instance with Input_At => 0,
Input_Length => Ada.Directories.Size (File_Path),
others => <>);

View File

@ -8,6 +8,7 @@ package Lexer.Source.File is
-- this provides streams which are backed by files on the file system.
type Instance is new Source.Instance with private;
type Instance_Access is access all Instance;
overriding procedure Read_Data (S : in out Instance; Buffer : out String;
Length : out Natural);

View File

@ -102,5 +102,5 @@ To edit the code, you can use GNAT Programming Studio to open the `*.gpr` files.
[MIT](copying.txt)
[1]: https://github.com/yaml/summit.yaml.io/wiki/YAML-RFC-Index
[2]: https://github.com/yaml/summit.yaml.io/wiki/The-Transformations-Extension
[3]: https://blog.adacore.com/running-american-fuzzy-lop-on-your-ada-code
[2]: https://github.com/yaml/yaml-spec/wiki/The-Transformations-Extension
[3]: https://blog.adacore.com/running-american-fuzzy-lop-on-your-ada-code

View File

@ -12,7 +12,7 @@ package Yaml.Servers is
new Server.Connections_Factory with null record;
type Yaml_Client is new HTTP.HTTP_Client with null record;
pragma Warnings (Off, "formal parameter ""From"" is not referenced");
overriding function Create (Factory : access Yaml_Factory;
Listener : access Server.Connections_Server'Class;
From : GNAT.Sockets.Sock_Addr_Type)
@ -22,5 +22,7 @@ package Yaml.Servers is
Input_Size => Factory.Input_Size,
Output_Size => Factory.Output_Size));
pragma Warnings (On, "formal parameter ""From"" is not referenced");
overriding procedure Do_Get (Client : in out Yaml_Client);
end Yaml.Servers;

View File

@ -122,7 +122,7 @@ package body Yaml.Events.Context is
procedure Create_Local_Store (Object : Reference;
Position : out Local_Scope_Cursor) is
begin
Grow_Scopes (Object.Data.all);
Grow_Scopes (Instance (Object.Data.all));
Object.Data.Local_Scopes (Object.Data.Local_Scope_Count).Events :=
Store.New_Store.Optional;
Position := Local_Scope_Cursor (Object.Data.Local_Scope_Count);
@ -131,7 +131,7 @@ package body Yaml.Events.Context is
procedure Create_Local_Symbol_Scope (Object : Reference;
Position : out Local_Scope_Cursor) is
begin
Grow_Scopes (Object.Data.all);
Grow_Scopes (Instance (Object.Data.all));
Object.Data.Local_Scopes (Object.Data.Local_Scope_Count).Symbols :=
new Symbol_Tables.Map;
Position := Local_Scope_Cursor (Object.Data.Local_Scope_Count);

View File

@ -113,6 +113,7 @@ private
Local_Scopes : Scope_Array_Pointer := null;
Local_Scope_Count, Generated_Data_Count : Natural := 0;
end record;
type Instance_Access is access all Instance;
overriding procedure Finalize (Object : in out Instance);
@ -122,7 +123,7 @@ private
type Symbol_Cursor is new Symbol_Tables.Cursor;
type Reference is new Ada.Finalization.Controlled with record
Data : not null access Instance := raise Constraint_Error with "uninitialized context instance!";
Data : not null Instance_Access := raise Constraint_Error with "uninitialized context instance!";
end record;
overriding procedure Adjust (Object : in out Reference);

View File

@ -281,7 +281,6 @@ package body Yaml.Transformator.Annotation_Processor is
Object.Current.Kind /= Document_End));
function Next (Object : in out Instance) return Event is
use type Events.Context.Location_Type;
procedure Look_For_Additional_Element is
begin

View File

@ -43,7 +43,7 @@ package body Yaml.Dom.Mapping_Data is
Increase_Refcount (Position.Container.Document);
return ((Ada.Finalization.Controlled with
Data => Node_Maps.Key (Position.Position),
Document => Position.Container.Document));
Document => Document_Instance_Access (Position.Container.Document)));
end Key;
function Value (Position : Cursor) return Node_Reference is
@ -51,7 +51,7 @@ package body Yaml.Dom.Mapping_Data is
Increase_Refcount (Position.Container.Document);
return ((Ada.Finalization.Controlled with
Data => Node_Maps.Element (Position.Position),
Document => Position.Container.Document));
Document => Document_Instance_Access (Position.Container.Document)));
end Value;
function Find (Object : Instance; Key : Node_Reference) return Cursor is
@ -144,7 +144,7 @@ package body Yaml.Dom.Mapping_Data is
procedure Raw_Insert (Container : in out Instance;
Key, Value : not null access Node.Instance) is
begin
Container.Data.Insert (Key, Value);
Container.Data.Insert (Node_Pointer (Key), Node_Pointer (Value));
end Raw_Insert;
end Friend_Interface;
end Yaml.Dom.Mapping_Data;

View File

@ -3,21 +3,21 @@
package body Yaml.Dom.Node_Memory is
procedure Visit (Object : in out Instance;
Value : not null access constant Node.Instance;
Value : not null access Node.Instance;
Previously_Visited : out Boolean) is
begin
if Object.Data.Contains (Value) then
if Object.Data.Contains (Node_Pointer (Value)) then
Previously_Visited := True;
else
Object.Data.Include (Value);
Object.Data.Include (Node_Pointer (Value));
Previously_Visited := False;
end if;
end Visit;
procedure Forget (Object : in out Instance;
Value : not null access constant Node.Instance) is
Value : not null access Node.Instance) is
begin
Object.Data.Exclude (Value);
Object.Data.Exclude (Node_Pointer (Value));
end Forget;
function Pop_First (Object : in out Instance)

View File

@ -9,11 +9,11 @@ private package Yaml.Dom.Node_Memory is
type Instance is tagged limited private;
procedure Visit (Object : in out Instance;
Value : not null access constant Node.Instance;
Value : not null access Node.Instance;
Previously_Visited : out Boolean);
procedure Forget (Object : in out Instance;
Value : not null access constant Node.Instance);
Value : not null access Node.Instance);
function Pop_First (Object : in out Instance)
return not null access Node.Instance;

View File

@ -5,7 +5,6 @@ with Yaml.Dom.Node;
package body Yaml.Dom.Sequence_Data is
use type Count_Type;
use type Ada.Containers.Hash_Type;
type Iterator is new Iterators.Forward_Iterator with record
Container : not null access constant Instance;
@ -234,7 +233,7 @@ package body Yaml.Dom.Sequence_Data is
procedure Raw_Append (Container : in out Instance;
New_Item : not null access Node.Instance) is
begin
Container.Data.Append (New_Item);
Container.Data.Append (Node_Pointer (New_Item));
end Raw_Append;
end Friend_Interface;
end Yaml.Dom.Sequence_Data;

View File

@ -8,8 +8,6 @@ with Yaml.Dom.Mapping_Data;
with Yaml.Dom.Node_Memory;
package body Yaml.Dom is
use type Text.Reference;
use type Count_Type;
use type Node.Instance;
function For_Document (Document : not null access Document_Instance)

View File

@ -80,7 +80,7 @@ package body Yaml.Events.Queue is
((Data => Object.Data));
function New_Queue return Reference is
Ptr : constant not null access Instance := new Instance;
Ptr : constant not null Instance_Access := new Instance;
begin
return Reference'(Ada.Finalization.Controlled with Data => Ptr);
end New_Queue;
@ -96,7 +96,7 @@ package body Yaml.Events.Queue is
end Element;
function As_Stream (Object : Reference'Class) return Stream_Reference is
Ptr : constant not null access Stream_Instance :=
Ptr : constant not null Stream_Instance_Access :=
new Stream_Instance'(Refcount_Base with Buffer => Reference (Object),
Offset => 0);
begin

View File

@ -3,7 +3,7 @@
package body Yaml.Events.Store is
function New_Store return Reference is
Ptr : constant not null access Instance := new Instance;
Ptr : constant not null Instance_Access := new Instance;
begin
return (Ada.Finalization.Controlled with Data => Ptr);
end New_Store;
@ -208,7 +208,7 @@ package body Yaml.Events.Store is
function Retrieve (Object : Reference'Class; Position : Anchor_Cursor)
return Stream_Reference is
Ptr : constant not null access Stream_Instance :=
Ptr : constant not null Stream_Instance_Access :=
new Stream_Instance'(Refcount_Base with Object => Reference (Object),
Depth => 0, Current => Anchor_To_Index.Element
(Anchor_To_Index.Cursor (Position)).Position);
@ -219,7 +219,7 @@ package body Yaml.Events.Store is
function Retrieve (Object : Reference'Class; Position : Element_Cursor)
return Stream_Reference is
Ptr : constant not null access Stream_Instance :=
Ptr : constant not null Stream_Instance_Access :=
new Stream_Instance'(Refcount_Base with Object => Reference (Object),
Depth => 0, Current => Positive (Position));
begin

View File

@ -4,8 +4,9 @@
with Ada.Exceptions;
with Yaml.Events.Queue;
with Yaml.Parser;
With GNAT.Strings;
procedure Yaml.Inspect (Input : String) is
use GNAT.Strings;
type Error_Kind is (None, From_Lexer, From_Parser);
P : Parser.Instance;
@ -15,7 +16,7 @@ procedure Yaml.Inspect (Input : String) is
Read_Events : constant Events.Queue.Reference := Events.Queue.New_Queue;
Occurred_Error : Error_Kind := None;
Lexer_Token_Start, Lexer_Token_End : Mark;
Exception_Message : access String;
Exception_Message : String_Access;
begin
P.Set_Input (Input);
Start_Emitting;

View File

@ -4,8 +4,6 @@
with Yaml.Lexer.Evaluation;
package body Yaml.Lexer is
use type Text.Reference;
-----------------------------------------------------------------------------
-- Initialization and buffer handling --
-----------------------------------------------------------------------------

View File

@ -10,7 +10,7 @@ package body Yaml.Parser is
use type Text.Reference;
function New_Parser return Reference is
Ptr : constant not null access Instance := new Instance;
Ptr : constant not null Instance_Access := new Instance;
begin
return Reference'(Ada.Finalization.Controlled with Data => Ptr);
end New_Parser;

View File

@ -84,7 +84,7 @@ package body Yaml.Presenter is
subtype Chosen_Scalar_Style_Type is Scalar_Style_Type range
Plain .. Folded;
pragma Warnings (Off, "formal parameter ""In_Flow"" is not referenced");
function Possibly_Block_Scalar_Style (Features : Analysis.Scalar_Features;
In_Flow : Boolean)
return Chosen_Scalar_Style_Type is
@ -95,6 +95,7 @@ package body Yaml.Presenter is
P.Cur_Max_Column then Literal elsif Features.Folding_Possible
and then Features.Max_Word_Length + P.Levels.Top.Indentation + 2 <=
P.Cur_Max_Column then Folded else Single_Quoted);
pragma Warnings (On, "formal parameter ""In_Flow"" is not referenced");
function Chosen_Scalar_Style (Features : Analysis.Scalar_Features;
In_Flow : Boolean)
@ -500,7 +501,6 @@ package body Yaml.Presenter is
procedure Render_Scalar (In_Flow : Boolean;
Features : Analysis.Scalar_Features)
with Pre => E.Kind = Scalar is
use type Scalar_Style_Type;
begin
if P.Flow_Style = Canonical then
if E.Scalar_Style in Literal | Folded then

View File

@ -64,7 +64,7 @@ package body Yaml.Text_Set is
begin
<<Start>>
declare
Cur : constant not null access Holder := Raw_Set (Object, Hash, S);
Cur : constant not null Holder_Access := Raw_Set (Object, Hash, S);
begin
if Cur.Hash = 0 then
if Grow_If_Needed (Object) then

View File

@ -25,6 +25,7 @@ package Yaml.Text_Set is
Initial_Size : Positive);
procedure Clear (Object : in out Reference);
private
type Holder_Access is access all Holder;
type Holder_Array is array (Natural range <>) of aliased Holder;
type Holder_Array_Access is access Holder_Array;

View File

@ -34,7 +34,7 @@ package body Yaml.Transformation is
end Transform;
function Transform (Original : Stream_Impl.Reference) return Reference is
Ptr : constant not null access Instance :=
Ptr : constant not null Instance_Access :=
new Instance'(Refcount_Base with Original => Original,
Transformators => <>);
begin
@ -42,7 +42,7 @@ package body Yaml.Transformation is
end Transform;
function Value (Object : Reference) return Accessor is
((Data => Object.Data));
((Data => Object.Data.all'Access));
function Next (Object : in out Instance) return Event is
use type Transformator_Vectors.Cursor;

View File

@ -85,6 +85,7 @@ package Yaml.Dom is
private
type Node_Pointer is not null access all Node.Instance;
type Constant_Node_Pointer is not null access constant Node.Instance;
function Nodes_Equal (Left, Right : access Node.Instance) return Boolean;
@ -93,9 +94,9 @@ private
Pool : Text.Pool.Reference;
Implicit_Start, Implicit_End : Boolean;
end record;
type Document_Instance_Access is access all Document_Instance;
type Document_Reference is new Ada.Finalization.Controlled with record
Data : not null access Document_Instance;
Data : not null Document_Instance_Access;
end record;
overriding procedure Adjust (Object : in out Document_Reference);
@ -103,7 +104,7 @@ private
type Node_Reference is new Ada.Finalization.Controlled with record
Data : Node_Pointer;
Document : not null access Document_Instance;
Document : not null Document_Instance_Access;
end record;
overriding procedure Adjust (Object : in out Node_Reference);
@ -111,7 +112,7 @@ private
type Optional_Node_Reference is new Ada.Finalization.Controlled with record
Data : access Node.Instance;
Document : access Document_Instance;
Document : Document_Instance_Access;
end record;
overriding procedure Adjust (Object : in out Optional_Node_Reference);

View File

@ -5,6 +5,7 @@ private with Ada.Finalization;
package Yaml.Events.Queue is
type Instance is limited new Refcount_Base with private;
type Instance_Access is access all Instance;
type Reference is tagged private;
type Accessor (Data : not null access Instance) is limited null record with
Implicit_Dereference => Data;
@ -27,6 +28,7 @@ package Yaml.Events.Queue is
return Element_Accessor;
type Stream_Instance is new Refcount_Base with private;
type Stream_Instance_Access is access all Stream_Instance;
type Stream_Reference is tagged private;
type Stream_Accessor (Data : not null access Stream_Instance) is limited
null record with Implicit_Dereference => Data;

View File

@ -5,6 +5,7 @@ private with Ada.Containers.Hashed_Maps;
package Yaml.Events.Store is
type Instance is limited new Refcount_Base with private;
type Instance_Access is access all Instance;
type Reference is tagged private;
type Optional_Reference is tagged private;
@ -45,6 +46,8 @@ package Yaml.Events.Store is
procedure Copy (Source : in Instance; Target : in out Instance);
type Stream_Instance is limited new Refcount_Base with private;
type Stream_Instance_Access is access all Stream_Instance;
type Stream_Reference is tagged private;
type Optional_Stream_Reference is tagged private;
type Stream_Accessor (Data : not null access Stream_Instance) is limited

View File

@ -13,6 +13,7 @@ package Yaml.Parser is
-- YAML characters stream source.
type Instance is limited new Refcount_Base with private;
type Instance_Access is access all Instance;
subtype Class is Instance'Class;
type Reference is tagged private;
type Accessor (Data : not null access Instance) is limited null record with

View File

@ -9,6 +9,7 @@ generic
with package Stream_Impl is new Stream_Concept (<>);
package Yaml.Transformation is
type Instance is limited new Refcount_Base with private;
type Instance_Access is access all Instance;
type Reference is tagged private;
type Accessor (Data : not null access Instance) is null record with
Implicit_Dereference => Data;
@ -24,10 +25,10 @@ package Yaml.Transformation is
-- takes ownership of the given pointer.
procedure Append (Object : in out Instance;
T : not null Transformator.Pointer);
T : not null Transformator.Pointer);
private
type Reference is new Ada.Finalization.Controlled with record
Data : not null access Instance;
Data : not null Instance_Access;
end record;
overriding procedure Adjust (Object : in out Reference);
@ -39,7 +40,7 @@ private
(Positive, Not_Null_Pointer, Transformator."=");
type Instance is limited new Refcount_Base with record
Original : Stream_Impl.Reference;
Original : Stream_Impl.Reference;
Transformators : Transformator_Vectors.Vector;
end record;
end Yaml.Transformation;

View File

@ -69,7 +69,6 @@ package body Yaml.Annotation_Test is
Expected_Event : constant String := Get_Line (Expected);
Actual : constant Event := Trans.Next;
Actual_Event : constant String := To_String (Actual);
use type Event_Kind;
begin
if Expected_Event = Actual_Event then
Append (Output, Actual_Event & Character'Val (10));
@ -101,7 +100,6 @@ package body Yaml.Annotation_Test is
Expected_Error : File_Type;
Output : Unbounded_String;
Cur : Event;
use type Event_Kind;
begin
TC (T).Cur := TC (T).Cur + 1;
P.Value.Set_Input (Source.File.As_Source (Compose (Test_Dir, "in.yaml")));

View File

@ -92,7 +92,6 @@ package body Yaml.Parser.Event_Test is
Expected_Event : constant String := Get_Line (Expected);
Actual : constant Event := P.Next;
Actual_Event : constant String := To_String (Actual);
use type Event_Kind;
begin
if Expected_Event = Actual_Event then
Append (Output, Actual_Event & Character'Val (10));
@ -122,7 +121,6 @@ package body Yaml.Parser.Event_Test is
Output : Unbounded_String;
Cur : Event;
Expected_Error : File_Type;
use type Event_Kind;
begin
TC (T).Cur := TC (T).Cur + 1;
P.Set_Input (Source.File.As_Source (Compose (Test_Dir, "in.yaml")));

View File

@ -18,22 +18,26 @@ library project Yaml is
end Ide;
package Builder is
for Default_Switches ("ada") use ("-s", "-j0");
case Mode is
when "debug" =>
for Default_Switches ("ada") use ("-s", "-g");
for Default_Switches ("ada") use Builder'Default_Switches ("ada") & ("-g");
when "release" =>
for Default_Switches ("ada") use ("-s");
null;
end case;
end Builder;
package Compiler is
for Default_Switches ("ada") use
("-gnat12", "-gnatwa", "-gnatwl", "-gnata", "-gnaty3abcefhiklmNprt", "-fstack-check");
case Mode is
when "debug" =>
for Default_Switches ("ada") use
("-gnat12", "-gnatwa", "-gnatwl", "-gnata", "-gnateE", "-E", "-gnaty3abcefhiklmNprt", "-g", "-fstack-check");
for Default_Switches ("ada") use Compiler'Default_Switches ("ada") &
("-gnata", "-gnateE", "-E", "-g");
when "release" =>
for Default_Switches ("ada") use
("-gnat12", "-gnatwa", "-gnatwl", "-O3", "-gnaty3abcefhiklmNprt", "-fstack-check");
("-O3" );
end case;
end Compiler;
end Yaml;

7
yaml_all.gpr Normal file
View File

@ -0,0 +1,7 @@
Aggregate project Yaml_All is
for Project_Files use project'Project_Files & ("yaml-annotation_processor.gpr");
for Project_Files use project'Project_Files & ("yaml.gpr");
for Project_Files use project'Project_Files & ("yaml-server.gpr");
for Project_Files use project'Project_Files & ("yaml-tests.gpr");
for Project_Files use project'Project_Files & ("yaml-utils.gpr");
end Yaml_All;