From 607da0a015588ca8cee6adaa009c305eaf60f81f Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Tue, 23 Jan 2024 19:19:41 +0200 Subject: [PATCH 1/2] JSON Schema tool: Fix generation "array of enums" Refs #232, #230 --- .../json_schema-writers-inputs.adb | 2 +- .../json_schema-writers-outputs.adb | 2 +- .../json_schema/json_schema-writers-types.adb | 87 +++++++++++++------ tools/json_schema/json_schema-writers.adb | 43 ++++++--- tools/json_schema/json_schema-writers.ads | 5 +- 5 files changed, 99 insertions(+), 40 deletions(-) diff --git a/tools/json_schema/json_schema-writers-inputs.adb b/tools/json_schema/json_schema-writers-inputs.adb index b62487ac..d317ad5b 100644 --- a/tools/json_schema/json_schema-writers-inputs.adb +++ b/tools/json_schema/json_schema-writers-inputs.adb @@ -807,7 +807,7 @@ package body JSON_Schema.Writers.Inputs is Type_Prefix : VSS.Strings.Virtual_String; begin Get_Element_Type - (Map, Property.Schema, Item_Type, Type_Prefix); + (Name, Map, Property, Item_Type, Type_Prefix); Put ("if Success and Reader.Is_Start_Array then"); New_Line; Put ("Reader.Read_Next;"); New_Line; diff --git a/tools/json_schema/json_schema-writers-outputs.adb b/tools/json_schema/json_schema-writers-outputs.adb index 85dea65c..9891a6b7 100644 --- a/tools/json_schema/json_schema-writers-outputs.adb +++ b/tools/json_schema/json_schema-writers-outputs.adb @@ -559,7 +559,7 @@ package body JSON_Schema.Writers.Outputs is Type_Prefix : VSS.Strings.Virtual_String; begin Get_Element_Type - (Map, Property.Schema, Item_Type, Type_Prefix); + (Name, Map, Property, Item_Type, Type_Prefix); Put ("Handler.Start_Array;"); New_Line; diff --git a/tools/json_schema/json_schema-writers-types.adb b/tools/json_schema/json_schema-writers-types.adb index fc802c9e..a6a88407 100644 --- a/tools/json_schema/json_schema-writers-types.adb +++ b/tools/json_schema/json_schema-writers-types.adb @@ -132,9 +132,9 @@ package body JSON_Schema.Writers.Types is -- optional properties. procedure Find_Array_Types - (Map : JSON_Schema.Readers.Schema_Map; - Schema : Schema_Access; - Result : in out Readers.Schema_Map); + (Enclosing_Type : Schema_Name; + Map : JSON_Schema.Readers.Schema_Map; + Result : in out Readers.Schema_Map); -- Scan Schema recursively and find all types that are referenced as items -- in an array schema. @@ -195,32 +195,60 @@ package body JSON_Schema.Writers.Types is ---------------------- procedure Find_Array_Types - (Map : JSON_Schema.Readers.Schema_Map; - Schema : Schema_Access; - Result : in out Readers.Schema_Map) + (Enclosing_Type : Schema_Name; + Map : JSON_Schema.Readers.Schema_Map; + Result : in out Readers.Schema_Map) is use type Definitions.Simple_Types; - Ref : Schema_Name; - begin - if Schema.Kind.Last_Index = 1 - and then Schema.Kind (1) = Definitions.An_Array - and then not Schema.Items.First_Element.Ref.Is_Empty - then - pragma Assert (Schema.Items.Last_Index = 1); - Ref := Schema.Items.First_Element.Ref; - Result.Include (Ref_To_Type_Name (Ref), Map (Ref)); - end if; + procedure Recursion + (Schema : Schema_Access; + Prop : VSS.Strings.Virtual_String); - for Item of Schema.All_Of loop - if Item.Ref.Is_Empty then - Find_Array_Types (Map, Item, Result); + procedure Recursion + (Schema : Schema_Access; + Prop : VSS.Strings.Virtual_String) + is + Ref : Schema_Name; + begin + if Schema.Kind.Last_Index = 1 + and then Schema.Kind (1) = Definitions.An_Array + then + if not Schema.Items.First_Element.Ref.Is_Empty then + pragma Assert (Schema.Items.Last_Index = 1); + Ref := Schema.Items.First_Element.Ref; + Result.Include (Ref_To_Type_Name (Ref), Map (Ref)); + + elsif Is_Enum (Schema.Items.First_Element) then + + declare + Name : VSS.Strings.Virtual_String := + Ref_To_Type_Name (Enclosing_Type); + begin + if not Prop.Is_Empty then + Name.Append ("_"); + Name.Append (Prop); + end if; + + Result.Insert (Name, Schema.Items.First_Element); + end; + end if; end if; - end loop; - for Property of Schema.Properties loop - Find_Array_Types (Map, Property.Schema, Result); - end loop; + for Item of Schema.All_Of loop + if Item.Ref.Is_Empty then + Recursion (Item, Prop); + end if; + end loop; + + for Property of Schema.Properties loop + Recursion (Property.Schema, Property.Name); + end loop; + end Recursion; + + Schema : constant Schema_Access := Map (Enclosing_Type); + begin + Recursion (Schema, ""); end Find_Array_Types; ------------------------- @@ -274,9 +302,16 @@ package body JSON_Schema.Writers.Types is Optional_Types : String_Sets.Set; Array_Types : Readers.Schema_Map; begin - for Schema of Map loop - Find_Optional_Types (Schema, Optional_Types); - Find_Array_Types (Map, Schema, Array_Types); + for Cursor in Map.Iterate loop + declare + Name : constant VSS.Strings.Virtual_String := + JSON_Schema.Readers.Schema_Maps.Key (Cursor); + Schema : constant Schema_Access := + JSON_Schema.Readers.Schema_Maps.Element (Cursor); + begin + Find_Optional_Types (Schema, Optional_Types); + Find_Array_Types (Name, Map, Array_Types); + end; end loop; Array_Types.Insert ("Integer", null); diff --git a/tools/json_schema/json_schema-writers.adb b/tools/json_schema/json_schema-writers.adb index 41b8145a..210bdedd 100644 --- a/tools/json_schema/json_schema-writers.adb +++ b/tools/json_schema/json_schema-writers.adb @@ -115,6 +115,12 @@ package body JSON_Schema.Writers is end if; end loop; + for Item of Schema.Items loop + if Item.Ref.Is_Empty then + Traverse_Nested_Schemas (Name, Property, Item, False); + end if; + end loop; + for Property of Schema.Properties loop Traverse_Nested_Schemas (Name, @@ -410,21 +416,33 @@ package body JSON_Schema.Writers is ---------------------- procedure Get_Element_Type - (Map : JSON_Schema.Readers.Schema_Map; - Schema : Schema_Access; + (Name : Schema_Name; + Map : JSON_Schema.Readers.Schema_Map; + Prop : Property; Type_Name : out VSS.Strings.Virtual_String; - Prefix : out VSS.Strings.Virtual_String) is + Prefix : out VSS.Strings.Virtual_String) + is + Schema : constant Schema_Access := Prop.Schema; begin if Schema.Kind.Last_Index = 1 then case Schema.Kind (1) is when Definitions.An_Array => - Get_Field_Type - (Map, Schema.Items.First_Element, - True, "", Type_Name, Prefix); - if Type_Name.Is_Empty then - Type_Name := "Virtual_String"; - Prefix := "VSS.Strings."; + if Is_Enum (Schema.Items.First_Element) then + Type_Name := Ref_To_Type_Name (Name); + Type_Name.Append ("_"); + Type_Name.Append (Prop.Name); + Prefix := "Enum."; + + else + Get_Field_Type + (Map, Schema.Items.First_Element, + True, "", Type_Name, Prefix); + + if Type_Name.Is_Empty then + Type_Name := "Virtual_String"; + Prefix := "VSS.Strings."; + end if; end if; when others => null; @@ -514,6 +532,11 @@ package body JSON_Schema.Writers is if not Item.Ref.Is_Empty then Result := Ref_To_Type_Name (Item.Ref); Result.Append ("_Vector"); + + elsif Is_Enum (Item) then + Result := Fallback; + Result.Append ("_Vector"); + else case Item.Kind (1) is when Definitions.A_Boolean => @@ -610,7 +633,7 @@ package body JSON_Schema.Writers is List : constant VSS.String_Vectors.Virtual_String_Vector := Subschema.Split ('/'); begin - return List.Element (List.Length); + return Escape_Keywords (List.Element (List.Length)); end Ref_To_Type_Name; ------------------ diff --git a/tools/json_schema/json_schema-writers.ads b/tools/json_schema/json_schema-writers.ads index 1f0a4e73..fdfd067c 100644 --- a/tools/json_schema/json_schema-writers.ads +++ b/tools/json_schema/json_schema-writers.ads @@ -107,8 +107,9 @@ package JSON_Schema.Writers is -- If type is defined in a package, then return package name in Prefix. procedure Get_Element_Type - (Map : JSON_Schema.Readers.Schema_Map; - Schema : Schema_Access; + (Name : Schema_Name; + Map : JSON_Schema.Readers.Schema_Map; + Prop : Property; Type_Name : out VSS.Strings.Virtual_String; Prefix : out VSS.Strings.Virtual_String); From a5b1e994875e028d6ed57a71fb3e7046707b66a9 Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Tue, 23 Jan 2024 19:21:16 +0200 Subject: [PATCH 2/2] Rebase JSON Schema test --- testsuite/json_schema/dap/expected.txt | 207 +++++++++++++++++++++++-- 1 file changed, 197 insertions(+), 10 deletions(-) diff --git a/testsuite/json_schema/dap/expected.txt b/testsuite/json_schema/dap/expected.txt index 9edb14c5..a467a56d 100644 --- a/testsuite/json_schema/dap/expected.txt +++ b/testsuite/json_schema/dap/expected.txt @@ -123,6 +123,10 @@ type Source_Vector is tagged private with Variable_Indexing => Get_Source_Variable_Reference, Constant_Indexing => Get_Source_Constant_Reference; +type VariablePresentationHint_attributes_Vector is tagged private +with Variable_Indexing => Get_VariablePresentationHint_attributes_Variable_Reference, +Constant_Indexing => Get_VariablePresentationHint_attributes_Constant_Reference; + type SourceBreakpoint_Vector is tagged private with Variable_Indexing => Get_SourceBreakpoint_Variable_Reference, Constant_Indexing => Get_SourceBreakpoint_Constant_Reference; @@ -465,6 +469,44 @@ when True => Value : VariablePresentationHint_kind; when False => null; end case; end record; +type VariablePresentationHint_attributes_Value is (static, a_constant, readOnly, rawString, hasObjectId, canHaveObjectId, hasSideEffects, hasDataBreakpoint, Custom_Value); + +subtype VariablePresentationHint_attributes_Predefined is VariablePresentationHint_attributes_Value range static .. hasDataBreakpoint; + +type VariablePresentationHint_attributes (Kind : VariablePresentationHint_attributes_Value := Custom_Value) is record +case Kind is + when Custom_Value => + Custom_Value : VSS.Strings.Virtual_String; + when VariablePresentationHint_attributes_Predefined => + null; +end case; +end record; + +function static return VariablePresentationHint_attributes is (Kind => static); + -- Indicates that the object is static. + +function a_constant return VariablePresentationHint_attributes is (Kind => a_constant); + -- Indicates that the object is a constant. + +function readOnly return VariablePresentationHint_attributes is (Kind => readOnly); + -- Indicates that the object is read only. + +function rawString return VariablePresentationHint_attributes is (Kind => rawString); + -- Indicates that the object is a raw string. + +function hasObjectId return VariablePresentationHint_attributes is (Kind => hasObjectId); + -- Indicates that the object can have an Object ID created for it. + +function canHaveObjectId return VariablePresentationHint_attributes is (Kind => canHaveObjectId); + -- Indicates that the object has an Object ID associated with it. + +function hasSideEffects return VariablePresentationHint_attributes is (Kind => hasSideEffects); + -- Indicates that the evaluation had side effects. + +function hasDataBreakpoint return VariablePresentationHint_attributes is (Kind => hasDataBreakpoint); + -- Indicates that the object has its value tracked by a data breakpoint. + + type VariablePresentationHint_visibility_Value is (public, a_private, a_protected, internal, final, Custom_Value); subtype VariablePresentationHint_visibility_Predefined is VariablePresentationHint_visibility_Value range public .. final; @@ -1347,7 +1389,7 @@ end record; type VariablePresentationHint is record kind : Enum.Optional_VariablePresentationHint_kind; -- The kind of variable. Before introducing additional values, try to use the listed values. -attributes : VSS.String_Vectors.Virtual_String_Vector; +attributes : VariablePresentationHint_attributes_Vector; -- Set of attributes represented as an array of strings. Before introducing additional values, try to use the listed values. visibility : Enum.Optional_VariablePresentationHint_visibility; -- Visibility of variable. Before introducing additional values, try to use the listed values. @@ -3946,6 +3988,34 @@ Index : Positive) return Source_Constant_Reference with Inline; +function Length (Self : VariablePresentationHint_attributes_Vector) return Natural; + +procedure Clear (Self : in out VariablePresentationHint_attributes_Vector); + +procedure Append +(Self : in out VariablePresentationHint_attributes_Vector; +Value : Enum.VariablePresentationHint_attributes); + +type VariablePresentationHint_attributes_Variable_Reference +(Element : not null access Enum.VariablePresentationHint_attributes) is null record +with Implicit_Dereference => Element; + +not overriding function Get_VariablePresentationHint_attributes_Variable_Reference +(Self : aliased in out VariablePresentationHint_attributes_Vector; +Index : Positive) +return VariablePresentationHint_attributes_Variable_Reference +with Inline; + +type VariablePresentationHint_attributes_Constant_Reference +(Element : not null access constant Enum.VariablePresentationHint_attributes) is null record +with Implicit_Dereference => Element; + +not overriding function Get_VariablePresentationHint_attributes_Constant_Reference +(Self : aliased VariablePresentationHint_attributes_Vector; +Index : Positive) +return VariablePresentationHint_attributes_Constant_Reference +with Inline; + function Length (Self : SourceBreakpoint_Vector) return Natural; procedure Clear (Self : in out SourceBreakpoint_Vector); @@ -4431,6 +4501,17 @@ overriding procedure Adjust (Self : in out Source_Vector); overriding procedure Finalize (Self : in out Source_Vector); +type VariablePresentationHint_attributes_Array is array (Positive range <>) of aliased Enum.VariablePresentationHint_attributes; +type VariablePresentationHint_attributes_Array_Access is access VariablePresentationHint_attributes_Array; +type VariablePresentationHint_attributes_Vector is new Ada.Finalization.Controlled with record +Data : VariablePresentationHint_attributes_Array_Access; +Length : Natural := 0; +end record; + +overriding procedure Adjust (Self : in out VariablePresentationHint_attributes_Vector); + +overriding procedure Finalize (Self : in out VariablePresentationHint_attributes_Vector); + type SourceBreakpoint_Array is array (Positive range <>) of aliased SourceBreakpoint; type SourceBreakpoint_Array_Access is access SourceBreakpoint_Array; type SourceBreakpoint_Vector is new Ada.Finalization.Controlled with record @@ -5456,6 +5537,61 @@ Index : Positive) return Source_Constant_Reference is (Element => Self.Data (Index)'Access); +procedure Free is new Ada.Unchecked_Deallocation +(VariablePresentationHint_attributes_Array, VariablePresentationHint_attributes_Array_Access); + +overriding procedure Adjust (Self : in out VariablePresentationHint_attributes_Vector) is +begin +if Self.Length > 0 then +Self.Data := +new VariablePresentationHint_attributes_Array'(Self.Data (1 .. Self.Length)); +end if; +end Adjust; + +overriding procedure Finalize (Self : in out VariablePresentationHint_attributes_Vector) is +begin +Free (Self.Data); +Self.Length := 0; +end Finalize; + +function Length (Self : VariablePresentationHint_attributes_Vector) return Natural is (Self.Length); + +procedure Clear (Self : in out VariablePresentationHint_attributes_Vector) is +begin + Self.Length := 0; +end Clear; + +procedure Append +(Self : in out VariablePresentationHint_attributes_Vector; +Value : Enum.VariablePresentationHint_attributes) is +Init_Length : constant Positive := +Positive'Max (1, 256 / Enum.VariablePresentationHint_attributes'Size); +Self_Data_Saved : VariablePresentationHint_attributes_Array_Access := Self.Data; +begin +if Self.Length = 0 then +Self.Data := new VariablePresentationHint_attributes_Array (1 .. Init_Length); +elsif Self.Length = Self.Data'Last then +Self.Data := +new VariablePresentationHint_attributes_Array'(Self.Data.all + & VariablePresentationHint_attributes_Array'(1 .. Self.Length => <>)); +Free (Self_Data_Saved); +end if; +Self.Length := Self.Length + 1; +Self.Data (Self.Length) := Value; +end Append; + +not overriding function Get_VariablePresentationHint_attributes_Variable_Reference +(Self : aliased in out VariablePresentationHint_attributes_Vector; +Index : Positive) +return VariablePresentationHint_attributes_Variable_Reference +is (Element => Self.Data (Index)'Access); + +not overriding function Get_VariablePresentationHint_attributes_Constant_Reference +(Self : aliased VariablePresentationHint_attributes_Vector; +Index : Positive) +return VariablePresentationHint_attributes_Constant_Reference +is (Element => Self.Data (Index)'Access); + procedure Free is new Ada.Unchecked_Deallocation (SourceBreakpoint_Array, SourceBreakpoint_Array_Access); @@ -6167,6 +6303,10 @@ procedure Output_VariablePresentationHint_kind (Handler : in out VSS.JSON.Content_Handlers.JSON_Content_Handler'Class; Value : Enum.VariablePresentationHint_kind); +procedure Output_VariablePresentationHint_attributes +(Handler : in out VSS.JSON.Content_Handlers.JSON_Content_Handler'Class; +Value : Enum.VariablePresentationHint_attributes); + procedure Output_VariablePresentationHint_visibility (Handler : in out VSS.JSON.Content_Handlers.JSON_Content_Handler'Class; Value : Enum.VariablePresentationHint_visibility); @@ -7350,6 +7490,33 @@ Handler.String_Value ("dataBreakpoint"); end case; end Output_VariablePresentationHint_kind; +procedure Output_VariablePresentationHint_attributes +(Handler : in out VSS.JSON.Content_Handlers.JSON_Content_Handler'Class; +Value : Enum.VariablePresentationHint_attributes) is +begin +case Value.Kind is +when Enum.Custom_Value => +Handler.String_Value (Value.Custom_Value); + +when Enum.static => +Handler.String_Value ("static"); +when Enum.a_constant => +Handler.String_Value ("constant"); +when Enum.readOnly => +Handler.String_Value ("readOnly"); +when Enum.rawString => +Handler.String_Value ("rawString"); +when Enum.hasObjectId => +Handler.String_Value ("hasObjectId"); +when Enum.canHaveObjectId => +Handler.String_Value ("canHaveObjectId"); +when Enum.hasSideEffects => +Handler.String_Value ("hasSideEffects"); +when Enum.hasDataBreakpoint => +Handler.String_Value ("hasDataBreakpoint"); +end case; +end Output_VariablePresentationHint_attributes; + procedure Output_VariablePresentationHint_visibility (Handler : in out VSS.JSON.Content_Handlers.JSON_Content_Handler'Class; Value : Enum.VariablePresentationHint_visibility) is @@ -10612,11 +10779,11 @@ if Value.kind.Is_Set then Handler.Key_Name ("kind"); Output_VariablePresentationHint_kind (Handler, Value.kind.Value); end if; -if not Value.attributes.Is_Empty then +if Value.attributes.Length > 0 then Handler.Key_Name ("attributes"); Handler.Start_Array; for J in 1 .. Value.attributes.Length loop -Handler.String_Value (Value.attributes (J)); +Output_VariablePresentationHint_attributes (Handler, Value.attributes (J)); end loop; Handler.End_Array; end if; @@ -12160,6 +12327,11 @@ procedure Input_VariablePresentationHint_kind Value : out Enum.VariablePresentationHint_kind; Success : in out Boolean); +procedure Input_VariablePresentationHint_attributes +(Reader : in out VSS.JSON.Pull_Readers.JSON_Pull_Reader'Class; +Value : out Enum.VariablePresentationHint_attributes; +Success : in out Boolean); + procedure Input_VariablePresentationHint_visibility (Reader : in out VSS.JSON.Pull_Readers.JSON_Pull_Reader'Class; Value : out Enum.VariablePresentationHint_visibility; @@ -13532,6 +13704,26 @@ Success := False; end if; end Input_VariablePresentationHint_kind; +package VariablePresentationHint_attributes_Minimal_Perfect_Hash is new Minimal_Perfect_Hash (["static", "constant", "readOnly", "rawString", "hasObjectId", "canHaveObjectId", "hasSideEffects", "hasDataBreakpoint"]); + +procedure Input_VariablePresentationHint_attributes +(Reader : in out VSS.JSON.Pull_Readers.JSON_Pull_Reader'Class; +Value : out Enum.VariablePresentationHint_attributes; +Success : in out Boolean) is +Index : constant Integer := (if Reader.Is_String_Value then +VariablePresentationHint_attributes_Minimal_Perfect_Hash.Get_Index (Reader.String_Value)else -1); +begin +if Index > 0 then +pragma Warnings (Off, "redundant conversion"); +Value := (Kind => Enum.VariablePresentationHint_attributes_Predefined (Enum.VariablePresentationHint_attributes_Value'Val (Index - 1)));pragma Warnings (On, "redundant conversion"); +Reader.Read_Next; +elsif Index = 0 then +Value := (Enum.Custom_Value, Reader.String_Value);Reader.Read_Next; +else +Success := False; +end if; +end Input_VariablePresentationHint_attributes; + package VariablePresentationHint_visibility_Minimal_Perfect_Hash is new Minimal_Perfect_Hash (["public", "private", "protected", "internal", "final"]); procedure Input_VariablePresentationHint_visibility @@ -23472,14 +23664,9 @@ if Success and Reader.Is_Start_Array then Reader.Read_Next; while Success and not Reader.Is_End_Array loop declare -Item : VSS.Strings.Virtual_String; +Item : Enum.VariablePresentationHint_attributes; begin -if Reader.Is_String_Value then -Item := Reader.String_Value; -Reader.Read_Next; -else -Success := False; -end if; +Input_VariablePresentationHint_attributes (Reader, Item, Success); Value.attributes.Append (Item); end; end loop;