(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

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

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

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;

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 :=