From dfd7a4d599509db46007fb96fed511bb900ca40f Mon Sep 17 00:00:00 2001 From: Emmanuel Briot Date: Fri, 5 Nov 2010 10:48:00 +0000 Subject: [PATCH] (Set_Locator, Locator): new subprogram Fixes resolution of URI when loading secondary XSD files git-svn-id: svn+ssh://svn.eu.adacore.com/Dev/trunk/xmlada@166661 936e1b1b-40f2-da11-902a-00137254ae57 --- schema/schema-readers.adb | 25 ++++++++++++++++- schema/schema-readers.ads | 6 +++++ schema/schema-schema_readers.adb | 46 +++++++++++++++++--------------- schema/schema-schema_readers.ads | 2 -- 4 files changed, 55 insertions(+), 24 deletions(-) diff --git a/schema/schema-readers.adb b/schema/schema-readers.adb index 578e721..cb5109a 100644 --- a/schema/schema-readers.adb +++ b/schema/schema-readers.adb @@ -167,6 +167,9 @@ package body Schema.Readers is elsif U (U'First) /= '/' and then U (U'First) /= '\' then + Debug_Output ("MANU Normalizing " + & Get (Get_System_Id (Handler.Locator)).all + & " " & U.all); return Find_Symbol (Handler, Dir_Name (Get (Get_System_Id (Handler.Locator)).all) & U.all); @@ -897,6 +900,7 @@ package body Schema.Readers is Doc_Locator => null); end if; + -- Not a dispatching call Parse (Schema.Validators.Abstract_Validation_Reader (Parser), Input); if not In_Final (Parser.Matcher) then @@ -945,7 +949,7 @@ package body Schema.Readers is (Handler : in out Sax_Reader'Class; Loc : in out Sax.Locators.Locator) is begin - Validating_Reader (Handler).Locator := Loc; + Set_Locator (Validating_Reader (Handler), Loc); end Hook_Set_Document_Locator; ------------------------------- @@ -979,4 +983,23 @@ package body Schema.Readers is end if; end Free; + ------------- + -- Locator -- + ------------- + + function Locator (Parser : Validating_Reader) return Sax.Locators.Locator is + begin + return Parser.Locator; + end Locator; + + ----------------- + -- Set_Locator -- + ----------------- + + procedure Set_Locator + (Parser : in out Validating_Reader; Loc : Sax.Locators.Locator) is + begin + Parser.Locator := Loc; + end Set_Locator; + end Schema.Readers; diff --git a/schema/schema-readers.ads b/schema/schema-readers.ads index d48ee73..b54051b 100644 --- a/schema/schema-readers.ads +++ b/schema/schema-readers.ads @@ -129,6 +129,12 @@ package Schema.Readers is Input : in out Input_Sources.Input_Source'Class); -- Override inherited method. + function Locator (Parser : Validating_Reader) return Sax.Locators.Locator; + procedure Set_Locator + (Parser : in out Validating_Reader; Loc : Sax.Locators.Locator); + -- The locator used to get information on the current location of the + -- parser. + private type Validating_Reader is new Schema.Validators.Abstract_Validation_Reader diff --git a/schema/schema-schema_readers.adb b/schema/schema-schema_readers.adb index 09ddfd2..561b0d0 100644 --- a/schema/schema-schema_readers.adb +++ b/schema/schema-schema_readers.adb @@ -1313,7 +1313,12 @@ package body Schema.Schema_Readers is overriding procedure Set_Document_Locator (Handler : in out Schema_Reader; Loc : in out Sax.Locators.Locator) is begin - Handler.Locator := Loc; + if Debug then + Debug_Output ("Schema.Schema_Readers.Set_Document_Locator " + & To_String (Get_Location (Loc))); + end if; + + Set_Locator (Handler, Loc); end Set_Document_Locator; ------------------- @@ -1331,9 +1336,18 @@ package body Schema.Schema_Readers is S_File_Full : constant Symbol := To_Absolute_URI (Handler.all, Xsd_File); Need_To_Initialize : Boolean := True; begin + if URI_Was_Parsed (Get_Grammar (Handler.all), S_File_Full) then + if Debug then + Debug_Output ("Parse_Grammar " & Get (S_File_Full).all + & " already parsed"); + end if; + return; + end if; + if Debug then Debug_Output ("Parse_Grammar NS={" & Get (URI).all - & "} XSD={" & Get (Xsd_File).all & "}"); + & "} XSD={" & Get (Xsd_File).all & "} " + & Get (S_File_Full).all); end if; if Get_XSD_Version (Handler.Grammar) = XSD_1_0 then @@ -1476,10 +1490,6 @@ package body Schema.Schema_Readers is Set_Feature (Parser, Sax.Readers.Schema_Validation_Feature, False); Set_Parsed_URI (Parser, URI); --- Find_NS_From_URI (Parser, URI => Parser.Target_NS, NS => NS); --- pragma Assert (NS /= No_XML_NS); -- Always False in practice! --- Set_System_Id (NS, URI); - Schema.Readers.Parse (Validating_Reader (Parser), Input); if Do_Create_NFA then @@ -1934,27 +1944,21 @@ package body Schema.Schema_Readers is else declare Location : constant Symbol := Get_Value (Atts, Location_Index); - Absolute : constant Symbol := To_Absolute_URI - (Handler.all, Location); begin if Debug then - Debug_Output ("Import: " & Get (Absolute).all); + Debug_Output ("Import: " & Get (Location).all); Debug_Output ("Adding new grammar to Handler.Created_Grammar"); end if; - if not URI_Was_Parsed (Get_Grammar (Handler.all), Absolute) then - -- The namespace attribute indicates that the XSD may contain - -- qualified references to schema components in that namespace. - -- (4.2.6.1). It does not give the default targetNamespace + -- The namespace attribute indicates that the XSD may contain + -- qualified references to schema components in that namespace. + -- (4.2.6.1). It does not give the default targetNamespace - Parse_Grammar - (Handler, - URI => Empty_String, - Do_Create_NFA => True, - Xsd_File => Location); - elsif Debug then - Debug_Output ("Already imported"); - end if; + Parse_Grammar + (Handler, + URI => Empty_String, + Do_Create_NFA => True, + Xsd_File => Location); end; end if; end Create_Import; diff --git a/schema/schema-schema_readers.ads b/schema/schema-schema_readers.ads index 67319a7..7d1a4c8 100644 --- a/schema/schema-schema_readers.ads +++ b/schema/schema-schema_readers.ads @@ -313,8 +313,6 @@ private -- or redefine) XSD, until we can create the NFA type Schema_Reader is new Schema.Readers.Validating_Reader with record - Locator : Sax.Locators.Locator; - Attribute_Form_Default : Schema.Validators.Form_Type := Schema.Validators.Unqualified; Element_Form_Default : Schema.Validators.Form_Type :=