------------------------------------------------------------------------------
-- XML/Ada - An XML suite for Ada95 --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- --
-- --
-- --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- . --
-- --
------------------------------------------------------------------------------
pragma ada_05;
with Ada.Exceptions;
with GNAT.Dynamic_Tables;
with Interfaces;
with Unicode.CES;
with Sax.HTable;
with Sax.Locators;
with Sax.Pointers;
with Sax.Readers; use Sax.Readers;
with Sax.State_Machines;
with Sax.Symbols;
with Sax.Utils;
with Schema.Simple_Types;
package Schema.Validators is
XML_Schema_URI : constant Unicode.CES.byte_sequence :=
"http://www.w3.org/2001/XMLSchema";
XML_URI : constant Unicode.CES.byte_sequence :=
"http://www.w3.org/XML/1998/namespace";
XML_Instance_URI : constant Unicode.CES.byte_sequence :=
"http://www.w3.org/2001/XMLSchema-instance";
XML_Validation_Error : exception;
-- Raised in case of error in the validation process. The exception message
-- contains the error, but not its location
type xsd_versions is (xsd_1_0, xsd_1_1);
-- The version of XSD the parser should support.
-- The support for 1.1 is only partial at present.
type xml_grammar is private;
-- A grammar can contain the definition for multiple namespaces (generally
-- the standard XML Schema namespace for predefined types, and the
-- namespace we are defining).
-- A grammar is a smart pointer, and will take care of freeing memory
-- automatically when no longer needed.
procedure Set_XSD_Version
(Grammar : in out xml_grammar;
XSD_Version : xsd_versions);
function Get_XSD_Version (Grammar : xml_grammar) return xsd_versions;
-- Set the version of XSD accepted by this grammar
function Get_Symbol_Table
(Grammar : xml_grammar) return Sax.Utils.symbol_table;
procedure Set_Symbol_Table
(Grammar : xml_grammar;
Symbols : Sax.Utils.symbol_table);
-- The symbol table used to create the grammar.
-- Any parser using this grammmar must also use the same symbol table,
-- otherwise no validation can succeed (this is ensured by special tests in
-- Set_Grammar and Set_Symbol_Table).
No_Grammar : constant xml_grammar;
-- No Grammar has been defined
type occurrences (Unbounded : Boolean := False) is record
case Unbounded is
when True =>
null;
when False =>
Value : Natural;
end case;
end record;
-- The number of occurrences
type form_type is (qualified, unqualified);
-- Whether locally declared elements need to be qualified or whether
-- qualification is optional (the latter is the default). This does not
-- apply to global elements, that always need to be qualified (or found in
-- the default namespace).
-- Note that elements defined in a are considered local only if
-- they do not use the R.Ref attribute, otherwise they are considered
-- global and therefore the "form" does not apply to them.
type process_contents_type is (process_strict, process_lax, process_skip);
-- When in an element that accepts any children (ur-type, or xsd:any), this
-- type indicates that should be done to validate the children:
-- Strict: the children must have a definition in the schema (as a
-- global element)
-- Lax: if the children have a definition, it is used, otherwise they
-- are just accepted as is.
-- Skip: even if the children have a definition, it is ignored, and
-- the child is processed as a ur-type.
--------------------
-- State machines --
--------------------
-- The validators are implemented as state machines
type header_num is new Interfaces.Integer_32 range 0 .. 1023;
function Hash (Name : qualified_name) return header_num;
function Hash (Name : Sax.Symbols.symbol) return header_num;
-- Suitable for instantiating hash tables
type any_descr is record
Process_Contents : process_contents_type := process_strict;
No_Namespaces : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Namespaces : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
-- The combined list of namespaces. This could include ##any and
-- ##local, since there is no way to represent them otherwise, but will
-- not include ##targetNamespace which must be resolved first.
-- No_Namespaces is the list of namespaces we must not match, and
-- replaces the use of ##other in the list of namespaces. (note that if
-- a namespace matches [Namespaces], it will match even if it is in
-- [No_Namespaces].
--
-- Combining :
-- - when we have an extension, we must match any of the namespaces
-- either from the base or from the extension.
-- - when we have a restriction, we restrict the list of valid
-- namespaces.
end record;
No_Any_Descr : constant any_descr := (others => <>);
function Combine
(Grammar : xml_grammar;
Base_Any : any_descr;
Local_Process : process_contents_type;
Local : Sax.Symbols.symbol; -- includes ##other
As_Restriction : Boolean;
Target_NS : Sax.Symbols.symbol) return any_descr;
-- Combines [Base_Any] and [Local_Any] into a single one.
-- [Base_Any] can be No_Any_Descr if we simply want to resolve
-- ##targetNamespace and ##other in [Local_Any]
function Match_Any (Any : any_descr; Name : qualified_name) return Boolean;
-- Whether [Name] matches the namespaces in [Any]
type transition_event is record
Name : qualified_name;
Closing : Boolean := False;
end record;
-- The event to do a transition in the state machine.
-- [Closing] is set to true if we are seeing the end tag for [Name]
type transition_kind is
(transition_symbol,
transition_any,
transition_close,
transition_symbol_from_all,
transition_close_from_all);
-- Transition_*_From_All is used to support the construct without
-- creating a set of states for all possible permuations of child elements
-- (since otherwise the number of states explodes). Instead, an node
-- has one output transition per possible child elements (these transitions
-- are Transition_Symbol_From_All). These transitions are disabled once
-- they have been visited (since maxOccurs=1 for children of ) and
-- cannot be visited again. The state also has one output transition
-- to the next state. This transition is also conditional: it will be on
-- active on any symbol, provided that all children of have been
-- visited once or have minOccurs=0.
-- This also requires temporary data associated with all active instances
-- of the state in the Matcher, to remember which children have been
-- visited.
type visited_all_children is mod 2**32;
-- A mask for the children of an element that have been visited.
-- Such children can be visited at most once. In the transition, we store
-- the mask for all such children that must be visited (the optional ones
-- have a 0 in the mask). In the Matcher, we also store this info in the
-- node itself to make sure that children are not visited more than
-- once.
type transition_descr
(Kind : transition_kind := transition_symbol) is record
case Kind is
when transition_symbol | transition_symbol_from_all =>
Name : qualified_name;
Form : form_type := qualified;
-- For nodes: the index of this transition in the mask
-- (Visited_All_Children) for . This is used to memorize
-- which children have already been visited.
All_Child_Index : Integer;
when transition_close_from_all =>
Mask : visited_all_children := 0;
when transition_close =>
null;
when transition_any =>
Any : any_descr;
end case;
end record;
type named_attribute_list is new Natural;
Empty_Named_Attribute_List : constant named_attribute_list := 0;
type attributes_list is record
Any : any_descr := No_Any_Descr;
Named : named_attribute_list := Empty_Named_Attribute_List;
end record;
No_Attributes : constant attributes_list := (others => <>);
-- All types are assumed to have a even if it never
-- accepts anything. For an extension or restriction, it is merged with the
-- base's
type block_type is (block_restriction, block_extension, block_substitution);
type block_status is array (block_type) of Boolean;
pragma pack (block_status);
No_Block : constant block_status := (others => False);
function To_String (Blocks : block_status) return String;
-- Return a displayable version of [Blocks], for debugging purposes.
type final_type is
(final_restriction, final_extension, final_union, final_list);
type final_status is array (final_type) of Boolean;
pragma pack (final_status);
type type_index is new Natural;
No_Type_Index : constant type_index := 0;
-- Index into a global table that contains the [Type_Descr].
-- Going through a table instead of storing directly a [Type_Descr] (for
-- instance in NFA states) reduces memory usage, but more importantly
-- means that we can modify the type even once the NFA has been created,
-- and still impact all states that reference that type.
type attribute_use_type is (prohibited, optional, required, default);
type attribute_descr is record
Target_NS : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Name : qualified_name := No_Qualified_Name;
Simple_Type : Schema.Simple_Types.simple_type_index :=
Schema.Simple_Types.No_Simple_Type_Index;
Fixed : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Default : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Use_Type : attribute_use_type := optional;
Form : form_type := qualified;
Is_Local : Boolean := True;
Next : named_attribute_list := Empty_Named_Attribute_List;
end record;
pragma pack (attribute_descr);
No_Attribute_Descr : constant attribute_descr := (others => <>);
function Image (Trans : transition_descr) return String;
-- Needed for the instantiation of Sax.State_Machines
type state_data is record
Simple : type_index;
Fixed : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Default : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Block : block_status := No_Block;
Nillable : Boolean := False;
end record;
No_State_Data : constant state_data :=
(No_Type_Index,
Sax.Symbols.No_Symbol,
Sax.Symbols.No_Symbol,
No_Block,
False);
-- User data associated with each state. This mostly point to the
-- corresponding type in the schema, but also includes overridding data
-- from the corresponding element itself.
package Schema_State_Machines is new Sax.State_Machines
(symbol => transition_event,
transition_symbol => transition_descr,
Image => Image,
state_user_data => state_data,
Default_Data => No_State_Data,
Default_State_Count => 200, -- XSD metaschema takes 904 states
Default_Transition_Count => 200); -- XSD metaschema takes 1096
use Schema_State_Machines;
type type_descr is record
Name : qualified_name := No_Qualified_Name;
Attributes : attributes_list := No_Attributes;
Block : block_status := No_Block;
Final : final_status := (others => False);
Restriction_Of : type_index := No_Type_Index;
Extension_Of : type_index := No_Type_Index;
Simple_Content : Schema.Simple_Types.simple_type_index :=
Schema.Simple_Types.No_Simple_Type_Index;
-- set if we have a simpleType or simpleContent
Mixed : Boolean := False;
Is_Abstract : Boolean := False;
Complex_Content : Schema_State_Machines.state :=
Schema_State_Machines.No_State;
-- The start of the nested NFA for a complexType
end record;
type type_descr_access is access all type_descr;
pragma pack (type_descr);
No_Type_Descr : constant type_descr := (others => <>);
function Image
(Self : access nfa'class;
S : Schema_State_Machines.state;
Data : state_data) return String;
-- Needed for the instantiation of Pretty_Printers
type active_state_data is record
Visited : visited_all_children := 0;
end record;
No_Active_Data : constant active_state_data := (Visited => 0);
function Match
(Self : access abstract_nfa_matcher'class;
From_State, To_State : state;
Parent_Data : access active_state_data;
Trans : transition_descr;
Sym : transition_event) return Boolean;
-- Whether [Sym] matches [Trans].
-- Parent_Data is the execution data associated with the parent state in
-- which From_State is nested. It is used to validate nodes (which
-- needs to check that all children are either optional or were visited).
function Expected
(Self : abstract_nfa_matcher'class;
From_State, To_State : state;
Parent_Data : access active_state_data;
Trans : transition_descr) return String;
-- What to display in "expecting ..." for this transition.
package Schema_State_Machines_PP is new Schema_State_Machines
.Pretty_Printers
(Image);
package Schema_State_Machines_Matchers is new Schema_State_Machines.Matchers
(active_state_data,
No_Active_Data,
Match,
Expected);
type schema_nfa is new Schema_State_Machines.nfa with private;
type schema_nfa_access is access all schema_nfa'class;
type schema_nfa_matcher is
new Schema_State_Machines_Matchers.nfa_matcher with private;
procedure Do_Match
(Matcher : in out schema_nfa_matcher;
Sym : transition_event;
Success : out Boolean;
Through_Any : out Boolean;
Through_Process : out process_contents_type);
-- Process the next event through NFA, and report whether it matched
-- through a
function Ur_Type
(NFA : access schema_nfa'class;
Process_Contents : process_contents_type)
return Schema_State_Machines.nested_nfa;
-- Return the nested NFA for
type reference_kind is
(ref_element, ref_type, ref_attribute, ref_group, ref_attrgroup);
type global_reference (Kind : reference_kind := ref_element) is record
Name : qualified_name;
case Kind is
when ref_element =>
Element : state;
when ref_type =>
Typ : type_index;
when ref_group =>
Gr_Start, Gr_End : state;
when ref_attribute | ref_attrgroup =>
Attributes : attributes_list;
end case;
end record;
No_Global_Reference : constant global_reference :=
(ref_type, Name => No_Qualified_Name, Typ => No_Type_Index);
-- The global elements in a grammar that can be referenced from another
-- grammar (or from an XML file).
type reference_name is record
Name : qualified_name;
Kind : reference_kind;
end record;
function Hash (Name : reference_name) return Interfaces.Unsigned_32;
function Get_Key (Ref : global_reference) return reference_name;
package Reference_HTables is new Sax.HTable
(element => global_reference,
Empty_Element => No_Global_Reference,
key => reference_name,
Get_Key => Get_Key,
Hash => Hash,
Equal => "=");
type reference_htable is access Reference_HTables.htable;
reference_htable_size : constant := 1023;
-- Size created for the references table
function Get_NFA (Grammar : xml_grammar) return schema_nfa_access;
function Get_References (Grammar : xml_grammar) return reference_htable;
-- Returns the state machine and global references used to validate
-- [Grammar]
function Dump_Dot_NFA
(Grammar : xml_grammar;
Nested : nested_nfa := No_Nested) return String;
-- Return a "dot" graph for the NFA, possibly restricted to a specific
-- nested NFA.
function Get_Simple_Type
(NFA : access schema_nfa'class;
Simple : Schema.Simple_Types.simple_type_index)
return Schema.Simple_Types.simple_type_descr;
pragma inline (Get_Simple_Type);
-- Return the simple type corresponding to the index
function Get_Type_Descr
(NFA : access schema_nfa'class;
Index : type_index) return access type_descr;
pragma inline (Get_Type_Descr);
-- Return the type description at that index
------------
-- Parser --
------------
-- See packages Schema.Readers and Schema.Schema_Readers for non-abstract
-- implementation of those.
type abstract_validation_reader is abstract new Sax.Readers.sax_reader with
record
Error_Location : Sax.Locators.location;
Error_Msg : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Id_Table : Schema.Simple_Types.symbol_htable_access;
-- Mapping of IDs to elements
Grammar : xml_grammar := No_Grammar;
All_NNI : Sax.Symbols.symbol; -- "allNNI"
Annotated : Sax.Symbols.symbol; -- "annotated"
Annotation : Sax.Symbols.symbol; -- "annotation"
Any : Sax.Symbols.symbol; -- "any"
Any_Attribute : Sax.Symbols.symbol; -- "anyAttribute"
Any_Namespace : Sax.Symbols.symbol; -- "##any"
Any_Simple_Type : Sax.Symbols.symbol; -- "anySimpleType"
Anytype : Sax.Symbols.symbol; -- "anyType"
Appinfo : Sax.Symbols.symbol; -- "appinfo"
Attr_Decls : Sax.Symbols.symbol; -- "attrDecls"
Attribute : Sax.Symbols.symbol; -- "attribute"
Attribute_Group : Sax.Symbols.symbol; -- "attributeGroup"
Attribute_Group_Ref : Sax.Symbols.symbol; -- "attributeGroupRef"
Base : Sax.Symbols.symbol; -- "base"
Block : Sax.Symbols.symbol; -- "block"
Block_Default : Sax.Symbols.symbol; -- "blockDefault"
Block_Set : Sax.Symbols.symbol; -- "blockSet"
Choice : Sax.Symbols.symbol; -- "choice"
Complex_Content : Sax.Symbols.symbol; -- "complexContent"
Complex_Extension_Type : Sax.Symbols.symbol; -- "complexExtensionType"
Complex_Restriction_Type : Sax.Symbols.symbol;
Complex_Type : Sax.Symbols.symbol; -- "complexType"
Complex_Type_Model : Sax.Symbols.symbol; -- "complexTypeModel"
Def_Ref : Sax.Symbols.symbol; -- "defRef"
Default : Sax.Symbols.symbol; -- "default"
Derivation_Control : Sax.Symbols.symbol; -- "derivationControl"
Derivation_Set : Sax.Symbols.symbol; -- "derivationSet"
Documentation : Sax.Symbols.symbol; -- "documentation"
Element : Sax.Symbols.symbol; -- "element"
Enumeration : Sax.Symbols.symbol; -- "enumeration"
Explicit_Group : Sax.Symbols.symbol; -- "explicitGroup"
Extension : Sax.Symbols.symbol; -- "extension"
Extension_Type : Sax.Symbols.symbol; -- "extensionType"
Facet : Sax.Symbols.symbol; -- "facet"
Field : Sax.Symbols.symbol; -- "field"
Final : Sax.Symbols.symbol; -- "final"
Final_Default : Sax.Symbols.symbol; -- "finalDefault"
Fixed : Sax.Symbols.symbol; -- "fixed"
Form : Sax.Symbols.symbol; -- "form"
Form_Choice : Sax.Symbols.symbol; -- "formChoice
Fraction_Digits : Sax.Symbols.symbol;
Group : Sax.Symbols.symbol; -- "group"
Group_Def_Particle : Sax.Symbols.symbol; -- "groupDefParticle"
Group_Ref : Sax.Symbols.symbol; -- "groupRef"
Id : Sax.Symbols.symbol; -- "id"
IDREF : Sax.Symbols.symbol; -- "IDREF"
IDREFS : Sax.Symbols.symbol; -- "IDREFS"
Identity_Constraint : Sax.Symbols.symbol; -- "identityConstraint"
Import : Sax.Symbols.symbol; -- "import"
Include : Sax.Symbols.symbol; -- "include"
Item_Type : Sax.Symbols.symbol; -- "itemType"
Key : Sax.Symbols.symbol; -- "key"
Keybase : Sax.Symbols.symbol; -- "keybase"
Keyref : Sax.Symbols.symbol; -- "keyref"
Lang : Sax.Symbols.symbol; -- "lang"
Lax : Sax.Symbols.symbol; -- "lax"
Length : Sax.Symbols.symbol;
List : Sax.Symbols.symbol; -- "list"
Local : Sax.Symbols.symbol;
Local_Complex_Type : Sax.Symbols.symbol; -- "localComplexType"
Local_Element : Sax.Symbols.symbol; -- "localElement"
Local_Simple_Type : Sax.Symbols.symbol; -- "localSimpleType"
MaxExclusive : Sax.Symbols.symbol;
MaxInclusive : Sax.Symbols.symbol;
MaxOccurs : Sax.Symbols.symbol;
Max_Bound : Sax.Symbols.symbol; -- "maxBound"
Maxlength : Sax.Symbols.symbol; -- "maxLength"
Member_Types : Sax.Symbols.symbol; -- "memberTypes"
MinExclusive : Sax.Symbols.symbol;
MinInclusive : Sax.Symbols.symbol;
MinOccurs : Sax.Symbols.symbol;
Min_Bound : Sax.Symbols.symbol; -- "minBound"
Minlength : Sax.Symbols.symbol; -- "minLength"
Mixed : Sax.Symbols.symbol; -- "mixed"
NCName : Sax.Symbols.symbol; -- "NCName"
NMTOKEN : Sax.Symbols.symbol; -- "NMTOKEN"
Name : Sax.Symbols.symbol;
Named_Attribute_Group : Sax.Symbols.symbol; -- "namedAttributeGroup"
Named_Group : Sax.Symbols.symbol; -- "namedGroup"
Namespace : Sax.Symbols.symbol;
Namespace_List : Sax.Symbols.symbol; -- "namespaceList"
Namespace_Target : Sax.Symbols.symbol; -- "targetNamespace"
Nested_Particle : Sax.Symbols.symbol; -- "nestedParticle"
Nil : Sax.Symbols.symbol;
Nillable : Sax.Symbols.symbol; -- "nillable"
No_Namespace_Schema_Location : Sax.Symbols.symbol;
Non_Negative_Integer : Sax.Symbols.symbol; -- "nonNegativeInteger"
Notation : Sax.Symbols.symbol; -- "notation"
Num_Facet : Sax.Symbols.symbol; -- "numFacet"
Occurs : Sax.Symbols.symbol; -- "occurs"
Open_Attrs : Sax.Symbols.symbol; -- "openAttrs"
Optional : Sax.Symbols.symbol; -- "optional"
Other_Namespace : Sax.Symbols.symbol;
Particle : Sax.Symbols.symbol; -- "particle"
Pattern : Sax.Symbols.symbol;
Positive_Integer : Sax.Symbols.symbol;
Precision_Decimal : Sax.Symbols.symbol;
Process_Contents : Sax.Symbols.symbol; -- "processContents"
Prohibited : Sax.Symbols.symbol; -- "prohibited"
Public : Sax.Symbols.symbol; -- "public"
QName : Sax.Symbols.symbol; -- "QName"
Qualified : Sax.Symbols.symbol; -- "qualified"
Real_Group : Sax.Symbols.symbol; -- "realGroup"
Redefinable : Sax.Symbols.symbol; -- "redefinable"
Redefine : Sax.Symbols.symbol; -- "redefine"
Reduced_Derivation_Control : Sax.Symbols.symbol;
Ref : Sax.Symbols.symbol;
Refer : Sax.Symbols.symbol; -- "refer"
Required : Sax.Symbols.symbol; -- "required"
Restriction : Sax.Symbols.symbol; -- "restriction"
Restriction_Type : Sax.Symbols.symbol; -- "restrictionType"
S_1 : Sax.Symbols.symbol; -- "1"
S_Abstract : Sax.Symbols.symbol; -- "abstract"
S_All : Sax.Symbols.symbol; -- "all"
S_Attribute_Form_Default : Sax.Symbols.symbol; -- "attributeFormDefault"
S_Boolean : Sax.Symbols.symbol; -- "boolean"
S_Element_Form_Default : Sax.Symbols.symbol; -- "elementFormDefault"
S_False : Sax.Symbols.symbol; -- "false"
S_Schema : Sax.Symbols.symbol; -- "schema"
S_String : Sax.Symbols.symbol; -- "string"
S_Use : Sax.Symbols.symbol; -- "use"
Schema_Location : Sax.Symbols.symbol;
Schema_Top : Sax.Symbols.symbol; -- "schemaTop"
Selector : Sax.Symbols.symbol; -- "selector"
Sequence : Sax.Symbols.symbol; -- "sequence"
Simple_Content : Sax.Symbols.symbol; -- "simpleContent"
Simple_Derivation : Sax.Symbols.symbol; -- "simpleDerivation"
Simple_Derivation_Set : Sax.Symbols.symbol; -- "simpleDerivationSet"
Simple_Extension_Type : Sax.Symbols.symbol; -- "simpleExtensionType"
Simple_Restriction_Model : Sax.Symbols.symbol;
Simple_Restriction_Type : Sax.Symbols.symbol;
Simple_Type : Sax.Symbols.symbol; -- "simpleType"
Source : Sax.Symbols.symbol; -- "source"
Strict : Sax.Symbols.symbol; -- "strict"
Substitution_Group : Sax.Symbols.symbol; -- "substitutionGroup"
System : Sax.Symbols.symbol; -- "system"
Target_Namespace : Sax.Symbols.symbol; -- "##targetNamespace"
Token : Sax.Symbols.symbol; -- "token"
Top_Level_Attribute : Sax.Symbols.symbol; -- "topLevelAttribute"
Top_Level_Complex_Type : Sax.Symbols.symbol; -- "topLevelComplexType"
Top_Level_Element : Sax.Symbols.symbol; -- "topLevelElement"
Top_Level_Simple_Type : Sax.Symbols.symbol; -- "topLevelSimpleType"
Total_Digits : Sax.Symbols.symbol;
Typ : Sax.Symbols.symbol;
Type_Def_Particle : Sax.Symbols.symbol; -- "typeDefParticle"
UC_ID : Sax.Symbols.symbol; -- "ID"
URI_Reference : Sax.Symbols.symbol; -- "uriReference"
Unbounded : Sax.Symbols.symbol;
Union : Sax.Symbols.symbol; -- "union"
Unique : Sax.Symbols.symbol; -- "unique"
Unqualified : Sax.Symbols.symbol; -- "unqualified"
Ur_Type : Sax.Symbols.symbol; -- "ur-Type"
Value : Sax.Symbols.symbol; -- "value"
Version : Sax.Symbols.symbol; -- "version"
Whitespace : Sax.Symbols.symbol;
Wildcard : Sax.Symbols.symbol; -- "wildcard"
XML_Instance_URI : Sax.Symbols.symbol;
XML_Schema_URI : Sax.Symbols.symbol;
XML_URI : Sax.Symbols.symbol; -- XML_URI
XPath : Sax.Symbols.symbol; -- "xpath"
XPath_Expr_Approx : Sax.Symbols.symbol; -- "XPathExprApprox"
XPath_Spec : Sax.Symbols.symbol; -- "XPathSpec"
Xmlns : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
end record;
type abstract_validating_reader_access is
access all abstract_validation_reader'class;
procedure Free (Reader : in out abstract_validation_reader);
-- Free the memory used by Reader
overriding procedure Initialize_Symbols
(Parser : in out abstract_validation_reader);
-- See inherited documentation
procedure Validation_Error
(Reader : access abstract_validation_reader;
Message : Unicode.CES.byte_sequence;
Loc : Sax.Locators.location := Sax.Locators.No_Location;
Except : Ada.Exceptions.Exception_Id := XML_Validation_Error'identity);
-- Sets an error message, and raise XML_Validation_Error.
-- If [Message] starts with "#", this indicates a non-implemented
-- feature, and XML_Not_Implemented is raised instead.
function Get_Error_Message
(Reader : abstract_validation_reader) return Unicode.CES.byte_sequence;
-- Return the current error message
procedure Check_Substitution_Group_OK
(Handler : access abstract_validation_reader'class;
New_Type, Old_Type : type_index;
Loc : Sax.Locators.location;
Element_Block : block_status);
-- Verifies that [New_Type] is a valid substitution for [Old_Type],
-- according to 3.3.6.3.
-- If not, raises a [Validation_Error]
-------------------------
-- Attribute_Validator --
-------------------------
type namespace_kind is (namespace_other, namespace_any, namespace_list);
-- "Any": any non-conflicting namespace
-- "Other": any non-conflicting namespace other than targetNamespace
-- Namespace_List can contain "##local", "##targetNamespace" or actual
-- namespaces.
---------------------
-- Type validators --
---------------------
-- Such validators are build to validate specific parts of an XML
-- document (a whole element).
procedure Validate_Simple_Type
(Reader : access abstract_validation_reader'class;
Simple_Type : Schema.Simple_Types.simple_type_index;
Ch : Unicode.CES.byte_sequence;
Loc : Sax.Locators.location;
Insert_Id : Boolean := True);
-- Validate [Ch] as a simpleType
-- If [Insert_Id] is True, and the type is ID, it is inserted in a global
-- htables. Thus calling this procedure twice with this parameter set to
-- true will result in a "duplicate id" error.
procedure Normalize_And_Validate
(Parser : access abstract_validation_reader'class;
Simple : Schema.Simple_Types.simple_type_index;
Fixed : in out Sax.Symbols.symbol;
Loc : Sax.Locators.location);
-- Normalize whitespaces in [Fixed] according to the simple type.
function Equal
(Reader : access abstract_validation_reader'class;
Simple_Type : Schema.Simple_Types.simple_type_index;
Ch1 : Sax.Symbols.symbol;
Ch2 : Unicode.CES.byte_sequence) return Boolean;
-- Checks whether [Ch1]=[Ch2] according to the type (possibly involving
-- whitespace normalization)
procedure Validate_Attributes
(NFA : access schema_nfa'class;
Typ : access type_descr;
Reader : access abstract_validation_reader'class;
Atts : in out Sax.Readers.sax_attribute_list;
Is_Nil : in out Integer);
-- Check whether this list of attributes is valid for elements associated
-- with this validator. By default, this simply check whether the list of
-- attributes registered through Add_Attribute matches Atts.
--
-- Id_Table is used to ensure that two same Ids are not in the document. It
-- is passed as an access type, so that in case of exception it is still
-- properly set on exit.
--
-- [Is_Nil] is set to the index in [Atts] for the xsi:nil attribute, or
-- -1 if not found.
--
-- Sets the type of the attributes (through Sax.Attributes.Set_Type) to Id
-- if the corresponding attribute is an id.
type internal_any_descr is record
Target_NS : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
Process_Contents : process_contents_type := process_strict;
Namespaces : Sax.Symbols.symbol := Sax.Symbols.No_Symbol;
end record;
No_Internal_Any_Descr : constant internal_any_descr := (others => <>);
-- We need to temporarily store the target_NS, in case we are parsing
-- multiple grammars before we generate the NFA
procedure Add_Any_Attribute
(Grammar : xml_grammar;
List : in out attributes_list;
Any : internal_any_descr;
As_Restriction : Boolean);
procedure Add_Attribute
(Parser : access abstract_validation_reader'class;
List : in out attributes_list;
Attribute : attribute_descr;
Ref : named_attribute_list := Empty_Named_Attribute_List;
Loc : Sax.Locators.location);
procedure Add_Attributes
(Parser : access abstract_validation_reader'class;
List : in out attributes_list;
Attributes : attributes_list;
As_Restriction : Boolean;
Loc : Sax.Locators.location);
-- Add a valid attribute to Validator.
-- Is_Local should be true if the attribute is local, or False if this is
-- a reference to a global attribute.
-- The second version copies elements from [Attributes] into [List].
-- [As_Restriction] is used when including a . Since there
-- can be only one in the list, this is merged with any existing
-- . [Target_NS] is also used in this context.
-- [Ref], if specified, is the "refed" attribute. Its type is used, but
-- the use type of [Attribute] is used, instead.
--------------
-- Grammars --
--------------
procedure Initialize_Grammar
(Reader : in out abstract_validation_reader'class);
-- Initialize the internal structure of the grammar.
-- This adds the definition for all predefined types
procedure Reset (Grammar : in out xml_grammar);
-- Partial reset of the grammar: all the namespace-specific grammars are
-- deleted, except for the grammar used to validate the XSD files
-- themselves. This is mostly convenient if you want to reuse a grammar
-- to handle _lots_ of unrelated XSD files (if your application only uses
-- a few of these, you can easily store them all in the same grammar, but
-- if you have hundreds of them, it might be more memory-efficient to
-- discard the namespaces you no longer use).
-- Keeping the grammar for the XSD files provides a minor optimization,
-- avoiding the need to recreate it the next time you parse a XSD file.
--
-- TASKING: you should not call this procedure while some parsers are still
-- using the grammar.
procedure Create_Global_Attribute
(Parser : access abstract_validation_reader'class;
Attr : attribute_descr;
Loc : Sax.Locators.location);
function Create_Simple_Type
(NFA : access schema_nfa'class;
Descr : Schema.Simple_Types.simple_type_descr)
return Schema.Simple_Types.simple_type_index;
function Create_Type
(NFA : access schema_nfa'class;
Descr : type_descr) return type_index;
-- Register a global attribute or type.
-- [Name] or [Descr.Name] can be [No_Qualified_Name], in which case a local
-- type is created (ie not registered in the list of global elements).
procedure Add_Facet
(Grammar : xml_grammar;
Facets : in out Schema.Simple_Types.all_facets;
Facet_Name : Sax.Symbols.symbol;
Value : Sax.Symbols.symbol;
Loc : Sax.Locators.location);
pragma inline (Add_Facet);
-- See doc in schema-simple_types, this is a proxy
function URI_Was_Parsed
(Grammar : xml_grammar;
URI : Sax.Symbols.symbol) return Boolean;
-- Return True if the schema at URI was already parsed and included in
-- Grammar. URI must be an absolute URI.
procedure Set_Parsed_URI
(Reader : in out abstract_validation_reader'class;
URI : Sax.Symbols.symbol);
-- Indicate that the schema found at URI was fully parsed and integrated
-- into Grammar. It can then be tested through URI_Was_Parsed.
procedure Debug_Dump (Grammar : xml_grammar);
-- Dump the grammar to stdout. This is for debug only
function To_QName (Name : qualified_name) return Unicode.CES.byte_sequence;
-- Return the name as it should be displayed in error messages
function Simple_Nested
(NFA : access schema_nfa'class) return Schema_State_Machines.state;
procedure Add_Notation
(NFA : access schema_nfa'class;
Name : Sax.Symbols.symbol);
-- Register a new NOTATION
private
-------------------------
-- Attribute_Validator --
-------------------------
package Attributes_Tables is new GNAT.Dynamic_Tables
(Table_Component_Type => attribute_descr,
Table_Index_Type => named_attribute_list,
Table_Low_Bound => Empty_Named_Attribute_List + 1,
Table_Initial => 200,
Table_Increment => 200);
package Types_Tables is new GNAT.Dynamic_Tables
(Table_Component_Type => type_descr,
Table_Index_Type => type_index,
Table_Low_Bound => No_Type_Index + 1,
Table_Initial => 300,
Table_Increment => 100);
--------------
-- Grammars --
--------------
type string_list_record;
type string_list is access string_list_record;
type string_list_record is record
Str : Sax.Symbols.symbol;
Next : string_list;
end record;
-- We will use Ada2005 containers when the compiler is more widely
-- available
procedure Free (List : in out string_list);
-- Free the list and its contents
type schema_nfa is new Schema_State_Machines.nfa with record
Simple_Types : Schema.Simple_Types.simple_type_table;
References : reference_htable;
Attributes : Attributes_Tables.instance;
Enumerations : Schema.Simple_Types.Enumeration_Tables.instance;
Types : Types_Tables.instance;
Notations : Schema.Simple_Types.Symbol_Htable.htable (101);
-- List of all notations defined in the current XSD
Ur_Type : Schema_State_Machines.state;
Ur_Type_Skip : Schema_State_Machines.state;
Simple_Nested : Schema_State_Machines.state;
-- A dummy nested NFA: this is used when xsi:type replaces a complex
-- type with a simple type, so that we accept no children, but still
-- accept the tag. We will temporarily override the state
-- data to match the simple type.
Metaschema_NFA_Last : nfa_snapshot := No_NFA_Snapshot;
Metaschema_Simple_Types_Last : Schema.Simple_Types.simple_type_index;
Metaschema_Attributes_Last : named_attribute_list;
Metaschema_Enumerations_Last : Schema.Simple_Types.enumeration_index;
Metaschema_Types_Last : type_index;
-- Last state for the metaschema XSD (for Reset)
end record;
type schema_nfa_matcher is new Schema_State_Machines_Matchers
.nfa_matcher with
record
Matched_Through_Any : Boolean := False;
Matched_Process_Content : process_contents_type;
end record;
type xml_grammar_record is new Sax.Pointers.root_encapsulated with record
Symbols : Sax.Utils.symbol_table;
Parsed_Locations : string_list;
-- List of schema locations that have already been parsed. This is used
-- in particular to handle cases where a schema imports two others
-- schemas, that in turn import a common one.
XSD_Version : xsd_versions := xsd_1_0;
NFA : schema_nfa_access;
-- The state machine representing the grammar
-- This includes the states for all namespaces
end record;
procedure Free (Grammar : in out xml_grammar_record);
-- Free the memory occupied by the grammar
package XML_Grammars is new Sax.Pointers.Smart_Pointers
(xml_grammar_record);
type xml_grammar is new XML_Grammars.pointer;
No_Grammar : constant xml_grammar :=
xml_grammar (XML_Grammars.Null_Pointer);
end Schema.Validators;