+2013-04-11 Eric Botcazou <ebotcazou@adacore.com>
+
+ * init.c (RETURN_ADDR_OFFSET): Delete as unused.
+
+2013-04-11 Robert Dewar <dewar@adacore.com>
+
+ * a-crbtgk.adb, a-ciorse.adb, a-crbtgo.adb, a-coorse.adb, a-rbtgbo.adb,
+ a-cborse.adb, a-rbtgso.adb, exp_ch3.adb: Minor reformatting.
+
+2013-04-11 Yannick Moy <moy@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Selected_Component): Do not expand
+ discriminant check for Unchecked_Union.
+ * sem_res.adb (Resolve_Selected_Component): Set flag
+ Do_Discriminant_Check even when expansion is not performed.
+ * sinfo.ads (Do_Discriminant_Check): Update documentation for the case
+ of Unchecked_Union.
+
+2013-04-11 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch13.adb (Same_Representation): Two types with different scalar
+ storage order never have the same representation.
+
+2013-04-11 Arnaud Charlet <charlet@adacore.com>
+
+ * xgnatugn.adb (Push_Conditional): Simplify handling,
+ no longer need to keep track of "excluding" sections.
+ (Currently_Excluding): Removed.
+ (Process_Source_File):
+ Set unw/vms flag so that texinfo can do the whole handling of
+ @ifset/@ifclear sections. Fix handling of nested @ifset/@ifclear
+ sections.
+ * gnat_ugn.texi: Add a section on performing unassisted install
+ on Windows.
+
2013-04-11 Johannes Kanig <kanig@adacore.com>
* debug.adb: Document usage of -gnatd.Q switch.
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
end;
if Compare then
+
-- Item is equivalent to the node's element, so we will not have to
-- move the node.
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
raise;
end;
- if not Compare then -- Item is equivalent to Nodes (Hint).Element
+ -- Item is equivalent to Nodes (Hint).Element
+
+ if not Compare then
+
-- Ceiling returns an element that is equivalent or greater than
-- Item. If Item is "not less than" the element, then by
-- elimination we know that Item is equivalent to the element.
procedure Delete (Container : in out Set; Item : Element_Type) is
X : Node_Access := Element_Keys.Find (Container.Tree, Item);
-
begin
if X = null then
raise Constraint_Error with "attempt to delete element not in set";
+ else
+ Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
+ Free (X);
end if;
-
- Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
- Free (X);
end Delete;
------------------
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
raise;
end;
- if not Compare then -- Item >= Hint.Element
- -- Ceiling returns an element that is equivalent or greater than
- -- Item. If Item is "not less than" the element, then by
- -- elimination we know that Item is equivalent to the element.
+ -- Item >= Hint.Element
+
+ if not Compare then
+
+ -- Ceiling returns an element that is equivalent or greater
+ -- than Item. If Item is "not less than" the element, then
+ -- by elimination we know that Item is equivalent to the element.
-- But this means that it is not possible to assign the value of
-- Item to the specified element (on Node), because a different
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
raise;
end;
- if not Compare then -- Item >= Hint.Element
- -- Ceiling returns an element that is equivalent or greater than
- -- Item. If Item is "not less than" the element, then by
- -- elimination we know that Item is equivalent to the element.
+ -- Item >= Hint.Element
+
+ if not Compare then
+
+ -- Ceiling returns an element that is equivalent or greater
+ -- than Item. If Item is "not less than" the element, then
+ -- by elimination we know that Item is equivalent to the element.
-- But this means that it is not possible to assign the value of
-- Item to the specified element (on Node), because a different
L := L - 1;
return Y;
+
exception
when others =>
B := B - 1;
L := L - 1;
return Result;
+
exception
when others =>
B := B - 1;
L := L - 1;
return Y;
+
exception
when others =>
B := B - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
B := B + 1;
L := L + 1;
- Compare := Tree.Last = null
- or else Is_Greater_Key_Node (Key, Tree.Last);
+ Compare :=
+ Tree.Last = null or else Is_Greater_Key_Node (Key, Tree.Last);
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
return;
end if;
- -- We know that Key isn't less than the hint so we try again,
- -- this time to see if it's greater than the hint. If so we
- -- compare Key to the node that follows the hint. If Key is both
- -- greater than the hint and less than the hint's next neighbor,
- -- then we're done; otherwise we must search.
+ -- We know that Key isn't less than the hint so we try again, this time
+ -- to see if it's greater than the hint. If so we compare Key to the
+ -- node that follows the hint. If Key is both greater than the hint and
+ -- less than the hint's next neighbor, then we're done; otherwise we
+ -- must search.
begin
B := B + 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
L := L - 1;
B := B - 1;
+
exception
when others =>
L := L - 1;
return;
end if;
- -- We know that Key is neither less than the hint nor greater
- -- than the hint, and that's the definition of equivalence.
- -- There's nothing else we need to do, since a search would just
- -- reach the same conclusion.
+ -- We know that Key is neither less than the hint nor greater than the
+ -- hint, and that's the definition of equivalence. There's nothing else
+ -- we need to do, since a search would just reach the same conclusion.
Node := Position;
Inserted := False;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
BS := BS - 1;
LS := LS - 1;
+
exception
when others =>
BT := BT - 1;
LR := LR - 1;
return Tree;
+
exception
when others =>
BL := BL - 1;
BS := BS - 1;
LS := LS - 1;
+
exception
when others =>
BT := BT - 1;
LR := LR - 1;
return Tree;
+
exception
when others =>
BL := BL - 1;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
BS := BS - 1;
LS := LS - 1;
+
exception
when others =>
BT := BT - 1;
LR := LR - 1;
return Tree;
+
exception
when others =>
BL := BL - 1;
BS := BS - 1;
LS := LS - 1;
+
exception
when others =>
BS := BS - 1;
LR := LR - 1;
return Tree;
+
exception
when others =>
BL := BL - 1;
begin
Full_Type := Typ;
- if Is_Private_Type (Typ)
- and then Present (Full_View (Typ))
- then
+
+ if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
Full_Type := Full_View (Typ);
end if;
(N, New_Copy_Tree (Init_Expr, New_Scope => Current_Scope));
return;
- -- If type has discriminants, try to build equivalent
- -- aggregate using discriminant values from the declaration.
- -- This is a useful optimization, in particular if restriction
+ -- If type has discriminants, try to build equivalent aggregate
+ -- using discriminant values from the declaration. This
+ -- is a useful optimization, in particular if restriction
-- No_Elaboration_Code is active.
elsif Build_Equivalent_Aggregate then
Loc : constant Source_Ptr := Sloc (N);
Par : constant Node_Id := Parent (N);
P : constant Node_Id := Prefix (N);
+ S : constant Node_Id := Selector_Name (N);
Ptyp : Entity_Id := Underlying_Type (Etype (P));
Disc : Entity_Id;
New_N : Node_Id;
-- Deal with discriminant check required
if Do_Discriminant_Check (N) then
+ if Present (Discriminant_Checking_Func
+ (Original_Record_Component (Entity (S))))
+ then
+ -- Present the discriminant checking function to the backend, so
+ -- that it can inline the call to the function.
+
+ Add_Inlined_Body
+ (Discriminant_Checking_Func
+ (Original_Record_Component (Entity (S))));
- -- Present the discriminant checking function to the backend, so that
- -- it can inline the call to the function.
+ -- Now reset the flag and generate the call
- Add_Inlined_Body
- (Discriminant_Checking_Func
- (Original_Record_Component (Entity (Selector_Name (N)))));
+ Set_Do_Discriminant_Check (N, False);
+ Generate_Discriminant_Check (N);
- -- Now reset the flag and generate the call
+ -- In the case of Unchecked_Union, no discriminant checking is
+ -- actually performed.
- Set_Do_Discriminant_Check (N, False);
- Generate_Discriminant_Check (N);
+ else
+ Set_Do_Discriminant_Check (N, False);
+ end if;
end if;
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
@ifset unw
Microsoft Windows Topics
+@ifclear FSFEDITION
+* Installing from the Command Line::
+@end ifclear
* Using GNAT on Windows::
+* Using a network installation of GNAT::
* CONSOLE and WINDOWS subsystems::
* Temporary Files::
* Mixed-Language Programming on Windows::
platforms (NT, 2000, and XP Professional).
@menu
+@ifclear FSFEDITION
+* Installing from the Command Line::
+@end ifclear
* Using GNAT on Windows::
* Using a network installation of GNAT::
* CONSOLE and WINDOWS subsystems::
* Setting Heap Size from gnatlink::
@end menu
+@ifclear FSFEDITION
+@node Installing from the Command Line
+@section Installing from the Command Line
+@cindex Batch installation
+@cindex Silent installation
+@cindex Unassisted installation
+
+@noindent
+By default the @value{EDITION} installers display a GUI that prompts the user
+to enter installation path and similar information, and guide him through the
+installation process. It is also possible to perform silent installations
+using the command-line interface.
+
+In order to install one of the @value{EDITION} installers from the command
+line you should pass parameter @code{/S} (and, optionally,
+@code{/D=<directory>}) as command-line arguments.
+
+@ifset PROEDITION
+For example, for an unattended installation of
+@value{EDITION} 7.0.2 into the default directory
+@code{C:\GNATPRO\7.0.2} you would run:
+
+@smallexample
+gnatpro-7.0.2-i686-pc-mingw32-bin.exe /S
+@end smallexample
+
+To install into a custom directory, say, @code{C:\TOOLS\GNATPRO\7.0.2}:
+
+@smallexample
+gnatpro-7.0.2-i686-pc-mingw32-bin /S /D=C:\TOOLS\GNATPRO\7.0.2
+@end smallexample
+@end ifset
+
+@ifset GPLEDITION
+For example, for an unattended installation of
+@value{EDITION} 2012 into @code{C:\GNAT\2012}:
+
+@smallexample
+gnat-gpl-2012-i686-pc-mingw32-bin /S /D=C:\GNAT\2012
+@end smallexample
+@end ifset
+
+You can use the same syntax for all installers.
+
+Note that unattended installations don't modify system path, nor create file
+associations, so such activities need to be done by hand.
+@end ifclear
+
@node Using GNAT on Windows
@section Using GNAT on Windows
#include <sys/ucontext.h>
#include <sys/regset.h>
-/* The code below is common to SPARC and x86. Beware of the delay slot
- differences for signal context adjustments. */
-
-#if defined (__sparc)
-#define RETURN_ADDR_OFFSET 8
-#else
-#define RETURN_ADDR_OFFSET 0
-#endif
-
static void
__gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
{
return False;
end if;
- -- Representations are different if component alignments differ
+ -- Representations are different if component alignments or scalar
+ -- storage orders differ.
if (Is_Record_Type (T1) or else Is_Array_Type (T1))
and then
(Is_Record_Type (T2) or else Is_Array_Type (T2))
- and then Component_Alignment (T1) /= Component_Alignment (T2)
+ and then
+ (Component_Alignment (T1) /= Component_Alignment (T2)
+ or else
+ Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
then
return False;
end if;
function Same_Rep return Boolean;
-- CD1 and CD2 are either components or discriminants. This
- -- function tests whether the two have the same representation
+ -- function tests whether they have the same representation.
--------------
-- Same_Rep --
begin
if No (Component_Clause (CD1)) then
return No (Component_Clause (CD2));
-
else
+ -- Note: at this point, component clauses have been
+ -- normalized to the default bit order, so that the
+ -- comparison of Component_Bit_Offsets is meaningful.
+
return
Present (Component_Clause (CD2))
and then
and then Ekind_In (Entity (S), E_Component, E_Discriminant)
and then Present (Original_Record_Component (Entity (S)))
and then Ekind (Original_Record_Component (Entity (S))) = E_Component
- and then Present (Discriminant_Checking_Func
- (Original_Record_Component (Entity (S))))
and then not Discriminant_Checks_Suppressed (T)
and then not Init_Component
then
-- This flag is set on N_Selected_Component nodes to indicate that a
-- discriminant check is required using the discriminant check routine
-- associated with the selector. The actual check is generated by the
- -- expander when processing selected components.
+ -- expander when processing selected components. In the case of
+ -- Unchecked_Union, the flag is also set, but no discriminant check
+ -- routine is associated with the selector, and the expander does not
+ -- generate a check.
-- Do_Division_Check (Flag13-Sem)
-- This flag is set on a division operator (/ mod rem) to indicate
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2013, 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- --
procedure Put_Line (F : Sfile; S : String);
-- Local version of Put_Line ensures Unix style line endings
+ First_Time : Boolean := True;
Number_Of_Warnings : Natural := 0;
Number_Of_Errors : Natural := 0;
Warnings_Enabled : Boolean;
-- It relies on information in Source_File to generate error messages.
type Conditional is (Set, Clear);
- procedure Push_Conditional (Cond : Conditional; Flag : Target_Type);
+ procedure Push_Conditional (Cond : Conditional; Flag : Flag_Type);
procedure Pop_Conditional (Cond : Conditional);
-- These subprograms deal with conditional processing (@ifset/@ifclear).
-- They rely on information in Source_File to generate error messages.
- function Currently_Excluding return Boolean;
- -- Returns true if conditional processing directives imply that the
- -- current line should not be included in the output.
-
function VMS_Context_Determined return Boolean;
-- Returns true if, in the current conditional preprocessing context, we
-- always have a VMS or a non-VMS version, regardless of the value of
Starting_Line : Positive;
Cond : Conditional;
Flag : Flag_Type;
- Excluding : Boolean;
end record;
Conditional_Stack_Depth : constant := 3;
Error (Source_File, "flag has to be lowercase");
end if;
+ -- Set unw/vms flag in the output file so that
+ -- @ifset/@ifclear will work as expected.
+
+ if First_Time then
+ Put_Line (Output_File, "@set " & Argument (1));
+ First_Time := False;
+ end if;
+
when Edition_Type =>
null;
end case;
Error (Source_File, "flag has to be lowercase");
end if;
+ -- Set unw/vms flag in the output file so that
+ -- @ifset/@ifclear will work as expected.
+
+ if First_Time then
+ Put_Line (Output_File, "@set " & Argument (1));
+ First_Time := False;
+ end if;
+
when Edition_Type =>
null;
end case;
end;
end if;
- if Have_Conditional and (Flag in Target_Type) then
-
+ if Have_Conditional then
-- We create a new conditional context and suppress the
-- directive in the output.
elsif Line'Length >= Endsetclear'Length
and then Line (1 .. Endsetclear'Length) = Endsetclear
- and then (Flag in Target_Type)
then
-- The '@end ifset'/'@end ifclear' case is handled here. We
-- have to pop the conditional context.
if Have_Conditional then
Pop_Conditional (Cond);
+
+ if Conditional_TOS > 0 then
+ Flag := Conditional_Stack (Conditional_TOS).Flag;
+ end if;
end if;
-- We fall through to the ordinary case for other @end
end;
end if; -- Have_Conditional
- if (not Have_Conditional) or (Flag in Edition_Type) then
-
- -- The ordinary case
-
- if not Currently_Excluding then
- Put_Line (Output_File, Rewritten);
- end if;
- end if;
+ Put_Line (Output_File, Rewritten);
end;
end loop;
-- Push_Conditional --
----------------------
- procedure Push_Conditional (Cond : Conditional; Flag : Target_Type) is
- Will_Exclude : Boolean;
-
+ procedure Push_Conditional (Cond : Conditional; Flag : Flag_Type) is
begin
- -- If we are already in an excluding context, inherit this property,
- -- otherwise calculate it from scratch.
+ if Flag in Target_Type then
- if Conditional_TOS > 0
- and then Conditional_Stack (Conditional_TOS).Excluding
- then
- Will_Exclude := True;
- else
- case Cond is
- when Set =>
- Will_Exclude := Flag /= Target;
- when Clear =>
- Will_Exclude := Flag = Target;
- end case;
- end if;
+ -- Check if the current directive is pointless because of a previous,
+ -- enclosing directive.
- -- Check if the current directive is pointless because of a previous,
- -- enclosing directive.
-
- for J in 1 .. Conditional_TOS loop
- if Conditional_Stack (J).Flag = Flag then
- Warning (Source_File, "directive without effect because of line"
- & Integer'Image (Conditional_Stack (J).Starting_Line));
- end if;
- end loop;
+ for J in 1 .. Conditional_TOS loop
+ if Conditional_Stack (J).Flag = Flag then
+ Warning
+ (Source_File, "directive without effect because of line"
+ & Integer'Image (Conditional_Stack (J).Starting_Line));
+ end if;
+ end loop;
+ end if;
Conditional_TOS := Conditional_TOS + 1;
Conditional_Stack (Conditional_TOS) :=
(Starting_Line => Source_File.Line,
Cond => Cond,
- Flag => Flag,
- Excluding => Will_Exclude);
+ Flag => Flag);
end Push_Conditional;
---------------------
end if;
end Pop_Conditional;
- -------------------------
- -- Currently_Excluding --
- -------------------------
-
- function Currently_Excluding return Boolean is
- begin
- return Conditional_TOS > 0
- and then Conditional_Stack (Conditional_TOS).Excluding;
- end Currently_Excluding;
-
----------------------------
-- VMS_Context_Determined --
----------------------------
projects / platform / upstream / gcc.git / commitdiff