From 3dbceb8b098bd0b3cb7a8979827052d5e71a9199 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 10 Mar 2017 07:28:36 +0100 Subject: [PATCH] Fix schema handling in WSDL. First the tool ada2wsdl does not generate targetNamespace in elements inside the schema as this is not valid. When there is multiple schema used, ada2wsdl generates multiple schema one for each targetNamespace. At the same time the wsdl2aws has been fixed to support multiple schema definition. This change was needed to properly support derived types for which the base type are found in different packages. So have different targetNamespace. Some tests expected output have been changed due to the change above, the new output are better as the original namespace is kept. Add corresponding regression tests. For Q309-017 and Q301-031. --- regtests/0266_type_constraints/test.out | 22 +-- regtests/0274_doclit2/test.out | 10 +- regtests/0292_multiple_schema/another.ads | 23 +++ regtests/0292_multiple_schema/api-child.adb | 33 +++++ regtests/0292_multiple_schema/api-child.ads | 40 +++++ regtests/0292_multiple_schema/api.ads | 23 +++ .../0292_multiple_schema/multiple_schema.adb | 102 +++++++++++++ .../0292_multiple_schema/multiple_schema.gpr | 24 +++ regtests/0292_multiple_schema/test.opt | 2 + regtests/0292_multiple_schema/test.out | 3 + regtests/0292_multiple_schema/test.py | 8 + regtests/0293_multiple_schema/another.ads | 23 +++ regtests/0293_multiple_schema/api-child.ads | 40 +++++ .../api-child_service-cb.adb | 83 +++++++++++ .../api-child_service-cb.ads | 44 ++++++ regtests/0293_multiple_schema/api.ads | 23 +++ regtests/0293_multiple_schema/api_imp.adb | 36 +++++ regtests/0293_multiple_schema/api_imp.ads | 25 ++++ .../0293_multiple_schema/multiple_schema.adb | 101 +++++++++++++ .../0293_multiple_schema/multiple_schema.gpr | 24 +++ regtests/0293_multiple_schema/test.opt | 2 + regtests/0293_multiple_schema/test.out | 3 + regtests/0293_multiple_schema/test.py | 7 + src/soap/soap-generator.adb | 12 +- src/soap/soap-wsdl-parser.adb | 128 ++++++++-------- tools/ada2wsdl-generator.adb | 138 +++++++++--------- 26 files changed, 819 insertions(+), 160 deletions(-) create mode 100644 regtests/0292_multiple_schema/another.ads create mode 100644 regtests/0292_multiple_schema/api-child.adb create mode 100644 regtests/0292_multiple_schema/api-child.ads create mode 100644 regtests/0292_multiple_schema/api.ads create mode 100644 regtests/0292_multiple_schema/multiple_schema.adb create mode 100644 regtests/0292_multiple_schema/multiple_schema.gpr create mode 100644 regtests/0292_multiple_schema/test.opt create mode 100644 regtests/0292_multiple_schema/test.out create mode 100644 regtests/0292_multiple_schema/test.py create mode 100644 regtests/0293_multiple_schema/another.ads create mode 100644 regtests/0293_multiple_schema/api-child.ads create mode 100644 regtests/0293_multiple_schema/api-child_service-cb.adb create mode 100644 regtests/0293_multiple_schema/api-child_service-cb.ads create mode 100644 regtests/0293_multiple_schema/api.ads create mode 100644 regtests/0293_multiple_schema/api_imp.adb create mode 100644 regtests/0293_multiple_schema/api_imp.ads create mode 100644 regtests/0293_multiple_schema/multiple_schema.adb create mode 100644 regtests/0293_multiple_schema/multiple_schema.gpr create mode 100644 regtests/0293_multiple_schema/test.opt create mode 100644 regtests/0293_multiple_schema/test.out create mode 100644 regtests/0293_multiple_schema/test.py diff --git a/regtests/0266_type_constraints/test.out b/regtests/0266_type_constraints/test.out index 0c53bd2ea..447456dbe 100644 --- a/regtests/0266_type_constraints/test.out +++ b/regtests/0266_type_constraints/test.out @@ -2,37 +2,37 @@ 125 ============================== - - - - - - - - - - diff --git a/regtests/0274_doclit2/test.out b/regtests/0274_doclit2/test.out index 48d48dfa4..279216cbf 100644 --- a/regtests/0274_doclit2/test.out +++ b/regtests/0274_doclit2/test.out @@ -14,13 +14,13 @@ maximumQueueSize = 16 + xmlns:sp="http://aurn.here.org/spatial"> XXXX-XX-XXTXX:XX:XXZ - 1.00000000000000 - 1.10000000000000 + 1.00000000000000 + 1.10000000000000 3.00000000000000 4.00000000000000 @@ -31,8 +31,8 @@ maximumQueueSize = 16 - 2.00000000000000 - 2.10000000000000 + 2.00000000000000 + 2.10000000000000 3.20000000000000 4.20000000000000 diff --git a/regtests/0292_multiple_schema/another.ads b/regtests/0292_multiple_schema/another.ads new file mode 100644 index 000000000..aed42add2 --- /dev/null +++ b/regtests/0292_multiple_schema/another.ads @@ -0,0 +1,23 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +package Another is + + type Data is new Integer; + +end Another; diff --git a/regtests/0292_multiple_schema/api-child.adb b/regtests/0292_multiple_schema/api-child.adb new file mode 100644 index 000000000..719373831 --- /dev/null +++ b/regtests/0292_multiple_schema/api-child.adb @@ -0,0 +1,33 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Text_IO; + +package body API.Child is + + procedure Call (O : Rec) is + begin + Ada.Text_IO.Put_Line ("API.Call : " & To_String (O.V)); + Ada.Text_IO.Put_Line (" : " & O.C'Img); + Ada.Text_IO.Put_Line (" : " & O.D'Img); + exception + when others => + Ada.Text_IO.Put_Line ("API.Call!!!!!"); + end Call; + +end API.Child; diff --git a/regtests/0292_multiple_schema/api-child.ads b/regtests/0292_multiple_schema/api-child.ads new file mode 100644 index 000000000..4acb7d49b --- /dev/null +++ b/regtests/0292_multiple_schema/api-child.ads @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Strings.Unbounded; + +with Another; + +package API.Child is + + use Ada.Strings.Unbounded; + + subtype T is API.T; + type Data is new Another.Data; + + type Rec is record + V : Unbounded_String; + A : Integer; + B : Unbounded_String; + C : T; + D : Data; + end record; + + procedure Call (O : Rec); + +end API.Child; diff --git a/regtests/0292_multiple_schema/api.ads b/regtests/0292_multiple_schema/api.ads new file mode 100644 index 000000000..3f28c88c1 --- /dev/null +++ b/regtests/0292_multiple_schema/api.ads @@ -0,0 +1,23 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +package API is + + type T is new Integer; + +end API; diff --git a/regtests/0292_multiple_schema/multiple_schema.adb b/regtests/0292_multiple_schema/multiple_schema.adb new file mode 100644 index 000000000..11db40ec8 --- /dev/null +++ b/regtests/0292_multiple_schema/multiple_schema.adb @@ -0,0 +1,102 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +-- SOAP/WSDL test + +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Config.Set; +with AWS.MIME; +with AWS.Net; +with AWS.Response; +with AWS.Server.Status; +with AWS.Status; + +with SOAP.Dispatchers.Callback; +with SOAP.Utils; + +with API.Child_Service.CB; +with API.Child_Service.Client; +with API.Child_Service.Server; + +with API.Child; + +procedure Multiple_Schema is + + use Ada.Strings.Unbounded; + use AWS; + + H_Server : Server.HTTP; + CNF : Config.Object; + Disp : API.Child_Service.CB.Handler; + + procedure WSDL_Demo_Client is + use Ada; + R : API.Child.Rec; + begin + R.V := To_Unbounded_String ("from client"); + R.C := 5; + R.D := 9912; + API.Child_Service.Client.Call + (O => R, + Endpoint => AWS.Server.Status.Local_URL (H_Server)); + end WSDL_Demo_Client; + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + SOAPAction : constant String := Status.SOAPAction (Request); + begin + return Response.Build (MIME.Text_HTML, "

Not a SOAP request"); + end CB; + +begin + Config.Set.Server_Name (CNF, "WSDL Multiple Schema"); + Config.Set.Server_Host (CNF, "localhost"); + Config.Set.Server_Port (CNF, 0); + + Disp := SOAP.Dispatchers.Callback.Create + (CB'Unrestricted_Access, + API.Child_Service.CB.SOAP_CB'Access, + API.Child_Service.Schema); + + Server.Start (H_Server, Disp, CNF); + + if Net.IPv6_Available then + -- Need to start second server on same port but on the different + -- Protocol_Family because we do not know which family would client try + -- to connect. + + if AWS.Server.Status.Is_IPv6 (H_Server) then + Server.Add_Listening + (H_Server, "localhost", + AWS.Server.Status.Port (H_Server), Net.FAMILY_INET); + else + Server.Add_Listening + (H_Server, "localhost", + AWS.Server.Status.Port (H_Server), Net.FAMILY_INET6); + end if; + end if; + + WSDL_Demo_Client; + + Server.Shutdown (H_Server); +end Multiple_Schema; diff --git a/regtests/0292_multiple_schema/multiple_schema.gpr b/regtests/0292_multiple_schema/multiple_schema.gpr new file mode 100644 index 000000000..3047c074f --- /dev/null +++ b/regtests/0292_multiple_schema/multiple_schema.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project Multiple_Schema is + for Source_Dirs use ("."); + for Main use ("multiple_schema.adb"); +end Multiple_Schema; diff --git a/regtests/0292_multiple_schema/test.opt b/regtests/0292_multiple_schema/test.opt new file mode 100644 index 000000000..3617e9803 --- /dev/null +++ b/regtests/0292_multiple_schema/test.opt @@ -0,0 +1,2 @@ +!xmlada DEAD +!asis DEAD diff --git a/regtests/0292_multiple_schema/test.out b/regtests/0292_multiple_schema/test.out new file mode 100644 index 000000000..6def4eb30 --- /dev/null +++ b/regtests/0292_multiple_schema/test.out @@ -0,0 +1,3 @@ +API.Call : from client + : 5 + : 9912 diff --git a/regtests/0292_multiple_schema/test.py b/regtests/0292_multiple_schema/test.py new file mode 100644 index 000000000..e011d9cbe --- /dev/null +++ b/regtests/0292_multiple_schema/test.py @@ -0,0 +1,8 @@ +from test_support import * + +exec_cmd('ada2wsdl', + ['-q', '-lit', '-f', '-o', 'api-child.wsdl', 'api-child.ads']) + +exec_cmd('wsdl2aws', + ['-q', '-f', '-spec', 'api.child', '-cb', 'api-child.wsdl']) +build_and_run('multiple_schema') diff --git a/regtests/0293_multiple_schema/another.ads b/regtests/0293_multiple_schema/another.ads new file mode 100644 index 000000000..aed42add2 --- /dev/null +++ b/regtests/0293_multiple_schema/another.ads @@ -0,0 +1,23 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +package Another is + + type Data is new Integer; + +end Another; diff --git a/regtests/0293_multiple_schema/api-child.ads b/regtests/0293_multiple_schema/api-child.ads new file mode 100644 index 000000000..4acb7d49b --- /dev/null +++ b/regtests/0293_multiple_schema/api-child.ads @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Strings.Unbounded; + +with Another; + +package API.Child is + + use Ada.Strings.Unbounded; + + subtype T is API.T; + type Data is new Another.Data; + + type Rec is record + V : Unbounded_String; + A : Integer; + B : Unbounded_String; + C : T; + D : Data; + end record; + + procedure Call (O : Rec); + +end API.Child; diff --git a/regtests/0293_multiple_schema/api-child_service-cb.adb b/regtests/0293_multiple_schema/api-child_service-cb.adb new file mode 100644 index 000000000..c46576ada --- /dev/null +++ b/regtests/0293_multiple_schema/api-child_service-cb.adb @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Exceptions; + +with SOAP.Message.Response.Error; + +with API_Imp; + +with API.Child_Service.Server; +with API.Child_Service.Types; + +package body API.Child_Service.CB is + + use Ada.Exceptions; + use SOAP; + + pragma Warnings (Off, API.Child_Service.Server); + pragma Warnings (Off, API.Child_Service.Types); + + pragma Style_Checks (Off); + + function Call_CB is + new API.Child_Service.Server.Call_CB (API_Imp.Call); + + --------------------------- + -- Is_SOAPAction_Defined -- + --------------------------- + + function Is_SOAPAction_Defined + (SOAPAction : String) return Boolean is + begin + if SOAPAction = "Call" then + return True; + else + return False; + end if; + end Is_SOAPAction_Defined; + + ------------- + -- SOAP_CB -- + ------------- + + function SOAP_CB + (SOAPAction : String; + Payload : Message.Payload.Object; + Request : AWS.Status.Data) + return Response.Data is + begin + if SOAPAction = "Call" then + return Call_CB (SOAPAction, Payload, Request); + + else + return Message.Response.Build + (Message.Response.Error.Build + (Message.Response.Error.Client, + "Wrong SOAP action " & SOAPAction)); + end if; + exception + when E : others => + return Message.Response.Build + (Message.Response.Error.Build + (Message.Response.Error.Client, + "Error in SOAP_CB for SOAPAction " & SOAPAction + & " (" & Exception_Information (E) & ")")); + end SOAP_CB; + +end API.Child_Service.CB; diff --git a/regtests/0293_multiple_schema/api-child_service-cb.ads b/regtests/0293_multiple_schema/api-child_service-cb.ads new file mode 100644 index 000000000..fff472d92 --- /dev/null +++ b/regtests/0293_multiple_schema/api-child_service-cb.ads @@ -0,0 +1,44 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with AWS.Response; +with AWS.Status; + +with SOAP.Dispatchers.Callback; +with SOAP.Message.Payload; + +package API.Child_Service.CB is + + use AWS; + use SOAP; + + pragma Style_Checks (Off); + + subtype Handler is SOAP.Dispatchers.Callback.Handler; + + function Is_SOAPAction_Defined + (SOAPAction : String) return Boolean; + -- Returns True if SOAPAction handled by SOAP_CB below + + function SOAP_CB + (SOAPAction : String; + Payload : Message.Payload.Object; + Request : AWS.Status.Data) + return Response.Data; + +end API.Child_Service.CB; diff --git a/regtests/0293_multiple_schema/api.ads b/regtests/0293_multiple_schema/api.ads new file mode 100644 index 000000000..3f28c88c1 --- /dev/null +++ b/regtests/0293_multiple_schema/api.ads @@ -0,0 +1,23 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +package API is + + type T is new Integer; + +end API; diff --git a/regtests/0293_multiple_schema/api_imp.adb b/regtests/0293_multiple_schema/api_imp.adb new file mode 100644 index 000000000..d26d1b8f9 --- /dev/null +++ b/regtests/0293_multiple_schema/api_imp.adb @@ -0,0 +1,36 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +package body API_Imp is + + use Ada.Strings.Unbounded; + + procedure Call (O : API.Child_Service.Types.Rec_Type) is + begin + Ada.Text_IO.Put_Line ("API.Call : " & To_String (O.V)); + Ada.Text_IO.Put_Line (" : " & O.C'Img); + Ada.Text_IO.Put_Line (" : " & O.D'Img); + exception + when others => + Ada.Text_IO.Put_Line ("API.Call!!!!!"); + end Call; + +end API_Imp; diff --git a/regtests/0293_multiple_schema/api_imp.ads b/regtests/0293_multiple_schema/api_imp.ads new file mode 100644 index 000000000..71b591e95 --- /dev/null +++ b/regtests/0293_multiple_schema/api_imp.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with API.Child_Service.Types; + +package API_Imp is + + procedure Call (O : API.Child_Service.Types.Rec_Type); + +end API_Imp; diff --git a/regtests/0293_multiple_schema/multiple_schema.adb b/regtests/0293_multiple_schema/multiple_schema.adb new file mode 100644 index 000000000..737516eb9 --- /dev/null +++ b/regtests/0293_multiple_schema/multiple_schema.adb @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +-- SOAP/WSDL test + +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Config.Set; +with AWS.MIME; +with AWS.Net; +with AWS.Response; +with AWS.Server.Status; +with AWS.Status; + +with SOAP.Dispatchers.Callback; +with SOAP.Utils; + +with API.Child_Service.CB; +with API.Child_Service.Client; +with API.Child_Service.Server; +with API.Child_Service.Types; + +procedure Multiple_Schema is + + use Ada.Strings.Unbounded; + use AWS; + + H_Server : Server.HTTP; + CNF : Config.Object; + Disp : API.Child_Service.CB.Handler; + + procedure WSDL_Demo_Client is + use Ada; + R : API.Child_Service.Types.Rec_Type; + begin + R.V := To_Unbounded_String ("from client"); + R.C := 5; + R.D := 9912; + API.Child_Service.Client.Call + (O => R, + Endpoint => AWS.Server.Status.Local_URL (H_Server)); + end WSDL_Demo_Client; + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + SOAPAction : constant String := Status.SOAPAction (Request); + begin + return Response.Build (MIME.Text_HTML, "

Not a SOAP request"); + end CB; + +begin + Config.Set.Server_Name (CNF, "WSDL Multiple Schema"); + Config.Set.Server_Host (CNF, "localhost"); + Config.Set.Server_Port (CNF, 0); + + Disp := SOAP.Dispatchers.Callback.Create + (CB'Unrestricted_Access, + API.Child_Service.CB.SOAP_CB'Access, + API.Child_Service.Schema); + + Server.Start (H_Server, Disp, CNF); + + if Net.IPv6_Available then + -- Need to start second server on same port but on the different + -- Protocol_Family because we do not know which family would client try + -- to connect. + + if AWS.Server.Status.Is_IPv6 (H_Server) then + Server.Add_Listening + (H_Server, "localhost", + AWS.Server.Status.Port (H_Server), Net.FAMILY_INET); + else + Server.Add_Listening + (H_Server, "localhost", + AWS.Server.Status.Port (H_Server), Net.FAMILY_INET6); + end if; + end if; + + WSDL_Demo_Client; + + Server.Shutdown (H_Server); +end Multiple_Schema; diff --git a/regtests/0293_multiple_schema/multiple_schema.gpr b/regtests/0293_multiple_schema/multiple_schema.gpr new file mode 100644 index 000000000..3047c074f --- /dev/null +++ b/regtests/0293_multiple_schema/multiple_schema.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2017, AdaCore -- +-- -- +-- This 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 software is distributed in the hope that it will -- +-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- +-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- +-- General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project Multiple_Schema is + for Source_Dirs use ("."); + for Main use ("multiple_schema.adb"); +end Multiple_Schema; diff --git a/regtests/0293_multiple_schema/test.opt b/regtests/0293_multiple_schema/test.opt new file mode 100644 index 000000000..3617e9803 --- /dev/null +++ b/regtests/0293_multiple_schema/test.opt @@ -0,0 +1,2 @@ +!xmlada DEAD +!asis DEAD diff --git a/regtests/0293_multiple_schema/test.out b/regtests/0293_multiple_schema/test.out new file mode 100644 index 000000000..6def4eb30 --- /dev/null +++ b/regtests/0293_multiple_schema/test.out @@ -0,0 +1,3 @@ +API.Call : from client + : 5 + : 9912 diff --git a/regtests/0293_multiple_schema/test.py b/regtests/0293_multiple_schema/test.py new file mode 100644 index 000000000..4af545c54 --- /dev/null +++ b/regtests/0293_multiple_schema/test.py @@ -0,0 +1,7 @@ +from test_support import * + +exec_cmd('ada2wsdl', + ['-q', '-lit', '-f', '-o', 'api-child.wsdl', 'api-child.ads']) + +exec_cmd('wsdl2aws', ['-q', '-f', 'api-child.wsdl']) +build_and_run('multiple_schema') diff --git a/src/soap/soap-generator.adb b/src/soap/soap-generator.adb index 381a0bdbe..d054f80b7 100644 --- a/src/soap/soap-generator.adb +++ b/src/soap/soap-generator.adb @@ -1887,7 +1887,7 @@ package body SOAP.Generator is Text_IO.New_Line (Der_Ads); - Text_IO.Put_Line (Der_Ads, " function To_" & Q_Name); + Text_IO.Put_Line (Der_Ads, " function To_" & Q_Name & "_Type"); Text_IO.Put_Line (Der_Ads, " (D : " & F_Name & ")"); Text_IO.Put_Line (Der_Ads, @@ -1896,7 +1896,7 @@ package body SOAP.Generator is Text_IO.New_Line (Der_Ads); - Text_IO.Put_Line (Der_Ads, " function From_" & Q_Name); + Text_IO.Put_Line (Der_Ads, " function From_" & Q_Name & "_Type"); Text_IO.Put_Line (Der_Ads, " (D : " & Types_Spec (O) & "." & Utils.No_NS (Name) & ")"); @@ -1909,7 +1909,7 @@ package body SOAP.Generator is & "." & Utils.No_NS (Name) & ")"); Text_IO.Put_Line (Der_Ads, " return " & F_Name - & " renames From_" & Q_Name & ';'); + & " renames From_" & Q_Name & "_Type;"); if WSDL.Is_Standard (P_Name) then Text_IO.New_Line (Der_Ads); @@ -1983,7 +1983,8 @@ package body SOAP.Generator is & "." & Utils.No_NS (Name)); Text_IO.Put_Line (Tmp_Ads, " renames " - & To_Unit_Name (To_String (Prefix)) & ".To_" & Q_Name & ';'); + & To_Unit_Name (To_String (Prefix)) + & ".To_" & Q_Name & "_Type;"); Text_IO.Put_Line (Tmp_Ads, @@ -1993,7 +1994,8 @@ package body SOAP.Generator is (Tmp_Ads, " return " & F_Name); Text_IO.Put_Line (Tmp_Ads, " renames " - & To_Unit_Name (To_String (Prefix)) & ".From_" & Q_Name & ';'); + & To_Unit_Name (To_String (Prefix)) + & ".From_" & Q_Name & "_Type;"); if WSDL.Is_Standard (P_Name) then Text_IO.New_Line (Tmp_Ads); diff --git a/src/soap/soap-wsdl-parser.adb b/src/soap/soap-wsdl-parser.adb index 8ce2348f7..fddb5826c 100644 --- a/src/soap/soap-wsdl-parser.adb +++ b/src/soap/soap-wsdl-parser.adb @@ -951,13 +951,6 @@ package body SOAP.WSDL.Parser is exit when D /= null; end loop; end if; - - -- Then check all mixed-schemas - - if D = null then - WSDL.Schema.For_All - (Namespace => "", Process => Look_Schema'Access); - end if; end; return D; @@ -980,21 +973,7 @@ package body SOAP.WSDL.Parser is Parse_Definitions (O, N, Document); - -- Record this schema as the targetNamespace schema - - declare - Embedded_Schema : constant DOM.Core.Node := - Get_Node (DOM.Core.Node (Document), - "definitions.types.schema"); - begin - if Embedded_Schema /= null then - Schema.Register - (Name_Space.Value (Get_Target_Name_Space (Embedded_Schema)), - Embedded_Schema); - end if; - end; - - -- Then we load all external schemas + -- Then we load all schemas Parse_Schema (O, DOM.Core.Node (Document), "definitions.types.schema"); @@ -1902,60 +1881,63 @@ package body SOAP.WSDL.Parser is Root : DOM.Core.Node; XPath : String) is - N : constant DOM.Core.Node := Get_Node (Root, XPath); + N : DOM.Core.Node := Get_Node (Root, XPath); + C : DOM.Core.Node; begin - if N /= null then - declare - NL : constant DOM.Core.Node_List := - DOM.Core.Nodes.Child_Nodes (N); - begin - for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop - declare - S : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K); - L : constant String := - XML.Get_Attr_Value (S, "schemaLocation"); - begin - if DOM.Core.Nodes.Local_Name (S) = "import" - and then L /= "" - and then (L'Length < 7 - or else L (L'First .. L'First + 6) /= "http://") - then - -- Register the root node of the schema under the - -- corresponding namespace. + while N /= null loop - declare - N : constant DOM.Core.Node := - DOM.Core.Node - (Load - (XML.Get_Attr_Value (S, "schemaLocation"))); - begin - Trace ("(Parse_Schema) " - & XML.Get_Attr_Value (S, "namespace"), - XML.First_Child (N)); + if DOM.Core.Nodes.Local_Name (N) = "schema" then + -- Register this schema - Schema.Register - (XML.Get_Attr_Value (S, "namespace"), - XML.First_Child (N)); + Schema.Register + (Name_Space.Value (Get_Target_Name_Space (N)), N); - Register_Name_Spaces (N); + -- Look for import in this schema - -- Check recursively for imported schema + C := XML.First_Child (N); - Parse_Schema (O, N, "schema"); - end; - end if; - end; + while C /= null loop + if DOM.Core.Nodes.Local_Name (C) = "import" then + declare + L : constant String := + XML.Get_Attr_Value (C, "schemaLocation"); + begin + if L /= "" + and then + (L'Length < 7 + or else L (L'First .. L'First + 6) /= "http://") + then + -- Register the root node of the schema under the + -- corresponding namespace. + + declare + N : constant DOM.Core.Node := + DOM.Core.Node (Load (L)); + begin + Trace ("(Parse_Schema) " + & XML.Get_Attr_Value (C, "namespace"), + XML.First_Child (N)); + + Schema.Register + (XML.Get_Attr_Value (C, "namespace"), + XML.First_Child (N)); + + Register_Name_Spaces (XML.First_Child (N)); + + -- Check recursively for imported schema + + Parse_Schema (O, N, "schema"); + end; + end if; + end; + end if; + + C := XML.Next_Sibling (C); end loop; - end; - - -- If this schema has no targetNamespace then it is a schema - -- containing definition for different name-space. Record it as - -- a mixed name-space. - - if XML.Get_Attr_Value (N, "targetNamespace") = "" then - Schema.Register ("", N); end if; - end if; + + N := XML.Next_Sibling (N); + end loop; end Parse_Schema; ------------------- @@ -2330,9 +2312,13 @@ package body SOAP.WSDL.Parser is -- We can have multiple prefix pointing to the same URL -- (namespace). But an URL must be unique - WSDL.Name_Spaces.Register - (DOM.Core.Nodes.Local_Name (N), - DOM.Core.Nodes.Node_Value (N)); + if not WSDL.Name_Spaces.Contains + (DOM.Core.Nodes.Local_Name (N)) + then + WSDL.Name_Spaces.Register + (DOM.Core.Nodes.Local_Name (N), + DOM.Core.Nodes.Node_Value (N)); + end if; if not WSDL.Name_Spaces.Contains (DOM.Core.Nodes.Node_Value (N)) diff --git a/tools/ada2wsdl-generator.adb b/tools/ada2wsdl-generator.adb index ede691df0..576e2651f 100644 --- a/tools/ada2wsdl-generator.adb +++ b/tools/ada2wsdl-generator.adb @@ -26,6 +26,7 @@ with Ada.Text_IO; with GNAT.Calendar.Time_IO; +with AWS.Containers.String_Vectors; with AWS.Utils; with SOAP.Name_Space; with SOAP.Types; @@ -862,6 +863,9 @@ package body Ada2WSDL.Generator is procedure Generate_Element; -- Write the Element for document style binding + procedure Write_Schema_For (NS : String); + -- Write schema definitions for the given name-space + ---------------------- -- Generate_Element -- ---------------------- @@ -924,8 +928,8 @@ package body Ada2WSDL.Generator is procedure Write_Array (E : Definition) is begin New_Line; - Put_Line (" "); + Put_Line + (" "); Put_Line (" "); Put_Line (" "); @@ -966,8 +970,7 @@ package body Ada2WSDL.Generator is P : access Parameter := E.Parameters; begin New_Line; - Put_Line (" "); + Put_Line (" "); Put_Line (" "); while P /= null loop @@ -988,8 +991,7 @@ package body Ada2WSDL.Generator is P : access Parameter := E.Parameters; begin New_Line; - Put_Line (" "); + Put_Line (" "); Put_Line (" "); while P /= null loop @@ -1002,6 +1004,51 @@ package body Ada2WSDL.Generator is Put_Line (" "); end Write_Record; + ---------------------- + -- Write_Schema_For -- + ---------------------- + + procedure Write_Schema_For (NS : String) is + begin + New_Line; + Put + (" "); + + if Character_Schema then + Write_Character; + end if; + + -- Output document/style element + + if Options.Document then + Generate_Element; + end if; + + -- Output all structures + + for A of API loop + if A.Def_Mode in Structure | Table | Simple_Type | Enumeration + and then -A.NS = NS + then + case A.Def_Mode is + when Structure => Write_Record (A); + when Table => Write_Array (A); + when Simple_Type => Write_Type (A); + when Enumeration => Write_Enumeration (A); + + when Safe_Pointer_Definition | Routine => + null; + end case; + end if; + end loop; + + Put_Line (" "); + end Write_Schema_For; + ---------------- -- Write_Type -- ---------------- @@ -1010,8 +1057,7 @@ package body Ada2WSDL.Generator is P : constant not null access Parameter := E.Parameters; begin New_Line; - Put_Line (" "); + Put_Line (" "); Put_Line (" "); @@ -1034,78 +1080,34 @@ package body Ada2WSDL.Generator is Put_Line (" "); end Write_Type; + Schemas : AWS.Containers.String_Vectors.Vector; + -- Record all schemas defined + begin if Schema_Needed or else Options.Document or else Character_Schema then - New_Line; - Put_Line (" "); - Put - (" - if Global_NS = Null_Unbounded_String then - Global_NS := A.NS; - - elsif Global_NS /= A.NS then - Single_NS := False; - end if; - - when Safe_Pointer_Definition | Routine => - null; - end case; - end loop; - - if Single_NS then - New_Line; - Put (" targetNamespace=""" & (-Global_NS) & '"'); - end if; - - -- Finally, close schema - Put_Line (">"); - end; - - if Character_Schema then - Write_Character; - end if; - - -- Output document/style element - - if Options.Document then - Generate_Element; - end if; - - -- Output all structures - for A of API loop case A.Def_Mode is - when Structure => Write_Record (A); - when Table => Write_Array (A); - when Simple_Type => Write_Type (A); - when Enumeration => Write_Enumeration (A); - + when Structure | Table | Simple_Type | Enumeration => + if not Schemas.Contains (-A.NS) then + Schemas.Append (-A.NS); + end if; when Safe_Pointer_Definition | Routine => null; end case; end loop; - Put_Line (" "); + -- Now write all needed schemas + + New_Line; + Put (" "); + + for S of Schemas loop + Write_Schema_For (S); + end loop; + Put_Line (" "); end if; end Write_Schema;