ada/xmlada
0
0
Fork 0
mirror of https://github.com/AdaCore/xmlada.git synced 2026-02-12 12:30:28 -08:00
Code Issues Packages Projects Releases Wiki Activity

Remove support for XML_Group, already implemented in the state machine

Browse Source 
J302-043

git-svn-id: svn+ssh://svn.eu.adacore.com/Dev/trunk/xmlada@166608 936e1b1b-40f2-da11-902a-00137254ae57
This commit is contained in:
Emmanuel Briot
2010-11-05 10:45:49 +00:00
committed by briot
parent ecd0821649
commit f254706101
7 changed files with 9 additions and 209 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
schema/schema-schema_readers.adb
View File

@@ -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

4
schema/schema-schema_readers.ads
View File

@@ -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; -- <redefine>
when Context_Group => Group : Group_Descr;
when Context_All =>
null;

3
schema/schema-validators-extensions.adb
View File

@@ -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

1
schema/schema-validators-extensions.ads
View File

@@ -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.

12
schema/schema-validators-xsd_grammar.adb
View File

@@ -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);

131
schema/schema-validators.adb
View File

@@ -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;
----------

66
schema/schema-validators.ads
View File

@@ -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
-- <redefine> 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;