diff --git a/schema/schema-schema_readers.adb b/schema/schema-schema_readers.adb index 01a0d1b..a47f0ff 100644 --- a/schema/schema-schema_readers.adb +++ b/schema/schema-schema_readers.adb @@ -922,7 +922,6 @@ package body Schema.Schema_Readers is Handler.Contexts := new Context' (Typ => Context_Group, Group => Group, - Redefined_Group => No_XML_Group, Next => Handler.Contexts); -- Do not use In_Redefine_Context, since this only applies for types diff --git a/schema/schema-schema_readers.ads b/schema/schema-schema_readers.ads index 570f690..6a146ec 100644 --- a/schema/schema-schema_readers.ads +++ b/schema/schema-schema_readers.ads @@ -179,9 +179,7 @@ private when Context_Choice => Choice : Type_Details_Access; when Context_Attribute_Group => Attr_Group : AttrGroup_Descr; when Context_Schema | Context_Redefine => null; - when Context_Group => - Group : Group_Descr; - Redefined_Group : Schema.Validators.XML_Group; -- + when Context_Group => Group : Group_Descr; when Context_All => null; diff --git a/schema/schema-validators-extensions.adb b/schema/schema-validators-extensions.adb index bb268dd..9d27d79 100644 --- a/schema/schema-validators-extensions.adb +++ b/schema/schema-validators-extensions.adb @@ -271,11 +271,10 @@ package body Schema.Validators.Extensions is (G : XML_Grammar_NS; Reader : access Abstract_Validation_Reader'Class; Base : XML_Type; - Group : XML_Group; Min_Occurs : Natural := 1; Max_Occurs : Integer := 1) return XML_Validator is - pragma Unreferenced (Group, Min_Occurs, Max_Occurs); + pragma Unreferenced (Min_Occurs, Max_Occurs); Result : constant Extension_Type := new Extension_XML_Validator; begin if Get_Final (Base)(Final_Extension) then diff --git a/schema/schema-validators-extensions.ads b/schema/schema-validators-extensions.ads index 56ab4d6..5b47a9c 100644 --- a/schema/schema-validators-extensions.ads +++ b/schema/schema-validators-extensions.ads @@ -38,7 +38,6 @@ private package Schema.Validators.Extensions is (G : XML_Grammar_NS; Reader : access Abstract_Validation_Reader'Class; Base : XML_Type; - Group : XML_Group; Min_Occurs : Natural := 1; Max_Occurs : Integer := 1) return XML_Validator; -- Create new extensions of Base, either through a type or a group. diff --git a/schema/schema-validators-xsd_grammar.adb b/schema/schema-validators-xsd_grammar.adb index 38d9043..fce6232 100644 --- a/schema/schema-validators-xsd_grammar.adb +++ b/schema/schema-validators-xsd_grammar.adb @@ -44,7 +44,7 @@ package body Schema.Validators.XSD_Grammar is -- Choice1 : Choice; All_Validator : XML_Type; Elem : XML_Element; - Gr : XML_Group; +-- Gr : XML_Group; Union, Union2 : XML_Validator; Annotation, Any : XML_Element; @@ -68,12 +68,12 @@ package body Schema.Validators.XSD_Grammar is Facet_Type : XML_Type; Redefinable, SchemaTop : XML_Element; maxBound, minBound : XML_Element; - attrDecls : XML_Group; - typeDefParticle : XML_Group; +-- attrDecls : XML_Group; +-- typeDefParticle : XML_Group; -- defRef, Occurs : XML_Attribute_Group; - complexTypeModel : XML_Group; - groupDefParticle : XML_Group; - simpleRestrictionModel : XML_Group; +-- complexTypeModel : XML_Group; +-- groupDefParticle : XML_Group; +-- simpleRestrictionModel : XML_Group; begin Get_NS (R.Grammar, R.XML_Schema_URI, Result => G); diff --git a/schema/schema-validators.adb b/schema/schema-validators.adb index 5692a69..188ecb9 100644 --- a/schema/schema-validators.adb +++ b/schema/schema-validators.adb @@ -93,15 +93,6 @@ package body Schema.Validators is Extension : XML_Validator := null) return XML_Validator renames Schema.Validators.Extensions.Create_Extension_Of; - function Extension_Of - (G : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Base : XML_Type; - Group : XML_Group; - Min_Occurs : Natural := 1; - Max_Occurs : Integer := 1) return XML_Validator - renames Schema.Validators.Extensions.Create_Extension_Of; - function Restriction_Of (G : XML_Grammar_NS; Reader : access Abstract_Validation_Reader'Class; @@ -1278,31 +1269,6 @@ package body Schema.Validators is return (Elem => Result, Is_Ref => True); end Lookup_Element; - ------------------ - -- Lookup_Group -- - ------------------ - - function Lookup_Group - (Grammar : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Local_Name : Symbol) return XML_Group - is - Result : XML_Group := Groups_Htable.Get - (Grammar.Groups.all, Local_Name); - begin - if Result = No_XML_Group then - if Grammar.Checked then - Validation_Error - (Reader, "#Declaration not found for " - & To_QName (Grammar, Local_Name)); - end if; - - Result := Create_Global_Group (Grammar, Reader, Local_Name); - Result.Is_Forward_Decl := True; - end if; - return Result; - end Lookup_Group; - ---------------------- -- Lookup_Attribute -- ---------------------- @@ -1633,7 +1599,6 @@ package body Schema.Validators is System_ID => No_Symbol, Types => new Types_Htable.HTable (101), Elements => new Elements_Htable.HTable (101), - Groups => new Groups_Htable.HTable (101), Attributes => new Attributes_Htable.HTable (101), Checked => False, NFA => Get (Grammar).NFA, @@ -1849,23 +1814,6 @@ package body Schema.Validators is return No_Type; end Redefine_Type; - -------------------- - -- Redefine_Group -- - -------------------- - - function Redefine_Group - (Grammar : XML_Grammar_NS; Local_Name : Symbol) return XML_Group - is - Old : constant XML_Group := Groups_Htable.Get - (Grammar.Groups.all, Local_Name); - begin - if Old /= No_XML_Group then - Old.Is_Forward_Decl := True; - return Old; - end if; - return No_XML_Group; - end Redefine_Group; - ---------------- -- Debug_Name -- ---------------- @@ -2078,35 +2026,6 @@ package body Schema.Validators is return Attribute_Validator (Old); end Create_Global_Attribute; - ------------------------- - -- Create_Global_Group -- - ------------------------- - - function Create_Global_Group - (Grammar : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Local_Name : Symbol) return XML_Group - is - Group : XML_Group := Groups_Htable.Get (Grammar.Groups.all, Local_Name); - begin - if Group /= No_XML_Group then - if not Group.Is_Forward_Decl then - Validation_Error - (Reader, "#Group has already been declared: " - & Get (Local_Name).all); - end if; - - Group.Is_Forward_Decl := False; - else - Group := new XML_Group_Record' - (Local_Name => Local_Name, - -- Particles => Empty_Particle_List, - Is_Forward_Decl => False); - Groups_Htable.Set (Grammar.Groups.all, Group); - end if; - return Group; - end Create_Global_Group; - ---------- -- Free -- ---------- @@ -2234,8 +2153,6 @@ package body Schema.Validators is (Types_Htable.HTable, Types_Htable_Access); procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Elements_Htable.HTable, Elements_Htable_Access); - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Groups_Htable.HTable, Groups_Htable_Access); procedure Unchecked_Free is new Ada.Unchecked_Deallocation (XML_Grammar_NS_Record, XML_Grammar_NS); procedure Unchecked_Free is new Ada.Unchecked_Deallocation @@ -2291,8 +2208,6 @@ package body Schema.Validators is Unchecked_Free (Grammar.Elements); Types_Htable.Reset (Grammar.Types.all); Unchecked_Free (Grammar.Types); - Groups_Htable.Reset (Grammar.Groups.all); - Unchecked_Free (Grammar.Groups); Attributes_Htable.Reset (Grammar.Attributes.all); Unchecked_Free (Grammar.Attributes); @@ -2490,18 +2405,6 @@ package body Schema.Validators is return Element.Elem.Fixed; end Get_Fixed; - ---------- - -- Free -- - ---------- - - procedure Free (Group : in out XML_Group) is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (XML_Group_Record, XML_Group); - begin --- Free (Group.Particles); - Unchecked_Free (Group); - end Free; - ------------- -- Get_Key -- ------------- @@ -2524,15 +2427,6 @@ package body Schema.Validators is -- Get_Key -- ------------- - function Get_Key (Group : XML_Group) return Symbol is - begin - return Group.Local_Name; - end Get_Key; - - ------------- - -- Get_Key -- - ------------- - function Get_Key (Att : Named_Attribute_Validator) return Symbol is begin return Att.Local_Name; @@ -2608,15 +2502,6 @@ package body Schema.Validators is return Element.Elem.Substitution_Group; end Get_Substitution_Group; - -------------------- - -- Get_Local_Name -- - -------------------- - - function Get_Local_Name (Group : XML_Group) return Symbol is - begin - return Group.Local_Name; - end Get_Local_Name; - ----------------------- -- Create_Local_Type -- ----------------------- @@ -2660,17 +2545,15 @@ package body Schema.Validators is (Reader : access Abstract_Validation_Reader'Class; Grammar : XML_Grammar_NS) is - use Elements_Htable, Types_Htable, Attributes_Htable, Groups_Htable; + use Elements_Htable, Types_Htable, Attributes_Htable; Elem_Iter : Elements_Htable.Iterator := First (Grammar.Elements.all); Type_Iter : Types_Htable.Iterator := First (Grammar.Types.all); Attr_Iter : Attributes_Htable.Iterator := First (Grammar.Attributes.all); - Group_Iter : Groups_Htable.Iterator := First (Grammar.Groups.all); Elem : XML_Element_Access; Typ : XML_Type; Attr : Named_Attribute_Validator; - Group : XML_Group; begin if Grammar.Checked then return; @@ -2713,18 +2596,6 @@ package body Schema.Validators is Next (Grammar.Attributes.all, Attr_Iter); end loop; - - while Group_Iter /= Groups_Htable.No_Iterator loop - Group := Current (Group_Iter); - if Group.Is_Forward_Decl then - Validation_Error - (Reader, "Group """ - & To_QName (Grammar.Namespace_URI, Group.Local_Name) - & """ is referenced, but not defined"); - end if; - - Next (Grammar.Groups.all, Group_Iter); - end loop; end Global_Check; ---------- diff --git a/schema/schema-validators.ads b/schema/schema-validators.ads index 280484c..6da908a 100644 --- a/schema/schema-validators.ads +++ b/schema/schema-validators.ads @@ -874,28 +874,6 @@ package Schema.Validators is function Get_QName (Element : XML_Element) return Qualified_Name; -- Return the qualified name for Element - ------------ - -- Groups -- - ------------ - - type XML_Group is private; - No_XML_Group : constant XML_Group; - -- A group of elements, Create through a call to Create_Global_Group - - function Extension_Of - (G : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Base : XML_Type; - Group : XML_Group; - Min_Occurs : Natural := 1; - Max_Occurs : Integer := 1) return XML_Validator; - -- Create an extension of Base. - -- Base doesn't need to be a Clone of some other type, since it isn't - -- altered - - function Get_Local_Name (Group : XML_Group) return Sax.Symbols.Symbol; - -- Return the local name of the group - -------------- -- Grammars -- -------------- @@ -923,10 +901,6 @@ package Schema.Validators is Reader : access Abstract_Validation_Reader'Class; Local_Name : Sax.Symbols.Symbol; Create_If_Needed : Boolean := True) return XML_Type; - function Lookup_Group - (Grammar : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Local_Name : Sax.Symbols.Symbol) return XML_Group; function Lookup_Attribute (Grammar : XML_Grammar_NS; Reader : access Abstract_Validation_Reader'Class; @@ -951,10 +925,6 @@ package Schema.Validators is Reader : access Abstract_Validation_Reader'Class; Local_Name : Sax.Symbols.Symbol; Form : Form_Type) return XML_Element; - function Create_Global_Group - (Grammar : XML_Grammar_NS; - Reader : access Abstract_Validation_Reader'Class; - Local_Name : Sax.Symbols.Symbol) return XML_Group; function Create_Global_Attribute (NS : XML_Grammar_NS; Reader : access Abstract_Validation_Reader'Class; @@ -982,9 +952,6 @@ package Schema.Validators is function Redefine_Type (Grammar : XML_Grammar_NS; Local_Name : Sax.Symbols.Symbol) return XML_Type; - function Redefine_Group - (Grammar : XML_Grammar_NS; - Local_Name : Sax.Symbols.Symbol) return XML_Group; -- Indicate that a given type or element is being redefined inside a -- tag. The old definition is returned, and all types that -- were referencing it will now refer to a new, invalid type. You need to @@ -1355,26 +1322,6 @@ private -- is destroyed, the validator is properly deallocated. -- This does nothing if Validator was already registered. - --------------- - -- XML_Group -- - --------------- - - type XML_Group_Record; - type XML_Group is access all XML_Group_Record; - No_XML_Group : constant XML_Group := null; - - ---------------------- - -- XML_Group_Record -- - ---------------------- - - type XML_Group_Record is record - Local_Name : Sax.Symbols.Symbol; --- Particles : Particle_List; - Is_Forward_Decl : Boolean; - -- Set to true if the group was defined as a call to Lookup, but never - -- through Create_Global_Group - end record; - ------------- -- Grammar -- ------------- @@ -1411,18 +1358,6 @@ private Equal => Sax.Symbols."="); type Elements_Htable_Access is access Elements_Htable.HTable; - procedure Free (Group : in out XML_Group); - function Get_Key (Group : XML_Group) return Sax.Symbols.Symbol; - package Groups_Htable is new Sax.HTable - (Element => XML_Group, - Empty_Element => No_XML_Group, - Free => Free, - Key => Sax.Symbols.Symbol, - Get_Key => Get_Key, - Hash => Sax.Symbols.Hash, - Equal => Sax.Symbols."="); - type Groups_Htable_Access is access Groups_Htable.HTable; - function Get_Key (Att : Named_Attribute_Validator) return Sax.Symbols.Symbol; procedure Do_Nothing (Att : in out Named_Attribute_Validator); @@ -1442,7 +1377,6 @@ private System_ID : Sax.Symbols.Symbol; Types : Types_Htable_Access; Elements : Elements_Htable_Access; - Groups : Groups_Htable_Access; Attributes : Attributes_Htable_Access; Validators_For_Mem : XML_Validator;