The unified diff between revisions [e2585a44..] and [4f51e3cd..] is displayed below. It can also be downloaded as a raw diff.
#
#
# delete "common/Makefile"
#
# delete "common/Makefile.common.in"
#
# delete "common/expect/Makefile.expect"
#
# delete "common/src/pthread.c"
#
# delete "examples/demo/Makefile.sdc"
#
# delete "gnatlib/Makefile.gnatcoll_gtk"
#
# delete "gvd/Attic"
#
# delete "gvd/Attic/canvas"
#
# delete "gvd/distrib"
#
# delete "gvd/docs"
#
# delete "gvd/glide"
#
# delete "kernel/src_info/Makefile"
#
# delete "kernel/src_info/Makefile.standalone"
#
# delete "kernel/src_info/common"
#
# delete "kernel/src_info/sn/Makefile.sn"
#
# add_file "gvd/gvd/debugger-vms-ada.adb"
# content [88bb7d1c12f0faadcccb31b39d0961af9408efd2]
#
# add_file "gvd/gvd/debugger-vms-ada.ads"
# content [c3e3f82a0090407a5b4959359ed831d01a035dd7]
#
# add_file "gvd/gvd/debugger-vms.adb"
# content [8ee8ed781cb99dcd341163d52362ab300e9fe930]
#
# add_file "gvd/gvd/debugger-vms.ads"
# content [a210863f1b3ffd14955be0901eaccb6a1bd9478d]
#
# add_file "kernel/src_info/sn/sn.gpr"
# content [e8f2b56c1d4d707163224c544b75689fcae08dee]
#
# patch "Makefile.gnat"
# from [fa78ef75b415765154638f9771759835de219362]
# to [025e9ed5b8a9c640833b402835ebdbca59473fdf]
#
# patch "Makefile.in"
# from [8411709614ccb315202e62ddeb47355aecd8d4d7]
# to [b53cba3efe0609ecdcb2f17cc8900d8ea02ca3dd]
#
# patch "ada_module/ada_module.gpr"
# from [c096073b32ef86727b78b23c0fcb49c05a5d009e]
# to [afe1927724d253bb70f5a05b27495ee8852bcd4a]
#
# patch "builder/src/build_command_manager.adb"
# from [8284db952775fe536af92b269b4fc1893516d429]
# to [99ea69df1614ac0db1a54eb0d160d14d51cdd6be]
#
# patch "builder/src/builder_facility_module-scripts.adb"
# from [cbf21aae426102e2abfbb6f0b47e8398e1615bec]
# to [245eb44c7cf2c99c440cce0847a232f6ab14f6db]
#
# patch "builder/src/builder_facility_module.adb"
# from [6cd476838df33ecaaa231a5cd521e46ed1a9bbaf]
# to [18507e087732b067880bb35d4f750855fc203009]
#
# patch "codefix/codefix.gpr"
# from [1d3ccab76a0e52b05c6d6f489a2832e2341ccdbf]
# to [61159fe3cd9ac7516d56d61590fdab133dd25062]
#
# patch "codefix/src/codefix-error_lists.adb"
# from [d4fc850d0eb700e40aaf98d9494dac3b5def63ad]
# to [54fae03b57ca907ad05c1a36424c76307eb64e84]
#
# patch "common/common_no_xmlada.gpr.in"
# from [ed51e7b7bf5392154a244a06d1ea53ffe7ceadc2]
# to [31d91273923875d497e3314a6d497e66f6f60349]
#
# patch "common/common_with_xmlada.gpr.in"
# from [68428482b900778acf2b3bf842b9def2811be101]
# to [2abaa8e72f4bd1d57e2389a09f9cc1f2f4d624ab]
#
# patch "common/src/filesystems.adb"
# from [c8ce53cb47c6a7f6bc1a7cc9cd8303abfc237f39]
# to [eb6a78b77469ca3ceee8849d83fe3febc1f387bc]
#
# patch "common/src/g-exttre.adb"
# from [b4d9d4978d24f2a513c9e72cd7e90a4f922a9437]
# to [7c9801b656f56fb57637038f63cbd1d28489cfe7]
#
# patch "common/src/interactive_consoles.adb"
# from [032b6ca5095c0c16af1a981f766e5320732dab97]
# to [b42fba369a7ac1d219cb42655dc0fc392bbe2fd0]
#
# patch "common/src/interactive_consoles.ads"
# from [1ab44af0e6a04b5668fa4027d56e0ce3b32a47a9]
# to [ee31102d1c58ca7ad274253354c9cc3874875175]
#
# patch "common/tests/run.sh"
# from [6d1b3aba22b5d9bcd87fae958978fb81684411a9]
# to [ebac055031f39f24b4a9834457b8d666886ca8fd]
#
# patch "completion/completion.gpr"
# from [cf2b8a5d5b76f03b2a4403495d0009d6a9416f48]
# to [8b34909fe4c664272d4b2ed6c49f9410e84bc9f1]
#
# patch "configure"
# from [2b4fb8ae2c30399cca97cec33c58eb76e8fa4513]
# to [85eaf1c826e61cc30705cd1b38012682ab3b9833]
#
# patch "configure.in"
# from [5190661de942f1f9e3a17081ead7a36e23064411]
# to [16134af8acbbe8590040a09f1360853f89a9957b]
#
# patch "distrib/doinstall"
# from [2d9b20419959ce0250b0a56971a9d3c18fb0df20]
# to [61da58431cabe7c473fb43cf3368b354cd553670]
#
# patch "gnatlib/aclocal.m4"
# from [b6e617700678d224a6b06ef3703b2cc09d452e0c]
# to [2a85a459679f75754605566c1473ca8026b15555]
#
# patch "gnatlib/configure"
# from [dac8c5731f6966303847c3339bd66cb73032eca3]
# to [f92507d8dc93c9be52358f13e1c383e242055bbc]
#
# patch "gnatlib/src/gnatcoll_gtk.gpr"
# from [188fc83cb2b956e5e94cf104ad6895968f2b4d4f]
# to [b184a559bfd6eb088803c57e008949a79d3650a6]
#
# patch "gnatlib/src/gnatcoll_python.gpr.in"
# from [c973252984e465502b0ee58f3678977bba1a98c9]
# to [ab4e7ed94358bdb3d4e7eec9c0cf8b3c16f5ddea]
#
# patch "gps/Makefile"
# from [02c27607c5ddffa9c30e170c2d939e1efd847a04]
# to [4301e2847588b047e3c604e8b2110d8b0b843beb]
#
# patch "gps/gps.gpr"
# from [b004c606d94498042ea1a600e1c799788a0b3ba0]
# to [6ac9a1cb29cd4bb3ef9188ad36e14e249192691e]
#
# patch "gvd/gvd/debugger.adb"
# from [a1eefa876eba9d00bc3567cda1d63d752e456584]
# to [9ff20f6137dbc8873f00e87b473789f12919107e]
#
# patch "gvd/gvd/debugger.ads"
# from [c4909f14cf5fcf8c5e01bf82c02d13a2b05d5633]
# to [f7741a60c78f27464a426b4781a3abd68432f918]
#
# patch "gvd/gvd/gvd-types.ads"
# from [9d72971df4bae2778544d63cda9b00856a297f37]
# to [4f0fa6da45b0e224694b6f177ddf054543d550b1]
#
# patch "gvd/gvd.gpr"
# from [b8bcaf0198e920f6bc4669b9f36b1eaaaec2741c]
# to [704bc4f16ecf4faef5a082f86a4966c29c3e2296]
#
# patch "kernel/kernel.gpr"
# from [4aadd766c706e34f0ed47b15975d6161be86bf50]
# to [485da9e8ecc8710170463ad4465ff74ba2303c76]
#
# patch "kernel/src/gps-kernel-console.adb"
# from [925eb79c134b70b970c69436e4ca1e9c2351b35a]
# to [338be9aa173827fadeebb07f44fda6796102f1e3]
#
# patch "kernel/src/gps-kernel-hooks.adb"
# from [97af39a00cff36245fd38c71211afb7888831283]
# to [0049e30759c3f7f92a028acddb1a5a3b4f7543c8]
#
# patch "kernel/src/gps-kernel-standard_hooks.adb"
# from [98899a9d1dc9b02e9b14aec95b48b3825046be92]
# to [73b46f67eea651da0c30f9ae85c955decec6c372]
#
# patch "kernel/src/gps-kernel-timeout.adb"
# from [45d5d11a160ca4223a84ce65b277b46af8699710]
# to [33eeafd41825cf13583a1cd97c2b875451b9a584]
#
# patch "kernel/src/gps-kernel.adb"
# from [65d3376d6ac7515763d16014f5103b43d0e15a81]
# to [201af151daea5f02f5a51fb2d138d243274e0f62]
#
# patch "kernel/src/gps-location_view.adb"
# from [5e224739b40d1fa4a56b324f4fe0609b3541fa9f]
# to [1821403354f5f8a5b840c6ce69b9783cdc89da60]
#
# patch "kernel/src/gps-location_view.ads"
# from [4915ddc39cf8c7e3197bb8538c504499a44773dc]
# to [a1c20519891997f85d4c3473e00c2370f6621abf]
#
# patch "kernel/src/task_manager-gui.adb"
# from [9f4cdbef56cf865313b85d38d79903739d452175]
# to [dee3f172cded47c25de0cc8b23ea8c5fe2a446b0]
#
# patch "kernel/src/task_manager.adb"
# from [b7910e494861a1e65fb4bf33e9d9c3af4bd53ab9]
# to [fc55d8265cf4aae9326f2e03c4c522ad3be77fb8]
#
# patch "kernel/src_info/projects-registry.adb"
# from [155b5cc8da77f57240a438962f98feb5551ce994]
# to [cf68abd7cfc2c0eda82604216c3c3f6c805724e7]
#
# patch "kernel/src_info/standalone.gpr"
# from [94a0a5aff252db84d7cf66364cd317cf0238fe6b]
# to [04b9dbae23d592c6af7a051f3ddbba66d0983171]
#
# patch "prj_editor/prj_editor.gpr"
# from [966e4c4a1a9013905d919d2aa5925cd8e029e289]
# to [f80102ca4cf69fb05302341181f44d530725929c]
#
# patch "prj_editor/testsuite/run"
# from [e3dd60d6b6b8e3229a25554edb276addcad68026]
# to [6e6d591cd1970e44420476475f7203f7246e3452]
#
# patch "python/src/python_module.adb"
# from [58599d5581479a2e13f8243c2073d3e231f164ba]
# to [a0db538e04f64d6a6b4da806e10288bb2b9aba30]
#
# patch "share/library/dispatching.py"
# from [ab956954cb95ed6339f701803b9aabc0c1068ee0]
# to [11d8e60fc067836a14d8aefc33d34a0292ee1d49]
#
# patch "shared.gpr"
# from [f71cdc25f394003ff720737ace673235161c4576]
# to [a91ffe0e4e06bbaf660b20313729bffd85f0d3ed]
#
# patch "src_editor/src/src_editor_box.adb"
# from [cdf97d7de171f4d6265762602f53656623d742cc]
# to [477b41fcdafa2f16726eb1e6c79cf0715635aeae]
#
# patch "src_editor/src/src_editor_buffer-line_information.adb"
# from [20121c407692e27067d4703cbaf375e0dd2f1295]
# to [0cc78743c9e86ee580dae376567a0c7dda9a3f1b]
#
# patch "src_editor/src/src_editor_buffer-line_information.ads"
# from [d8454e79d99775eb892bd878db299fb795d6c8c4]
# to [bb8ff1549d216778e1e8ec5bdb0ff2284066ed51]
#
# patch "src_editor/src/src_editor_buffer.adb"
# from [8102557244df0bd4b8fd37471e8dfc54b7bdcea1]
# to [0ad931732ba2c6262892372d201bef14b6477407]
#
# patch "src_editor/src/src_editor_module.adb"
# from [d625f84ca7a37f6dfd9c54562e2d40602a63aa4d]
# to [13f07da5d4792a50511ee655bedcb6440aa916d8]
#
# patch "syntax/syntax.gpr"
# from [437f189a08183125399e8ed11d44d15a45fde73b]
# to [68cebf1aa2b88359d6f6ceb22c6f7b26e974f2e0]
#
# patch "tools/project_converter/convert-adp.adb"
# from [f6181afa37997c26960be658fbe4ff2ac4cfea04]
# to [44c8624146237d896240ac1751a7f57e304a50c5]
#
# patch "tools/project_converter/convert.gpr"
# from [e9898e8389c681175deef6d51067ce6dde3b8e15]
# to [efad315385adbe9794e7ae9d7600395f2209c3ac]
#
# patch "vcs/src/vcs_view-explorer.adb"
# from [5f456aad025567696dc29bf5415e5ba54f05c21d]
# to [8c25a565754a0f6edc6ed6e1000df933357eb523]
#
# patch "vdiff/vdiff.gpr"
# from [d5ec6efeaa87fd7fd05957046f1949c464131e3b]
# to [64aadf9ced88c54be32c3d5e03f89de0ac23c5a5]
#
# set "gvd/gvd/debugger-vms-ada.adb"
# attr "mtn:execute"
# value "true"
#
# set "gvd/gvd/debugger-vms-ada.ads"
# attr "mtn:execute"
# value "true"
#
# set "gvd/gvd/debugger-vms.adb"
# attr "mtn:execute"
# value "true"
#
# set "gvd/gvd/debugger-vms.ads"
# attr "mtn:execute"
# value "true"
#
# set "kernel/src_info/sn/sn.gpr"
# attr "mtn:execute"
# value "true"
#
============================================================
--- gvd/gvd/debugger-vms-ada.adb 88bb7d1c12f0faadcccb31b39d0961af9408efd2
+++ gvd/gvd/debugger-vms-ada.adb 88bb7d1c12f0faadcccb31b39d0961af9408efd2
@@ -0,0 +1,321 @@
+-----------------------------------------------------------------------
+-- GPS --
+-- --
+-- Copyright (C) 2000-2008, AdaCore --
+-- --
+-- GVD is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with Items.Arrays; use Items.Arrays;
+with Items; use Items;
+with Language.Ada; use Language.Ada;
+with Language.Debugger; use Language.Debugger;
+
+package body Debugger.VMS.Ada is
+
+ --------------
+ -- Get_Name --
+ --------------
+
+ overriding function Get_Name
+ (Lang : access VMS_Ada_Language) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return "ada";
+ end Get_Name;
+
+ --------------------
+ -- Is_Simple_Type --
+ --------------------
+
+ overriding function Is_Simple_Type
+ (Lang : access VMS_Ada_Language; Str : String) return Boolean
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Is_Simple_Type (Ada_Lang, Str);
+ end Is_Simple_Type;
+
+ --------------
+ -- Keywords --
+ --------------
+
+ overriding function Keywords
+ (Lang : access VMS_Ada_Language)
+ return GNAT.Expect.Pattern_Matcher_Access
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Keywords (Ada_Lang);
+ end Keywords;
+
+ overriding function Keywords
+ (Lang : access VMS_Ada_Language) return GNAT.Strings.String_List
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Keywords (Ada_Lang);
+ end Keywords;
+
+ --------------------------
+ -- Get_Language_Context --
+ --------------------------
+
+ overriding function Get_Language_Context
+ (Lang : access VMS_Ada_Language) return Language.Language_Context_Access
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Get_Language_Context (Ada_Lang);
+ end Get_Language_Context;
+
+ ----------------------
+ -- Explorer_Regexps --
+ ----------------------
+
+ overriding function Explorer_Regexps
+ (Lang : access VMS_Ada_Language) return Language.Explorer_Categories
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Explorer_Regexps (Ada_Lang);
+ end Explorer_Regexps;
+
+ --------------------
+ -- Is_System_File --
+ --------------------
+
+ overriding function Is_System_File
+ (Lang : access VMS_Ada_Language; File_Name : String) return Boolean
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Is_System_File (Ada_Lang, File_Name);
+ end Is_System_File;
+
+ ----------------------
+ -- Dereference_Name --
+ ----------------------
+
+ overriding function Dereference_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Dereference_Name (Ada_Lang, Name);
+ end Dereference_Name;
+
+ ---------------------
+ -- Array_Item_Name --
+ ---------------------
+
+ overriding function Array_Item_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String;
+ Index : String) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Array_Item_Name (Ada_Lang, Name, Index);
+ end Array_Item_Name;
+
+ -----------------------
+ -- Record_Field_Name --
+ -----------------------
+
+ overriding function Record_Field_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String;
+ Field : String) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Record_Field_Name (Ada_Lang, Name, Field);
+ end Record_Field_Name;
+
+ ------------------------
+ -- Get_Project_Fields --
+ ------------------------
+
+ overriding function Get_Project_Fields
+ (Lang : access VMS_Ada_Language) return Project_Field_Array
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Get_Project_Fields (Ada_Lang);
+ end Get_Project_Fields;
+
+ ---------------------
+ -- Break Exception --
+ ---------------------
+
+ overriding function Break_Exception
+ (Debugger : access VMS_Ada_Language;
+ Name : String := "";
+ Temporary : Boolean := False;
+ Unhandled : Boolean := False) return String
+ is
+ pragma Unreferenced (Debugger, Name, Unhandled);
+ begin
+ if Temporary then
+ return "set break/exception/temp";
+ else
+ return "set break/exception";
+ end if;
+ end Break_Exception;
+
+ ----------------
+ -- Parse_Type --
+ ----------------
+
+ overriding procedure Parse_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Result : out Items.Generic_Type_Access)
+ is
+ pragma Unreferenced (Lang, Type_Str, Entity);
+ begin
+ -- ???
+ Index := 0;
+ Result := null;
+ end Parse_Type;
+
+ -----------------
+ -- Parse_Value --
+ -----------------
+
+ overriding procedure Parse_Value
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Index : in out Natural;
+ Result : in out Items.Generic_Type_Access;
+ Repeat_Num : out Positive) is
+ pragma Unreferenced (Lang, Type_Str, Index, Repeat_Num);
+ begin
+ -- ???
+ Result := null;
+ end Parse_Value;
+
+ ----------------------
+ -- Parse_Array_Type --
+ ----------------------
+
+ overriding procedure Parse_Array_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Start_Of_Dim : Natural;
+ Result : out Generic_Type_Access)
+ is
+ begin
+ -- ???
+ null;
+ end Parse_Array_Type;
+
+ -----------------------
+ -- Parse_Record_Type --
+ -----------------------
+
+ overriding procedure Parse_Record_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Is_Union : Boolean;
+ Result : out Generic_Type_Access;
+ End_On : String)
+ is
+ begin
+ -- ???
+ null;
+ end Parse_Record_Type;
+
+ -----------------------
+ -- Parse_Array_Value --
+ -----------------------
+
+ overriding procedure Parse_Array_Value
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Index : in out Natural;
+ Result : in out Array_Type_Access)
+ is
+ begin
+ -- ???
+ null;
+ end Parse_Array_Value;
+
+ -----------------------------------
+ -- Get_Language_Debugger_Context --
+ -----------------------------------
+
+ overriding function Get_Language_Debugger_Context
+ (Lang : access VMS_Ada_Language) return Language_Debugger_Context
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return (Record_Field_Length => 2,
+ Record_Start => '(',
+ Record_End => ')',
+ Array_Start => '(',
+ Array_End => ')',
+ Record_Field => "=>");
+ end Get_Language_Debugger_Context;
+
+ ------------------
+ -- Set_Variable --
+ ------------------
+
+ overriding function Set_Variable
+ (Lang : access VMS_Ada_Language;
+ Var_Name : String;
+ Value : String) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return "deposit " & Var_Name & " = " & Value;
+ end Set_Variable;
+
+ -----------
+ -- Start --
+ -----------
+
+ overriding function Start
+ (Debugger : access VMS_Ada_Language) return String
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ return "go";
+ end Start;
+
+ ---------------------------
+ -- Can_Tooltip_On_Entity --
+ ---------------------------
+
+ overriding
+ function Can_Tooltip_On_Entity
+ (Lang : access VMS_Ada_Language;
+ Entity : String) return Boolean
+ is
+ pragma Unreferenced (Lang, Entity);
+ begin
+ return True;
+ end Can_Tooltip_On_Entity;
+
+end Debugger.VMS.Ada;
============================================================
--- gvd/gvd/debugger-vms-ada.ads c3e3f82a0090407a5b4959359ed831d01a035dd7
+++ gvd/gvd/debugger-vms-ada.ads c3e3f82a0090407a5b4959359ed831d01a035dd7
@@ -0,0 +1,158 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2008, AdaCore --
+-- --
+-- GVD is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+-- This package defines the object VMS_Ada_Language that provides support
+-- for the Ada language in VMS Debug.
+--
+-- See language.ads and language-debugger.ads for a complete spec.
+
+with Items.Arrays;
+with Language; use Language;
+with Language.Debugger;
+with GNAT.Expect;
+
+package Debugger.VMS.Ada is
+
+ type VMS_Ada_Language is new
+ Language.Debugger.Language_Debugger with private;
+
+ --------------------
+ -- Simple Parsing --
+ --------------------
+
+ overriding function Is_Simple_Type
+ (Lang : access VMS_Ada_Language; Str : String) return Boolean;
+
+ overriding function Keywords
+ (Lang : access VMS_Ada_Language)
+ return GNAT.Expect.Pattern_Matcher_Access;
+
+ overriding function Keywords
+ (Lang : access VMS_Ada_Language) return GNAT.Strings.String_List;
+
+ overriding function Get_Language_Context
+ (Lang : access VMS_Ada_Language) return Language.Language_Context_Access;
+
+ --------------
+ -- Explorer --
+ --------------
+
+ overriding function Explorer_Regexps
+ (Lang : access VMS_Ada_Language) return Language.Explorer_Categories;
+
+ overriding function Is_System_File
+ (Lang : access VMS_Ada_Language; File_Name : String) return Boolean;
+
+ ------------------------
+ -- Naming conventions --
+ ------------------------
+
+ overriding function Dereference_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String) return String;
+
+ overriding function Array_Item_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String;
+ Index : String) return String;
+
+ overriding function Record_Field_Name
+ (Lang : access VMS_Ada_Language;
+ Name : String;
+ Field : String) return String;
+
+ ---------------------
+ -- Project support --
+ ---------------------
+
+ overriding function Get_Project_Fields
+ (Lang : access VMS_Ada_Language) return Project_Field_Array;
+
+ -------------
+ -- Parsing --
+ -------------
+
+ overriding procedure Parse_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Result : out Items.Generic_Type_Access);
+
+ overriding procedure Parse_Value
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Index : in out Natural;
+ Result : in out Items.Generic_Type_Access;
+ Repeat_Num : out Positive);
+
+ overriding function Break_Exception
+ (Debugger : access VMS_Ada_Language;
+ Name : String := "";
+ Temporary : Boolean := False;
+ Unhandled : Boolean := False) return String;
+
+ overriding procedure Parse_Array_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Start_Of_Dim : Natural;
+ Result : out Items.Generic_Type_Access);
+
+ overriding procedure Parse_Record_Type
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Entity : String;
+ Index : in out Natural;
+ Is_Union : Boolean;
+ Result : out Items.Generic_Type_Access;
+ End_On : String);
+
+ overriding procedure Parse_Array_Value
+ (Lang : access VMS_Ada_Language;
+ Type_Str : String;
+ Index : in out Natural;
+ Result : in out Items.Arrays.Array_Type_Access);
+
+ overriding function Set_Variable
+ (Lang : access VMS_Ada_Language;
+ Var_Name : String;
+ Value : String) return String;
+
+ overriding function Start
+ (Debugger : access VMS_Ada_Language) return String;
+
+ overriding function Get_Language_Debugger_Context
+ (Lang : access VMS_Ada_Language)
+ return Language.Debugger.Language_Debugger_Context;
+
+ overriding function Can_Tooltip_On_Entity
+ (Lang : access VMS_Ada_Language;
+ Entity : String) return Boolean;
+
+private
+
+ type VMS_Ada_Language is new
+ Language.Debugger.Language_Debugger with null record;
+
+ overriding function Get_Name (Lang : access VMS_Ada_Language) return String;
+ -- See inherited documentation
+
+end Debugger.VMS.Ada;
============================================================
--- gvd/gvd/debugger-vms.adb 8ee8ed781cb99dcd341163d52362ab300e9fe930
+++ gvd/gvd/debugger-vms.adb 8ee8ed781cb99dcd341163d52362ab300e9fe930
@@ -0,0 +1,1114 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with GNAT.Expect; use GNAT.Expect;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Regpat; use GNAT.Regpat;
+
+with Basic_Types; use Basic_Types;
+with Process_Proxies; use Process_Proxies;
+with GVD.Process; use GVD.Process;
+with GVD.Types; use GVD.Types;
+with String_Utils; use String_Utils;
+with Language; use Language;
+with Language.Debugger; use Language.Debugger;
+with Debugger.VMS.Ada; use Debugger.VMS.Ada;
+
+package body Debugger.VMS is
+
+ Prompt_Regexp : constant Pattern_Matcher :=
+ Compile ("^DBG> ", Multiple_Lines);
+ -- Regular expressions used to recognize the prompt.
+ -- Note that this regexp needs to be as simple as possible, since it will
+ -- be used several times when receiving long results from commands.
+
+ Prompt_Length : constant := 5;
+ -- Length of the prompt ("DBG> ")
+
+ Highlight_Pattern : constant Pattern_Matcher :=
+ Compile ("^DBG> ", Multiple_Lines);
+ -- Matches everything that should be highlighted in the debugger window
+
+ File_Name_Pattern : constant Pattern_Matcher :=
+ Compile ("^stepped to (.+)\.%LINE (\d+)$", Multiple_Lines);
+ -- Matches a file name/line indication in debug's output
+
+ function Temp_String (Temporary : Boolean) return String;
+ -- Return temporary qualifier for breakpoints if temporary is
+ -- true, a space otherwise.
+
+ procedure Add_BP (Debugger : access VMS_Debugger; Expr : String);
+ -- Add breakpoint in Debugger
+
+ procedure Remove_BP
+ (Debugger : access VMS_Debugger; Num : GVD.Types.Breakpoint_Identifier);
+ -- Remove breakpoint from Debugger
+
+ function Get_BP
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier) return String;
+ -- Return given breakpoint from Debugger
+
+ ------------
+ -- Add_BP --
+ ------------
+
+ procedure Add_BP (Debugger : access VMS_Debugger; Expr : String) is
+ begin
+ for J in Debugger.Breakpoints'Range loop
+ if Length (Debugger.Breakpoints (J).Expression) = 0 then
+ Set_Unbounded_String (Debugger.Breakpoints (J).Expression, Expr);
+ end if;
+ end loop;
+ end Add_BP;
+
+ ---------------
+ -- Remove_BP --
+ ---------------
+
+ procedure Remove_BP
+ (Debugger : access VMS_Debugger; Num : GVD.Types.Breakpoint_Identifier) is
+ begin
+ Set_Unbounded_String
+ (Debugger.Breakpoints (Integer (Num)).Expression, "");
+ end Remove_BP;
+
+ ------------
+ -- Get_BP --
+ ------------
+
+ function Get_BP
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier) return String
+ is
+ begin
+ return To_String (Debugger.Breakpoints (Integer (Num)).Expression);
+ end Get_BP;
+
+ -----------
+ -- Spawn --
+ -----------
+
+ overriding
+ procedure Spawn
+ (Debugger : access VMS_Debugger;
+ Kernel : access GPS.Kernel.Kernel_Handle_Record'Class;
+ Executable : GNATCOLL.VFS.Virtual_File;
+ Debugger_Args : GNAT.Strings.String_List;
+ Executable_Args : String;
+ Proxy : Process_Proxies.Process_Proxy_Access;
+ Window : Gtk.Window.Gtk_Window;
+ Remote_Target : String := "";
+ Remote_Protocol : String := "";
+ Debugger_Name : String := "")
+ is
+ pragma Unreferenced
+ (Debugger_Args, Window, Remote_Target, Remote_Protocol, Debugger_Name);
+
+ Exec_Args : Argument_List_Access :=
+ Argument_String_To_List (Executable_Args);
+ Args : Argument_List (1 .. 2 + Exec_Args'Length);
+
+ begin
+ Args (1) := new String'("/debug");
+ Args (2) := new String'(Executable.Base_Name);
+ Args (3 .. Args'Last) := Exec_Args.all;
+ Unchecked_Free (Exec_Args);
+
+ Debugger.Executable := Executable;
+ General_Spawn (Debugger, Kernel, Args, "run", Proxy);
+
+ for J in Args'Range loop
+ Free (Args (J));
+ end loop;
+ end Spawn;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ overriding
+ procedure Initialize (Debugger : access VMS_Debugger) is
+ Language : Language_Access;
+ begin
+ -- Wait for initial output and prompt
+ Wait_Prompt (Debugger);
+ Debugger.Execution_Window := False;
+ Display_Prompt (Debugger);
+
+ Language := new VMS_Ada_Language;
+ Set_Debugger
+ (Language_Debugger_Access (Language), Debugger.all'Access);
+ Set_Language (Debugger, Language);
+ end Initialize;
+
+ --------------------------
+ -- Highlighting_Pattern --
+ --------------------------
+
+ overriding function Highlighting_Pattern
+ (Debugger : access VMS_Debugger)
+ return GNAT.Regpat.Pattern_Matcher
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ return Highlight_Pattern;
+ end Highlighting_Pattern;
+
+ -----------
+ -- Close --
+ -----------
+
+ overriding procedure Close (Debugger : access VMS_Debugger) is
+ begin
+ if Get_Process (Debugger) /= null
+ and then Get_Descriptor (Get_Process (Debugger)) /= null
+ and then Get_Pid (Get_Descriptor (Get_Process (Debugger)).all) /=
+ GNAT.Expect.Invalid_Pid
+ then
+ if Command_In_Process (Debugger.Process) then
+ Interrupt (Debugger);
+ end if;
+
+ -- Now exit the debugger
+ Send (Debugger, "quit", Wait_For_Prompt => False, Mode => Internal);
+ end if;
+
+ Close (Debugger_Root (Debugger.all)'Access);
+ end Close;
+
+ -----------------
+ -- Wait_Prompt --
+ -----------------
+
+ overriding procedure Wait_Prompt
+ (Debugger : access VMS_Debugger)
+ is
+ Num : Expect_Match;
+ pragma Unreferenced (Num);
+ begin
+ Wait (Get_Process (Debugger), Num, Prompt_Regexp, Timeout => -1);
+ end Wait_Prompt;
+
+ overriding function Wait_Prompt
+ (Debugger : access VMS_Debugger;
+ Timeout : Integer)
+ return Boolean
+ is
+ Num : Expect_Match;
+ begin
+ Wait (Get_Process (Debugger), Num, Prompt_Regexp, Timeout => Timeout);
+ return Num /= Expect_Timeout;
+ end Wait_Prompt;
+
+ --------------------
+ -- Display_Prompt --
+ --------------------
+
+ overriding procedure Display_Prompt
+ (Debugger : access VMS_Debugger)
+ is
+ Proc : constant Visual_Debugger := Convert (Debugger);
+ begin
+ if Proc /= null then
+ Output_Text
+ (Proc, "DBG> ",
+ Is_Command => False,
+ Set_Position => True);
+ end if;
+ end Display_Prompt;
+
+ -------------
+ -- Type_Of --
+ -------------
+
+ overriding
+ function Type_Of
+ (Debugger : access VMS_Debugger;
+ Entity : String)
+ return String
+ is
+ pragma Unreferenced (Debugger, Entity);
+ begin
+ -- ???
+ return "";
+ end Type_Of;
+
+ -----------------
+ -- Info_Locals --
+ -----------------
+
+ overriding
+ function Info_Locals
+ (Debugger : access VMS_Debugger)
+ return String
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ -- ???
+ return "";
+ end Info_Locals;
+
+ ---------------
+ -- Info_Args --
+ ---------------
+
+ overriding function Info_Args
+ (Debugger : access VMS_Debugger)
+ return String
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ -- ???
+ return "";
+ end Info_Args;
+
+ --------------------
+ -- Info_Registers --
+ --------------------
+
+ overriding function Info_Registers
+ (Debugger : access VMS_Debugger) return String is
+ begin
+ return Send (Debugger, "dump/quadword r1:r39");
+ end Info_Registers;
+
+ --------------
+ -- Value_Of --
+ --------------
+
+ subtype String_4 is String (1 .. 4);
+ Fmt_Array : constant array (Value_Format) of String_4 :=
+ (Default_Format => " ",
+ Decimal => "/dec",
+ Binary => "/bin",
+ Hexadecimal => "/hex",
+ Octal => "/oct");
+ -- Array used by Value_Of to print values in various formats
+
+ overriding function Value_Of
+ (Debugger : access VMS_Debugger;
+ Entity : String;
+ Format : Value_Format := Default_Format)
+ return String
+ is
+ S : constant String :=
+ Send (Debugger, "evaluate" & Fmt_Array (Format) & ' ' & Entity,
+ Mode => Internal);
+
+ begin
+ -- The value is valid only if it starts with '$'
+
+ if S = ""
+ or else (S'Length >= 7
+ and then S (S'First .. S'First + 6) = "%DEBUG-")
+ then
+ return "";
+ end if;
+
+ return S;
+ end Value_Of;
+
+ ---------------------
+ -- Print_Value_Cmd --
+ ---------------------
+
+ overriding
+ function Print_Value_Cmd
+ (Debugger : access VMS_Debugger;
+ Entity : String)
+ return String
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ return "evaluate " & Entity;
+ end Print_Value_Cmd;
+
+ ----------------------
+ -- Change_Directory --
+ ----------------------
+
+ overriding
+ procedure Change_Directory
+ (Debugger : access VMS_Debugger;
+ Dir : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Change_Directory;
+
+ ---------------------
+ -- Found_File_Name --
+ ---------------------
+
+ overriding
+ procedure Found_File_Name
+ (Debugger : access VMS_Debugger;
+ Str : String;
+ Name_First : out Natural;
+ Name_Last : out Positive;
+ First, Last : out Natural;
+ Line : out Natural;
+ Addr_First : out Natural;
+ Addr_Last : out Natural)
+ is
+ pragma Unreferenced (Debugger);
+
+ Start : Natural := Str'First;
+ Matched : Match_Array (0 .. 2);
+ Matched2 : Match_Array (0 .. 2);
+
+ begin
+ -- Search for the last file reference in the output. There might be
+ -- several of them, for instance when we hit a breakpoint with an
+ -- associated 'up' command.
+
+ Matched (0) := No_Match;
+
+ loop
+ Match (File_Name_Pattern, Str (Start .. Str'Last), Matched2);
+ exit when Matched2 (0) = No_Match;
+ Matched := Matched2;
+ Start := Matched (0).Last + 1;
+ end loop;
+
+ First := Matched (0).First;
+ Last := Matched (0).Last;
+
+ if Last < Str'Last and then Str (Last + 1) = ASCII.LF then
+ Last := Last + 1;
+ end if;
+
+ Name_First := Matched (1).First;
+ Name_Last := Matched (1).Last;
+ Addr_First := 0;
+ Addr_Last := 0;
+ Line := Natural'Value
+ (Str (Matched (2).First .. Matched (2).Last));
+ end Found_File_Name;
+
+ ----------------------
+ -- Found_Frame_Info --
+ ----------------------
+
+ overriding
+ procedure Found_Frame_Info
+ (Debugger : access VMS_Debugger;
+ Str : String;
+ First, Last : out Natural;
+ Message : out Frame_Info_Type)
+ is
+ pragma Unreferenced (Debugger, Str, Message);
+ begin
+ -- ???
+ First := 0;
+ Last := 0;
+ end Found_Frame_Info;
+
+ -----------------------
+ -- Source_Files_List --
+ -----------------------
+
+ overriding
+ function Source_Files_List
+ (Debugger : access VMS_Debugger) return GNAT.Strings.String_List
+ is
+ S : constant String := Send (Debugger, "show module");
+ pragma Unreferenced (S);
+ begin
+ -- Parse "show module" output ???
+ return (1 .. 0 => <>);
+ end Source_Files_List;
+
+ --------------------
+ -- Set_Executable --
+ --------------------
+
+ overriding
+ procedure Set_Executable
+ (Debugger : access VMS_Debugger;
+ Executable : GNATCOLL.VFS.Virtual_File;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Debugger.Executable := Executable;
+ Send (Debugger, "set image " & Executable.Base_Name, Mode => Mode);
+ end Set_Executable;
+
+ --------------------
+ -- Get_Executable --
+ --------------------
+
+ overriding function Get_Executable
+ (Debugger : access VMS_Debugger)
+ return GNATCOLL.VFS.Virtual_File
+ is
+ begin
+ return Debugger.Executable;
+ end Get_Executable;
+
+ --------------------
+ -- Load_Core_File --
+ --------------------
+
+ overriding procedure Load_Core_File
+ (Debugger : access VMS_Debugger;
+ Core : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Load_Core_File;
+
+ -----------------
+ -- Add_Symbols --
+ -----------------
+
+ overriding procedure Add_Symbols
+ (Debugger : access VMS_Debugger;
+ Module : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Add_Symbols;
+
+ ---------
+ -- Run --
+ ---------
+
+ overriding procedure Run
+ (Debugger : access VMS_Debugger;
+ Arguments : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Arguments);
+ begin
+ Send (Debugger, "go", Mode => Mode);
+ Set_Is_Started (Debugger, True);
+ end Run;
+
+ -----------
+ -- Start --
+ -----------
+
+ overriding procedure Start
+ (Debugger : access VMS_Debugger;
+ Arguments : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Arguments);
+ begin
+ Send (Debugger, "go", Mode => Mode);
+ Set_Is_Started (Debugger, True);
+ end Start;
+
+ --------------------
+ -- Attach_Process --
+ --------------------
+
+ overriding procedure Attach_Process
+ (Debugger : access VMS_Debugger;
+ Process : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Attach_Process;
+
+ --------------------
+ -- Detach_Process --
+ --------------------
+
+ overriding procedure Detach_Process
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Detach_Process;
+
+ ------------------
+ -- Kill_Process --
+ ------------------
+
+ overriding procedure Kill_Process
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ -- ???
+ null;
+ end Kill_Process;
+
+ ---------------
+ -- Step_Into --
+ ---------------
+
+ overriding procedure Step_Into
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ -- ???
+ null;
+ end Step_Into;
+
+ ---------------
+ -- Step_Over --
+ ---------------
+
+ overriding procedure Step_Over
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send (Debugger, "step/over", Mode => Mode);
+ end Step_Over;
+
+ ---------------------------
+ -- Step_Into_Instruction --
+ ---------------------------
+
+ overriding procedure Step_Into_Instruction
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send (Debugger, "step/into/instruction", Mode => Mode);
+ end Step_Into_Instruction;
+
+ ---------------------------
+ -- Step_Over_Instruction --
+ ---------------------------
+
+ overriding procedure Step_Over_Instruction
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send (Debugger, "step/over/instruction", Mode => Mode);
+ end Step_Over_Instruction;
+
+ --------------
+ -- Continue --
+ --------------
+
+ overriding procedure Continue
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send (Debugger, "go", Mode => Mode);
+ end Continue;
+
+ ---------------
+ -- Interrupt --
+ ---------------
+
+ overriding procedure Interrupt (Debugger : access VMS_Debugger) is
+ Proxy : constant Process_Proxy_Access := Get_Process (Debugger);
+ Descriptor : constant Process_Descriptor_Access :=
+ Get_Descriptor (Proxy);
+
+ begin
+ Interrupt (Descriptor.all);
+ Set_Interrupted (Proxy);
+ end Interrupt;
+
+ --------------------------
+ -- Is_Execution_Command --
+ --------------------------
+
+ overriding function Is_Execution_Command
+ (Debugger : access VMS_Debugger;
+ Command : String)
+ return Boolean
+ is
+ pragma Unreferenced (Debugger, Command);
+ begin
+ -- ???
+ return True;
+ end Is_Execution_Command;
+
+ ------------------------
+ -- Is_Context_Command --
+ ------------------------
+
+ overriding function Is_Context_Command
+ (Debugger : access VMS_Debugger;
+ Command : String)
+ return Boolean
+ is
+ pragma Unreferenced (Debugger, Command);
+ begin
+ -- ???
+ return False;
+ end Is_Context_Command;
+
+ ---------------------
+ -- Is_Load_Command --
+ ---------------------
+
+ overriding function Is_Load_Command
+ (Debugger : access VMS_Debugger;
+ Command : String)
+ return Boolean
+ is
+ pragma Unreferenced (Debugger, Command);
+ begin
+ -- ???
+ return False;
+ end Is_Load_Command;
+
+ ----------------------
+ -- Is_Break_Command --
+ ----------------------
+
+ overriding
+ function Is_Break_Command
+ (Debugger : access VMS_Debugger;
+ Command : String)
+ return Boolean
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ -- ???
+ return Command'Length > 9
+ and then Command (Command'First .. Command'First + 9) = "set break";
+ end Is_Break_Command;
+
+ ----------------
+ -- Stack_Down --
+ ----------------
+
+ overriding procedure Stack_Down
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ -- ???
+ null;
+ end Stack_Down;
+
+ --------------
+ -- Stack_Up --
+ --------------
+
+ overriding procedure Stack_Up
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ -- ???
+ null;
+ end Stack_Up;
+
+ -----------------
+ -- Stack_Frame --
+ -----------------
+
+ overriding procedure Stack_Frame
+ (Debugger : access VMS_Debugger;
+ Frame : Positive;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ -- ???
+ null;
+ end Stack_Frame;
+
+ ------------
+ -- Finish --
+ ------------
+
+ overriding procedure Finish
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send (Debugger, "step/return", Mode => Mode);
+ end Finish;
+
+ ---------------
+ -- Backtrace --
+ ---------------
+
+ overriding
+ procedure Backtrace
+ (Debugger : access VMS_Debugger;
+ Value : out Backtrace_Array;
+ Len : out Natural)
+ is
+ pragma Unreferenced (Value);
+
+ S : constant String := Send (Debugger, "show calls", Mode => Internal);
+ pragma Unreferenced (S);
+ begin
+ -- ???
+ Len := 0;
+ end Backtrace;
+
+ -----------------
+ -- Temp_String --
+ -----------------
+
+ function Temp_String (Temporary : Boolean) return String is
+ begin
+ if Temporary then
+ return "/temp ";
+ else
+ return " ";
+ end if;
+ end Temp_String;
+
+ ----------------------
+ -- Break_Subprogram --
+ ----------------------
+
+ overriding procedure Break_Subprogram
+ (Debugger : access VMS_Debugger;
+ Name : String;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send
+ (Debugger, "set break" & Temp_String (Temporary) & Name, Mode => Mode);
+
+ if not Temporary then
+ Add_BP (Debugger, Name);
+ end if;
+ end Break_Subprogram;
+
+ ------------------
+ -- Break_Source --
+ ------------------
+
+ overriding
+ procedure Break_Source
+ (Debugger : access VMS_Debugger;
+ File : GNATCOLL.VFS.Virtual_File;
+ Line : Positive;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ S : constant String :=
+ File.Base_Name & "\%LINE " & Image (Line);
+ begin
+ Send
+ (Debugger,
+ "set break" & Temp_String (Temporary) & S,
+ Mode => Mode);
+
+ if not Temporary then
+ Add_BP (Debugger, S);
+ end if;
+ end Break_Source;
+
+ ---------------------
+ -- Break_Exception --
+ ---------------------
+
+ overriding
+ procedure Break_Exception
+ (Debugger : access VMS_Debugger;
+ Name : String := "";
+ Temporary : Boolean := False;
+ Unhandled : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Name);
+ begin
+ if not Unhandled then
+ Send
+ (Debugger,
+ "set break" & Temp_String (Temporary) & "/exception",
+ Mode => Mode);
+
+ if not Temporary then
+ Add_BP (Debugger, "/exception");
+ end if;
+ end if;
+ end Break_Exception;
+
+ -------------------
+ -- Break_Address --
+ -------------------
+
+ overriding
+ procedure Break_Address
+ (Debugger : access VMS_Debugger;
+ Address : GVD.Types.Address_Type;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ S : constant String := Address_To_String (Address);
+ S2 : constant String := "%HEX " & S (S'First + 2 .. S'Last);
+ begin
+ Send
+ (Debugger,
+ "set break" & Temp_String (Temporary) & S2,
+ Mode => Mode);
+
+ if not Temporary then
+ Add_BP (Debugger, S2);
+ end if;
+ end Break_Address;
+
+ ------------------
+ -- Break_Regexp --
+ ------------------
+
+ overriding procedure Break_Regexp
+ (Debugger : access VMS_Debugger;
+ Regexp : String;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ Send
+ (Debugger,
+ "set break" & Temp_String (Temporary) & Regexp, Mode => Mode);
+
+ if not Temporary then
+ Add_BP (Debugger, Regexp);
+ end if;
+ end Break_Regexp;
+
+ -----------------------
+ -- Enable_Breakpoint --
+ -----------------------
+
+ overriding procedure Enable_Breakpoint
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Enable : Boolean := True;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ S : constant String := Get_BP (Debugger, Num);
+ begin
+ if Enable then
+ Send (Debugger, "activate break " & S, Mode => Mode);
+ else
+ Send (Debugger, "deactivate break " & S, Mode => Mode);
+ end if;
+ end Enable_Breakpoint;
+
+ -----------------------
+ -- Remove_Breakpoint --
+ -----------------------
+
+ overriding procedure Remove_Breakpoint
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ S : constant String := Get_BP (Debugger, Num);
+ begin
+ Send (Debugger, "cancel break " & S, Mode => Mode);
+ Remove_BP (Debugger, Num);
+ end Remove_Breakpoint;
+
+ ----------------------
+ -- List_Breakpoints --
+ ----------------------
+
+ overriding
+ function List_Breakpoints
+ (Debugger : access VMS_Debugger)
+ return GVD.Types.Breakpoint_Array
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ -- ???
+ return (1 .. 0 => <>);
+ end List_Breakpoints;
+
+ ----------------------------
+ -- Get_Last_Breakpoint_Id --
+ ----------------------------
+
+ overriding function Get_Last_Breakpoint_Id
+ (Debugger : access VMS_Debugger)
+ return GVD.Types.Breakpoint_Identifier
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ -- ???
+ return 0;
+ end Get_Last_Breakpoint_Id;
+
+ -----------
+ -- Watch --
+ -----------
+
+ overriding
+ procedure Watch
+ (Debugger : access VMS_Debugger;
+ Name : String;
+ Trigger : GVD.Types.Watchpoint_Trigger;
+ Condition : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Trigger);
+ begin
+ if Condition = "" then
+ Send (Debugger, "set watch " & Name, Mode => Mode);
+ else
+ Send
+ (Debugger, "set watch " & Name & "when " & Condition, Mode => Mode);
+ end if;
+ end Watch;
+
+ ----------------------
+ -- Get_Machine_Code --
+ ----------------------
+
+ overriding procedure Get_Machine_Code
+ (Debugger : access VMS_Debugger;
+ Range_Start : out GVD.Types.Address_Type;
+ Range_End : out GVD.Types.Address_Type;
+ Code : out GNAT.Strings.String_Access;
+ Start_Address : GVD.Types.Address_Type := GVD.Types.Invalid_Address;
+ End_Address : GVD.Types.Address_Type := GVD.Types.Invalid_Address)
+ is
+ begin
+ -- Generated stub: replace with real body!
+ raise Program_Error;
+ end Get_Machine_Code;
+
+ ----------------------
+ -- Get_Line_Address --
+ ----------------------
+
+ overriding procedure Get_Line_Address
+ (Debugger : access VMS_Debugger;
+ Line : Natural;
+ Range_Start : out GVD.Types.Address_Type;
+ Range_End : out GVD.Types.Address_Type)
+ is
+ begin
+ -- Generated stub: replace with real body!
+ raise Program_Error;
+ end Get_Line_Address;
+
+ ----------------
+ -- Get_Memory --
+ ----------------
+
+ overriding
+ function Get_Memory
+ (Debugger : access VMS_Debugger;
+ Size : Integer;
+ Address : String)
+ return String
+ is
+ S : constant String := Send
+ (Debugger,
+ "dump/quadword " & Address & ":" & Address & "+" &
+ Image (Size / 8), Mode => Internal);
+ pragma Unreferenced (S);
+ begin
+ -- ??? parse S
+ return "";
+ end Get_Memory;
+
+ ---------------------
+ -- Put_Memory_Byte --
+ ---------------------
+
+ overriding procedure Put_Memory_Byte
+ (Debugger : access VMS_Debugger;
+ Address : String;
+ Byte : String)
+ is
+ begin
+ -- Generated stub: replace with real body!
+ raise Program_Error;
+ end Put_Memory_Byte;
+
+ --------------------------
+ -- Get_Variable_Address --
+ --------------------------
+
+ overriding function Get_Variable_Address
+ (Debugger : access VMS_Debugger;
+ Variable : String)
+ return String
+ is
+ begin
+ -- Generated stub: replace with real body!
+ raise Program_Error;
+ return "";
+ end Get_Variable_Address;
+
+ ---------------------
+ -- Get_Endian_Type --
+ ---------------------
+
+ overriding function Get_Endian_Type
+ (Debugger : access VMS_Debugger) return Endian_Type
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ return Little_Endian;
+ end Get_Endian_Type;
+
+ --------------
+ -- Complete --
+ --------------
+
+ overriding function Complete
+ (Debugger : access VMS_Debugger;
+ Beginning : String)
+ return GNAT.Strings.String_List
+ is
+ pragma Unreferenced (Debugger, Beginning);
+ begin
+ return (1 .. 0 => <>);
+ end Complete;
+
+ ----------
+ -- Send --
+ ----------
+
+ overriding
+ function Send
+ (Debugger : access VMS_Debugger;
+ Cmd : String;
+ Mode : GVD.Types.Invisible_Command := GVD.Types.Hidden)
+ return String
+ is
+ S : constant String := Send_Full (Debugger, Cmd, Mode);
+ Pos : Integer := S'Last - Prompt_Length;
+ begin
+ if S'Length <= Prompt_Length then
+ return "";
+ end if;
+
+ if S (Pos) = ASCII.LF then
+ Pos := Pos - 1;
+ end if;
+
+ return S (S'First .. Pos);
+ end Send;
+
+end Debugger.VMS;
============================================================
--- gvd/gvd/debugger-vms.ads a210863f1b3ffd14955be0901eaccb6a1bd9478d
+++ gvd/gvd/debugger-vms.ads a210863f1b3ffd14955be0901eaccb6a1bd9478d
@@ -0,0 +1,358 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2008, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+-- This is the implementation of Debugger for VMS Debug
+-- See debugger.ads for complete documentation on this package.
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with GNAT.Strings;
+with Debugger;
+with GNAT.Regpat;
+with Gtk.Window;
+with GVD.Types;
+with GNATCOLL.VFS;
+
+package Debugger.VMS is
+
+ type VMS_Debugger is new Debugger.Debugger_Root with private;
+
+ overriding procedure Spawn
+ (Debugger : access VMS_Debugger;
+ Kernel : access GPS.Kernel.Kernel_Handle_Record'Class;
+ Executable : GNATCOLL.VFS.Virtual_File;
+ Debugger_Args : GNAT.Strings.String_List;
+ Executable_Args : String;
+ Proxy : Process_Proxies.Process_Proxy_Access;
+ Window : Gtk.Window.Gtk_Window;
+ Remote_Target : String := "";
+ Remote_Protocol : String := "";
+ Debugger_Name : String := "");
+
+ overriding procedure Initialize (Debugger : access VMS_Debugger);
+
+ overriding function Highlighting_Pattern
+ (Debugger : access VMS_Debugger)
+ return GNAT.Regpat.Pattern_Matcher;
+
+ overriding procedure Close (Debugger : access VMS_Debugger);
+
+ overriding procedure Wait_Prompt
+ (Debugger : access VMS_Debugger);
+
+ overriding function Wait_Prompt
+ (Debugger : access VMS_Debugger;
+ Timeout : Integer) return Boolean;
+
+ overriding procedure Display_Prompt
+ (Debugger : access VMS_Debugger);
+
+ overriding function Type_Of
+ (Debugger : access VMS_Debugger;
+ Entity : String) return String;
+
+ overriding function Info_Locals
+ (Debugger : access VMS_Debugger) return String;
+
+ overriding function Info_Args
+ (Debugger : access VMS_Debugger) return String;
+
+ overriding function Info_Registers
+ (Debugger : access VMS_Debugger) return String;
+
+ overriding function Value_Of
+ (Debugger : access VMS_Debugger;
+ Entity : String;
+ Format : Value_Format := Default_Format) return String;
+
+ overriding function Print_Value_Cmd
+ (Debugger : access VMS_Debugger;
+ Entity : String) return String;
+
+ ------------------------------
+ -- Source/Path manipulation --
+ ------------------------------
+
+ overriding procedure Change_Directory
+ (Debugger : access VMS_Debugger;
+ Dir : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Found_File_Name
+ (Debugger : access VMS_Debugger;
+ Str : String;
+ Name_First : out Natural;
+ Name_Last : out Positive;
+ First, Last : out Natural;
+ Line : out Natural;
+ Addr_First : out Natural;
+ Addr_Last : out Natural);
+
+ overriding procedure Found_Frame_Info
+ (Debugger : access VMS_Debugger;
+ Str : String;
+ First, Last : out Natural;
+ Message : out Frame_Info_Type);
+
+ overriding function Source_Files_List
+ (Debugger : access VMS_Debugger) return GNAT.Strings.String_List;
+
+ ------------------------
+ -- Execution Commands --
+ ------------------------
+
+ overriding procedure Set_Executable
+ (Debugger : access VMS_Debugger;
+ Executable : GNATCOLL.VFS.Virtual_File;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding function Get_Executable
+ (Debugger : access VMS_Debugger)
+ return GNATCOLL.VFS.Virtual_File;
+
+ overriding procedure Load_Core_File
+ (Debugger : access VMS_Debugger;
+ Core : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Add_Symbols
+ (Debugger : access VMS_Debugger;
+ Module : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Run
+ (Debugger : access VMS_Debugger;
+ Arguments : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Start
+ (Debugger : access VMS_Debugger;
+ Arguments : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Attach_Process
+ (Debugger : access VMS_Debugger;
+ Process : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Detach_Process
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Kill_Process
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Step_Into
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Step_Over
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Step_Into_Instruction
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Step_Over_Instruction
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Continue
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Interrupt (Debugger : access VMS_Debugger);
+
+ overriding function Is_Execution_Command
+ (Debugger : access VMS_Debugger;
+ Command : String) return Boolean;
+
+ overriding function Is_Context_Command
+ (Debugger : access VMS_Debugger;
+ Command : String) return Boolean;
+
+ overriding function Is_Load_Command
+ (Debugger : access VMS_Debugger;
+ Command : String) return Boolean;
+
+ overriding function Is_Break_Command
+ (Debugger : access VMS_Debugger;
+ Command : String) return Boolean;
+
+ ----------------------
+ -- Stack Management --
+ ----------------------
+
+ overriding procedure Stack_Down
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Stack_Up
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Stack_Frame
+ (Debugger : access VMS_Debugger;
+ Frame : Positive;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Finish
+ (Debugger : access VMS_Debugger;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Backtrace
+ (Debugger : access VMS_Debugger;
+ Value : out Backtrace_Array;
+ Len : out Natural);
+
+ -------------------------
+ -- Breakpoint Handling --
+ -------------------------
+
+ overriding procedure Break_Subprogram
+ (Debugger : access VMS_Debugger;
+ Name : String;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Break_Source
+ (Debugger : access VMS_Debugger;
+ File : GNATCOLL.VFS.Virtual_File;
+ Line : Positive;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Break_Exception
+ (Debugger : access VMS_Debugger;
+ Name : String := "";
+ Temporary : Boolean := False;
+ Unhandled : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Break_Address
+ (Debugger : access VMS_Debugger;
+ Address : GVD.Types.Address_Type;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Break_Regexp
+ (Debugger : access VMS_Debugger;
+ Regexp : String;
+ Temporary : Boolean := False;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Enable_Breakpoint
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Enable : Boolean := True;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding procedure Remove_Breakpoint
+ (Debugger : access VMS_Debugger;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ overriding function List_Breakpoints
+ (Debugger : access VMS_Debugger)
+ return GVD.Types.Breakpoint_Array;
+
+ overriding function Get_Last_Breakpoint_Id
+ (Debugger : access VMS_Debugger)
+ return GVD.Types.Breakpoint_Identifier;
+
+ -----------------
+ -- Watchpoints --
+ -----------------
+
+ overriding procedure Watch
+ (Debugger : access VMS_Debugger;
+ Name : String;
+ Trigger : GVD.Types.Watchpoint_Trigger;
+ Condition : String := "";
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
+
+ -------------------
+ -- Assembly code --
+ -------------------
+
+ overriding procedure Get_Machine_Code
+ (Debugger : access VMS_Debugger;
+ Range_Start : out GVD.Types.Address_Type;
+ Range_End : out GVD.Types.Address_Type;
+ Code : out GNAT.Strings.String_Access;
+ Start_Address : GVD.Types.Address_Type := GVD.Types.Invalid_Address;
+ End_Address : GVD.Types.Address_Type := GVD.Types.Invalid_Address);
+
+ overriding procedure Get_Line_Address
+ (Debugger : access VMS_Debugger;
+ Line : Natural;
+ Range_Start : out GVD.Types.Address_Type;
+ Range_End : out GVD.Types.Address_Type);
+
+ -----------------------
+ -- Memory operations --
+ -----------------------
+
+ overriding function Get_Memory
+ (Debugger : access VMS_Debugger;
+ Size : Integer;
+ Address : String) return String;
+
+ overriding procedure Put_Memory_Byte
+ (Debugger : access VMS_Debugger;
+ Address : String;
+ Byte : String);
+
+ overriding function Get_Variable_Address
+ (Debugger : access VMS_Debugger;
+ Variable : String) return String;
+
+ overriding function Get_Endian_Type
+ (Debugger : access VMS_Debugger) return Endian_Type;
+
+ -----------------------------
+ -- Command Line operations --
+ -----------------------------
+
+ overriding function Complete
+ (Debugger : access VMS_Debugger;
+ Beginning : String) return GNAT.Strings.String_List;
+
+private
+
+ overriding function Send
+ (Debugger : access VMS_Debugger;
+ Cmd : String;
+ Mode : GVD.Types.Invisible_Command := GVD.Types.Hidden)
+ return String;
+
+ type Breakpoint_Record is record
+ Expression : Unbounded_String;
+ end record;
+
+ type BP_Array is array (Integer range <>) of Breakpoint_Record;
+
+ Max_BP : constant := 128;
+ type VMS_Debugger is new Debugger.Debugger_Root with record
+ Executable : GNATCOLL.VFS.Virtual_File;
+ Breakpoints : BP_Array (1 .. Max_BP);
+ end record;
+
+end Debugger.VMS;
============================================================
--- kernel/src_info/sn/sn.gpr e8f2b56c1d4d707163224c544b75689fcae08dee
+++ kernel/src_info/sn/sn.gpr e8f2b56c1d4d707163224c544b75689fcae08dee
@@ -0,0 +1,10 @@
+project SN is
+
+ for Source_Dirs use ();
+ for Externally_Built use "true";
+
+ package Linker is
+ for Linker_Options use ("lib/db_capi.o", "snsrc/db/PORT/libdb.a");
+ end Linker;
+
+end SN;
============================================================
--- Makefile.gnat fa78ef75b415765154638f9771759835de219362
+++ Makefile.gnat 025e9ed5b8a9c640833b402835ebdbca59473fdf
@@ -82,8 +82,6 @@ GNAT_SOURCES= \
scng.ads \
scng.adb \
sdefault.ads \
- sinfo-cn.ads \
- sinfo-cn.adb \
sinput-c.ads \
sinput-c.adb \
sinput-p.ads \
============================================================
--- Makefile.in 8411709614ccb315202e62ddeb47355aecd8d4d7
+++ Makefile.in b53cba3efe0609ecdcb2f17cc8900d8ea02ca3dd
@@ -12,27 +12,12 @@ examplesdir = $(prefix)/share/exampl
sharedir = $(prefix)/share
examplesdir = $(prefix)/share/examples/gps
-ifeq ($(Build), Production)
-TP_BUILD=Release
-else
-TP_BUILD=Debug
-endif
+default:
+ $(MAKE) -C gps $@
-export TP_TASKING = No_Tasking
-export PRJ_BUILD = $(TP_BUILD)
-export LIBRARY_TYPE = static
-
-default build compile link ada c c++: setup-tp
- $(MAKE) -s -C gps -f Makefile.gps $@
-
-setup-tp:
- $(MAKE) PRJ_BUILD=$(TP_BUILD) LIBRARY_TYPE=static \
- -C templates_parser setup
-
clean:
+ $(MAKE) -C gps $@
$(RM) gnat/*.ad*
- $(RM) obj/*.ali obj/*.o
- $(MAKE) -s -C gps -f Makefile.gps $@
test-clean:
(cd scripts; ./testsuites clean)
============================================================
--- ada_module/ada_module.gpr c096073b32ef86727b78b23c0fcb49c05a5d009e
+++ ada_module/ada_module.gpr afe1927724d253bb70f5a05b27495ee8852bcd4a
@@ -1,6 +1,7 @@ with "../prj_editor/prj_editor";
with "../kernel/kernel";
with "../shared";
with "../prj_editor/prj_editor";
+with "../gvd/gvd";
with "gtkada";
project Ada_Module is
@@ -8,6 +9,10 @@ project Ada_Module is
for Source_Dirs use ("src");
for Object_Dir use "obj";
+ package Builder is
+ for Default_Switches ("Ada") use ("-m");
+ end Builder;
+
package Compiler renames Shared.Compiler;
package IDE renames Shared.IDE;
============================================================
--- builder/src/build_command_manager.adb 8284db952775fe536af92b269b4fc1893516d429
+++ builder/src/build_command_manager.adb 99ea69df1614ac0db1a54eb0d160d14d51cdd6be
@@ -628,6 +628,8 @@ package body Build_Command_Manager is
Synchronous, Uses_Shell (T));
Change_Dir (Old_Dir);
+ Free (Full);
+
Unchecked_Free (All_Extra_Args);
end Launch_For_Mode;
============================================================
--- builder/src/builder_facility_module-scripts.adb cbf21aae426102e2abfbb6f0b47e8398e1615bec
+++ builder/src/builder_facility_module-scripts.adb 245eb44c7cf2c99c440cce0847a232f6ab14f6db
@@ -209,6 +209,7 @@ package body Builder_Facility_Module.Scr
Synchronous => True,
Dialog => Mode,
Main => Main);
+ Free (Extra_Args);
end;
elsif Command = "get_build_output" then
============================================================
--- builder/src/builder_facility_module.adb 6cd476838df33ecaaa231a5cd521e46ed1a9bbaf
+++ builder/src/builder_facility_module.adb 18507e087732b067880bb35d4f750855fc203009
@@ -438,6 +438,8 @@ package body Builder_Facility_Module is
overriding procedure Destroy (Module : in out Builder_Module_ID_Record) is
begin
+ String_List_Utils.String_List.Free (Module.Shadow_Output);
+ String_List_Utils.String_List.Free (Module.Output);
Free (Module.Registry);
end Destroy;
@@ -1243,6 +1245,7 @@ package body Builder_Facility_Module is
end if;
Free (Mains);
+ Destroy (Data);
end;
else
Button_For_Target (Get_Name (Target), (1 .. 0 => <>));
@@ -1351,6 +1354,7 @@ package body Builder_Facility_Module is
end loop;
Free (Mains);
+ Destroy (Data);
end;
else
Menu_For_Action (Parent_Path => To_String (Cat_Path),
============================================================
--- codefix/codefix.gpr 1d3ccab76a0e52b05c6d6f489a2832e2341ccdbf
+++ codefix/codefix.gpr 61159fe3cd9ac7516d56d61590fdab133dd25062
@@ -7,7 +7,7 @@ project Codefix is
project Codefix is
for Source_Dirs use ("src");
- for Languages use ("Ada");
+ for Languages use ("Ada", "C");
for Object_Dir use "obj/";
for Exec_Dir use "obj/";
============================================================
--- codefix/src/codefix-error_lists.adb d4fc850d0eb700e40aaf98d9494dac3b5def63ad
+++ codefix/src/codefix-error_lists.adb 54fae03b57ca907ad05c1a36424c76307eb64e84
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2007, AdaCore --
+-- Copyright (C) 2007-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -42,6 +42,7 @@ package body Codefix.Error_Lists is
(Error_Message_List_Record, Error_Message_List);
begin
Clear_Messages (This);
+ Free (This.File_Regexp);
Unchecked_Free (This);
end Free;
============================================================
--- common/common_no_xmlada.gpr.in ed51e7b7bf5392154a244a06d1ea53ffe7ceadc2
+++ common/common_no_xmlada.gpr.in 31d91273923875d497e3314a6d497e66f6f60349
@@ -12,6 +12,7 @@ project Common is
package Compiler is
for Default_Switches ("Ada") use Shared.Compiler'Default_Switches ("Ada");
for Switches ("test_htables.adb") use ("-g", "-O2", "-gnatwue");
+ for Switches ("s-memory.adb") use ("-g", "-O2", "-gnatpg");
case Shared.Build is
when "Production" =>
@@ -27,4 +28,9 @@ project Common is
for Implementation ("xml_parsers") use "xml_parsers_gtk.adb";
end Naming;
+ package Linker is
+ for Linker_Options use
+ @TARGET_LFLAGS@;
+ end Linker;
+
end Common;
============================================================
--- common/common_with_xmlada.gpr.in 68428482b900778acf2b3bf842b9def2811be101
+++ common/common_with_xmlada.gpr.in 2abaa8e72f4bd1d57e2389a09f9cc1f2f4d624ab
@@ -13,6 +13,7 @@ project Common is
package Compiler is
for Default_Switches ("Ada") use Shared.Compiler'Default_Switches ("Ada");
for Switches ("test_htables.adb") use ("-g", "-O2", "-gnatwue");
+ for Switches ("s-memory.adb") use ("-g", "-O2", "-gnatpg");
case Shared.Build is
when "Production" =>
@@ -32,4 +33,9 @@ project Common is
for Implementation ("xml_parsers") use "xml_parsers_xmlada.adb";
end Naming;
+ package Linker is
+ for Linker_Options use
+ @TARGET_LFLAGS@;
+ end Linker;
+
end Common;
============================================================
--- common/src/filesystems.adb c8ce53cb47c6a7f6bc1a7cc9cd8303abfc237f39
+++ common/src/filesystems.adb eb6a78b77469ca3ceee8849d83fe3febc1f387bc
@@ -208,6 +208,7 @@ package body Filesystems is
function Get_Host
(FS : access Filesystem_Record'Class) return String is
begin
+ -- ??? should use dispatching directly
if FS.all in Remote_Unix_Filesystem_Record'Class then
return Get_Host (Remote_Unix_Filesystem_Record (FS.all));
elsif FS.all in Remote_Windows_Filesystem_Record'Class then
============================================================
--- common/src/g-exttre.adb b4d9d4978d24f2a513c9e72cd7e90a4f922a9437
+++ common/src/g-exttre.adb 7c9801b656f56fb57637038f63cbd1d28489cfe7
@@ -1181,7 +1181,13 @@ package body GNAT.Expect.TTY.Remote is
Desc.Buffer (1 .. Matched (0).Last), Output);
end if;
- if Desc.Buffer'Last - Matched (0).First + 1 > Str'First then
+ -- ??? Str may only contain the last part of the matching string,
+ -- so the below code will not always work. Make sure that we at
+ -- least never compute a negative index.
+
+ if Str'Last > Desc.Buffer'Last
+ and then Desc.Buffer'Last - Matched (0).First + 1 > Str'First
+ then
Idx_Last :=
Str'Last - (Desc.Buffer'Last - Matched (0).First + 1);
else
============================================================
--- common/src/interactive_consoles.adb 032b6ca5095c0c16af1a981f766e5320732dab97
+++ common/src/interactive_consoles.adb b42fba369a7ac1d219cb42655dc0fc392bbe2fd0
@@ -67,49 +67,63 @@ package body Interactive_Consoles is
-- Interactive_Virtual_Console --
---------------------------------
- type Interactive_Virtual_Console_Record is new Virtual_Console_Record with
- record
- Console : Interactive_Console;
- Script : Scripting_Language;
- Took_Grab : Boolean := False;
- Child : MDI_Child := null;
- -- MDI_Child cached, used in Insert_Error
- end record;
+ type Interactive_Virtual_Console_Record is
+ new Virtual_Console_Record
+ with record
+ Console : Interactive_Console;
+ Script : Scripting_Language;
+ Took_Grab : Boolean := False;
+ Child : MDI_Child := null;
+ -- MDI_Child cached, used in Insert_Error
+ end record;
+
type Interactive_Virtual_Console
is access all Interactive_Virtual_Console_Record'Class;
overriding procedure Ref
(Console : access Interactive_Virtual_Console_Record);
+
overriding procedure Unref
(Console : access Interactive_Virtual_Console_Record);
+
overriding procedure Insert_Text
(Console : access Interactive_Virtual_Console_Record; Txt : String);
+
overriding procedure Insert_Log
(Console : access Interactive_Virtual_Console_Record; Txt : String);
+
overriding procedure Insert_Prompt
(Console : access Interactive_Virtual_Console_Record; Txt : String);
+
overriding procedure Insert_Error
(Console : access Interactive_Virtual_Console_Record; Txt : String);
+
overriding procedure Grab_Events
(Console : access Interactive_Virtual_Console_Record; Grab : Boolean);
+
overriding procedure Set_As_Default_Console
- (Console : access Interactive_Virtual_Console_Record;
- Script : GNATCOLL.Scripts.Scripting_Language);
+ (Console : access Interactive_Virtual_Console_Record;
+ Script : GNATCOLL.Scripts.Scripting_Language);
+
overriding procedure Set_Data_Primitive
(Instance : Class_Instance;
Console : access Interactive_Virtual_Console_Record);
+
overriding function Get_Instance
(Script : access Scripting_Language_Record'Class;
Console : access Interactive_Virtual_Console_Record)
return Class_Instance;
+
overriding procedure Process_Pending_Events_Primitive
(Console : access Interactive_Virtual_Console_Record);
+
overriding function Read
(Console : access Interactive_Virtual_Console_Record;
Size : Integer;
Whole_Line : Boolean) return String;
+
overriding procedure Clear
- (Console : access Interactive_Virtual_Console_Record);
+ (Console : access Interactive_Virtual_Console_Record);
-- See inherited subprograms
-----------------------
@@ -240,8 +254,7 @@ package body Interactive_Consoles is
-----------------
overriding procedure Insert_Text
- (Console : access Interactive_Virtual_Console_Record; Txt : String)
- is
+ (Console : access Interactive_Virtual_Console_Record; Txt : String) is
begin
if Console.Console /= null then
Insert (Console.Console, Txt, Add_LF => False, Show_Prompt => False);
@@ -622,8 +635,8 @@ package body Interactive_Consoles is
is
Last_Iter, Prompt_Iter, Tmp_Iter : Gtk_Text_Iter;
Internal : Boolean;
- Success : Boolean;
- Count : Natural := 0;
+ Success : Boolean;
+ Count : Natural := 0;
begin
-- Special case: if the text starts with ^H characters, we delete that
@@ -647,6 +660,7 @@ package body Interactive_Consoles is
Get_End_Iter (Console.Buffer, Last_Iter);
Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
+
if Get_Offset (Last_Iter) /= Get_Offset (Prompt_Iter) then
-- in user edition
Copy (Last_Iter, Dest => Tmp_Iter);
============================================================
--- common/src/interactive_consoles.ads 1ab44af0e6a04b5668fa4027d56e0ce3b32a47a9
+++ common/src/interactive_consoles.ads ee31102d1c58ca7ad274253354c9cc3874875175
@@ -226,8 +226,8 @@ package Interactive_Consoles is
-- Return the text view
function From_View
- (View : access Gtk.Text_View.Gtk_Text_View_Record'Class)
- return Interactive_Console;
+ (View : access Gtk.Text_View.Gtk_Text_View_Record'Class)
+ return Interactive_Console;
-- Return the console associated with the text view
-----------------
@@ -263,10 +263,10 @@ package Interactive_Consoles is
-- regexp is highlighted.
procedure Insert_With_Links
- (Console : access Interactive_Console_Record;
- Text : String;
- Add_LF : Boolean := True;
- Highlight : Boolean := False);
+ (Console : access Interactive_Console_Record;
+ Text : String;
+ Add_LF : Boolean := True;
+ Highlight : Boolean := False);
-- Insert text in the console, highlighting any text that matches one of
-- hyper links registered with Create_Hyper_Link.
-- Clicking on these links will call On_Click on the matching Callback.
============================================================
--- common/tests/run.sh 6d1b3aba22b5d9bcd87fae958978fb81684411a9
+++ common/tests/run.sh ebac055031f39f24b4a9834457b8d666886ca8fd
@@ -11,7 +11,7 @@ fi
exit 0
fi
-run_and_exit "make -C .."
+run_and_exit "gprbuild -q -ws -P../common test_htables.adb test_arrays.adb test_strings.adb test_trie.adb"
$valgrind ../obj/test_htables
$valgrind ../obj/test_arrays
$valgrind ../obj/test_strings
============================================================
--- completion/completion.gpr cf2b8a5d5b76f03b2a4403495d0009d6a9416f48
+++ completion/completion.gpr 8b34909fe4c664272d4b2ed6c49f9410e84bc9f1
@@ -1,7 +1,8 @@ with "../shared";
with "../kernel/kernel";
with "../common/common";
with "../shared";
-with "../ada_module/ada_module.gpr";
+with "../ada_module/ada_module";
+with "../gvd/gvd";
project Completion is
============================================================
# configure is binary
============================================================
--- configure.in 5190661de942f1f9e3a17081ead7a36e23064411
+++ configure.in 16134af8acbbe8590040a09f1360853f89a9957b
@@ -1,4 +1,4 @@
-ADC_REVISION($Revision: 131917 $)
+ADC_REVISION($Revision: 132159 $)
AC_INIT(gps/src/gps-main.adb)
AC_CANONICAL_SYSTEM
@@ -7,7 +7,7 @@ TARGET_CFLAGS=""
STRIP_CR=False
CAN_OUTPUT=True
TARGET_CFLAGS=""
-TARGET_LFLAGS=""
+TARGET_LFLAGS='()'
EXEC_COMMAND="xterm -e"
DEFAULT_FONT="sans 9"
PATH_STYLE=UNIX
@@ -58,9 +58,9 @@ AC_CHECK_LIB(util,openpty,
AC_CHECK_HEADERS(sys/stropts.h)
AC_CHECK_LIB(util,openpty,
- [AC_DEFINE(HAVE_OPENPTY) TARGET_LFLAGS="$TARGET_LFLAGS -lutil"],
+ [AC_DEFINE(HAVE_OPENPTY) TARGET_LFLAGS=$TARGET_LFLAGS' & ("-lutil")'],
[AC_CHECK_LIB(bsd,openpty,
- [AC_DEFINE(HAVE_OPENPTY) TARGET_LFLAGS="$TARGET_LFLAGS -lbsd"],
+ [AC_DEFINE(HAVE_OPENPTY) TARGET_LFLAGS=$TARGET_LFLAGS' & ("-lbsd")'],
[AC_CHECK_FUNCS(openpty)]
])
)
@@ -71,7 +71,7 @@ case "${host}" in
alpha*-dec-osf* ) EXECUTION_WINDOW=False ;;
## IBM, AIX machines
- powerpc-ibm-aix5.* ) TARGET_LFLAGS="$TARGET_LFLAGS -Wl,-bbigtoc" ;;
+ powerpc-ibm-aix5.* ) TARGET_LFLAGS=$TARGET_LFLAGS' & ("-Wl,-bbigtoc")' ;;
## PowerPC
powerpc-*-linux-gnu ) PRINT_CMD="a2ps" ;;
@@ -82,7 +82,7 @@ case "${host}" in
*-sun-solaris* \
| i[[3456]]86-*-solaris2* | i[3456]86-*-sunos5* | sparc*-linux*-gnu )
case "${host}" in
- *-sunos5* | *-solaris* ) TARGET_LFLAGS="$TARGET_LFLAGS -lXrender" ;;
+ *-sunos5* | *-solaris* ) TARGET_LFLAGS=$TARGET_LFLAGS' & ("-lXrender")' ;;
*-linux-gnu* ) PRINT_CMD="a2ps" ;;
esac;;
@@ -108,7 +108,7 @@ case "${host}" in
*win32* | *mingw32* | *cygwin* )
STRIP_CR=True
CAN_OUTPUT=False
- TARGET_LFLAGS="$TARGET_LFLAGS -luser32 -lcomdlg32 -mwindows -Wl,--stack=0x5000000"
+ TARGET_LFLAGS='("-luser32", "-lcomdlg32", "-mwindows", "-Wl,--stack=0x5000000")'
TARGET=pentium-mingw32msv
COLOR_SELECTION="#BEBEBE"
EXEC_COMMAND="cmd /c start"
@@ -171,4 +171,4 @@ AC_MSG_NOTICE([-------------------------
AC_MSG_NOTICE([ use ADA_PROJECT_PATH to find xmlada.gpr])
AC_MSG_NOTICE([--------------------------------------------------])
-AC_OUTPUT(Makefile Makefile.common gnat/sdefault/sdefault.adb docs/Makefile po/Makefile common/Makefile.common common/src/config.ads common/expect/Makefile common/common.gpr:common/common_${XMLADA_GPR}.gpr.in share/plug-ins/protocols.xml widgets/Makefile.widgets)
+AC_OUTPUT(Makefile gnat/sdefault/sdefault.adb docs/Makefile po/Makefile common/src/config.ads common/expect/Makefile common/common.gpr:common/common_${XMLADA_GPR}.gpr.in share/plug-ins/protocols.xml)
============================================================
--- distrib/doinstall 2d9b20419959ce0250b0a56971a9d3c18fb0df20
+++ distrib/doinstall 61da58431cabe7c473fb43cf3368b354cd553670
@@ -117,17 +117,23 @@ install_binaries() {
(cd $current_dir; tar cf - bin etc lib share) | tar xf -
if [ -d lib/gps-xorg ]; then
+ if [ -f lib/64 ]; then
+ lib=lib64
+ else
+ lib=lib
+ fi
+
if [ "`type Xorg 2>/dev/null | cut -d' ' -f3`" != "" ]; then
ln -s gps-xorg lib/gps
- if [ -f /usr/lib/libexpat.so.1 ]; then
- ln -s /usr/lib/libexpat.so.1 lib/gps/libexpat.so.0
+ if [ -f /usr/$lib/libexpat.so.1 ]; then
+ ln -s /usr/$lib/libexpat.so.1 lib/gps/libexpat.so.0
else
- ln -s /usr/lib/libexpat.so lib/gps/libexpat.so.1
+ ln -s /usr/$lib/libexpat.so lib/gps/libexpat.so.1
fi
else
ln -s gps-xfree lib/gps
- if [ -f /usr/lib/libexpat.so.1 ]; then
- ln -s /usr/lib/libexpat.so.1 lib/gps/libexpat.so.0
+ if [ -f /usr/$lib/libexpat.so.1 ]; then
+ ln -s /usr/$lib/libexpat.so.1 lib/gps/libexpat.so.0
fi
fi
fi
@@ -160,8 +166,7 @@ end_message() {
for csh and tcsh shells:
setenv PATH $basedir/bin:\$PATH
for sh, bash, ksh and zsh:
- PATH=$basedir/bin:\$PATH
- export PATH
+ PATH=$basedir/bin:\$PATH; export PATH
EOF
}
============================================================
--- gnatlib/aclocal.m4 b6e617700678d224a6b06ef3703b2cc09d452e0c
+++ gnatlib/aclocal.m4 2a85a459679f75754605566c1473ca8026b15555
@@ -149,12 +149,7 @@ AC_HELP_STRING(
# @PYTHON_VERSION@: Version of python detected
# @PYTHON_CFLAGS@: Compiler flags to use for python code
# @PYTHON_DIR@: Directory for libpython.so
-# @PYTHON_LIBS@: extra command line switches to pass to the linker
-# In some cases, -lpthread should be added. We do not
-# add this systematically, to allow you to recompile
-# your own libpython and avoid dragging the tasking
-# Ada runtime in your application if you do not use it
-# otherwise
+# @PYTHON_LIBS@: extra command line switches to pass to the linker.
# @WITH_PYTHON@: either "yes" or "no" depending on whether
# python support is available.
#############################################################
@@ -294,11 +289,7 @@ AC_HELP_STRING(
fi
# Automatically check whether some libraries are needed to link with
- # the python libraries. If you are using the default system library, it is
- # generally the case that at least -lpthread will be needed. But you might
- # also have recompiled your own version, and if it doesn't depend on
- # pthreads, we shouldn't bring that in, since that also impacts the choice
- # of the GNAT runtime
+ # the python libraries.
CFLAGS="${CFLAGS} ${PYTHON_CFLAGS}"
LIBS="${LIBS} ${PYTHON_LIBS}"
@@ -307,15 +298,20 @@ AC_HELP_STRING(
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([#include <Python.h>],[Py_Initialize();])],
[AC_MSG_RESULT(yes)],
- [LIBS="${LIBS} -lpthread -lutil"
+ [LIBS="${LIBS} -lutil"
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([#include <Python.h>],[Py_Initialize();])],
- [PYTHON_LIBS="${PYTHON_LIBS} -lpthread -lutil"
+ [PYTHON_LIBS="${PYTHON_LIBS} -lutil"
AC_MSG_RESULT(yes)],
- [AC_MSG_RESULT(no, [can't compile and link python example])
- WITH_PYTHON=no
- PYTHON_BASE=[]
- PYTHON_LIBS=[]])])
+ [LIBS="${LIBS} -lpthread"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([#include <Python.h>],[Py_Initialize();])],
+ [PYTHON_LIBS="${PYTHON_LIBS} -lpthread -lutil"
+ AC_MSG_RESULT(yes)],
+ [AC_MSG_RESULT(no, [can't compile and link python example])
+ WITH_PYTHON=no
+ PYTHON_BASE=[]
+ PYTHON_LIBS=[]])])])
fi
AC_SUBST(PYTHON_BASE)
============================================================
--- gnatlib/configure dac8c5731f6966303847c3339bd66cb73032eca3
+++ gnatlib/configure f92507d8dc93c9be52358f13e1c383e242055bbc
@@ -3493,7 +3493,7 @@ echo "${ECHO_T}yes (version $PYTHON_MAJO
;;
esac
- if [ -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ]; then
+ if -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ; then
PYTHON_LIBS="${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ${PYTHON_LIBS}"
else
PYTHON_LIBS="-L${PYTHON_DIR} -lpython${PYTHON_VERSION} ${PYTHON_LIBS}"
@@ -3506,11 +3506,7 @@ echo "${ECHO_T}yes (version $PYTHON_MAJO
fi
# Automatically check whether some libraries are needed to link with
- # the python libraries. If you are using the default system library, it is
- # generally the case that at least -lpthread will be needed. But you might
- # also have recompiled your own version, and if it doesn't depend on
- # pthreads, we shouldn't bring that in, since that also impacts the choice
- # of the GNAT runtime
+ # the python libraries.
CFLAGS="${CFLAGS} ${PYTHON_CFLAGS}"
LIBS="${LIBS} ${PYTHON_LIBS}"
@@ -3551,7 +3547,7 @@ sed 's/^/| /' conftest.$ac_ext >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-LIBS="${LIBS} -lpthread -lutil"
+LIBS="${LIBS} -lutil"
cat >conftest.$ac_ext <<_ACEOF
#line $LINENO "configure"
/* confdefs.h. */
@@ -3580,8 +3576,44 @@ if { (eval echo "$as_me:$LINENO: \"$ac_l
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
+ PYTHON_LIBS="${PYTHON_LIBS} -lutil"
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+LIBS="${LIBS} -lpthread"
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <Python.h>
+int
+main ()
+{
+Py_Initialize();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
PYTHON_LIBS="${PYTHON_LIBS} -lpthread -lutil"
- echo "$as_me:$LINENO: result: yes" >&5
+ echo "$as_me:$LINENO: result: yes" >&5
echo "${ECHO_T}yes" >&6
else
echo "$as_me: failed program was:" >&5
@@ -3589,13 +3621,15 @@ echo "${ECHO_T}no" >&6
echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
- WITH_PYTHON=no
- PYTHON_BASE=
- PYTHON_LIBS=
+ WITH_PYTHON=no
+ PYTHON_BASE=
+ PYTHON_LIBS=
fi
rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
fi
rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
fi
============================================================
--- gnatlib/src/gnatcoll_gtk.gpr 188fc83cb2b956e5e94cf104ad6895968f2b4d4f
+++ gnatlib/src/gnatcoll_gtk.gpr b184a559bfd6eb088803c57e008949a79d3650a6
@@ -22,22 +22,24 @@ project GnatColl_Gtk is
case GnatColl_Shared.Python is
when "yes" =>
for Source_Dirs use Project'Source_Dirs & ("gtk/python");
-
- -- Seems this line is sometimes needed when compiling GPS
- -- (but not always). However, it fails when building gnatcoll
- -- standalone, because of duplicate symbols in such a case.
- -- Not clear what is happening, though.
- --
- -- for Library_Options use ("python_support_gtk.o");
when "no" =>
for Source_Dirs use Project'Source_Dirs & ("gtk/nopython");
end case;
end case;
- package Compiler renames GnatColl_Shared.Compiler;
+ package Compiler is
+ for Default_Switches ("Ada") use
+ GnatColl_Shared.Compiler'Default_Switches ("Ada");
- package Linker renames GnatColl_Shared.Linker;
+ for Default_Switches ("C") use
+ ("-g", "-O2")
+ & GnatColl_Shared.Python_Cflags
+ & GnatColl_Shared.Pygtk_Include
+ & GnatColl_Shared.Gtk_Include;
+ end Compiler;
+ package Linker renames GnatColl_Shared.Linker;
+
package Ide renames GnatColl_Shared.Ide;
end GnatColl_Gtk;
============================================================
--- gnatlib/src/gnatcoll_python.gpr.in c973252984e465502b0ee58f3678977bba1a98c9
+++ gnatlib/src/gnatcoll_python.gpr.in ab4e7ed94358bdb3d4e7eec9c0cf8b3c16f5ddea
@@ -22,8 +22,14 @@ project GnatColl_Python is
for Source_Dirs use Project'Source_Dirs & ("nopython");
end case;
- package Compiler renames GnatColl_Shared.Compiler;
+ package Compiler is
+ for Default_Switches ("Ada") use
+ GnatColl_Shared.Compiler'Default_Switches ("Ada");
+ for Default_Switches ("C") use
+ ("-g", "-O2") & GnatColl_Shared.Python_Cflags;
+ end Compiler;
+
package Linker is
-- When linking an executable
for Linker_Options use (@PYTHON_LIBS_GPR@);
============================================================
--- gps/Makefile 02c27607c5ddffa9c30e170c2d939e1efd847a04
+++ gps/Makefile 4301e2847588b047e3c604e8b2110d8b0b843beb
@@ -1,3 +1,41 @@
-default build compile link ada c c++ clean internal-clean :
- $(MAKE) -s -f Makefile.gps $@
+ifeq ($(OS),Windows_NT)
+ LN = cp -p
+else
+ LN = ln -s
+endif
+GPRBUILD=gprbuild
+
+.PHONY: default resources do_links all clean
+
+default: resources do_links all
+
+include ../Makefile.gnat
+
+all:
+ $(MAKE) -s LIBRARY_TYPE=static ENABLE_SHARED=no \
+ -C ../templates_parser setup
+ $(MAKE) -s -C ../kernel/src_info/sn
+ $(GPRBUILD) -p -ws -P../gnatlib/src/gnatcoll
+ $(GPRBUILD) -p -ws -XTP_TASKING=No_Tasking -Pgps
+
+resources:
+ifeq ($(OS),Windows_NT)
+ @cd src; windres gps.rc -O coff -o ../obj/gps.res
+ $(MAKE) -s -C ../common/expect
+endif
+
+do_links:
+ -@$(foreach f,$(GNAT_SOURCES), \
+ $(LN) ../gnat_src/$(f) ../gnat > /dev/null 2>&1 ;)
+ @sed -e 's/GNAT.Command_Line/GComLin/g' ../gnat_src/g-comlin.ads > ../gnat/gcomlin.ads
+ @sed -e 's/GNAT.Command_Line/GComLin/g' ../gnat_src/g-comlin.adb > ../gnat/gcomlin.adb
+ @(cd ../gnat && gnatmake -q xsnamest && ./xsnamest && mv snames.ns snames.ads && mv snames.nb snames.adb)
+
+clean:
+ifeq ($(OS),Windows_NT)
+ $(MAKE) -s -C ../common/expect clean
+endif
+ $(MAKE) -s -C ../kernel/src_info/sn clean
+ -gprclean -q -r -Pgps
+
============================================================
--- gps/gps.gpr b004c606d94498042ea1a600e1c799788a0b3ba0
+++ gps/gps.gpr 6ac9a1cb29cd4bb3ef9188ad36e14e249192691e
@@ -49,11 +49,11 @@ project GPS is
case Shared.Build is
when "Debug" =>
- for Default_Switches ("Ada") use ("-m", "-a", "-g");
+ for Default_Switches ("Ada") use ("-m", "-g");
for Global_Configuration_Pragmas use "gnat_debug.adc";
when "Production" =>
- for Default_Switches ("Ada") use ("-m", "-a", "-g");
+ for Default_Switches ("Ada") use ("-m", "-g");
for Global_Configuration_Pragmas use "gnat.adc";
end case;
end Builder;
============================================================
--- gvd/gvd/debugger.adb a1eefa876eba9d00bc3567cda1d63d752e456584
+++ gvd/gvd/debugger.adb 9ff20f6137dbc8873f00e87b473789f12919107e
@@ -1158,4 +1158,171 @@ package body Debugger is
return Debugger.Kernel;
end Get_Kernel;
+ ------------------------------
+ -- Set_Breakpoint_Condition --
+ ------------------------------
+
+ procedure Set_Breakpoint_Condition
+ (Debugger : access Debugger_Root;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Condition : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Set_Breakpoint_Condition;
+
+ ----------------------
+ -- Set_Scope_Action --
+ ----------------------
+
+ procedure Set_Breakpoint_Command
+ (Debugger : access Debugger_Root;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Commands : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Set_Breakpoint_Command;
+
+ ----------------------
+ -- Set_Scope_Action --
+ ----------------------
+
+ procedure Set_Breakpoint_Ignore_Count
+ (Debugger : access Debugger_Root;
+ Num : GVD.Types.Breakpoint_Identifier;
+ Count : Integer;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ begin
+ null;
+ end Set_Breakpoint_Ignore_Count;
+
+ ----------------------
+ -- Set_Scope_Action --
+ ----------------------
+
+ procedure Set_Scope_Action
+ (Debugger : access Debugger_Root;
+ Scope : GVD.Types.Scope_Type := GVD.Types.No_Scope;
+ Action : GVD.Types.Action_Type := GVD.Types.No_Action;
+ Num : GVD.Types.Breakpoint_Identifier := 0;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Scope, Action, Num, Mode);
+ begin
+ null;
+ end Set_Scope_Action;
+
+ -----------------
+ -- Task_Switch --
+ -----------------
+
+ procedure Task_Switch
+ (Debugger : access Debugger_Root;
+ Task_Num : Natural;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Task_Num, Mode);
+ begin
+ null;
+ end Task_Switch;
+
+ -------------------
+ -- Thread_Switch --
+ -------------------
+
+ procedure Thread_Switch
+ (Debugger : access Debugger_Root;
+ Thread : Natural;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (Thread, Mode);
+ begin
+ null;
+ end Thread_Switch;
+
+ ---------------
+ -- PD_Switch --
+ ---------------
+
+ procedure PD_Switch
+ (Debugger : access Debugger_Root;
+ PD : String;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden)
+ is
+ pragma Unreferenced (PD, Mode);
+ begin
+ null;
+ end PD_Switch;
+
+ ----------------
+ -- Info_Tasks --
+ ----------------
+
+ procedure Info_Tasks
+ (Debugger : access Debugger_Root;
+ Info : out Thread_Information_Array;
+ Len : out Natural)
+ is
+ pragma Unreferenced (Info, Debugger);
+ begin
+ Len := 0;
+ end Info_Tasks;
+
+ ------------------
+ -- Info_Threads --
+ ------------------
+
+ procedure Info_Threads
+ (Debugger : access Debugger_Root;
+ Info : out Thread_Information_Array;
+ Len : out Natural)
+ is
+ pragma Unreferenced (Info, Debugger);
+ begin
+ Len := 0;
+ end Info_Threads;
+
+ -------------
+ -- Info_PD --
+ -------------
+
+ procedure Info_PD
+ (Debugger : access Debugger_Root;
+ Info : out PD_Information_Array;
+ Len : out Natural)
+ is
+ pragma Unreferenced (Info, Debugger);
+ begin
+ Len := 0;
+ end Info_PD;
+
+ -------------------------
+ -- Set_VxWorks_Version --
+ -------------------------
+
+ procedure Set_VxWorks_Version
+ (Debugger : access Debugger_Root; Force : Boolean := False)
+ is
+ pragma Unreferenced (Force);
+ begin
+ null;
+ end Set_VxWorks_Version;
+
+ ---------------------
+ -- VxWorks_Version --
+ ---------------------
+
+ function VxWorks_Version
+ (Debugger : access Debugger_Root)
+ return GVD.Types.VxWorks_Version_Type
+ is
+ pragma Unreferenced (Debugger);
+ begin
+ return Vx_None;
+ end VxWorks_Version;
+
end Debugger;
============================================================
--- gvd/gvd/debugger.ads c4909f14cf5fcf8c5e01bf82c02d13a2b05d5633
+++ gvd/gvd/debugger.ads f7741a60c78f27464a426b4781a3abd68432f918
@@ -656,14 +656,14 @@ package Debugger is
(Debugger : access Debugger_Root;
Num : GVD.Types.Breakpoint_Identifier;
Condition : String;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Set the condition on which a breakpoint should be activated.
procedure Set_Breakpoint_Command
(Debugger : access Debugger_Root;
Num : GVD.Types.Breakpoint_Identifier;
Commands : String;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Set the commands to execute upon stopping at the breakpoint.
-- One command per line in commands.
@@ -671,7 +671,7 @@ package Debugger is
(Debugger : access Debugger_Root;
Num : GVD.Types.Breakpoint_Identifier;
Count : Integer;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Set the number of times the breakpoint should be ignored before being
-- activated.
@@ -680,7 +680,7 @@ package Debugger is
Scope : GVD.Types.Scope_Type := GVD.Types.No_Scope;
Action : GVD.Types.Action_Type := GVD.Types.No_Action;
Num : GVD.Types.Breakpoint_Identifier := 0;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Set the scope/action of the breakpoint identified by Num:
-- GDB_COMMAND: change-breakpoint-scope/change-breakpoint-action
-- Set the default scope/action of a debugging session if Num = 0:
@@ -739,53 +739,52 @@ package Debugger is
procedure Task_Switch
(Debugger : access Debugger_Root;
Task_Num : Natural;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Switch to a specified task.
-- GDB_COMMAND: "task"
procedure Thread_Switch
(Debugger : access Debugger_Root;
Thread : Natural;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Switch to a specified thread.
-- GDB_COMMAND: "thread"
procedure PD_Switch
(Debugger : access Debugger_Root;
PD : String;
- Mode : GVD.Types.Command_Type := GVD.Types.Hidden) is abstract;
+ Mode : GVD.Types.Command_Type := GVD.Types.Hidden);
-- Switch to a specified protection domain.
-- GDB_COMMAND: "pd <pd_id>"
procedure Info_Tasks
(Debugger : access Debugger_Root;
Info : out Thread_Information_Array;
- Len : out Natural) is abstract;
+ Len : out Natural);
-- Return the current list of tasks.
-- GDB_COMMAND: "info tasks"
procedure Info_Threads
(Debugger : access Debugger_Root;
Info : out Thread_Information_Array;
- Len : out Natural) is abstract;
+ Len : out Natural);
-- Return the current list of threads.
-- GDB_COMMAND: "info threads"
procedure Info_PD
(Debugger : access Debugger_Root;
Info : out PD_Information_Array;
- Len : out Natural) is abstract;
+ Len : out Natural);
-- Return the current list of protection domains.
-- GDB_COMMAND: "info pds"
procedure Set_VxWorks_Version
- (Debugger : access Debugger_Root; Force : Boolean := False)
- is abstract;
+ (Debugger : access Debugger_Root; Force : Boolean := False);
-- Determine the VxWorks version running on the target
function VxWorks_Version
(Debugger : access Debugger_Root)
- return GVD.Types.VxWorks_Version_Type is abstract;
+ return GVD.Types.VxWorks_Version_Type;
-- Retrieve the VxWorks version stored in the debugger record
-----------------------------
============================================================
--- gvd/gvd/gvd-types.ads 9d72971df4bae2778544d63cda9b00856a297f37
+++ gvd/gvd/gvd-types.ads 4f0fa6da45b0e224694b6f177ddf054543d550b1
@@ -231,6 +231,7 @@ package GVD.Types is
type Debugger_Type is
(Gdb_Type,
+ VMS_Type,
Dbx_Type,
Xdb_Type,
Jdb_Type,
@@ -259,7 +260,7 @@ private
-- The string representing the address
Length : Natural := 0;
- -- This is the lenght of the remaining string once the "0x" prefix as
+ -- This is the length of the remaining string once the "0x" prefix as
-- well as all the following zeros have been stripped.
-- The meaningful part of Address_String is therefore the one in
-- the Last - Length + 1 .. Last range.
============================================================
--- gvd/gvd.gpr b8bcaf0198e920f6bc4669b9f36b1eaaaec2741c
+++ gvd/gvd.gpr 704bc4f16ecf4faef5a082f86a4966c29c3e2296
@@ -10,7 +10,7 @@ project GVD is
for Object_Dir use "obj";
package Builder is
- for Default_Switches ("Ada") use ("-a", "-m");
+ for Default_Switches ("Ada") use ("-m");
end Builder;
package Compiler renames Shared.Compiler;
============================================================
--- kernel/kernel.gpr 4aadd766c706e34f0ed47b15975d6161be86bf50
+++ kernel/kernel.gpr 485da9e8ecc8710170463ad4465ff74ba2303c76
@@ -5,6 +5,7 @@ with "../gnatlib/src/gnatcoll_gtk";
with "../shared";
with "../gnatlib/src/gnatcoll";
with "../gnatlib/src/gnatcoll_gtk";
+with "src_info/sn/sn";
project Kernel is
============================================================
--- kernel/src/gps-kernel-console.adb 925eb79c134b70b970c69436e4ca1e9c2351b35a
+++ kernel/src/gps-kernel-console.adb 338be9aa173827fadeebb07f44fda6796102f1e3
@@ -17,7 +17,7 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with Ada.Calendar; use Ada.Calendar;
+with Ada.Calendar; use Ada, Ada.Calendar;
with GNAT.Calendar; use GNAT.Calendar;
with GNAT.Calendar.Time_IO; use GNAT.Calendar.Time_IO;
@@ -49,6 +49,7 @@ package body GPS.Kernel.Console is
with Traces; use Traces;
package body GPS.Kernel.Console is
+
type GPS_Message_Record is new Interactive_Console_Record with null record;
type GPS_Message is access GPS_Message_Record'Class;
-- Type for the messages window. This is mostly use to have a unique tag
@@ -69,8 +70,8 @@ package body GPS.Kernel.Console is
Me : constant Debug_Handle := Create (Console_Module_Name);
- type GPS_Console_MDI_Child_Record is new GPS_MDI_Child_Record
- with null record;
+ type GPS_Console_MDI_Child_Record is
+ new GPS_MDI_Child_Record with null record;
overriding function Interrupt
(Child : access GPS_Console_MDI_Child_Record) return Boolean;
@@ -162,7 +163,7 @@ package body GPS.Kernel.Console is
Mode : Message_Type := Info)
is
Console : constant Interactive_Console := Get_Console (Kernel);
- T : constant Ada.Calendar.Time := Ada.Calendar.Clock;
+ T : constant Calendar.Time := Calendar.Clock;
begin
if Console = null then
Put_Line (Text);
@@ -333,6 +334,12 @@ package body GPS.Kernel.Console is
Destroy (Module.Console);
Module.Console := null;
end if;
+
+ -- Destroyed has been called as GPS is in the way to quit. We want to
+ -- invalidate the module access as it will be freed just after this
+ -- call. We want to do that to be sure that every call to Get_Console
+ -- will return null at this point.
+ Console_Module_Id := null;
end Destroy;
----------------------------
============================================================
--- kernel/src/gps-kernel-hooks.adb 97af39a00cff36245fd38c71211afb7888831283
+++ kernel/src/gps-kernel-hooks.adb 0049e30759c3f7f92a028acddb1a5a3b4f7543c8
@@ -1031,6 +1031,7 @@ package body GPS.Kernel.Hooks is
begin
if Info = null then
Insert (Kernel, -"No such hook: " & String (Hook));
+
else
if Set_Busy then
Push_State (Kernel_Handle (Kernel), Busy);
@@ -1569,9 +1570,8 @@ package body GPS.Kernel.Hooks is
-------------
procedure Destroy (Data : in out Hooks_Data) is
- pragma Unreferenced (Data);
begin
- null;
+ Free (Data.Data);
end Destroy;
-----------------------------
============================================================
--- kernel/src/gps-kernel-standard_hooks.adb 98899a9d1dc9b02e9b14aec95b48b3825046be92
+++ kernel/src/gps-kernel-standard_hooks.adb 73b46f67eea651da0c30f9ae85c955decec6c372
@@ -197,6 +197,8 @@ package body GPS.Kernel.Standard_Hooks i
Infos (-1).Text := new String'(Label);
Add_Line_Information (Kernel, File, Identifier, Infos);
+
+ Unchecked_Free (Infos);
end Add_Editor_Label;
------------------------------------
============================================================
--- kernel/src/gps-kernel-timeout.adb 45d5d11a160ca4223a84ce65b277b46af8699710
+++ kernel/src/gps-kernel-timeout.adb 33eeafd41825cf13583a1cd97c2b875451b9a584
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -17,7 +17,7 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with Ada.Calendar; use Ada.Calendar;
+with Ada.Calendar; use Ada, Ada.Calendar;
with Ada.Calendar.Formatting;
with Ada.Unchecked_Conversion;
with GNAT.Calendar.Time_IO; use GNAT.Calendar.Time_IO;
@@ -152,12 +152,15 @@ package body GPS.Kernel.Timeout is
C : constant Monitor_Command_Access :=
Monitor_Command_Access (Command);
Result : Command_Return_Type;
- Continue : Boolean;
- pragma Unreferenced (Continue);
begin
Result := Execute (Command);
- Continue := Process_Cb (C.Data);
- return Result;
+ if not Process_Cb (C.Data) then
+ -- Process_Cb detected that the process has ended, so we should not
+ -- retry later on
+ return Success;
+ else
+ return Result;
+ end if;
end Execute_Monitor;
procedure Launch_Monitor_Command_Synchronous is new
@@ -197,6 +200,7 @@ package body GPS.Kernel.Timeout is
Free (D.Name);
Cleanup (D.Data);
+ D.Data := null;
end Free;
-------------
@@ -299,6 +303,7 @@ package body GPS.Kernel.Timeout is
end if;
if Data.D.Descriptor = null then
+ Unref (Data);
return;
end if;
@@ -309,13 +314,13 @@ package body GPS.Kernel.Timeout is
end if;
declare
- End_Time : constant Ada.Calendar.Time := Ada.Calendar.Clock;
- Time_Stamp : constant String :=
- "[" & Image (End_Time, ISO_Date & " %T") & "] ";
- Elapsed : constant String :=
- Ada.Calendar.Formatting.Image
- (End_Time - Data.Start_Time,
- Include_Time_Fraction => True);
+ End_Time : constant Ada.Calendar.Time := Ada.Calendar.Clock;
+ Time_Stamp : constant String :=
+ "[" & Image (End_Time, ISO_Date & " %T") & "] ";
+ Elapsed : constant String :=
+ Calendar.Formatting.Image
+ (End_Time - Data.Start_Time,
+ Include_Time_Fraction => True);
Elapsed_Start : Natural := Elapsed'First;
begin
@@ -352,6 +357,9 @@ package body GPS.Kernel.Timeout is
end if;
end;
+ Free (Data.Args);
+ Free (Data.Directory);
+
if Data.D.Exit_Cb /= null then
Data.D.Exit_Cb (Data.D, Status);
end if;
@@ -479,13 +487,10 @@ package body GPS.Kernel.Timeout is
end if;
Data.Died := True;
- Cleanup (Data);
-
return False;
when E : others =>
Trace (Exception_Handle, E);
- Cleanup (Data);
return False;
end Process_Cb;
@@ -514,7 +519,6 @@ package body GPS.Kernel.Timeout is
exception
when E : others =>
Trace (Exception_Handle, E);
- Cleanup (Process);
return "";
end Data_Handler;
@@ -635,7 +639,6 @@ package body GPS.Kernel.Timeout is
Id => 0,
Timeout => Timeout);
Initialize (C.Data);
- Ref (C.Data);
if Synchronous then
Launch_Monitor_Command_Synchronous (Command_Access (C), 0.1);
@@ -810,7 +813,6 @@ package body GPS.Kernel.Timeout is
Button : Message_Dialog_Buttons;
begin
if Console.Died then
- Cleanup (Console);
return False;
end if;
@@ -822,7 +824,6 @@ package body GPS.Kernel.Timeout is
Button_Yes);
if Button = Button_Yes then
- Cleanup (Console);
return False;
else
@@ -832,7 +833,6 @@ package body GPS.Kernel.Timeout is
exception
when E : others =>
Trace (Exception_Handle, E);
- Cleanup (Console);
return False;
end Delete_Handler;
============================================================
--- kernel/src/gps-kernel.adb 65d3376d6ac7515763d16014f5103b43d0e15a81
+++ kernel/src/gps-kernel.adb 201af151daea5f02f5a51fb2d138d243274e0f62
@@ -99,11 +99,11 @@ package body GPS.Kernel is
package body GPS.Kernel is
- Me : constant Debug_Handle := Create ("gps_kernel");
- Ref_Me : constant Debug_Handle :=
- Create ("Contexts.Ref", GNATCOLL.Traces.Off);
+ Me : constant Debug_Handle := Create ("gps_kernel");
+ Ref_Me : constant Debug_Handle :=
+ Create ("Contexts.Ref", GNATCOLL.Traces.Off);
Create_Me : constant Debug_Handle :=
- Create ("Contexts.Mem", GNATCOLL.Traces.Off);
+ Create ("Contexts.Mem", GNATCOLL.Traces.Off);
History_Max_Length : constant Positive := 10;
-- <preferences> Maximum number of entries to store in each history
============================================================
--- kernel/src/gps-location_view.adb 5e224739b40d1fa4a56b324f4fe0609b3541fa9f
+++ kernel/src/gps-location_view.adb 1821403354f5f8a5b840c6ce69b9783cdc89da60
@@ -19,6 +19,8 @@ with Ada.Unchecked_Deallocation;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
+with GNAT.Expect; use GNAT.Expect;
+with GNAT.Regpat; use GNAT.Regpat;
with GNATCOLL.Scripts; use GNATCOLL.Scripts;
with GNATCOLL.Utils; use GNATCOLL.Utils;
with GNATCOLL.VFS; use GNATCOLL.VFS;
@@ -636,6 +638,7 @@ package body GPS.Location_View is
end if;
Path_Free (Path);
+ View.Row := null;
Path_Free (Start_Path);
Path_Free (End_Path);
@@ -1620,11 +1623,16 @@ package body GPS.Location_View is
Unref (V.Category_Pixbuf);
Unref (V.File_Pixbuf);
+ Basic_Types.Unchecked_Free (V.Secondary_File_Pattern);
if V.Idle_Redraw_Handler /= Glib.Main.No_Source_Id then
Glib.Main.Remove (V.Idle_Redraw_Handler);
end if;
+ if V.Row /= null then
+ Path_Free (V.Row);
+ end if;
+
if V.Idle_Row_Handler /= Glib.Main.No_Source_Id then
Glib.Main.Remove (V.Idle_Row_Handler);
end if;
@@ -1962,6 +1970,10 @@ package body GPS.Location_View is
begin
Get_Tree_Iter (Nth (Params, 1), Iter);
if Iter /= Null_Iter then
+ if View.Row /= null then
+ Path_Free (View.Row);
+ end if;
+
View.Row := Get_Path (Get_Model (View.Tree), Iter);
if View.Idle_Row_Handler = Glib.Main.No_Source_Id then
@@ -2536,8 +2548,6 @@ package body GPS.Location_View is
procedure Read_Secondary_Pattern_Preferences
(View : access Location_View_Record'Class)
is
- procedure Unchecked_Free is new Ada.Unchecked_Deallocation
- (Pattern_Matcher, Pattern_Matcher_Access);
begin
if View.Secondary_File_Pattern /= null then
Unchecked_Free (View.Secondary_File_Pattern);
============================================================
--- kernel/src/gps-location_view.ads 4915ddc39cf8c7e3197bb8538c504499a44773dc
+++ kernel/src/gps-location_view.ads a1c20519891997f85d4c3473e00c2370f6621abf
@@ -20,7 +20,7 @@
-- This package handles source file locations and displays them
-- in a graphical tree, per category.
-with GNAT.Regpat; use GNAT.Regpat;
+with GNAT.Expect;
with GNAT.Strings;
with GNATCOLL.VFS;
@@ -202,8 +202,6 @@ private
Children : List;
end record;
- type Pattern_Matcher_Access is access Pattern_Matcher;
-
type Location_View_Record is new Gtk_Hbox_Record with record
Kernel : Kernel_Handle;
Tree : Tree_View;
@@ -230,7 +228,7 @@ private
Stored_Locations : List;
-- The following are used for detection of secondary file locations
- Secondary_File_Pattern : Pattern_Matcher_Access;
+ Secondary_File_Pattern : GNAT.Expect.Pattern_Matcher_Access;
-- Regexp corresponding to a detection of the secondary file
SFF : Natural;
-- Index of the secondary file
============================================================
--- kernel/src/task_manager-gui.adb 9f4cdbef56cf865313b85d38d79903739d452175
+++ kernel/src/task_manager-gui.adb dee3f172cded47c25de0cc8b23ea8c5fe2a446b0
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -91,33 +91,33 @@ package body Task_Manager.GUI is
procedure Set_Column_Types
(View : access Task_Manager_Interface_Record'Class);
- -- Sets the types of columns to be displayed in the tree_view.
+ -- Sets the types of columns to be displayed in the tree_view
procedure On_View_Destroy
(Object : access GObject_Record'Class;
Params : GValues);
- -- Callback for a "destroy" signal.
+ -- Callback for a "destroy" signal
procedure On_View_Realize
(Object : access GObject_Record'Class;
Params : GValues);
- -- Callback for a "realize" signal. Initializes the graphical components.
+ -- Callback for a "realize" signal. Initializes the graphical components
function On_Button_Press_Event
(Object : access Gtk_Widget_Record'Class;
Event : Gdk_Event) return Boolean;
- -- Callback for a "button_press_event".
+ -- Callback for a "button_press_event"
procedure On_Progress_Bar_Destroy
(Object : access GObject_Record'Class;
Manager : Manager_Index_Record);
- -- Called when a progress bar is destroyed.
+ -- Called when a progress bar is destroyed
function On_Progress_Bar_Button_Pressed
(Object : access Gtk_Widget_Record'Class;
Params : GValues;
Manager : Manager_Contextual_Menus.Callback_User_Data) return Boolean;
- -- Callback for a "button_press_event" on a progress bar.
+ -- Callback for a "button_press_event" on a progress bar
procedure Interrupt_Task
(Object : access GObject_Record'Class;
@@ -133,40 +133,40 @@ package body Task_Manager.GUI is
procedure Pause_Command
(Manager : Task_Manager_Access;
Index : Integer);
- -- Pause command referenced by Index.
+ -- Pause command referenced by Index
procedure Resume_Command
(Manager : Task_Manager_Access;
Index : Integer);
- -- Resume command referenced by Index.
+ -- Resume command referenced by Index
function Menu_Create
(View : Manager_Index_Record;
Event : Gdk.Event.Gdk_Event) return Gtk.Menu.Gtk_Menu;
- -- Create the task manager contextual menu.
+ -- Create the task manager contextual menu
procedure Menu_Destroy
(Manager : Manager_Index_Record;
Menu : Gtk.Menu.Gtk_Menu);
- -- Destroy the task manager contextual menu.
+ -- Destroy the task manager contextual menu
procedure On_Pause_Command
(Object : access GObject_Record'Class;
Params : GValues;
Manager : Manager_Index_Record);
- -- Pause the referenced command in the task manager.
+ -- Pause the referenced command in the task manager
procedure On_Resume_Command
(Object : access GObject_Record'Class;
Params : GValues;
Manager : Manager_Index_Record);
- -- Resume the referenced command in the task manager.
+ -- Resume the referenced command in the task manager
procedure On_Interrupt_Command
(Object : access GObject_Record'Class;
Params : GValues;
Manager : Manager_Index_Record);
- -- Resume the referenced command in the task manager.
+ -- Resume the referenced command in the task manager
-----------------------------
-- On_Progress_Bar_Destroy --
@@ -777,7 +777,7 @@ package body Task_Manager.GUI is
(View.Tree.Model, View.Lines (Index), Command_Name_Column,
Name_String.all);
- -- Create the pixbuf showing the progress.
+ -- Create the pixbuf showing the progress
if View.Progress_Layout /= null then
declare
@@ -923,7 +923,7 @@ package body Task_Manager.GUI is
View.Manager := Manager;
View.Dialog := Dialog;
- -- Initialize the tree.
+ -- Initialize the tree
Gtk_New (View.Tree, Columns_Types);
@@ -979,7 +979,9 @@ package body Task_Manager.GUI is
Dummy : Command_Return_Type;
pragma Unreferenced (Dummy);
begin
- Dummy := Execute (Manager.Pop_Command);
+ if Manager.Pop_Command /= null then
+ Dummy := Execute (Manager.Pop_Command);
+ end if;
end Pop_State;
----------------
@@ -990,7 +992,9 @@ package body Task_Manager.GUI is
Dummy : Command_Return_Type;
pragma Unreferenced (Dummy);
begin
- Dummy := Execute (Manager.Push_Command);
+ if Manager.Push_Command /= null then
+ Dummy := Execute (Manager.Push_Command);
+ end if;
end Push_State;
end Task_Manager.GUI;
============================================================
--- kernel/src/task_manager.adb b7910e494861a1e65fb4bf33e9d9c3af4bd53ab9
+++ kernel/src/task_manager.adb fc55d8265cf4aae9326f2e03c4c522ad3be77fb8
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -177,6 +177,7 @@ package body Task_Manager is
Manager.Need_Global_Refresh := True;
if Manager.Queues'Length = 1 then
+ Unchecked_Free (Queue);
Unchecked_Free (Manager.Queues);
Manager.Referenced_Command := -1;
return False;
@@ -209,9 +210,7 @@ package body Task_Manager is
if Manager.Referenced_Command = Index then
Manager.Referenced_Command := -1;
- elsif Manager.Referenced_Command >
- Index
- then
+ elsif Manager.Referenced_Command > Index then
Manager.Referenced_Command :=
Manager.Referenced_Command - 1;
end if;
@@ -306,6 +305,7 @@ package body Task_Manager is
Free_Alternate_Actions (Command, True, False);
Free_Consequence_Actions (Command, False, False);
+
else
declare
New_Queue : constant Command_Queues.List :=
@@ -371,9 +371,7 @@ package body Task_Manager is
Priority => Glib.Main.Priority_Default_Idle);
end if;
- if Active
- and then not Manager.Running_Active
- then
+ if Active and then not Manager.Running_Active then
Manager.Running_Active := True;
if Active_Incremental (Manager) then
@@ -499,8 +497,8 @@ package body Task_Manager is
(Manager : Task_Manager_Access;
Command : Command_Access)
is
- Node : Command_Queues.List_Node;
use Command_Queues;
+ Node : Command_Queues.List_Node;
begin
for J in Manager.Queues'Range loop
Node := First (Manager.Queues (J).Queue);
============================================================
--- kernel/src_info/projects-registry.adb 155b5cc8da77f57240a438962f98feb5551ce994
+++ kernel/src_info/projects-registry.adb cf68abd7cfc2c0eda82604216c3c3f6c805724e7
@@ -1080,8 +1080,7 @@ package body Projects.Registry is
begin
while not At_End (Path, Iter) loop
declare
- Curr : constant String :=
- Name_As_Directory (Current (Path, Iter));
+ Curr : constant String := Name_As_Directory (Current (Path, Iter));
begin
if Curr /= "" then
Open (Dir, Curr);
============================================================
--- kernel/src_info/standalone.gpr 94a0a5aff252db84d7cf66364cd317cf0238fe6b
+++ kernel/src_info/standalone.gpr 04b9dbae23d592c6af7a051f3ddbba66d0983171
@@ -2,6 +2,7 @@ with "../../cpp_module/cpp_module";
with "../../kernel/kernel";
with "../../ada_module/ada_module";
with "../../cpp_module/cpp_module";
+with "../../gvd/gvd";
with "../../gnat";
with "../../shared";
============================================================
--- prj_editor/prj_editor.gpr 966e4c4a1a9013905d919d2aa5925cd8e029e289
+++ prj_editor/prj_editor.gpr f80102ca4cf69fb05302341181f44d530725929c
@@ -15,12 +15,10 @@ project Prj_Editor is
Build : Build_Type := External ("Build", "Debug");
package Builder is
- -- -a is required for g-exptty.adb
- for Default_Switches ("Ada") use ("-g", "-a", "-m");
+ for Default_Switches ("Ada") use ("-g", "-m");
case Build is
when "Debug" =>
- for Default_Switches ("Ada") use Builder'Default_Switches ("Ada")
- & ("-gnatVa");
+ for Default_Switches ("Ada") use Builder'Default_Switches ("Ada");
for Global_Configuration_Pragmas use "../gps/gnat_debug.adc";
when "Production" =>
for Global_Configuration_Pragmas use "../gps/gnat.adc";
============================================================
--- prj_editor/testsuite/run e3dd60d6b6b8e3229a25554edb276addcad68026
+++ prj_editor/testsuite/run 6e6d591cd1970e44420476475f7203f7246e3452
@@ -18,7 +18,7 @@ testsuite="../obj/testsuite"
pwd_replace="/foo/bar"
testsuite="../obj/testsuite"
-run_and_exit "make -C $testpwd/.. GNATMAKE='gnatmake -q'"
+run_and_exit "gprbuild -p -ws -q -P../prj_editor testsuite.adb"
setup_traces
check() {
============================================================
--- python/src/python_module.adb 58599d5581479a2e13f8243c2073d3e231f164ba
+++ python/src/python_module.adb a0db538e04f64d6a6b4da806e10288bb2b9aba30
@@ -72,7 +72,7 @@ package body Python_Module is
-- ~/.gps/startup.xml
function Create_Python_Console (Kernel : Kernel_Handle) return MDI_Child;
- -- Create the python console if it doesn't exist yet.
+ -- Create the python console if it doesn't exist yet
procedure Open_Python_Console
(Widget : access GObject_Record'Class; Kernel : Kernel_Handle);
@@ -107,7 +107,8 @@ package body Python_Module is
function Create_Python_Console (Kernel : Kernel_Handle) return MDI_Child is
Console : Interactive_Console;
Script : constant Scripting_Language :=
- Lookup_Scripting_Language (Get_Scripts (Kernel), Python_Name);
+ Lookup_Scripting_Language
+ (Get_Scripts (Kernel), Python_Name);
begin
Console := Create_Interactive_Console
(Kernel => Kernel,
============================================================
--- share/library/dispatching.py ab956954cb95ed6339f701803b9aabc0c1068ee0
+++ share/library/dispatching.py 11d8e60fc067836a14d8aefc33d34a0292ee1d49
@@ -66,9 +66,15 @@ def highlight_file_idle ():
return False
buffer = to_highlight[0]
+
if current_entities == []:
- current_entities = buffer.file().entities (local = False)
- current_entity = current_entities.__iter__()
+ try:
+ current_entities = buffer.file().entities (local = False)
+ current_entity = current_entities.__iter__()
+ except GPS.Exception:
+ ## The buffer might have been destroyed. Give up
+ return True
+
try:
e = current_entity.next()
highlight_entity_references (buffer, e)
@@ -84,7 +90,6 @@ def highlight_file_idle ():
return True
-
def highlight_dispatching_calls (buffer):
global insert_overlays_id
global to_highlight
============================================================
--- shared.gpr f71cdc25f394003ff720737ace673235161c4576
+++ shared.gpr a91ffe0e4e06bbaf660b20313729bffd85f0d3ed
@@ -1,3 +1,5 @@
+with "gnatlib/gnatcoll_shared";
+
project Shared is
type OS_Type is ("unix", "Windows_NT");
@@ -27,11 +29,17 @@ project Shared is
case Build is
when "Debug" =>
for Default_Switches ("Ada") use
- ("-g", "-O1", "-gnata", "-gnatVa", "-gnatQ", "-gnaty",
+ ("-g", "-O1", "-gnata", "-gnatVa", "-gnatQ", "-gnatygO",
"-gnatwaCJe", "-gnat05");
+
+ for Default_Switches ("C") use
+ ("-g", "-O1") & GnatColl_Shared.Gtk_Include;
+
when "Production" =>
for Default_Switches ("Ada") use
("-O2", "-gnatn", "-gnatws", "-gnat05");
+ for Default_Switches ("C") use
+ ("-g", "-O2") & GnatColl_Shared.Gtk_Include;
end case;
end Compiler;
============================================================
--- src_editor/src/src_editor_box.adb cdf97d7de171f4d6265762602f53656623d742cc
+++ src_editor/src/src_editor_box.adb 477b41fcdafa2f16726eb1e6c79cf0715635aeae
@@ -161,6 +161,10 @@ package body Src_Editor_Box is
Box : Source_Editor_Box);
-- Reflect the change in buffer filename
+ procedure Destroy_Info_Frames
+ (Box : access Source_Editor_Box_Record'Class);
+ -- Destroy Box.Buffer_Info_Frames
+
procedure On_Box_Destroy
(Object : access Glib.Object.GObject_Record'Class;
Params : Glib.Values.GValues;
@@ -656,15 +660,7 @@ package body Src_Editor_Box is
Label : Gtk_Label;
begin
- if Box.Buffer_Info_Frames /= null then
- for J in Box.Buffer_Info_Frames'Range loop
- Remove (Box.Label_Box, Box.Buffer_Info_Frames (J).Frame);
- Remove (Box.Label_Box, Box.Buffer_Info_Frames (J).Separator);
- end loop;
-
- Unchecked_Free (Box.Buffer_Info_Frames);
- end if;
-
+ Destroy_Info_Frames (Box);
if Info = null then
return;
end if;
@@ -753,6 +749,23 @@ package body Src_Editor_Box is
when E : others => Trace (Exception_Handle, E);
end Cursor_Position_Changed_Handler;
+ -------------------------
+ -- Destroy_Info_Frames --
+ -------------------------
+
+ procedure Destroy_Info_Frames
+ (Box : access Source_Editor_Box_Record'Class) is
+ begin
+ if Box.Buffer_Info_Frames /= null then
+ for J in Box.Buffer_Info_Frames'Range loop
+ Remove (Box.Label_Box, Box.Buffer_Info_Frames (J).Frame);
+ Remove (Box.Label_Box, Box.Buffer_Info_Frames (J).Separator);
+ end loop;
+
+ Unchecked_Free (Box.Buffer_Info_Frames);
+ end if;
+ end Destroy_Info_Frames;
+
--------------------
-- On_Box_Destroy --
--------------------
@@ -764,6 +777,8 @@ package body Src_Editor_Box is
is
pragma Unreferenced (Object, Params);
begin
+ Destroy_Info_Frames (Box);
+
Disconnect (Box.Source_Buffer, Box.Cursor_Handler);
Disconnect (Box.Source_Buffer, Box.Status_Handler);
Disconnect (Box.Source_Buffer, Box.Buffer_Info_Handler);
============================================================
--- src_editor/src/src_editor_buffer-line_information.adb 20121c407692e27067d4703cbaf375e0dd2f1295
+++ src_editor/src/src_editor_buffer-line_information.adb 0cc78743c9e86ee580dae376567a0c7dda9a3f1b
@@ -368,6 +368,25 @@ package body Src_Editor_Buffer.Line_Info
Side_Column_Configuration_Changed (Buffer);
end Remove_Line_Information_Column;
+ ---------------------------
+ -- Free_File_Information --
+ ---------------------------
+
+ procedure Free_File_Information
+ (Buffer : access Source_Buffer_Record'Class) is
+ begin
+ if Buffer.Extra_Information /= null then
+ for J in Buffer.Extra_Information'Range loop
+ GNAT.Strings.Free (Buffer.Extra_Information (J).Info.Text);
+ GNAT.Strings.Free (Buffer.Extra_Information (J).Info.Tooltip_Text);
+ Unchecked_Free (Buffer.Extra_Information (J).Info);
+ GNAT.Strings.Free (Buffer.Extra_Information (J).Identifier);
+ Unchecked_Free (Buffer.Extra_Information (J));
+ end loop;
+ Unchecked_Free (Buffer.Extra_Information);
+ end if;
+ end Free_File_Information;
+
--------------------------
-- Add_File_Information --
--------------------------
============================================================
--- src_editor/src/src_editor_buffer-line_information.ads d8454e79d99775eb892bd878db299fb795d6c8c4
+++ src_editor/src/src_editor_buffer-line_information.ads bb8ff1549d216778e1e8ec5bdb0ff2284066ed51
@@ -50,6 +50,10 @@ package Src_Editor_Buffer.Line_Informati
-- Add the line information to the Buffer.
-- User must not free Info.
+ procedure Free_File_Information
+ (Buffer : access Source_Buffer_Record'Class);
+ -- Free all file information stored in the buffer
+
function Get_Side_Information
(Buffer : access Source_Buffer_Record'Class;
Line : Editable_Line_Type) return Line_Info_Width_Array_Access;
============================================================
--- src_editor/src/src_editor_buffer.adb 8102557244df0bd4b8fd37471e8dfc54b7bdcea1
+++ src_editor/src/src_editor_buffer.adb 0ad931732ba2c6262892372d201bef14b6477407
@@ -1385,6 +1385,7 @@ package body Src_Editor_Buffer is
end if;
Free_Queue (Buffer.Queue);
+ Free_File_Information (Buffer);
Free_Column_Info (Buffer.Editable_Line_Info_Columns);
Unchecked_Free (Buffer.Editable_Line_Info_Columns);
============================================================
--- src_editor/src/src_editor_module.adb d625f84ca7a37f6dfd9c54562e2d40602a63aa4d
+++ src_editor/src/src_editor_module.adb 13f07da5d4792a50511ee655bedcb6440aa916d8
@@ -1882,10 +1882,10 @@ package body Src_Editor_Module is
begin
Launch_Process
(Kernel,
- Command => Cmd (Cmd'First).all,
- Arguments => Cmd (Cmd'First + 1 .. Cmd'Last),
- Console => Get_Console (Kernel),
- Success => Success);
+ Command => Cmd (Cmd'First).all,
+ Arguments => Cmd (Cmd'First + 1 .. Cmd'Last),
+ Console => Get_Console (Kernel),
+ Success => Success);
Free (Cmd);
end;
end if;
============================================================
--- syntax/syntax.gpr 437f189a08183125399e8ed11d44d15a45fde73b
+++ syntax/syntax.gpr 68cebf1aa2b88359d6f6ceb22c6f7b26e974f2e0
@@ -6,11 +6,16 @@ project Syntax is
for Source_Dirs use ("src");
for Object_Dir use "obj";
+ for Main use
+ ("gnatdiff.adb", "gnatpp.adb", "gnathighlight.adb", "gnatunit.adb",
+ "gnatparse.adb");
+
+
package Compiler renames Shared.Compiler;
package IDE renames Shared.IDE;
package Builder is
- for Default_Switches ("Ada") use ("-m", "-a");
+ for Default_Switches ("Ada") use ("-m");
end Builder;
package Linker is
============================================================
--- tools/project_converter/convert-adp.adb f6181afa37997c26960be658fbe4ff2ac4cfea04
+++ tools/project_converter/convert-adp.adb 44c8624146237d896240ac1751a7f57e304a50c5
@@ -36,5 +36,3 @@ end Convert.Adp;
Tmp := Save_Project (Project);
end Convert_From_Adp_To_Gpr;
end Convert.Adp;
-
-
============================================================
--- tools/project_converter/convert.gpr e9898e8389c681175deef6d51067ce6dde3b8e15
+++ tools/project_converter/convert.gpr efad315385adbe9794e7ae9d7600395f2209c3ac
@@ -10,4 +10,8 @@ project Convert is
for Exec_Dir use ".";
package Compiler renames Shared.Compiler;
+
+ package Builder is
+ for Default_Switches ("Ada") use ("-m");
+ end Builder;
end Convert;
============================================================
--- vcs/src/vcs_view-explorer.adb 5f456aad025567696dc29bf5415e5ba54f05c21d
+++ vcs/src/vcs_view-explorer.adb 8c25a565754a0f6edc6ed6e1000df933357eb523
@@ -455,7 +455,9 @@ package body VCS_View.Explorer is
Log :=
Get_Log_From_File (Kernel, File, False) /= GNATCOLL.VFS.No_File;
- Line := (Copy_File_Status (File_Status), Log);
+ -- Set_Cache already does a copy of the File_Status, no need to
+ -- redo it here
+ Line := (File_Status, Log);
Set_Cache (Get_Status_Cache, File, Line);
end if;
============================================================
--- vdiff/vdiff.gpr d5ec6efeaa87fd7fd05957046f1949c464131e3b
+++ vdiff/vdiff.gpr 64aadf9ced88c54be32c3d5e03f89de0ac23c5a5
@@ -5,6 +5,7 @@ project VDiff is
project VDiff is
+ for Languages use ("Ada", "C");
for Source_Dirs use ("src");
for Object_Dir use "obj";