The unified diff between revisions [101a9998..] and [40972ea6..] is displayed below. It can also be downloaded as a raw diff.
#
#
# patch "NEWS"
# from [6fc0fceeb50a100852553933104e5652218c6cba]
# to [413f4cca60647ed778506aecc2d0a52a4df8bf7d]
#
# patch "README"
# from [e5b5c1a75b95fab01cecd7b56d550fecee1b4703]
# to [773f00122f83c011800f6f469964e84c1eb92992]
#
# patch "compilers/gnatdist/xe_flags.ads"
# from [5d2516a7566b6a461e9e4b8ec52e8057ed123b6d]
# to [29d067af827ecd8dbc182f50868570b593eb4db1]
#
# patch "compilers/gnatdist/xe_front.adb"
# from [339a27c1e2d76132d77b5698616bd41bbcf8ab60]
# to [c3c0c8609031c32accc157055782a4036e30bd5a]
#
# patch "compilers/gnatdist/xe_list.adb"
# from [841330bc0c7fb68fda1c2da7c4d9dbaf4fa29f73]
# to [1da5089734ba65be61bd10ab67e59e033f13051d]
#
# patch "compilers/gnatdist/xe_main.adb"
# from [6e4a4ef4eb560b3825f7ec1e5421604e4e424ae1]
# to [229f95a8de1c44876c2b18dec014ab9df268d1f4]
#
# patch "compilers/gnatdist/xe_names.adb"
# from [ee462be4bb204bfdc0113c305e9341df068455ba]
# to [9f626338774a30892861b159ad1d19242dcf922b]
#
# patch "compilers/gnatdist/xe_sem.ads"
# from [9a154ed633bcaaf01cf7f9d466cceae3e75b23c7]
# to [52ca18b46bc7dc83d58996d4a68f6585b440fc36]
#
# patch "compilers/gnatdist/xe_units.ads"
# from [b67ccadd6b7a052c12db0eadc0f913fb16679974]
# to [6bbf5b503f94cc770be2272459be1751e18e545e]
#
# patch "compilers/gnatdist/xe_utils.adb"
# from [eb71f5970e1ed38bd2fcd9d6806cf696ce77ddf0]
# to [bfda99f6848352d2f29043f452fefc0dfbae91b0]
#
# patch "compilers/gnatdist/xe_utils.ads"
# from [d7c7889181a94f3184855858974cfa8a269b83d0]
# to [ea91ed265eb347102760c264d23d1d7dde95bfb0]
#
# patch "compilers/iac/analyzer.adb"
# from [e97b05917791db627bb2eeb7d7fb0d49cf0e6ef3]
# to [58361e185dd7826853a10c9b368345d86e082bb1]
#
# patch "compilers/iac/backend-be_corba_ada-cdrs.adb"
# from [b62279111337f36fab3a49914a33c5de220a9f6b]
# to [77c95113623b12bc649ad2ef967f167830047609]
#
# patch "compilers/iac/frontend-debug.adb"
# from [ec7fa8b9fdfe9f82f16fa90305838efa8d630fae]
# to [1c004d6d9c3c12c3973ec1751e762e71b2fa1401]
#
# patch "compilers/iac/frontend-nutils.adb"
# from [1f5b5878bd69620497cecb857e7b50e4fc7a864f]
# to [e112f2065ad7bd00281a28b0b3f971aa6c9f6b80]
#
# patch "compilers/iac/frontend-nutils.ads"
# from [e1c5692ca3794607c6e495765002e85fa4a1b5bc]
# to [c32b56035ea21b9a161db05b69effe1c656451af]
#
# patch "compilers/iac/scopes.adb"
# from [53180bbe8c7fca7b7af258623529a58fe2fc7e3c]
# to [5956136acfb318ce2916f4e4bcdd1d3de706165b]
#
# patch "configure.ac"
# from [db7c56dfe04a1db7c9ad3c83baccd9fe817705dc]
# to [e301e620bb84624fd00ff614360eb5a335ece06c]
#
# patch "docs/PROBLEM-REPORT-FORM"
# from [36d67c043b3af7404f8ab151ea3190a633606d37]
# to [c6823071e348f5a87dbb049460a5de7c8fbc610a]
#
# patch "docs/polyorb_ug.texi"
# from [69d0a7e50d0317cb3493de265250b0ab446e006d]
# to [3227a74c4722a6e741e9261ec54de4ff8e5af5d8]
#
# patch "features-26"
# from [41735ecbb7684cf95cc43957d8ba60913db6ca58]
# to [01d0df8003a72ca407a101c40972ed54eaf1c6e9]
#
# patch "idls/CORBA_IDL/CORBA_InterfaceRepository.idl"
# from [844fb3725d892426da3cc46df707e314132fa80d]
# to [d317f5d29a64f7e46b189710a5667e3f9b17e815]
#
# patch "idls/CORBA_IDL/orb.idl"
# from [9779ae7f13e7a021799b4358f670384be4f42db9]
# to [a70c8814d5d2c7621b339d54d890716b7eb82eb3]
#
# patch "src/dsa/polyorb-dsa_p-remote_launch.adb"
# from [91ed42e2531507b7b873e86d8234984a034bc21d]
# to [a4151732d88bca2f44aad13265a7866291f906f9]
#
# patch "src/dsa/polyorb-dsa_p-storages-dsm.adb"
# from [62d9fbed82b564a391595bd35b7945998cb99c2d]
# to [83d1e0f2d3d4d7a2a4291fe9897034313f462ecd]
#
# patch "src/dsa/polyorb-termination_manager-bootstrap.adb"
# from [359c9bc7bb5d26415c2e12e9ec422973aaccdcbb]
# to [d2b8d3bd53e17d4b4f7056880ce34e732eef4baf]
#
# patch "src/dsa/polyorb-termination_manager.adb"
# from [3829a151ef4a7e13a919d0979b77865e9ff53389]
# to [ca764e951dd7d8767a401479b8349990d83d7d62]
#
# patch "src/dsa/s-dsaser.adb"
# from [93a9aa012448b6919cfdf3d6f0046987ef8b1587]
# to [77e6a0194a647208f1996bc702107bda6b7ca5da]
#
# patch "src/dsa/s-parint.adb"
# from [f1dca136fe29c6758609d43a79d8272bbcda8600]
# to [2f4ffffecd0a853e7909586eda68889a45e83df6]
#
# patch "src/dsa/s-parint.ads"
# from [38082057900b75eeab5889a4800447b79939cd88]
# to [393f28edf78106ab8c02b29cc8598c2e67f89e0a]
#
# patch "src/giop/polyorb-protocols-giop-giop_1_0.adb"
# from [39cf55d98a1c310398d4ed54bf5ad112f80ec386]
# to [f330b8b28b43af0d38da768762dc822bba8c40d4]
#
# patch "src/giop/polyorb-protocols-giop-giop_1_1.adb"
# from [3103cb94e7346ca18ebe976010a5ef8a2a311556]
# to [5bcf4053b576ef21cfc9920dba7dc5d84823be83]
#
# patch "src/polyorb-annotations.ads"
# from [e23a0a162dc98f1e2f64c4926cf6327d4eeca63f]
# to [d8d1c05b434ba1d87354811084ff0bee2343895f]
#
# patch "src/polyorb-any.ads"
# from [d24b4749d2047c99e5abefb824d3be6dc713d1f7]
# to [fbc8f29c3c25f6029b8f6b387b031e8c9fa255bf]
#
# patch "src/polyorb-asynch_ev.ads"
# from [1ad471e732e32ac1cbeb4e6d980a9882d80e1720]
# to [5c60d2785bc9de6cbfb7f62ed3e7c034dff1c5fd]
#
# patch "src/polyorb-buffers.adb"
# from [de3d04a9d894b30e2109ec2933be2114f0709c7b]
# to [9069bb2fae5f20669d27e70176e373dca84f17f2]
#
# patch "src/polyorb-buffers.ads"
# from [1b8ebc7a25c8705634e689afd1b7c259a13e643b]
# to [690b535469e9f57538cc1fa11f33b858335ad472]
#
# patch "src/polyorb-components.ads"
# from [9c26f54428fb45e8d2272be24bb02af3e5af90d7]
# to [0f581e4374aacccb9630aaeb324a32bcdb37b8c6]
#
# patch "src/polyorb-errors.ads"
# from [d376307c52373bfac80437ac2fcc1bd0267418a0]
# to [5157bbb54504b063d5077e04e2aae6ecc25a4190]
#
# patch "src/polyorb-objects.ads"
# from [b047d8cf65dee9a64d8f0a911195b39a2fa466a2]
# to [d7483c9b03ec24627c1e195a1c0e2dd02f12a6c4]
#
# patch "src/polyorb-opaque-chunk_pools.adb"
# from [70261eaec2aee40c52b3c7e7634dba38401d035a]
# to [5801b21a748fd62b08666fb3880c60e6b207b388]
#
# patch "src/polyorb-opaque-chunk_pools.ads"
# from [a4f3ca205b2d723e8fc53876da9e538ef2d81dbb]
# to [21c8667e8d8aea501b7531631a1cd146481fe02b]
#
# patch "src/polyorb-parameters-initialization.adb"
# from [5e6248abb002915a3f256a5d5f859e4696af990b]
# to [b74b42a29239df0a3580ea27c6d1c889b13be470]
#
# patch "src/polyorb-qos.ads"
# from [6b0db3ceb7db7334519366c47fe030e5729a19b4]
# to [cce3c27568427e8b00894662affb925a17fd3fd1]
#
# patch "src/polyorb-representations.ads"
# from [58368c431c8a9540fae56f3861a046f9862487e1]
# to [a563bd4b1ab37edcc595f95551af6ea24dd395c0]
#
# patch "src/polyorb-smart_pointers.ads"
# from [ea54c240d3278d0be12d2936d3582b0fb3a3a200]
# to [301647994e7d39a0aae377eb4a896e754ea35f71]
#
# patch "src/polyorb-task_info.ads"
# from [495f627cd43ac04822c4a2bf8164a6e53551aed7]
# to [779029b067a6c55f705e30ba77c1835f1a263e84]
#
# patch "src/polyorb-tasking-idle_tasks_managers.ads"
# from [db0cc938ccab4dda1c7526d113498ebd35179bb3]
# to [838b6b36e3a70b8512f9eb7e446acdd0c373d5fa]
#
# patch "src/polyorb-tasking-profiles-ravenscar-threads.adb"
# from [1b8022c7bc7bd8500259d59c35c038982451cdf7]
# to [e629de26aebce0655cd975ad60042425a8ca58ba]
#
# patch "src/polyorb-tasking-threads.adb"
# from [3518df551ba5c54b30ee742f179e41472408fa12]
# to [08e09593ef843df288931bb1a299259028384a3c]
#
# patch "src/polyorb-transport-handlers.adb"
# from [5b1ed7eac38dc4aae07631f65eb37200f92b2db3]
# to [eada3561def41452d58cd9835db3af8a0fa2a249]
#
# patch "src/polyorb-transport-handlers.ads"
# from [65b9539280bbb4abf94d528c3164f90d9ad62097]
# to [ff361ab1466d2233496fb06476efeef183659a6a]
#
# patch "src/polyorb-utils-chained_lists.ads"
# from [93d0b2a36e20196781d22547eccd5b2642eeb3c7]
# to [9072ddeb9bdc95c93a4412a9203e4d123045d4e3]
#
# patch "src/polyorb-utils-ilists.ads"
# from [1ab855572ebcd02f9d6097a99c82ac99bad1cbf8]
# to [f2aa664946013e4ffa4c0cc0873fe5a2c62135c2]
#
# patch "src/security/tls/polyorb-tls.adb"
# from [92fa266ba1e718c2557baa1aaae596059eae22e1]
# to [a0f34a45b1c25f3ee0edb5237c3b029202e9c0f4]
#
# patch "src/ssl/polyorb-ssl.adb"
# from [38b026431581707995f72ce8f72c730f30d19966]
# to [41318cf97b6e8c5eb75dd4c7de297099db9eeab7]
#
# patch "support/reconfig"
# from [99d32916b9d0f2fbdf12ab0f878bf846f1a654e6]
# to [80c864c93631a212fcc2c333f86d5aad7f9d85fe]
#
# patch "support/subversion.m4"
# from [75a1499dfb0bebb84f1527a094ad35d220eb6da8]
# to [826d5b1575370de13382b451b7232c0df8d23048]
#
# patch "testsuite/acats/CXE4005/cxe4005_normal.adb"
# from [6afacaf0e73899db3760053341aa88ee478d9e27]
# to [c4f00ae547cf4d08b4e8baf0cb5946aa272905d5]
#
# patch "testsuite/tests/test_utils.py"
# from [6a28a2a617967b24717bf1a8c48a6ee0aaa3bfb1]
# to [486ef966b0706d18c396fb5ca8367e93eb4fcc93]
#
# patch "testsuite/tests/testsuite.py"
# from [d925546ca1a56366fa7c64f20ac302b5b45ef45d]
# to [be89582285829955c8705925b6493679b338dbdb]
#
# patch "utils/prepare_distrib"
# from [4fc0a4a15b5563293a0683969232dfc018649e3b]
# to [54dbb86717fac86b7d663c0e991d883b4019531d]
#
============================================================
--- NEWS 6fc0fceeb50a100852553933104e5652218c6cba
+++ NEWS 413f4cca60647ed778506aecc2d0a52a4df8bf7d
@@ -35,6 +35,22 @@ Bug fixes
Bug fixes
---------
+The iac compiler was failing to properly detect an error in case a name that
+should refer to a type referred to something else. (148035)
+
+DSA partitions used to start processing remote calls before the local
+partition ID was set, potentially causing exception messages to not be
+tagged with the partition ID (if raised before that point). (145085)
+
+The Ada DSA starter would fail if the complete path of some slave partition
+contained white space. (144288)
+
+When building a DSA application, a global configuration pragma filed
+provided through a user project wasn't taken into account. (143979)
+
+Building a DSA application in a directory whose complete path include
+white space was not correctly handled. (143929)
+
* PolyORB 2.5 (branched on 2008-11-03)
======================================
============================================================
--- README e5b5c1a75b95fab01cecd7b56d550fecee1b4703
+++ README 773f00122f83c011800f6f469964e84c1eb92992
@@ -112,8 +112,10 @@
Unsupported users may directly send their patches and bug report via
e-mail at the address
+ polyorb-bugs@lists.adacore.com
- polyorb-bugs@lists.adacore.com
+or seek community support through the public mailing list:
+ polyorb-users@lists.adacore.com
Please use the Problem Report Form in docs/PROBLEM-REPORT-FORM.
Please include the complete output of "polyorb-config --version"
@@ -158,6 +160,7 @@
* Fabrice Kordon
* Narinder Kumar
* Laurent Kubler
+* Stéphane Lanarre
* Lionel Litty
* Vincent Niebel
* Pascal Obry
============================================================
--- compilers/gnatdist/xe_flags.ads 5d2516a7566b6a461e9e4b8ec52e8057ed123b6d
+++ compilers/gnatdist/xe_flags.ads 29d067af827ecd8dbc182f50868570b593eb4db1
@@ -54,6 +54,9 @@ package XE_Flags is
-- exception on Windows where the MinGW environment does not support
-- spawning arbitrary shell scripts).
+ Use_GPRBuild : Boolean := False;
+ -- Use GPRBuild instead of gnatmake
+
Display_Compilation_Progress : Boolean := False;
Readonly_Flag : constant String_Access := new String'("-a");
============================================================
--- compilers/gnatdist/xe_front.adb 339a27c1e2d76132d77b5698616bd41bbcf8ab60
+++ compilers/gnatdist/xe_front.adb c3c0c8609031c32accc157055782a4036e30bd5a
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -522,7 +522,9 @@ package body XE_Front is
Build_New_Variable (Variable_Id (Node));
elsif Is_Configuration (Node) then
+ pragma Assert (Configuration = No_Name);
Configuration := Get_Node_Name (Node);
+ Set_Application_Names (Configuration);
elsif Is_Type (Node) then
Set_Type_Attribute (Type_Id (Node));
============================================================
--- compilers/gnatdist/xe_list.adb 841330bc0c7fb68fda1c2da7c4d9dbaf4fa29f73
+++ compilers/gnatdist/xe_list.adb 1da5089734ba65be61bd10ab67e59e033f13051d
@@ -40,6 +40,8 @@ package body XE_List is
package body XE_List is
+ Monolithic_Src_File : File_Descriptor;
+
-----------------------
-- Source File Stack --
-----------------------
============================================================
--- compilers/gnatdist/xe_main.adb 6e4a4ef4eb560b3825f7ec1e5421604e4e424ae1
+++ compilers/gnatdist/xe_main.adb 229f95a8de1c44876c2b18dec014ab9df268d1f4
@@ -25,7 +25,8 @@
-- --
------------------------------------------------------------------------------
-with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Exceptions; use Ada.Exceptions;
with XE; use XE;
with XE_Back; use XE_Back;
@@ -110,11 +111,14 @@ begin
Parse;
Frontend;
- -- Configuration name and configuration file name do not match
+ -- Configuration name and configuration file name do not match (case
+ -- insensitively, to mimic the way project files work)
Get_Name_String (Strip_Directory (Configuration_File_Name));
Name_Len := Name_Len - Cfg_Suffix'Length;
- if Configuration /= Name_Find then
+ if To_Lower (Get_Name_String (Configuration)) /=
+ To_Lower (Get_Name_String (Name_Find))
+ then
raise Fatal_Error
with "configuration file name should be "
& NS (Quote (Configuration & Cfg_Suffix_Id));
============================================================
--- compilers/gnatdist/xe_names.adb ee462be4bb204bfdc0113c305e9341df068455ba
+++ compilers/gnatdist/xe_names.adb 9f626338774a30892861b159ad1d19242dcf922b
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -521,7 +521,7 @@ package body XE_Names is
procedure wn (Id : Name_Id) is
begin
- Write_Name (Id);
+ Write_Str (Get_Name_String (Id));
Write_Eol;
end wn;
============================================================
--- compilers/gnatdist/xe_sem.ads 9a154ed633bcaaf01cf7f9d466cceae3e75b23c7
+++ compilers/gnatdist/xe_sem.ads 52ca18b46bc7dc83d58996d4a68f6585b440fc36
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -29,7 +29,5 @@ package XE_Sem is
-- configuration.
package XE_Sem is
-
procedure Analyze;
-
end XE_Sem;
============================================================
--- compilers/gnatdist/xe_units.ads b67ccadd6b7a052c12db0eadc0f913fb16679974
+++ compilers/gnatdist/xe_units.ads 6bbf5b503f94cc770be2272459be1751e18e545e
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -519,8 +519,8 @@ package XE_Units is
---------------------------
-- Configured units are different from units. Such units come from the
- -- configuration language and mau not correspond to Ada units in case
- -- of an illegal configuration file.
+ -- configuration language and might not correspond to Ada units in case of
+ -- an illegal configuration file.
type Conf_Unit_Type is record
============================================================
--- compilers/gnatdist/xe_utils.adb eb71f5970e1ed38bd2fcd9d6806cf696ce77ddf0
+++ compilers/gnatdist/xe_utils.adb bfda99f6848352d2f29043f452fefc0dfbae91b0
@@ -64,6 +64,7 @@ package body XE_Utils is
pragma Import (C, Dup2);
GNAT_Driver : String_Access;
+ GPRBuild : String_Access;
List_Command : constant String_Access := new String'("list");
Build_Command : constant String_Access := new String'("make");
@@ -213,12 +214,20 @@ package body XE_Utils is
Has_Prj : Boolean := False;
Index : Natural;
+ Builder : String_Access;
begin
- -- gnat make
+ if Use_GPRBuild then
+ Builder := GPRBuild;
- N_Flags := N_Flags + 1;
- Flags (N_Flags) := Build_Command;
+ else
+ Builder := GNAT_Driver;
+ -- gnat make
+
+ N_Flags := N_Flags + 1;
+ Flags (N_Flags) := Build_Command;
+ end if;
+
if Quiet_Mode then
-- Pass -q to gnatmake
@@ -279,7 +288,7 @@ package body XE_Utils is
-- Call gnat make
- Execute (GNAT_Driver, Flags (1 .. N_Flags), Success);
+ Execute (Builder, Flags (1 .. N_Flags), Success);
-- Free library file name argument
@@ -561,25 +570,9 @@ package body XE_Utils is
I_Current_Dir := new String'("-I.");
E_Current_Dir := new String'("-I-");
- Monolithic_App_Unit_Name := Id ("Monolithic_App");
-
- Get_Name_String (Monolithic_App_Unit_Name);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Add_Str_To_Name_Buffer (ADB_Suffix);
-
- Monolithic_Src_Base_Name := Name_Find;
- Monolithic_Src_Name := Dir (Id (Root), Monolithic_Src_Base_Name);
- Monolithic_ALI_Name := To_Afile (Monolithic_Src_Name);
- Monolithic_Obj_Name := To_Ofile (Monolithic_Src_Name);
-
- Monolithic_Obj_Dir := Dir (Id (Root), Id ("obj"));
-
PCS_Project := Id ("pcs_project");
Set_Corresponding_Project_File_Name (PCS_Project_File);
- Dist_App_Project := Id ("dist_app_project");
- Set_Corresponding_Project_File_Name (Dist_App_Project_File);
-
Part_Main_Src_Name := Id ("partition" & ADB_Suffix);
Part_Main_ALI_Name := To_Afile (Part_Main_Src_Name);
Part_Main_Obj_Name := To_Ofile (Part_Main_Src_Name);
@@ -618,10 +611,14 @@ package body XE_Utils is
Create_Dir (Stub_Dir_Name);
Create_Dir (Part_Dir_Name);
- Create_Dir (Monolithic_Obj_Dir);
GNAT_Driver := Locate ("gnat");
+ -- Note: we initialize variable GPRBuild in Scan_Dist_Arg rather than
+ -- unconditionally in Initialize so that the absence of gprbuild does
+ -- not cause initialization to fail in the normal case where -dB is not
+ -- used.
+
Check_User_Provided_S_RPC (".");
end Initialize;
@@ -665,7 +662,7 @@ package body XE_Utils is
Get_Name_String (Sources (J));
Flags (N_Flags) := new String'(Name_Buffer (1 .. Name_Len));
- Predef := Predef or Is_Predefined_File (Sources (J));
+ Predef := Predef or else Is_Predefined_File (Sources (J));
end loop;
if Predef then
@@ -982,6 +979,14 @@ package body XE_Utils is
when 'P' =>
Use_PolyORB_Project := True;
+ -- -dB: Use gprbuild (implies -dP)
+ -- (for experimentation, not expected to work yet???)
+
+ when 'B' =>
+ GPRBuild := Locate ("gprbuild");
+ Use_GPRBuild := True;
+ Use_PolyORB_Project := True;
+
when others =>
-- Other debugging flags are passed to the builder untouched
@@ -1130,6 +1135,36 @@ package body XE_Utils is
return Name_Find;
end To_Lower;
+ ---------------------------
+ -- Set_Application_Names --
+ ---------------------------
+
+ procedure Set_Application_Names (Configuration_Name : Name_Id) is
+ begin
+ Get_Name_String (Configuration_Name);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Add_Str_To_Name_Buffer ("_monolithic_app");
+
+ Monolithic_App_Unit_Name := Name_Find;
+
+ Add_Str_To_Name_Buffer (ADB_Suffix);
+ Monolithic_Src_Base_Name := Name_Find;
+
+ Monolithic_Src_Name := Dir (Id (Root), Monolithic_Src_Base_Name);
+ Monolithic_ALI_Name := To_Afile (Monolithic_Src_Name);
+ Monolithic_Obj_Name := To_Ofile (Monolithic_Src_Name);
+ Monolithic_Obj_Dir := Dir (Id (Root), Id ("obj"));
+
+ Create_Dir (Monolithic_Obj_Dir);
+
+ Get_Name_String (Configuration_Name);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Add_Str_To_Name_Buffer ("_dist_app");
+ Dist_App_Project := Name_Find;
+
+ Set_Corresponding_Project_File_Name (Dist_App_Project_File);
+ end Set_Application_Names;
+
------------------------
-- Write_Missing_File --
------------------------
============================================================
--- compilers/gnatdist/xe_utils.ads d7c7889181a94f3184855858974cfa8a269b83d0
+++ compilers/gnatdist/xe_utils.ads ea91ed265eb347102760c264d23d1d7dde95bfb0
@@ -60,27 +60,26 @@ package XE_Utils is
E_Current_Dir : String_Access;
I_Current_Dir : String_Access;
+ -- Monolithic application main subprogram (set by Set_Application_Names)
+
Monolithic_App_Unit_Name : File_Name_Type;
Monolithic_Src_Base_Name : File_Name_Type;
- Monolithic_Src_File : File_Descriptor;
- -- Monolithic application main
+ Monolithic_Src_Name : File_Name_Type;
+ Monolithic_ALI_Name : File_Name_Type;
+ Monolithic_Obj_Name : File_Name_Type;
- Monolithic_Src_Name : File_Name_Type;
- Monolithic_ALI_Name : File_Name_Type;
- Monolithic_Obj_Name : File_Name_Type;
- -- Monolithic application main
-
Monolithic_Obj_Dir : File_Name_Type;
-- Object dir for the monolithic application
- PCS_Project : Name_Id;
- PCS_Project_File : File_Name_Type;
- -- Project file for the PCS
+ -- Project file for the complete application (set by Set_Application_Names)
Dist_App_Project : Name_Id;
Dist_App_Project_File : File_Name_Type;
- -- Project file for the complete distributed application
+ PCS_Project : Name_Id;
+ PCS_Project_File : File_Name_Type;
+ -- Project file for the PCS
+
Part_Main_Src_Name : File_Name_Type;
Part_Main_ALI_Name : File_Name_Type;
Part_Main_Obj_Name : File_Name_Type;
@@ -95,7 +94,7 @@ package XE_Utils is
No_Args : constant Argument_List (1 .. 0) := (others => null);
procedure Initialize;
- -- Initialize global variables, global flags, ...
+ -- Perform global initialization of this unit
------------------------------
-- String and Name Handling --
@@ -127,22 +126,22 @@ package XE_Utils is
procedure Set_Corresponding_Project_File_Name (N : out File_Name_Type);
-- Assuming the Name_Buffer contains a project name, set N to the name of
- -- the corrsponding project file. (Assumes that the project name is already
- -- all lowercase).
+ -- the corrsponding project file. Assumes that the project name is already
+ -- all lowercase.
------------------------------------
-- Command Line Argument Handling --
------------------------------------
procedure Scan_Dist_Arg (Argv : String; Implicit : Boolean := True);
- -- Process one command line argument
+ -- Process one command line argument.
-- Implicit is set True for additional flags generated internally by
-- gnatdist.
procedure Scan_Dist_Args (Args : String);
- -- Split Args into a list of arguments according to usual shell
- -- splitting semantics, and process each argument using Scan_Dist_Arg
- -- (such arguments are always implicit).
+ -- Split Args into a list of arguments according to usual shell splitting
+ -- semantics, and process each argument using Scan_Dist_Arg as implicit
+ -- arguments.
function More_Source_Files return Boolean;
function Next_Main_Source return Name_Id;
@@ -151,6 +150,11 @@ package XE_Utils is
procedure Show_Dist_Args;
-- Output processed command line switches (for debugging purposes)
+ procedure Set_Application_Names (Configuration_Name : Name_Id);
+ -- Set the name of the monolithic application main subprogram and of the
+ -- distributed application project based on the configuration name.
+ -- Called once the configuration has been parsed.
+
--------------------
-- Error Handling --
--------------------
@@ -174,7 +178,7 @@ package XE_Utils is
E_Fatal); -- Fatal (serious) error
procedure Exit_Program (Code : Exit_Code_Type);
- -- Call exit() with return code
+ -- Clean up temporary files and exit with appropriate return code
procedure Write_Missing_File (Fname : File_Name_Type);
-- Output an informational message to indicate that Fname is missing
============================================================
--- compilers/iac/analyzer.adb e97b05917791db627bb2eeb7d7fb0d49cf0e6ef3
+++ compilers/iac/analyzer.adb 58361e185dd7826853a10c9b368345d86e082bb1
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -86,6 +86,9 @@ package body Analyzer is
-- resolve the expression of E, and then convert it to type T. Set the
-- Value field of E to the converted value.
+ procedure Analyze_Type_Spec (E : Node_Id);
+ -- Analyze E, and give an error if it's not a type spec
+
-- These procedures factorize the analyzing type prefix and type ID code
procedure Assign_Type_Id
@@ -345,7 +348,7 @@ package body Analyzer is
Attr_Exception : Node_Id;
begin
- Analyze (Decl_Type);
+ Analyze_Type_Spec (Decl_Type);
if not Is_A_Local_Type (Iface) then
No_Interface_Attribute_Of_Local_Type (Decl_Type, Iface);
end if;
@@ -412,7 +415,7 @@ package body Analyzer is
return;
end if;
- Analyze (T);
+ Analyze_Type_Spec (T);
-- Resolve base type of T. Types of constant declarations are
-- limited to integer types, character types, string types,
@@ -452,7 +455,7 @@ package body Analyzer is
procedure Analyze_Element (E : Node_Id) is
begin
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
Analyze (Declarator (E));
end Analyze_Element;
@@ -667,7 +670,7 @@ package body Analyzer is
D : Node_Id := First_Entity (Declarators (E));
begin
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
while Present (D) loop
Analyze (D);
D := Next_Entity (D);
@@ -810,7 +813,7 @@ package body Analyzer is
if Kind (E) /= K_Initializer_Declaration then
Return_Type_Id := Type_Spec (E);
- Analyze (Return_Type_Id);
+ Analyze_Type_Spec (Return_Type_Id);
Return_Type := Return_Type_Id;
if Kind (Return_Type) = K_Scoped_Name then
@@ -905,7 +908,7 @@ package body Analyzer is
procedure Analyze_Parameter_Declaration (E : Node_Id) is
begin
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
Analyze (Declarator (E));
end Analyze_Parameter_Declaration;
@@ -1007,7 +1010,7 @@ package body Analyzer is
-- entity, then enter the name in the scope.
if Depth (E) = 0
- and then Is_A_Type (C)
+ and then Is_Noninterface_Type (C)
and then Is_A_Non_Module (Current_Scope)
then
Enter_Name_In_Scope (N);
@@ -1031,7 +1034,7 @@ package body Analyzer is
Unsigned_Long_Long_Node : constant Node_Id
:= Parser.Resolve_Base_Type ((T_Unsigned, T_Long, T_Long), Loc (E));
begin
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
Analyze_And_Resolve_Expr (Max_Size (E), Unsigned_Long_Long_Node);
end Analyze_Sequence_Type;
@@ -1094,7 +1097,7 @@ package body Analyzer is
is
D : Node_Id := First_Entity (Declarators (E));
begin
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
while Present (D) loop
Analyze (D);
D := Next_Entity (D);
@@ -1125,7 +1128,7 @@ package body Analyzer is
-- Analyze_Type_Prefix_Declaration --
-------------------------------------
- procedure Analyze_Type_Prefix_Declaration (E : Node_Id)is
+ procedure Analyze_Type_Prefix_Declaration (E : Node_Id) is
R : Node_Id;
N : Node_Id;
begin
@@ -1141,6 +1144,25 @@ package body Analyzer is
Assign_Type_Prefix (R, N);
end Analyze_Type_Prefix_Declaration;
+ -----------------------
+ -- Analyze_Type_Spec --
+ -----------------------
+
+ procedure Analyze_Type_Spec (E : Node_Id) is
+ begin
+ Analyze (E);
+
+ -- If it's a scoped name, make sure it denotes a type. Otherwise, it is
+ -- syntactically a type, so nothing to check.
+
+ if Kind (E) = K_Scoped_Name then
+ if not Is_Type (Reference (E)) then
+ Error_Loc (1) := Loc (E);
+ DE ("type expected");
+ end if;
+ end if;
+ end Analyze_Type_Spec;
+
------------------------
-- Analyze_Union_Type --
------------------------
@@ -1154,7 +1176,7 @@ package body Analyzer is
Enter_Name_In_Scope (Identifier (E));
Push_Scope (E);
- Analyze (Switch_Type);
+ Analyze_Type_Spec (Switch_Type);
-- Check that switch type is a discrete type
@@ -1260,7 +1282,7 @@ package body Analyzer is
procedure Analyze_Value_Box_Declaration (E : Node_Id) is
begin
Enter_Name_In_Scope (Identifier (E));
- Analyze (Type_Spec (E));
+ Analyze_Type_Spec (Type_Spec (E));
end Analyze_Value_Box_Declaration;
-------------------------------
============================================================
--- compilers/iac/backend-be_corba_ada-cdrs.adb b62279111337f36fab3a49914a33c5de220a9f6b
+++ compilers/iac/backend-be_corba_ada-cdrs.adb 77c95113623b12bc649ad2ef967f167830047609
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -580,8 +580,10 @@ package body Backend.BE_CORBA_Ada.CDRs i
Make_Defining_Identifier (PN (P_Buffer)),
Make_Defining_Identifier (PN (P_Data_Alignment))));
- if (Present (T) and FEN.Kind (T) /= K_Void)
- or else Contains_Out_Parameters (E) then
+ if (Present (T) and then FEN.Kind (T) /= K_Void)
+ or else
+ Contains_Out_Parameters (E)
+ then
Append_To (Server_Statements, M);
end if;
============================================================
--- compilers/iac/frontend-debug.adb ec7fa8b9fdfe9f82f16fa90305838efa8d630fae
+++ compilers/iac/frontend-debug.adb 1c004d6d9c3c12c3973ec1751e762e71b2fa1401
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -195,15 +195,24 @@ package body Frontend.Debug is
if K = "Name_Id" then
Write_Line (Quoted (V));
+ -- If the attribute name is BE_Node, we don't want to call Kind (the
+ -- front-end one) on it, because it's (conceptually) the wrong type!
+
elsif K = "Node_Id"
and then Present (C)
+ and then A /= "BE_Node"
then
- case Kind (C) is
- when K_Float .. K_Value_Base =>
- Write_Line ('(' & Image (Kind (Node_Id (N))) & ')');
- when others =>
- Write_Line (V);
- end case;
+ if C > Frontend.Nodes.Entries.Last then
+ Write_Str ("*** invalid Node_Id: ");
+ Write_Line (V);
+ else
+ case Kind (C) is
+ when K_Float .. K_Value_Base =>
+ Write_Line ('(' & Image (Kind (Node_Id (N))) & ')');
+ when others =>
+ Write_Line (V);
+ end case;
+ end if;
else
Write_Line (V);
============================================================
--- compilers/iac/frontend-nutils.adb 1f5b5878bd69620497cecb857e7b50e4fc7a864f
+++ compilers/iac/frontend-nutils.adb e112f2065ad7bd00281a28b0b3f971aa6c9f6b80
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -255,12 +255,36 @@ package body Frontend.Nutils is
end Is_A_Scope;
---------------
- -- Is_A_Type --
+ -- Is_Type --
---------------
- function Is_A_Type (E : Node_Id) return Boolean is
+ function Is_Type (E : Node_Id) return Boolean is
begin
+ if Is_Noninterface_Type (E) then
+ return True;
+ end if;
+
case Kind (E) is
+ when K_Forward_Interface_Declaration
+ | K_Interface_Declaration =>
+ return True;
+
+ when K_Simple_Declarator
+ | K_Complex_Declarator =>
+ return Is_Type (Declaration (E));
+
+ when others =>
+ return False;
+ end case;
+ end Is_Type;
+
+ --------------------------
+ -- Is_Noninterface_Type --
+ --------------------------
+
+ function Is_Noninterface_Type (E : Node_Id) return Boolean is
+ begin
+ case Kind (E) is
when K_Type_Declaration
| K_Forward_Structure_Type
| K_Structure_Type
@@ -293,7 +317,7 @@ package body Frontend.Nutils is
when others =>
return False;
end case;
- end Is_A_Type;
+ end Is_Noninterface_Type;
-------------------------------
-- Is_Attribute_Or_Operation --
============================================================
--- compilers/iac/frontend-nutils.ads e1c5692ca3794607c6e495765002e85fa4a1b5bc
+++ compilers/iac/frontend-nutils.ads c32b56035ea21b9a161db05b69effe1c656451af
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -66,7 +66,8 @@ package Frontend.Nutils is
function Is_A_Forward_Of (X, Y : Node_Id) return Boolean;
function Is_A_Scope (E : Node_Id) return Boolean;
- function Is_A_Type (E : Node_Id) return Boolean;
+ function Is_Type (E : Node_Id) return Boolean;
+ function Is_Noninterface_Type (E : Node_Id) return Boolean;
function Is_Attribute_Or_Operation (E : Node_Id) return Boolean;
function Is_Interface_Redefinable_Node (E : Node_Id) return Boolean;
function Is_A_Non_Module (E : Node_Id) return Boolean;
============================================================
--- compilers/iac/scopes.adb 53180bbe8c7fca7b7af258623529a58fe2fc7e3c
+++ compilers/iac/scopes.adb 5956136acfb318ce2916f4e4bcdd1d3de706165b
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -385,7 +385,7 @@ package body Scopes is
declare
Export : constant Boolean :=
- Is_A_Type (S) and then Is_A_Non_Module (Current_Scope);
+ Is_Noninterface_Type (S) and then Is_A_Non_Module (Current_Scope);
begin
C := Scoped_Identifiers (S);
while Present (C) loop
============================================================
--- configure.ac db7c56dfe04a1db7c9ad3c83baccd9fe817705dc
+++ configure.ac e301e620bb84624fd00ff614360eb5a335ece06c
@@ -1,6 +1,6 @@
-# $Id: configure.ac 144247 2009-05-19 10:14:02Z quinot $
+# $Id: configure.ac 145301 2009-06-08 09:56:49Z quinot $
-define(POLYORB_RELEASE, ifelse(OVERRIDE_RELEASE,,[2.6.0w],OVERRIDE_RELEASE))
+define(POLYORB_RELEASE, ifdef([OVERRIDE_RELEASE],OVERRIDE_RELEASE,[2.6.0w]))
AC_PREREQ(2.57)
AC_INIT(PolyORB, pkg_version(POLYORB_RELEASE), polyorb-bugs@lists.adacore.com)
@@ -11,6 +11,7 @@ AC_SUBST(POLYORB_VERSION)
AM_SUBVERSION
POLYORB_VERSION="$PACKAGE_VERSION (rev. $SVNREVISION)"
AC_SUBST(POLYORB_VERSION)
+AC_MSG_NOTICE([Configuring PolyORB $POLYORB_VERSION])
##########################################
# Initialization.
============================================================
--- docs/PROBLEM-REPORT-FORM 36d67c043b3af7404f8ab151ea3190a633606d37
+++ docs/PROBLEM-REPORT-FORM c6823071e348f5a87dbb049460a5de7c8fbc610a
@@ -1,5 +1,5 @@ Please use the form below to submit any
Please use the form below to submit any bug or problem report on the public
-or academic versions of PolyORB to the developers and the user community.
+or GPL versions of PolyORB to the developers and the user community.
Complete the form and send it to polyorb-users@lists.adacore.com or
polyorb-bugs@lists.adacore.com.
============================================================
--- docs/polyorb_ug.texi 69d0a7e50d0317cb3493de265250b0ab446e006d
+++ docs/polyorb_ug.texi 3227a74c4722a6e741e9261ec54de4ff8e5af5d8
@@ -55,7 +55,7 @@
@c
@c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-@c $Id: polyorb_ug.texi 135863 2009-01-20 15:58:45Z hugues $
+@c $Id: polyorb_ug.texi 147741 2009-07-28 13:10:05Z quinot $
@include svn.texi
@@ -89,7 +89,7 @@
@title PolyORB User's Guide
@include polyorb_version.texi
@subtitle Version @value{POLYORB_VERSION}
-@svndate $Date: 2009-01-20 16:58:45 +0100 (Tue, 20 Jan 2009) $
+@svndate $Date: 2009-07-28 15:10:05 +0200 (Tue, 28 Jul 2009) $
@subtitle @value{SVNDate}
@author @value{AUTHORS1}
@author @value{AUTHORS2}
@@ -117,7 +117,7 @@ @top PolyORB User's Guide
@include polyorb_version.texi
Version @value{POLYORB_VERSION}
-$Date: 2009-01-20 16:58:45 +0100 (Tue, 20 Jan 2009) $
+$Date: 2009-07-28 15:10:05 +0200 (Tue, 28 Jul 2009) $
@value{AUTHORS1}
@value{AUTHORS2}
@@ -700,10 +700,12 @@ @section Build requirements
@c -------------------------------------------------------------------
@noindent
+GNU tar is required to unpack PolyORB source packages.
+
Ada compiler:
@itemize @bullet
@item GNAT Pro 6.0 or later
-@item GNAT GPL 2007 or later
+@item GNAT GPL 2007 or later
@item FSF GCC 4.3 or later
@end itemize
@@ -945,6 +947,8 @@ @section Platform notes
PolyORB must be compiled with the -mminimal-toc compiler switch. This is
taken care of automatically by the PolyORB configure script.
+The 'ulimit' command may be needed as for Tru64 (see above).
+
@noindent
HP-UX 11.00:
============================================================
--- features-26 41735ecbb7684cf95cc43957d8ba60913db6ca58
+++ features-26 01d0df8003a72ca407a101c40972ed54eaf1c6e9
@@ -31,5 +31,5 @@ NF-26-H731-006 Improved handling of unbo
When using the Ada DSA applicative personality, remote calls involving
arguments of type Ada.Strings.Unbounded.Unbounded_String now use the
native PolyORB string type, providing better performance. Note that the
- PCS API has been updated, and this requries a corresponding compiler
+ PCS API has been updated, and this requires a corresponding compiler
update.
============================================================
--- idls/CORBA_IDL/CORBA_InterfaceRepository.idl 844fb3725d892426da3cc46df707e314132fa80d
+++ idls/CORBA_IDL/CORBA_InterfaceRepository.idl d317f5d29a64f7e46b189710a5667e3f9b17e815
@@ -4,7 +4,7 @@
#ifdef _PRE_3_0_COMPILER_
#pragma prefix "omg.org"
#else
-typeprefix CORBA "omg.org";
+typeprefix CORBA "omg.org"; // ";" suppresses iac warning about missing ";".
#endif
typedef string ScopedName;
============================================================
--- idls/CORBA_IDL/orb.idl 9779ae7f13e7a021799b4358f670384be4f42db9
+++ idls/CORBA_IDL/orb.idl a70c8814d5d2c7621b339d54d890716b7eb82eb3
@@ -40,7 +40,7 @@ module CORBA {
#ifdef _PRE_3_0_COMPILER_
#pragma prefix "omg.org"
#else
-typeprefix CORBA "omg.org";
+typeprefix CORBA "omg.org"; // ";" suppresses iac warning about missing ";".
#endif
//PolyORB:WAidlac:end
============================================================
--- src/dsa/polyorb-dsa_p-remote_launch.adb 91ed42e2531507b7b873e86d8234984a034bc21d
+++ src/dsa/polyorb-dsa_p-remote_launch.adb a4151732d88bca2f44aad13265a7866291f906f9
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -61,6 +61,10 @@ package body PolyORB.DSA_P.Remote_Launch
-- This should be made more portable.
-- This is a no-op on non-Windows systems.
+ function Escape_Spaces (S : String) return String;
+ -- Protect shell metacharacters in S with an \
+ -- ??? Assumes a UNIX shell
+
procedure Initialize;
-- Retrieve rsh command and options from configuration
@@ -69,6 +73,30 @@ package body PolyORB.DSA_P.Remote_Launch
Rsh_Options : String_Access;
Rsh_Args : String_List_Access;
+ -------------------
+ -- Escape_Spaces --
+ -------------------
+
+ function Escape_Spaces (S : String) return String is
+ R : String (1 .. 2 * S'Length);
+ Last : Natural := 0;
+ begin
+ for J in S'Range loop
+ case S (J) is
+ when ' ' | ASCII.HT |
+ ''' | '"' | '*' | '?' | '|' |
+ '[' | ']' | '(' | ')' | '{' | '}' | '<' | '>' =>
+ Last := Last + 1;
+ R (Last) := '\';
+ when others =>
+ null;
+ end case;
+ Last := Last + 1;
+ R (Last) := S (J);
+ end loop;
+ return R (1 .. Last);
+ end Escape_Spaces;
+
----------------
-- Initialize --
----------------
@@ -128,7 +156,7 @@ package body PolyORB.DSA_P.Remote_Launch
procedure Launch_Partition
(Host : String; Command : String; Env_Vars : String)
is
- U_Command : constant String := Windows_To_Unix (Command);
+ U_Command : constant String := Escape_Spaces (Windows_To_Unix (Command));
Pid : Process_Id;
pragma Unreferenced (Pid);
============================================================
--- src/dsa/polyorb-dsa_p-storages-dsm.adb 62d9fbed82b564a391595bd35b7945998cb99c2d
+++ src/dsa/polyorb-dsa_p-storages-dsm.adb 83d1e0f2d3d4d7a2a4291fe9897034313f462ecd
@@ -2,11 +2,11 @@
-- --
-- POLYORB COMPONENTS --
-- --
--- P O L Y O R B . D S A _ P . S T O R A G E S . D S M --
+-- P O L Y O R B . D S A _ P . S T O R A G E S . D S M --
-- --
-- B o d y --
-- --
--- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -290,7 +290,7 @@ package body PolyORB.DSA_P.Storages.DSM
-- and if variable version isn't obsolete.
Enter (Self.Synchs.Critical_Section);
- if Self.Status = Read and Version >= Self.Version then
+ if Self.Status = Read and then Version >= Self.Version then
pragma Debug (C, O ("Invalidation request received"));
-- Send invalidation request to nodes in the copy set
============================================================
--- src/dsa/polyorb-termination_manager-bootstrap.adb 359c9bc7bb5d26415c2e12e9ec422973aaccdcbb
+++ src/dsa/polyorb-termination_manager-bootstrap.adb d2b8d3bd53e17d4b4f7056880ce34e732eef4baf
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -29,7 +29,6 @@ with PolyORB.Binding_Data;
with PolyORB.Annotations;
with PolyORB.Binding_Data.Neighbour;
with PolyORB.Binding_Data;
-with PolyORB.Components;
with PolyORB.DSA_P.Exceptions;
with PolyORB.Errors;
with PolyORB.Log;
@@ -40,7 +39,6 @@ with PolyORB.QoS.Term_Manager_Info;
with PolyORB.POA_Config.RACWs;
with PolyORB.POA_Manager;
with PolyORB.QoS.Term_Manager_Info;
-with PolyORB.References.Binding;
with PolyORB.Setup;
with PolyORB.Smart_Pointers;
with PolyORB.Tasking.Threads;
@@ -201,12 +199,9 @@ package body PolyORB.Termination_Manager
use PolyORB.Errors;
use PolyORB.Objects;
use PolyORB.Parameters;
- use PolyORB.References.Binding;
TM : constant Term_Manager_Ptr := new Term_Manager;
- S : Components.Component_Access;
- Pro : Binding_Data.Profile_Access;
- Error : Error_Container;
+ S : System.Partition_Interface.Servant_Access;
-- Retrieve the termination configuration parameters
@@ -275,19 +270,13 @@ package body PolyORB.Termination_Manager
-- We need the servant of TM so we can initiate a well known service
-- pointing to it. We bind the reference and get the servant of TM.
+ -- Note, we can't bind The_TM_Ref to obtain the servant because the
+ -- corresponding POA has not been activated yet, and so we would get
+ -- the Hold_Servant instead.
- Bind (R => The_TM_Ref,
- Local_ORB => The_ORB,
- Servant => S,
- QoS => (others => null),
- Pro => Pro,
- Local_Only => True,
- Error => Error);
+ S := Find_Receiving_Stub (RACW_Type_Name, Obj_Stub);
+ pragma Assert (S /= null);
- if Found (Error) then
- PolyORB.DSA_P.Exceptions.Raise_From_Error (Error);
- end if;
-
-- Start the Well Known Service
pragma Debug (C, O ("Initiating Well Known Service"));
@@ -388,9 +377,9 @@ package body PolyORB.Termination_Manager
Result : References.Ref;
begin
- -- We retrieve the receiver stub of Term_Manager racw for this partition
+ -- We retrieve the receiver stub of Term_Manager RACW for this partition
- Receiver := Retrieve_Receiving_Stub (RACW_Type_Name, Obj_Stub);
+ Receiver := Find_Receiving_Stub (RACW_Type_Name, Obj_Stub);
pragma Assert (Receiver /= null);
-- Then use it to get a reference to TM
============================================================
--- src/dsa/polyorb-termination_manager.adb 3829a151ef4a7e13a919d0979b77865e9ff53389
+++ src/dsa/polyorb-termination_manager.adb ca764e951dd7d8767a401479b8349990d83d7d62
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -38,7 +38,6 @@ with PolyORB.Termination_Manager.Bootstr
with PolyORB.Tasking.Mutexes;
with PolyORB.Termination_Activity;
with PolyORB.Termination_Manager.Bootstrap;
-with System.Partition_Interface;
with System.RPC;
package body PolyORB.Termination_Manager is
@@ -52,7 +51,6 @@ package body PolyORB.Termination_Manager
use PolyORB.Tasking.Mutexes;
use PolyORB.Termination_Activity;
use PolyORB.Termination_Manager.Bootstrap;
- use System.Partition_Interface;
procedure Termination_Loop;
-- Main loop of the task created by the termination manager
============================================================
--- src/dsa/s-dsaser.adb 93a9aa012448b6919cfdf3d6f0046987ef8b1587
+++ src/dsa/s-dsaser.adb 77e6a0194a647208f1996bc702107bda6b7ca5da
@@ -67,5 +67,10 @@ begin
(RPC.Partition_ID (Allocate_Partition_ID (Get_Local_Partition_Name)));
end if;
+ -- DSA services are now fully initialized, and incoming remote subprogram
+ -- calls can be processed: activate all pending RPC receivers.
+
+ System.Partition_Interface.Activate_RPC_Receivers;
+
pragma Debug (C, O ("DSA_Services Initialized"));
end System.DSA_Services;
============================================================
--- src/dsa/s-parint.adb f1dca136fe29c6758609d43a79d8272bbcda8600
+++ src/dsa/s-parint.adb 2f4ffffecd0a853e7909586eda68889a45e83df6
@@ -66,6 +66,7 @@ with PolyORB.Termination_Activity;
with PolyORB.Tasking.Mutexes;
with PolyORB.Tasking.Threads;
with PolyORB.Termination_Activity;
+with PolyORB.Utils.Ilists;
with PolyORB.Utils.Strings.Lists;
package body System.Partition_Interface is
@@ -245,8 +246,69 @@ package body System.Partition_Interface
Naming_Context_Cache : PSNNC.Ref;
- -- End of local declarations
+ ------------------------------------------
+ -- List of all RPC receivers (servants) --
+ ------------------------------------------
+ function Link
+ (S : access Private_Info;
+ Which : PolyORB.Utils.Ilists.Link_Type)
+ return access Private_Info_Access;
+
+ package Receiving_Stub_Lists is new PolyORB.Utils.Ilists.Lists
+ (Private_Info, Private_Info_Access, Doubly_Linked => False);
+
+ All_Receiving_Stubs : Receiving_Stub_Lists.List;
+
+ RPC_Receivers_Activated : Boolean := False;
+ -- False until Activate_RPC_Receivers has been called, at which point
+ -- incoming RPCs can be serviced.
+
+ procedure Activate_RPC_Receiver (Default_Servant : Servant_Access);
+ -- Activate one RPC receiver (i.e. enable the processing of incoming remote
+ -- subprogram calls to that servant).
+
+ ---------------------------
+ -- Activate_RPC_Receiver --
+ ---------------------------
+
+ procedure Activate_RPC_Receiver (Default_Servant : Servant_Access) is
+ use PolyORB.Errors;
+ use PolyORB.POA;
+ use PolyORB.POA_Manager;
+
+ POA : constant Obj_Adapter_Access :=
+ Obj_Adapter_Access (Default_Servant.Object_Adapter);
+ Error : Error_Container;
+ begin
+ pragma Debug (C, O ("Activate_RPC_Receiver: "
+ & Default_Servant.Impl_Info.Name.all));
+
+ Activate (POAManager_Access (Entity_Of (POA.POA_Manager)), Error);
+ if Found (Error) then
+ PolyORB.DSA_P.Exceptions.Raise_From_Error (Error);
+ end if;
+ end Activate_RPC_Receiver;
+
+ ----------------------------
+ -- Activate_RPC_Receivers --
+ ----------------------------
+
+ procedure Activate_RPC_Receivers is
+ use Receiving_Stub_Lists;
+ It : Iterator;
+ begin
+ pragma Debug (C, O ("Activate_RPC_Receivers: enter"));
+ RPC_Receivers_Activated := True;
+
+ It := First (All_Receiving_Stubs);
+ while not Last (It) loop
+ Activate_RPC_Receiver (Value (It).Receiver);
+ Next (It);
+ end loop;
+ pragma Debug (C, O ("Activate_RPC_Receivers: end"));
+ end Activate_RPC_Receivers;
+
-------------------------
-- Any_Aggregate_Build --
-------------------------
@@ -347,9 +409,9 @@ package body System.Partition_Interface
pragma Assert (Receiver.Object_Adapter /= null);
declare
- Key : aliased PolyORB.Objects.Object_Id := To_Local_Oid (Addr);
+ Key : aliased PolyORB.Objects.Object_Id := To_Local_Oid (Addr);
U_Oid : PolyORB.POA_Types.Unmarshalled_Oid;
- Oid : PolyORB.POA_Types.Object_Id_Access;
+ Oid : PolyORB.POA_Types.Object_Id_Access;
begin
PolyORB.POA.Activate_Object
@@ -532,7 +594,7 @@ package body System.Partition_Interface
declare
EMsg : Execute_Request renames Execute_Request (Msg);
begin
- if Receiving_Stub (Self.Impl_Info.all).Kind = Pkg_Stub then
+ if Self.Impl_Info.Kind = Pkg_Stub then
-- The base reference for an RCI unit implements operations
-- that correspond to the visible subprograms of the unit
@@ -588,7 +650,7 @@ package body System.Partition_Interface
-- Call implementation
Get_RAS_Info
- (Receiving_Stub (Self.Impl_Info.all).Name.all,
+ (Self.Impl_Info.Name.all,
PolyORB.Services.Naming.To_Standard_String
(ISNC.Get_Element (ISNC.Sequence (n), 1).id),
Result);
@@ -764,7 +826,7 @@ package body System.Partition_Interface
function FA_SU (Item : PolyORB.Any.Any) return Short_Unsigned is
begin
- return Short_Unsigned (PolyORB.Types.Short'(From_Any (Item)));
+ return Short_Unsigned (PolyORB.Types.Unsigned_Short'(From_Any (Item)));
end FA_SU;
function FA_SSI (Item : PolyORB.Any.Any) return Short_Short_Integer is
@@ -954,6 +1016,21 @@ package body System.Partition_Interface
return PATC.To_Ref (PolyORB.Any.Get_Unwound_Type (A));
end Get_TC;
+ ----------
+ -- Link --
+ ----------
+
+ function Link
+ (S : access Private_Info;
+ Which : PolyORB.Utils.Ilists.Link_Type)
+ return access Private_Info_Access
+ is
+ use PolyORB.Utils.Ilists;
+ begin
+ pragma Assert (Which = Next);
+ return S.Next'Unchecked_Access;
+ end Link;
+
-------------------------
-- Local_PID_Allocated --
-------------------------
@@ -1156,8 +1233,7 @@ package body System.Partition_Interface
declare
use Receiving_Stub_Lists;
- It : Receiving_Stub_Lists.Iterator :=
- First (All_Receiving_Stubs);
+ It : Receiving_Stub_Lists.Iterator := First (All_Receiving_Stubs);
Addr : System.Address := System.Null_Address;
Receiver : Servant_Access := null;
@@ -1175,38 +1251,34 @@ package body System.Partition_Interface
All_Stubs :
while not Last (It) loop
declare
- Rec_Stub : Receiving_Stub renames Value (It).all;
- pragma Assert (Rec_Stub.Subp_Info /= Null_Address);
+ RS : Private_Info renames Value (It).all;
+ pragma Assert (RS.Subp_Info /= Null_Address);
- subtype Subp_Array is RCI_Subp_Info_Array
- (0 .. Rec_Stub.Subp_Info_Len - 1);
+ subtype Subp_Array is
+ RCI_Subp_Info_Array (0 .. RS.Subp_Info_Len - 1);
package Subp_Info_Addr_Conv is
new System.Address_To_Access_Conversions (Subp_Array);
- Subp_Info : constant Subp_Info_Addr_Conv.Object_Pointer
- := Subp_Info_Addr_Conv.To_Pointer (Rec_Stub.Subp_Info);
+ Subp_Info : constant Subp_Info_Addr_Conv.Object_Pointer :=
+ Subp_Info_Addr_Conv.To_Pointer (RS.Subp_Info);
begin
- if Rec_Stub.Kind = Pkg_Stub
- and then To_Lower (Rec_Stub.Name.all) = To_Lower (Pkg_Name)
+ if RS.Kind = Pkg_Stub
+ and then To_Lower (RS.Name.all) = To_Lower (Pkg_Name)
then
for J in Subp_Info'Range loop
declare
- Info : RCI_Subp_Info
- renames Subp_Info (J);
+ Info : RCI_Subp_Info renames Subp_Info (J);
+ subtype Str is String (1 .. Info.Name_Length);
- subtype Str is
- String (1 .. Info.Name_Length);
-
package Str_Addr_Conv is
- new System.Address_To_Access_Conversions
- (Str);
+ new System.Address_To_Access_Conversions (Str);
begin
if Str_Addr_Conv.To_Pointer (Info.Name).all
= Subprogram_Name
then
Addr := Info.Addr;
- Receiver := Rec_Stub.Receiver;
+ Receiver := RS.Receiver;
exit All_Stubs;
end if;
end;
@@ -1220,6 +1292,7 @@ package body System.Partition_Interface
Build_Local_Reference (Addr, Pkg_Name, Receiver, Subp_Ref);
end;
+
else
declare
Ctx_Ref : PSNNC.Ref;
@@ -1613,57 +1686,52 @@ package body System.Partition_Interface
Receiver : Servant_Access)
is
use Receiving_Stub_Lists;
+ Stub : Private_Info renames Receiver.Impl_Info;
begin
pragma Assert (Name (Name'Last) = ASCII.NUL);
Receiver.Handler := Handler;
- Prepend
- (All_Receiving_Stubs,
- Receiving_Stub'
- (Kind => Obj_Stub,
- Name =>
- +Name (Name'First .. Name'Last - 1),
- Receiver => Receiver,
- Version => null,
- Subp_Info => Null_Address,
- Subp_Info_Len => 0,
- Is_All_Calls_Remote => False));
+ Stub :=
+ (Kind => Obj_Stub,
+ Name => +Name (Name'First .. Name'Last - 1),
+ Receiver => Receiver,
+ Version => null,
+ Subp_Info => Null_Address,
+ Subp_Info_Len => 0,
+ Is_All_Calls_Remote => False,
+ others => <>);
+ Prepend (All_Receiving_Stubs, Stub'Access);
- Receiver.Impl_Info := Private_Info_Access
- (Value (First (All_Receiving_Stubs)));
-
- declare
- Stub : Receiving_Stub renames Value (First (All_Receiving_Stubs)).all;
- begin
- pragma Debug (C, O ("Setting up RPC receiver: " & Stub.Name.all));
- Setup_Object_RPC_Receiver (Stub.Name.all, Stub.Receiver);
- end;
-
+ pragma Debug (C, O ("Setting up RPC receiver: " & Stub.Name.all));
+ Setup_Object_RPC_Receiver (Stub.Name.all, Stub.Receiver);
end Register_Obj_Receiving_Stub;
- -----------------------------
- -- Retrieve_Receiving_Stub --
- -----------------------------
+ -------------------------
+ -- Find_Receiving_Stub --
+ -------------------------
- function Retrieve_Receiving_Stub (Name : String;
- Kind : Receiving_Stub_Kind)
- return Servant_Access
+ function Find_Receiving_Stub
+ (Name : String; Kind : Receiving_Stub_Kind) return Servant_Access
is
use Receiving_Stub_Lists;
It : Receiving_Stub_Lists.Iterator := First (All_Receiving_Stubs);
begin
All_Stubs :
while not Last (It) loop
- if Value (It).all.Kind = Kind
- and then To_Lower (Value (It).all.Name.all) = To_Lower (Name)
- then
- return Value (It).all.Receiver;
- end if;
+ declare
+ RS : Private_Info renames Value (It).all;
+ begin
+ if RS.Kind = Kind
+ and then To_Lower (RS.Name.all) = To_Lower (Name)
+ then
+ return RS.Receiver;
+ end if;
+ end;
Next (It);
end loop All_Stubs;
return null;
- end Retrieve_Receiving_Stub;
+ end Find_Receiving_Stub;
------------------------------
-- Register_Passive_Package --
@@ -1671,7 +1739,10 @@ package body System.Partition_Interface
procedure Register_Passive_Package
(Name : Unit_Name;
- Version : String := "") is
+ Version : String := "")
+ is
+ pragma Unreferenced (Name);
+ pragma Unreferenced (Version);
begin
null;
end Register_Passive_Package;
@@ -1690,25 +1761,21 @@ package body System.Partition_Interface
Is_All_Calls_Remote : Boolean)
is
use Receiving_Stub_Lists;
+ Stub : Private_Info renames Receiver.Impl_Info;
begin
Receiver.Handler := Handler;
- Prepend
- (All_Receiving_Stubs,
- Receiving_Stub'
- (Kind => Pkg_Stub,
- Name => +Name,
- Receiver => Receiver,
- Version => +Version,
- Subp_Info => Subp_Info,
- Subp_Info_Len => Subp_Info_Len,
- Is_All_Calls_Remote => Is_All_Calls_Remote));
+ Receiver.Impl_Info :=
+ (Kind => Pkg_Stub,
+ Name => +Name,
+ Receiver => Receiver,
+ Version => +Version,
+ Subp_Info => Subp_Info,
+ Subp_Info_Len => Subp_Info_Len,
+ Is_All_Calls_Remote => Is_All_Calls_Remote,
+ others => <>);
+ Prepend (All_Receiving_Stubs, Stub'Access);
- Receiver.Impl_Info := Private_Info_Access
- (Value (First (All_Receiving_Stubs)));
-
declare
- Stub : Receiving_Stub renames Value (First (All_Receiving_Stubs)).all;
-
use PolyORB.Errors;
use PolyORB.ORB;
use PolyORB.Obj_Adapters;
@@ -1717,8 +1784,8 @@ package body System.Partition_Interface
use type PolyORB.POA.Obj_Adapter_Access;
Error : Error_Container;
- Key : aliased PolyORB.Objects.Object_Id
- := To_Local_Oid (System.Null_Address);
+ Key : aliased PolyORB.Objects.Object_Id :=
+ To_Local_Oid (System.Null_Address);
U_Oid : PolyORB.POA_Types.Unmarshalled_Oid;
Oid : PolyORB.POA_Types.Object_Id_Access;
@@ -1726,7 +1793,6 @@ package body System.Partition_Interface
begin
pragma Debug (C, O ("Setting up RPC receiver: " & Stub.Name.all));
- Setup_Object_RPC_Receiver (Stub.Name.all, Stub.Receiver);
-- Establish a child POA for this stub. For RACWs, this POA will
-- serve all objects of the same type. For RCIs, this POA will serve
@@ -1734,6 +1800,8 @@ package body System.Partition_Interface
-- sub-objects corresponding to each subprogram considered as an
-- object (for RAS).
+ Setup_Object_RPC_Receiver (Stub.Name.all, Stub.Receiver);
+
PolyORB.POA.Activate_Object
(Self => PolyORB.POA.Obj_Adapter_Access
(Servant_Access (Stub.Receiver).Object_Adapter),
@@ -1867,7 +1935,7 @@ package body System.Partition_Interface
begin
pragma Debug (C, O ("Register RACW In Name Server: enter"));
- Receiver := Retrieve_Receiving_Stub
+ Receiver := Find_Receiving_Stub
(Ada.Tags.External_Tag (Type_Tag), Obj_Stub);
PolyORB.POA.Activate_Object
@@ -2063,13 +2131,11 @@ package body System.Partition_Interface
use PolyORB.POA;
use PolyORB.POA_Config;
use PolyORB.POA_Config.RACWs;
- use PolyORB.POA_Manager;
use type PolyORB.Obj_Adapters.Obj_Adapter_Access;
- POA : Obj_Adapter_Access;
- PName : constant PolyORB.Types.String
- := PolyORB.Types.String (To_PolyORB_String (Name));
-
+ POA : Obj_Adapter_Access;
+ PName : constant PolyORB.Types.String :=
+ PolyORB.Types.String (To_PolyORB_String (Name));
Error : Error_Container;
begin
-- NOTE: Actually this does more than set up an RPC receiver. A TypeCode
@@ -2087,8 +2153,9 @@ package body System.Partition_Interface
end if;
Create_POA
- (Self => PolyORB.POA.Obj_Adapter_Access
- (PolyORB.ORB.Object_Adapter (PolyORB.Setup.The_ORB)),
+ (Self => Obj_Adapter_Access
+ (PolyORB.ORB.Object_Adapter
+ (PolyORB.Setup.The_ORB)),
Adapter_Name => Name,
A_POAManager => null,
Policies => Default_Policies (RACW_POA_Config.all),
@@ -2099,19 +2166,22 @@ package body System.Partition_Interface
PolyORB.DSA_P.Exceptions.Raise_From_Error (Error);
end if;
- POA.Default_Servant := PolyORB.Servants.Servant_Access
- (Default_Servant);
+ POA.Default_Servant := PolyORB.Servants.Servant_Access (Default_Servant);
Default_Servant.Object_Adapter :=
PolyORB.Obj_Adapters.Obj_Adapter_Access (POA);
- pragma Assert (Default_Servant.Object_Adapter /= null);
- Activate (POAManager_Access (Entity_Of (POA.POA_Manager)), Error);
+ if RPC_Receivers_Activated then
+ Activate_RPC_Receiver (Default_Servant);
- if Found (Error) then
- PolyORB.DSA_P.Exceptions.Raise_From_Error (Error);
+ else
+ -- If PCS elaboration is not completed yet, activation is deferred
+ -- until Activate_RPC_Receivers is called.
+
+ pragma Debug (C, O ("Setup_Object_RPC_Receiver: "
+ & Name & " activation deferred"));
+ null;
end if;
-
end Setup_Object_RPC_Receiver;
--------------
============================================================
--- src/dsa/s-parint.ads 38082057900b75eeab5889a4800447b79939cd88
+++ src/dsa/s-parint.ads 393f28edf78106ab8c02b29cc8598c2e67f89e0a
@@ -44,6 +44,7 @@ with PolyORB.Components;
with PolyORB.Any.ObjRef;
with PolyORB.Buffers;
with PolyORB.Components;
+with PolyORB.Initialization;
with PolyORB.Objects;
with PolyORB.Obj_Adapters;
with PolyORB.References;
@@ -51,9 +52,7 @@ with PolyORB.Types;
with PolyORB.Servants;
with PolyORB.Smart_Pointers;
with PolyORB.Types;
-with PolyORB.Utils.Chained_Lists;
with PolyORB.Utils.Strings;
-with PolyORB.Initialization;
with System.DSA_Types;
with System.RPC;
@@ -179,8 +178,7 @@ package System.Partition_Interface is
type Request_Handler_Access is access
procedure (R : Request_Access);
- type Private_Info is abstract tagged null record;
- type Private_Info_Access is access all Private_Info'Class;
+ type Private_Info is private;
type Servant is new PolyORB.Servants.Servant with record
Handler : Request_Handler_Access;
@@ -192,7 +190,7 @@ package System.Partition_Interface is
Obj_TypeCode : PolyORB.Any.TypeCode.Local_Ref;
-- The TypeCode to be used for references to objects of this type
- Impl_Info : Private_Info_Access;
+ Impl_Info : aliased Private_Info;
end record;
type Servant_Access is access all Servant'Class;
@@ -218,12 +216,14 @@ package System.Partition_Interface is
-- Subp_Info is the address of an array of a statically subtype
-- of RCI_Subp_Info_Array with a range of 0 .. Subp_Info_Len - 1.
- function Retrieve_Receiving_Stub
- (Name : String;
- Kind : Receiving_Stub_Kind) return Servant_Access;
+ function Find_Receiving_Stub
+ (Name : String; Kind : Receiving_Stub_Kind) return Servant_Access;
-- Return the servant for distributed objects with given Name and Kind, or
-- null if non-existant.
+ procedure Activate_RPC_Receivers;
+ -- Start processing incoming remote calls
+
---------------------------------
-- Remote Access to Class Wide --
---------------------------------
@@ -305,10 +305,10 @@ package System.Partition_Interface is
-- Receiver is the associated servant.
procedure Build_Local_Reference
- (Addr : System.Address;
- Typ : String;
+ (Addr : System.Address;
+ Typ : String;
Receiver : access Servant;
- Ref : out PolyORB.References.Ref);
+ Ref : out PolyORB.References.Ref);
-- Create a reference that can be used to designate the local object whose
-- address is Addr, whose type is the designated type of a RACW type
-- associated with Servant.
@@ -688,10 +688,16 @@ private
return PolyORB.Components.Message'Class;
pragma Inline (Execute_Servant);
- -- During elaboration, each RCI package and each distributed object type
- -- registers a Receiving_Stub entry.
+ type Buffer_Stream_Type is new Ada.Streams.Root_Stream_Type with record
+ Buf : aliased PolyORB.Buffers.Buffer_Type;
+ end record;
- type Receiving_Stub is new Private_Info with record
+ type Private_Info_Access is access all Private_Info;
+
+ type Private_Info is record
+ Next : aliased Private_Info_Access;
+ -- For chaining on All_Receiving_Stubs list
+
Kind : Receiving_Stub_Kind;
-- Indicates whether this info is relative to RACW type or a RCI
@@ -715,13 +721,4 @@ private
end record;
- package Receiving_Stub_Lists is new PolyORB.Utils.Chained_Lists
- (Receiving_Stub);
-
- All_Receiving_Stubs : Receiving_Stub_Lists.List;
-
- type Buffer_Stream_Type is new Ada.Streams.Root_Stream_Type with record
- Buf : aliased PolyORB.Buffers.Buffer_Type;
- end record;
-
end System.Partition_Interface;
============================================================
--- src/giop/polyorb-protocols-giop-giop_1_0.adb 39cf55d98a1c310398d4ed54bf5ad112f80ec386
+++ src/giop/polyorb-protocols-giop-giop_1_0.adb f330b8b28b43af0d38da768762dc822bba8c40d4
@@ -537,11 +537,12 @@ package body PolyORB.Protocols.GIOP.GIOP
Buffer : Buffer_Access;
Header_Buffer : Buffer_Access;
Header_Space : Reservation;
- Resp_Exp : constant Boolean
- := Is_Set (Sync_With_Target, R.Req.Req_Flags)
- or Is_Set (Sync_Call_Back, R.Req.Req_Flags);
- Oid : constant Object_Id_Access
- := Binding_Data.Get_Object_Key (R.Target_Profile.all);
+ Resp_Exp : constant Boolean :=
+ Is_Set (Sync_With_Target, R.Req.Req_Flags)
+ or else
+ Is_Set (Sync_Call_Back, R.Req.Req_Flags);
+ Oid : constant Object_Id_Access :=
+ Binding_Data.Get_Object_Key (R.Target_Profile.all);
begin
pragma Debug (C, O ("Sending request, Id :" & R.Request_Id'Img));
============================================================
--- src/giop/polyorb-protocols-giop-giop_1_1.adb 3103cb94e7346ca18ebe976010a5ef8a2a311556
+++ src/giop/polyorb-protocols-giop-giop_1_1.adb 5bcf4053b576ef21cfc9920dba7dc5d84823be83
@@ -533,9 +533,10 @@ package body PolyORB.Protocols.GIOP.GIOP
Header_Space : Reservation;
Resp_Exp : constant Boolean :=
Is_Set (Sync_With_Target, R.Req.Req_Flags)
- or Is_Set (Sync_Call_Back, R.Req.Req_Flags);
+ or else
+ Is_Set (Sync_Call_Back, R.Req.Req_Flags);
Oid : constant Object_Id_Access :=
- Binding_Data.Get_Object_Key (R.Target_Profile.all);
+ Binding_Data.Get_Object_Key (R.Target_Profile.all);
begin
pragma Debug (C, O ("Sending request, Id :" & R.Request_Id'Img));
============================================================
--- src/polyorb-annotations.ads e23a0a162dc98f1e2f64c4926cf6327d4eeca63f
+++ src/polyorb-annotations.ads d8d1c05b434ba1d87354811084ff0bee2343895f
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -16,12 +16,12 @@
-- TABILITY 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 PolyORB; see file COPYING. If --
--- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, --
--- Boston, MA 02111-1307, USA. --
+-- not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
+-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- --
--- PolyORB is maintained by ACT Europe. --
--- (email: sales@act-europe.fr) --
+-- PolyORB is maintained by AdaCore --
+-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
@@ -34,7 +34,7 @@ package PolyORB.Annotations is
package PolyORB.Annotations is
- pragma Elaborate_Body;
+ pragma Preelaborate;
type Note is abstract tagged private;
-- A note that can be attached to an object.
============================================================
--- src/polyorb-any.ads d24b4749d2047c99e5abefb824d3be6dc713d1f7
+++ src/polyorb-any.ads fbc8f29c3c25f6029b8f6b387b031e8c9fa255bf
@@ -170,6 +170,7 @@ package PolyORB.Any is
----------
type Local_Ref is private;
+ pragma Preelaborable_Initialization (Local_Ref);
type Object (Kind : TCKind) is
new Smart_Pointers.Non_Controlled_Entity
============================================================
--- src/polyorb-asynch_ev.ads 1ad471e732e32ac1cbeb4e6d980a9882d80e1720
+++ src/polyorb-asynch_ev.ads 5c60d2785bc9de6cbfb7f62ed3e7c034dff1c5fd
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -33,7 +33,7 @@ package PolyORB.Asynch_Ev is
package PolyORB.Asynch_Ev is
- pragma Elaborate_Body;
+ pragma Preelaborate;
-- Some environment components can produce events in an
-- asynchronous fashion, i.e. independently of middleware actions
============================================================
--- src/polyorb-buffers.adb de3d04a9d894b30e2109ec2933be2114f0709c7b
+++ src/polyorb-buffers.adb 9069bb2fae5f20669d27e70176e373dca84f17f2
@@ -290,9 +290,6 @@ package body PolyORB.Buffers is
(others => 0);
-- Null data used for padding
- Null_Data_Address : constant Opaque_Pointer :=
- Null_Data (Null_Data'First)'Address;
-
procedure Pad_Align
(Buffer : access Buffer_Type;
Alignment : Alignment_Type)
@@ -324,7 +321,7 @@ package body PolyORB.Buffers is
declare
Padding_Iovec : constant Iovec :=
- (Iov_Base => Null_Data_Address,
+ (Iov_Base => Null_Data'Address,
Iov_Len => Storage_Offset (Padding));
begin
Append (Iovec_Pool => Buffer.Contents, An_Iovec => Padding_Iovec);
============================================================
--- src/polyorb-buffers.ads 1b8ebc7a25c8705634e689afd1b7c259a13e643b
+++ src/polyorb-buffers.ads 690b535469e9f57538cc1fa11f33b858335ad472
@@ -43,13 +43,15 @@ package PolyORB.Buffers is
package PolyORB.Buffers is
- pragma Elaborate_Body;
+ pragma Preelaborate;
-------------------------
-- General definitions --
-------------------------
- type Endianness_Type is (Little_Endian, Big_Endian);
+ type Endianness_Type is new System.Bit_Order;
+ function Little_Endian return Endianness_Type renames Low_Order_First;
+ function Big_Endian return Endianness_Type renames High_Order_First;
-- Endianness of a buffer
type Alignment_Type is (Align_1, Align_2, Align_4, Align_8);
@@ -321,13 +323,8 @@ private
-- Determination of the host byte order --
------------------------------------------
- Default_Bit_Order_To_Endianness :
- constant array (System.Bit_Order) of Endianness_Type
- := (System.High_Order_First => Big_Endian,
- System.Low_Order_First => Little_Endian);
-
Host_Order : constant Endianness_Type :=
- Default_Bit_Order_To_Endianness (System.Default_Bit_Order);
+ Endianness_Type (System.Default_Bit_Order);
--------------
-- A Buffer --
@@ -353,13 +350,8 @@ private
Length : Ada.Streams.Stream_Element_Count;
end record;
- Null_Buffer_Chunk_Metadata : constant Buffer_Chunk_Metadata
- := (Last_Used => 0);
-
package Buffer_Chunk_Pools is
- new Opaque.Chunk_Pools
- (Chunk_Metadata => Buffer_Chunk_Metadata,
- Null_Metadata => Null_Buffer_Chunk_Metadata);
+ new Opaque.Chunk_Pools (Chunk_Metadata => Buffer_Chunk_Metadata);
subtype Chunk_Metadata_Access is
Buffer_Chunk_Pools.Metadata_Access;
============================================================
--- src/polyorb-components.ads 9c26f54428fb45e8d2272be24bb02af3e5af90d7
+++ src/polyorb-components.ads 0f581e4374aacccb9630aaeb324a32bcdb37b8c6
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -29,7 +29,7 @@ package PolyORB.Components is
package PolyORB.Components is
- pragma Elaborate_Body;
+ pragma Preelaborate;
-------------------------------------
-- Abstract message and components --
============================================================
--- src/polyorb-errors.ads d376307c52373bfac80437ac2fcc1bd0267418a0
+++ src/polyorb-errors.ads 5157bbb54504b063d5077e04e2aae6ecc25a4190
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -33,6 +33,8 @@ package PolyORB.Errors is
package PolyORB.Errors is
+ pragma Preelaborate;
+
------------------------
-- Exceptions Members --
------------------------
============================================================
--- src/polyorb-objects.ads b047d8cf65dee9a64d8f0a911195b39a2fa466a2
+++ src/polyorb-objects.ads d7483c9b03ec24627c1e195a1c0e2dd02f12a6c4
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -33,7 +33,7 @@ package PolyORB.Objects is
package PolyORB.Objects is
- pragma Elaborate_Body;
+ pragma Preelaborate;
type Object_Id is new Ada.Streams.Stream_Element_Array;
============================================================
--- src/polyorb-opaque-chunk_pools.adb 70261eaec2aee40c52b3c7e7634dba38401d035a
+++ src/polyorb-opaque-chunk_pools.adb 5801b21a748fd62b08666fb3880c60e6b207b388
@@ -61,7 +61,6 @@ package body PolyORB.Opaque.Chunk_Pools
Pool.Prealloc_Used := True;
else
New_Chunk := new Chunk (Size => Allocation_Size);
- New_Chunk.Metadata := Null_Metadata;
Append (Pool.Dynamic_Chunks, New_Chunk);
end if;
============================================================
--- src/polyorb-opaque-chunk_pools.ads a4f3ca205b2d723e8fc53876da9e538ef2d81dbb
+++ src/polyorb-opaque-chunk_pools.ads 21c8667e8d8aea501b7531631a1cd146481fe02b
@@ -33,9 +33,7 @@ generic
generic
type Chunk_Metadata is private;
- -- The metadata associated with each storage chunk.
-
- Null_Metadata : Chunk_Metadata;
+ -- The metadata associated with each storage chunk
package PolyORB.Opaque.Chunk_Pools is
pragma Preelaborate;
============================================================
--- src/polyorb-parameters-initialization.adb 5e6248abb002915a3f256a5d5f859e4696af990b
+++ src/polyorb-parameters-initialization.adb b74b42a29239df0a3580ea27c6d1c889b13be470
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -34,11 +34,9 @@ package body PolyORB.Parameters.Initiali
pragma Elaborate_All (PolyORB.Initialization);
package body PolyORB.Parameters.Initialization is
-
use PolyORB.Initialization;
use PolyORB.Initialization.String_Lists;
use PolyORB.Utils.Strings;
-
begin
Register_Module
(Module_Info'
============================================================
--- src/polyorb-qos.ads 6b0db3ceb7db7334519366c47fe030e5729a19b4
+++ src/polyorb-qos.ads cce3c27568427e8b00894662affb925a17fd3fd1
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -30,6 +30,8 @@ package PolyORB.QoS is
package PolyORB.QoS is
+ pragma Preelaborate;
+
-- List of supported QoS policies
type QoS_Kind is
============================================================
--- src/polyorb-representations.ads 58368c431c8a9540fae56f3861a046f9862487e1
+++ src/polyorb-representations.ads a563bd4b1ab37edcc595f95551af6ea24dd395c0
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -37,8 +37,9 @@ package PolyORB.Representations is
package PolyORB.Representations is
- type Representation is abstract tagged limited private;
+ pragma Preelaborate;
+ type Representation is abstract tagged limited private;
type Representation_Access is access all Representation'Class;
procedure Marshall_From_Any
============================================================
--- src/polyorb-smart_pointers.ads ea54c240d3278d0be12d2936d3582b0fb3a3a200
+++ src/polyorb-smart_pointers.ads 301647994e7d39a0aae377eb4a896e754ea35f71
@@ -87,6 +87,7 @@ package PolyORB.Smart_Pointers is
---------
type Ref is new Ada.Finalization.Controlled with private;
+ pragma Preelaborable_Initialization (Ref);
-- The base type of all references. This type is often derived but never
-- extended. It contains one field, which designates the referenced object.
============================================================
--- src/polyorb-task_info.ads 495f627cd43ac04822c4a2bf8164a6e53551aed7
+++ src/polyorb-task_info.ads 779029b067a6c55f705e30ba77c1835f1a263e84
@@ -40,7 +40,7 @@ package PolyORB.Task_Info is
package PolyORB.Task_Info is
- pragma Elaborate_Body;
+ pragma Preelaborate;
package PAE renames PolyORB.Asynch_Ev;
package PTCV renames PolyORB.Tasking.Condition_Variables;
============================================================
--- src/polyorb-tasking-idle_tasks_managers.ads db0cc938ccab4dda1c7526d113498ebd35179bb3
+++ src/polyorb-tasking-idle_tasks_managers.ads 838b6b36e3a70b8512f9eb7e446acdd0c373d5fa
@@ -31,6 +31,8 @@ package PolyORB.Tasking.Idle_Tasks_Manag
package PolyORB.Tasking.Idle_Tasks_Managers is
+ pragma Preelaborate;
+
package PTI renames PolyORB.Task_Info;
package PTCV renames PolyORB.Tasking.Condition_Variables;
============================================================
--- src/polyorb-tasking-profiles-ravenscar-threads.adb 1b8022c7bc7bd8500259d59c35c038982451cdf7
+++ src/polyorb-tasking-profiles-ravenscar-threads.adb e629de26aebce0655cd975ad60042425a8ca58ba
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -774,16 +774,13 @@ package body PolyORB.Tasking.Profiles.Ra
procedure Suspend (S : Synchro_Index_Type) is
begin
pragma Debug (C, O ("will suspend: " & Integer'Image (Integer (S))));
-
Sync_Pool (S).Wait;
- pragma Assert (not Sync_Pool (S).Get_Signaled and
+ pragma Assert (not Sync_Pool (S).Get_Signaled
+ and then
not Sync_Pool (S).Get_Waiting);
- -- XXX might fail because of a bug in GNAT 3.15a1 ...
- -- The call to wait didn't work.
pragma Debug (C, O ("end suspend: " & Integer'Image (Integer (S))));
-
Synchro_Index_Manager.Release (Synchro_Index_Manager.Index_Type (S));
end Suspend;
============================================================
--- src/polyorb-tasking-threads.adb 3518df551ba5c54b30ee742f179e41472408fa12
+++ src/polyorb-tasking-threads.adb 08e09593ef843df288931bb1a299259028384a3c
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -45,13 +45,11 @@ package body PolyORB.Tasking.Threads is
-- Create_Task --
-----------------
- procedure Create_Task
- (Main : Parameterless_Procedure)
- is
- T : constant Thread_Access
- := Run_In_Task
- (TF => My_Thread_Factory,
- P => Main);
+ procedure Create_Task (Main : Parameterless_Procedure) is
+ T : constant Thread_Access :=
+ Run_In_Task
+ (TF => My_Thread_Factory,
+ P => Main);
pragma Warnings (Off);
pragma Unreferenced (T);
pragma Warnings (On);
============================================================
--- src/polyorb-transport-handlers.adb 5b1ed7eac38dc4aae07631f65eb37200f92b2db3
+++ src/polyorb-transport-handlers.adb eada3561def41452d58cd9835db3af8a0fa2a249
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -44,12 +44,11 @@ package body PolyORB.Transport.Handlers
use PolyORB.Components;
use PolyORB.ORB;
- Reply : constant Message'Class
- := Emit
- (Component_Access (H.TE),
- Filters.Iface.Data_Indication'
- (Data_Amount => 0));
- -- The size of the data received is not known yet.
+ Reply : constant Message'Class :=
+ Emit
+ (Component_Access (H.TE),
+ Filters.Iface.Data_Indication'(Data_Amount => 0));
+ -- The size of the data received is not known yet
begin
@@ -57,8 +56,7 @@ package body PolyORB.Transport.Handlers
-- Notify the tasking policy that an endpoint is being destroyed.
- Handle_Close_Connection
- (H.ORB.Tasking_Policy, H.TE);
+ Handle_Close_Connection (H.ORB.Tasking_Policy, H.TE);
-- Close the endpoint.
============================================================
--- src/polyorb-transport-handlers.ads 65b9539280bbb4abf94d528c3164f90d9ad62097
+++ src/polyorb-transport-handlers.ads ff361ab1466d2233496fb06476efeef183659a6a
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -16,12 +16,12 @@
-- TABILITY 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 PolyORB; see file COPYING. If --
--- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, --
--- Boston, MA 02111-1307, USA. --
+-- not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
+-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- --
--- PolyORB is maintained by ACT Europe. --
--- (email: sales@act-europe.fr) --
+-- PolyORB is maintained by AdaCore --
+-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
@@ -71,7 +71,6 @@ package PolyORB.Transport.Handlers is
-- Back pointer to the corresponding endpoint.
end record;
- procedure Handle_Event
- (H : access TE_AES_Event_Handler);
+ procedure Handle_Event (H : access TE_AES_Event_Handler);
end PolyORB.Transport.Handlers;
============================================================
--- src/polyorb-utils-chained_lists.ads 93d0b2a36e20196781d22547eccd5b2642eeb3c7
+++ src/polyorb-utils-chained_lists.ads 9072ddeb9bdc95c93a4412a9203e4d123045d4e3
@@ -40,6 +40,11 @@ package PolyORB.Utils.Chained_Lists is
pragma Preelaborate;
type List is private;
+ -- pragma Preelaborable_Initialization (List);
+ -- WAG:61
+ -- Compiler fails to note that a type derived from a private type with
+ -- preelaborable initialization also has.
+
type Iterator is private;
type Element_Access is access all T;
============================================================
--- src/polyorb-utils-ilists.ads 1ab855572ebcd02f9d6097a99c82ac99bad1cbf8
+++ src/polyorb-utils-ilists.ads f2aa664946013e4ffa4c0cc0873fe5a2c62135c2
@@ -53,6 +53,7 @@ package PolyORB.Utils.Ilists is
package Lists is
type List is private;
+ pragma Preelaborable_Initialization (List);
-- A list of objects of type T
type Iterator is private;
============================================================
--- src/security/tls/polyorb-tls.adb 92fa266ba1e718c2557baa1aaae596059eae22e1
+++ src/security/tls/polyorb-tls.adb a0f34a45b1c25f3ee0edb5237c3b029202e9c0f4
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -422,7 +422,7 @@ package body PolyORB.TLS is
Status := Thin.SSL_shutdown (Socket);
end if;
- if Status /= 0 and Status /= 1 then
+ if Status not in 0 .. 1 then
Raise_TLS_Error;
end if;
============================================================
--- src/ssl/polyorb-ssl.adb 38b026431581707995f72ce8f72c730f30d19966
+++ src/ssl/polyorb-ssl.adb 41318cf97b6e8c5eb75dd4c7de297099db9eeab7
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
@@ -527,7 +527,7 @@ package body PolyORB.SSL is
-- Loading Certificate and Private Key files only if both are specified
- if Certificate_File = "" or Private_Key_File = "" then
+ if Certificate_File = "" or else Private_Key_File = "" then
return;
end if;
============================================================
--- support/reconfig 99d32916b9d0f2fbdf12ab0f878bf846f1a654e6
+++ support/reconfig 80c864c93631a212fcc2c333f86d5aad7f9d85fe
@@ -1,5 +1,17 @@
#! /bin/sh
+# Make sure we do not export SHELLOPTS to child processes. Otherwise, they
+# would inherit the "set -e" below, and those scripts expect to continue on
+# "errors". We could do "export -n SHELLOPTS", but we don't want to run
+# configure with SHELLOPTS=igncr, as is often done in Cygwin, because some
+# versions of autoconf put a hard CR in configure, and igncr ignores that CR.
+# Better to give an error here.
+if (export | grep -i shellopts > /dev/null); then
+ echo error: SHELLOPTS environment variable must not be exported
+ echo SHELLOPTS = $SHELLOPTS
+ exit 1
+fi
+
DISTRIBUTION_MODE=false
# Find a version of awk that supports gsub
@@ -10,7 +22,7 @@ fi
NAWK=awk
fi
-set -e
+set -e # Stop on errors.
# The -w switch is used when creating the source distribution from the contents
# of the repository. Its purpose is to adapt configure.ac for files that are
@@ -56,16 +68,20 @@ rm -f support/ltmain.sh.orig
sed -e '/xlinker)/,/;;$/s/\$wl/-Xlinker /g' < support/ltmain.sh.orig > support/ltmain.sh
rm -f support/ltmain.sh.orig
-echo "Running aclocal"
+show_step() {
+ echo "Running `$1 --version | head -1`"
+}
+
+show_step aclocal
aclocal -I support
-echo "Running autoheader"
+show_step autoheader
autoheader
-echo "Running autoconf"
+show_step autoconf
autoconf
-echo "Running automake"
+show_step automake
automake --add-missing --copy
echo "Generating IDL tree accessors"
============================================================
--- support/subversion.m4 75a1499dfb0bebb84f1527a094ad35d220eb6da8
+++ support/subversion.m4 826d5b1575370de13382b451b7232c0df8d23048
@@ -1,5 +1,5 @@ dnl Subversion infrastructure
dnl Subversion infrastructure
-dnl $Id: subversion.m4 127152 2008-07-28 13:25:39Z quinot $
+dnl $Id: subversion.m4 145301 2009-06-08 09:56:49Z quinot $
dnl Usage: AM_SUBVERSION
dnl Set SVNREVISION from DISTRIB_SVNREVISION if provided by support/distrib.m4.
@@ -18,6 +18,5 @@ AC_DEFUN([AM_SUBVERSION],[
fi
SVNREVISION=${last_changed_rev:-unknown}
])
- AC_MSG_NOTICE([building rev. ${SVNREVISION}])
AC_SUBST(SVNREVISION)
])
============================================================
--- testsuite/acats/CXE4005/cxe4005_normal.adb 6afacaf0e73899db3760053341aa88ee478d9e27
+++ testsuite/acats/CXE4005/cxe4005_normal.adb c4f00ae547cf4d08b4e8baf0cb5946aa272905d5
@@ -17,7 +17,8 @@ package body CXE4005_Normal is
RTT2 : access Cant_Use_In_Remote_Call;
Test_Number : in Integer;
Obj_SN1 : out Integer;
- Obj_SN2 : out Integer)is
+ Obj_SN2 : out Integer)
+ is
begin
Report.Failed ("Call made where type is declared in a normal " &
"package. Test number " &
============================================================
--- testsuite/tests/test_utils.py 6a28a2a617967b24717bf1a8c48a6ee0aaa3bfb1
+++ testsuite/tests/test_utils.py 486ef966b0706d18c396fb5ca8367e93eb4fcc93
@@ -9,6 +9,7 @@ You should never call this module direct
./testsuite.py NAME_OF_TESTCASE
"""
+from gnatpython.env import Env
from gnatpython.ex import Run, STDOUT
from gnatpython.expect import ExpectProcess
from gnatpython.fileutils import mkdir
@@ -19,6 +20,12 @@ POLYORB_CONF = "POLYORB_CONF"
POLYORB_CONF = "POLYORB_CONF"
+EXE_EXT = Env().target.os.exeext
+
+def assert_exists(filename):
+ """Assert that the given filename exists"""
+ assert os.path.exists(filename), "%s not found" % filename
+
def client_server(client_cmd, client_conf, server_cmd, server_conf):
"""Run a client server testcase
@@ -27,51 +34,64 @@ def client_server(client_cmd, client_con
Check for "END TESTS................ PASSED"
if found return True
"""
- client = os.path.join(BASE_DIR, client_cmd)
- server = os.path.join(BASE_DIR, server_cmd)
+ client = os.path.join(BASE_DIR, client_cmd + EXE_EXT)
+ server = os.path.join(BASE_DIR, server_cmd + EXE_EXT)
+ # Check that files exist
+ assert_exists(client)
+ assert_exists(server)
+
if server_conf:
server_polyorb_conf = os.path.join(options.testsuite_src_dir,
server_conf)
- assert(os.path.exists(server_polyorb_conf))
+ assert_exists(server_polyorb_conf)
else:
server_polyorb_conf = ""
os.environ[POLYORB_CONF] = server_polyorb_conf
# Run the server command and retrieve the IOR string
- server_handle = ExpectProcess([server])
+ server_handle = ExpectProcess(make_run_cmd([server],options.coverage))
- result = server_handle.expect([r"IOR:([a-z0-9]+)['|\n]"], 2.0)
- if result != 0:
- print "Expect error"
- server_handle.close()
- return False
+ try:
+ result = server_handle.expect([r"IOR:([a-z0-9]+)['|\n]"], 2.0)
+ if result != 0:
+ print "Expect error"
+ server_handle.close()
+ return False
- IOR_str = server_handle.out()[1]
+ IOR_str = server_handle.out()[1]
- # Run the client with the IOR argument
- mkdir(os.path.dirname(options.out_file))
+ # Run the client with the IOR argument
+ mkdir(os.path.dirname(options.out_file))
- if client_conf:
- client_polyorb_conf = os.path.join(options.testsuite_src_dir,
- client_conf)
- assert(os.path.exists(client_polyorb_conf))
- else:
- client_polyorb_conf = ''
+ if client_conf:
+ client_polyorb_conf = os.path.join(options.testsuite_src_dir,
+ client_conf)
+ assert_exists(client_polyorb_conf)
+ else:
+ client_polyorb_conf = ''
- if client_polyorb_conf != server_polyorb_conf:
- client_env = os.environ.copy()
- client_env[POLYORB_CONF] = client_polyorb_conf
- else:
- client_env = None
+ if client_polyorb_conf != server_polyorb_conf:
+ client_env = os.environ.copy()
+ client_env[POLYORB_CONF] = client_polyorb_conf
+ else:
+ client_env = None
- Run([client, IOR_str], output=options.out_file, error=STDOUT,
- timeout=options.timeout, env=client_env)
+ Run(make_run_cmd([client, IOR_str],options.coverage),
+ output=options.out_file, error=STDOUT,
+ timeout=options.timeout, env=client_env)
- # Kill the server process
- server_handle.close()
+ # Kill the server process
+ server_handle.close()
+ for elmt in [client, server]:
+ run_coverage_analysis(elmt)
+ except Exception, e:
+ # Be sure that the server handle is properly closed
+ print e
+ server_handle.close()
+
return _check_output()
def local(cmd, config_file):
@@ -83,13 +103,17 @@ def local(cmd, config_file):
"""
if config_file:
config_file = os.path.join(options.testsuite_src_dir, config_file)
- assert(os.path.exists(config_file))
+ assert_exists(config_file)
os.environ[POLYORB_CONF] = config_file
mkdir(os.path.dirname(options.out_file))
- command = os.path.join(BASE_DIR, cmd)
- Run([command], output=options.out_file, error=STDOUT,
+ command = os.path.join(BASE_DIR, cmd + EXE_EXT)
+ assert_exists(command)
+ Run(make_run_cmd([command],options.coverage),
+ output=options.out_file, error=STDOUT,
timeout=options.timeout)
+ if options.coverage=="True":
+ run_coverage_analysis(command)
return _check_output()
@@ -117,9 +141,36 @@ def parse_cmd_line():
main.add_option('--build-dir', dest="build_dir")
main.add_option('--testsuite-src-dir', dest='testsuite_src_dir')
main.add_option('--out-file', dest="out_file")
+ main.add_option('--coverage', dest="coverage", default=False)
main.parse_args()
return main.options
+def make_run_cmd(cmd, coverage="False"):
+ """Create a command line for Run in function of coverage
+
+ Returns command and arguments list
+ """
+ L = []
+ if coverage=="True":
+ L.extend(['xcov', '--run', '--target=i386-linux', '-o',
+ cmd[0] + '.trace', cmd[0]])
+ if len(cmd)>1:
+ L.append('-eargs')
+ L.extend(cmd[1:])
+ else:
+ L.extend(cmd);
+ return L
+
+def run_coverage_analysis(command):
+ """Run xcov with appropriate arguments to retrieve coverage information
+
+ Returns an object of type run
+ """
+ return Run(['xcov', '--coverage=branch', '--annotate=report',
+ command + ".trace"],
+ output=options.out_file + '.trace', error=STDOUT,
+ timeout=options.timeout)
+
# Parse command lines options
options = parse_cmd_line()
============================================================
--- testsuite/tests/testsuite.py d925546ca1a56366fa7c64f20ac302b5b45ef45d
+++ testsuite/tests/testsuite.py be89582285829955c8705925b6493679b338dbdb
@@ -13,7 +13,7 @@ from gnatpython.env import Env
"""
from gnatpython.env import Env
-from gnatpython.ex import Run
+from gnatpython.ex import Run, STDOUT
from gnatpython.fileutils import mkdir
from gnatpython.main import Main
from gnatpython.mainloop import MainLoop
@@ -28,6 +28,8 @@ DEFAULT_TIMEOUT = 60
DEFAULT_TIMEOUT = 60
+logger = logging.getLogger('polyorb.testsuite')
+
def main():
"""Run the testsuite and generate reports"""
# Parse the command lines options
@@ -61,15 +63,21 @@ def main():
# Then run all non dead tests
MainLoop(non_dead_list,
- gen_run_testcase(options.build_dir, options.testsuite_src_dir),
+ gen_run_testcase(options.build_dir, options.testsuite_src_dir,
+ options.coverage),
gen_collect_result(report, options.diffs),
options.jobs)
report.write()
# Human readable report (rep file)
- rep = GenerateRep('res_polyorb', targetname=env.target.platform)
+ if options.old_res is not None and not os.path.exists(options.old_res):
+ logger.warning("Cannot find %s" % options.old_res)
+ options.old_res = None
+ rep = GenerateRep('res_polyorb',
+ options.old_res,
+ targetname=env.target.platform)
report_file = open('rep_polyorb', 'w')
- report_file.write(rep.get_subject())
+ report_file.write(rep.get_subject() + '\n\n')
report_file.write(rep.get_report())
report_file.close()
@@ -146,7 +154,7 @@ class TestCase(object):
else:
return self.opt.is_dead
-def gen_run_testcase(build_dir, testsuite_src_dir):
+def gen_run_testcase(build_dir, testsuite_src_dir, coverage):
"""Returns the run_testcase function"""
# Set build_dir variable to the root of the build area, so test_utils.py
@@ -168,19 +176,23 @@ def gen_run_testcase(build_dir, testsuit
If limit is not set, run rlimit with DEFAULT_TIMEOUT
"""
- logging.debug("Running " + test.testdir)
+ logger.debug("Running " + test.testdir)
timeout = test.getopt('limit')
if timeout is None:
timeout = DEFAULT_TIMEOUT
+ mkdir(os.path.dirname(os.path.join('output', test.filename)))
+
return Run([sys.executable,
test.filename,
'--timeout', str(timeout),
'--out-file', os.path.join('output', test.filename),
'--testsuite-src-dir', os.path.realpath(testsuite_src_dir),
- '--build-dir', os.path.realpath(build_dir)],
- bg=True, output=None,
- error=None, timeout=int(timeout) + DEFAULT_TIMEOUT)
+ '--build-dir', os.path.realpath(build_dir),
+ '--coverage=' + str(coverage)],
+ bg=True, output=os.path.join('output',
+ test.filename + '.error'),
+ error=STDOUT, timeout=int(timeout) + DEFAULT_TIMEOUT)
return run_testcase
def gen_collect_result(report, show_diffs=False):
@@ -200,16 +212,18 @@ def gen_collect_result(report, show_diff
test.filename = test.filename.replace('./', '')
status = status_dict[success][xfail]
- logging.info("%-60s %s" % (test.filename, status))
+ logger.info("%-60s %s" % (test.filename, status))
if not success:
diff = ""
- if os.path.exists(os.path.join('output', test.filename)):
- f = open(os.path.join('output', test.filename))
- diff = f.read()
- f.close()
+ for filename in (test.filename, test.filename + '.error'):
+ if os.path.exists(os.path.join('output', filename)):
+ f = open(os.path.join('output', filename))
+ diff = f.read()
+ f.close()
+
report.add(test.filename, status, diff=diff)
if show_diffs:
- logging.info(diff)
+ logger.info(diff)
else:
report.add(test.filename, status)
@@ -224,14 +238,18 @@ def __parse_options():
metavar='N', default=1, help='Allow N jobs at once')
m.add_option('-b', '--build-dir', dest='build_dir',
help='separate PolyORB build directory')
+ m.add_option("--old-res", dest="old_res", type="string",
+ default=None, help="Old testsuite.res file")
m.add_option('--testsuite-src-dir', dest='testsuite_src_dir',
help='path to polyorb testsuite sources')
+ m.add_option('--coverage', dest='coverage', action='store_true',
+ default=False, help='generate coverage information')
m.parse_args()
if m.args:
# Run only one test
m.options.run_test = os.path.sep + m.args[0]
- logging.info("Running only test '%s'" % m.options.run_test)
+ logger.info("Running only test '%s'" % m.options.run_test)
else:
m.options.run_test = ""
============================================================
--- utils/prepare_distrib 4fc0a4a15b5563293a0683969232dfc018649e3b
+++ utils/prepare_distrib 54dbb86717fac86b7d663c0e991d883b4019531d
@@ -1,6 +1,6 @@
#!/bin/sh
#
-# $Id: prepare_distrib 144247 2009-05-19 10:14:02Z quinot $
+# $Id: prepare_distrib 145301 2009-06-08 09:56:49Z quinot $
#
# This script performs all the necessary steps to transform a checked
# out copy of PolyORB into a source tree suitable for packaging.
@@ -90,10 +90,13 @@ echo "define(DEFAULT_WARNINGS_MODE, [n])
echo "define(DEFAULT_WARNINGS_MODE, [n])"
# Release name override and additional version information from command line
-# (may be empty).
-echo "define([OVERRIDE_RELEASE],[$override_release])"
-echo "define([ADDITIONAL_VERSION],[$additional_version])"
+if [ -n "$override_release" ]; then
+ echo "define([OVERRIDE_RELEASE],[$override_release])"
+fi
+if [ -n "$additional_version" ]; then
+ echo "define([ADDITIONAL_VERSION],[$additional_version])"
+fi
# Subversion revision information (optional)