+2010-06-17 Robert Dewar <dewar@adacore.com>
+
+ * par.adb: Minor comment fix
+ * sem_aggr.adb, sem_ch3.adb: Minor reformatting
+
+2010-06-17 Doug Rupp <rupp@adacore.com>
+
+ * s-auxdec-vms_64.ads: Revert Integer to Long_Integer change, instead
+ change Address to Short_Address in functions where both must be the
+ same size for intrinsics to work.
+
+2010-06-17 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch4.adb (Analyze_Selected_Component): A selected component may
+ not denote a (private) component of a protected object.
+
+2010-06-17 Bob Duff <duff@adacore.com>
+
+ * par-labl.adb (Try_Loop): Test whether the label and the goto are in
+ the same list.
+
+2010-06-17 Joel Brobecker <brobecker@adacore.com brobecker>
+
+ * gnat_ugn.texi: Update the documentation about GDB re: exception
+ catchpoints.
+
2010-06-17 Arnaud Charlet <charlet@adacore.com>
* gnatvsn.ads: Bump to 4.6 version.
stops and @code{GDB} signals that the breakpoint was encountered by
printing the line of code before which the program is halted.
-@item breakpoint exception @var{name}
-A special form of the breakpoint command which breakpoints whenever
-exception @var{name} is raised.
-If @var{name} is omitted,
-then a breakpoint will occur when any exception is raised.
+@item catch exception @var{name}
+This command causes the program execution to stop whenever exception
+@var{name} is raised. If @var{name} is omitted, then the execution is
+suspended when any exception is raised.
@item print @var{expression}
This will print the value of the given expression. Most simple
that was stepped through.
@node Ada Exceptions
-@section Breaking on Ada Exceptions
+@section Stopping when Ada Exceptions are Raised
@cindex Exceptions
@noindent
-You can set breakpoints that trip when your program raises
-selected exceptions.
+You can set catchpoints that stop the program execution when your program
+raises selected exceptions.
@table @code
-@item break exception
-Set a breakpoint that trips whenever (any task in the) program raises
-any exception.
+@item catch exception
+Set a catchpoint that stops execution whenever (any task in the) program
+raises any exception.
-@item break exception @var{name}
-Set a breakpoint that trips whenever (any task in the) program raises
-the exception @var{name}.
+@item catch exception @var{name}
+Set a catchpoint that stops execution whenever (any task in the) program
+raises the exception @var{name}.
-@item break exception unhandled
-Set a breakpoint that trips whenever (any task in the) program raises an
-exception for which there is no handler.
+@item catch exception unhandled
+Set a catchpoint that stops executino whenever (any task in the) program
+raises an exception for which there is no handler.
@item info exceptions
@itemx info exceptions @var{regexp}
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
and then Matches (Node (N), Node (S1))
then
if not Found then
- if Parent (Node (N)) = Parent (Node (S1)) then
+
+ -- If the label and the goto are both in the same statement
+ -- list, then we've found a loop. Note that labels and goto
+ -- statements are always part of some list, so
+ -- List_Containing always makes sense.
+
+ if
+ List_Containing (Node (N)) = List_Containing (Node (S1))
+ then
Source := S1;
Found := True;
--------------
procedure Labl;
- -- This procedure creates implicit label declarations for all label that
- -- are declared in the current unit. Note that this could conceptually
- -- be done at the point where the labels are declared, but it is tricky
- -- to do it then, since the tree is not hooked up at the point where the
- -- label is declared (e.g. a sequence of statements is not yet attached
- -- to its containing scope at the point a label in the sequence is found)
+ -- This procedure creates implicit label declarations for all labels that
+ -- are declared in the current unit. Note that this could conceptually be
+ -- done at the point where the labels are declared, but it is tricky to do
+ -- it then, since the tree is not hooked up at the point where the label is
+ -- declared (e.g. a sequence of statements is not yet attached to its
+ -- containing scope at the point a label in the sequence is found).
--------------
-- Par.Load --
Address_Size : constant := Standard'Address_Size;
Short_Address_Size : constant := 32;
- function "+" (Left : Address; Right : Long_Integer) return Address;
- function "+" (Left : Long_Integer; Right : Address) return Address;
- function "-" (Left : Address; Right : Address) return Long_Integer;
- function "-" (Left : Address; Right : Long_Integer) return Address;
+ function "+" (Left : Short_Address; Right : Integer) return Short_Address;
+ function "+" (Left : Integer; Right : Short_Address) return Short_Address;
+ function "-" (Left : Short_Address; Right : Short_Address) return Integer;
+ function "-" (Left : Short_Address; Right : Integer) return Short_Address;
pragma Import (Intrinsic, "+");
pragma Import (Intrinsic, "-");
type Unsigned_Quadword_Array is
array (Integer range <>) of Unsigned_Quadword;
- function To_Address (X : Integer) return Address;
+ function To_Address (X : Integer) return Short_Address;
pragma Pure_Function (To_Address);
- function To_Address_Long (X : Unsigned_Longword) return Address;
+ function To_Address_Long (X : Unsigned_Longword) return Short_Address;
pragma Pure_Function (To_Address_Long);
- function To_Integer (X : Address) return Integer;
+ function To_Integer (X : Short_Address) return Integer;
- function To_Unsigned_Longword (X : Address) return Unsigned_Longword;
- function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword;
+ function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword;
+ function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword;
-- Conventional names for static subtypes of type UNSIGNED_LONGWORD
-- want warnings when we compile on such systems.
function To_Address_A is new
- Ada.Unchecked_Conversion (Integer, Address);
+ Ada.Unchecked_Conversion (Integer, Short_Address);
pragma Pure_Function (To_Address_A);
- function To_Address (X : Integer) return Address
+ function To_Address (X : Integer) return Short_Address
renames To_Address_A;
pragma Pure_Function (To_Address);
function To_Address_Long_A is new
- Ada.Unchecked_Conversion (Unsigned_Longword, Address);
+ Ada.Unchecked_Conversion (Unsigned_Longword, Short_Address);
pragma Pure_Function (To_Address_Long_A);
- function To_Address_Long (X : Unsigned_Longword) return Address
+ function To_Address_Long (X : Unsigned_Longword) return Short_Address
renames To_Address_Long_A;
pragma Pure_Function (To_Address_Long);
function To_Integer_A is new
- Ada.Unchecked_Conversion (Address, Integer);
+ Ada.Unchecked_Conversion (Short_Address, Integer);
- function To_Integer (X : Address) return Integer
+ function To_Integer (X : Short_Address) return Integer
renames To_Integer_A;
function To_Unsigned_Longword_A is new
- Ada.Unchecked_Conversion (Address, Unsigned_Longword);
+ Ada.Unchecked_Conversion (Short_Address, Unsigned_Longword);
- function To_Unsigned_Longword (X : Address) return Unsigned_Longword
+ function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword
renames To_Unsigned_Longword_A;
function To_Unsigned_Longword_A is new
-- This routine checks whether this is indeed the case and if so returns
-- False, signaling that no value for Discr should appear in N's
-- aggregate part. Also, in this case, the routine appends to
- -- New_Assoc_List the discriminant value specified in the ancestor
- -- part.
+ -- New_Assoc_List the discriminant value specified in the ancestor part.
+ --
-- If the aggregate is in a context with expansion delayed, it will be
-- reanalyzed, The inherited discriminant values must not be reinserted
-- in the component list to prevent spurious errors, but it must be
-- a list of N_Component_Association nodes.
-- What is this referring to??? There is no "following function" in
-- sight???
+ --
-- If no component association has a choice for the searched component,
-- the value provided by the others choice is returned, if there is one,
-- and Consider_Others_Choice is set to true. Otherwise Empty is
if Inherited_Discriminant (Comp_Assoc) then
return True;
end if;
+
Next (Comp_Assoc);
end loop;
end if;
Make_Class_Wide_Type (Typ);
Error_Msg_N
("incomplete view of tagged type should be declared tagged?",
- Parent (Current_Entity (Typ)));
+ Parent (Current_Entity (Typ)));
end if;
return;
Inc_T := Make_Defining_Identifier (Loc, Chars (Typ));
Decl := Make_Incomplete_Type_Declaration (Loc, Inc_T);
- -- Type has already been inserted into the current scope.
- -- Remove it, and add incomplete declaration for type, so
- -- that subsequent anonymous access types can use it.
- -- The entity is unchained from the homonym list and from
- -- immediate visibility. After analysis, the entity in the
- -- incomplete declaration becomes immediately visible in the
- -- record declaration that follows.
+ -- Type has already been inserted into the current scope. Remove
+ -- it, and add incomplete declaration for type, so that subsequent
+ -- anonymous access types can use it. The entity is unchained from
+ -- the homonym list and from immediate visibility. After analysis,
+ -- the entity in the incomplete declaration becomes immediately
+ -- visible in the record declaration that follows.
H := Current_Entity (Typ);
Set_Full_View (Inc_T, Typ);
if Is_Tagged then
- -- Create a common class-wide type for both views, and set
- -- the Etype of the class-wide type to the full view.
+
+ -- Create a common class-wide type for both views, and set the
+ -- Etype of the class-wide type to the full view.
Make_Class_Wide_Type (Inc_T);
Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T));
-- Analyze_Selected_Component --
--------------------------------
- -- Prefix is a record type or a task or protected type. In the
- -- later case, the selector must denote a visible entry.
+ -- Prefix is a record type or a task or protected type. In the latter case,
+ -- the selector must denote a visible entry.
procedure Analyze_Selected_Component (N : Node_Id) is
Name : constant Node_Id := Prefix (N);
-- a class-wide type, we use its root type, whose components are
-- present in the class-wide type.
+ Is_Single_Concurrent_Object : Boolean;
+ -- Set True if the prefix is a single task or a single protected object
+
function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
-- It is known that the parent of N denotes a subprogram call. Comp
-- is an overloadable component of the concurrent type of the prefix.
Type_To_Use := Root_Type (Prefix_Type);
end if;
+ -- If the prefix is a single concurrent object, use its name in error
+ -- messages, rather than that of its anonymous type.
+
+ Is_Single_Concurrent_Object :=
+ Is_Concurrent_Type (Prefix_Type)
+ and then Is_Internal_Name (Chars (Prefix_Type))
+ and then not Is_Derived_Type (Prefix_Type)
+ and then Is_Entity_Name (Name);
+
Comp := First_Entity (Type_To_Use);
-- If the selector has an original discriminant, the node appears in
return;
else
- Error_Msg_NE
- ("invisible selector for }",
- N, First_Subtype (Prefix_Type));
+ Error_Msg_Node_2 := First_Subtype (Prefix_Type);
+ Error_Msg_NE ("invisible selector& for }", N, Sel);
Set_Entity (Sel, Any_Id);
Set_Etype (N, Any_Type);
end if;
Has_Candidate := True;
end if;
+ -- Note: a selected component may not denote a component of a
+ -- protected type (4.1.3(7)).
+
elsif Ekind_In (Comp, E_Discriminant, E_Entry_Family)
- or else (In_Scope and then Is_Entity_Name (Name))
+ or else (In_Scope
+ and then not Is_Protected_Type (Prefix_Type)
+ and then Is_Entity_Name (Name))
then
Set_Entity_With_Style_Check (Sel, Comp);
Generate_Reference (Comp, Sel);
end if;
end if;
+ if Etype (N) = Any_Type and then Is_Protected_Type (Prefix_Type) then
+ -- Case of a prefix of a protected type: selector might denote
+ -- an invisible private component.
+
+ Comp := First_Private_Entity (Base_Type (Prefix_Type));
+ while Present (Comp) and then Chars (Comp) /= Chars (Sel) loop
+ Next_Entity (Comp);
+ end loop;
+
+ if Present (Comp) then
+ if Is_Single_Concurrent_Object then
+ Error_Msg_Node_2 := Entity (Name);
+ Error_Msg_NE ("invisible selector& for &", N, Sel);
+
+ else
+ Error_Msg_Node_2 := First_Subtype (Prefix_Type);
+ Error_Msg_NE ("invisible selector& for }", N, Sel);
+ end if;
+ return;
+ end if;
+ end if;
+
Set_Is_Overloaded (N, Is_Overloaded (Sel));
else
if Etype (N) = Any_Type then
- -- If the prefix is a single concurrent object, use its name in the
- -- error message, rather than that of its anonymous type.
-
- if Is_Concurrent_Type (Prefix_Type)
- and then Is_Internal_Name (Chars (Prefix_Type))
- and then not Is_Derived_Type (Prefix_Type)
- and then Is_Entity_Name (Name)
- then
-
+ if Is_Single_Concurrent_Object then
Error_Msg_Node_2 := Entity (Name);
Error_Msg_NE ("no selector& for&", N, Sel);
projects / platform / upstream / linaro-gcc.git / commitdiff