aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog834
-rw-r--r--gcc/ada/checks.ads9
-rw-r--r--gcc/ada/exp_ch13.adb20
-rw-r--r--gcc/ada/exp_ch8.adb30
-rw-r--r--gcc/ada/exp_util.ads11
-rw-r--r--gcc/ada/freeze.ads7
-rw-r--r--gcc/ada/g-dirope.adb5
-rw-r--r--gcc/ada/g-dirope.ads66
-rw-r--r--gcc/ada/g-regexp.adb103
-rw-r--r--gcc/ada/impunit.adb1
-rw-r--r--gcc/ada/mdllfile.ads29
-rw-r--r--gcc/ada/mlib-fil.ads8
-rw-r--r--gcc/ada/par-ch12.adb5
-rw-r--r--gcc/ada/prj-dect.ads2
-rw-r--r--gcc/ada/s-arit64.adb16
-rw-r--r--gcc/ada/s-fatgen.ads11
-rw-r--r--gcc/ada/s-stalib.adb11
-rw-r--r--gcc/ada/sem_ch4.adb14
18 files changed, 952 insertions, 230 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2f055e3..c92ffb9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,837 @@
+2001-12-12 Robert Dewar <dewar@gnat.com>
+
+ * s-stalib.adb: Add more comments on with statements being needed
+
+ * par-ch12.adb: Minor reformatting
+
+ * prj-dect.ads: Fix copyright header
+
+ * s-arit64.adb (Multiply_With_Ovflo_Check): Fix case where both
+ inputs fit in 32 bits, but the result still overflows.
+
+ * s-fatgen.ads: Minor comment improvement
+
+2001-12-12 Ed Schonberg <schonber@gnat.com>
+
+ * sem_ch4.adb (Analyze_Selected_Component): If the prefix is of a
+ formal derived type, look for an inherited component from the full
+ view of the parent, if any.
+
+2001-12-12 Robert Dewar <dewar@gnat.com>
+
+ * checks.ads (Apply_Alignment_Check): New procedure.
+
+ * exp_ch13.adb (Expand_N_Freeze_Entity): Generate dynamic check to
+ ensure that the alignment of objects with address clauses is
+ appropriate, and raise PE if not.
+
+ * exp_util.ads (Must_Be_Aligned): Removed, replaced by
+ Exp_Pakd.Known_Aligned_Enough
+
+ * mdllfile.ads: Minor reformatting
+
+ * mlib-fil.ads: Minor reformatting
+
+2001-12-12 Ed Schonberg <schonber@gnat.com>
+
+ * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Extend previous
+ fix to any component reference if enclosing record has non-standard
+ representation.
+
+2001-12-12 Vincent Celier <celier@gnat.com>
+
+ * g-dirope.ads (Find, Wildcard_Iterator): Moved to child package
+ Iteration
+
+2001-12-12 Ed Schonberg <schonber@gnat.com>
+
+ * freeze.ads: Make Freeze_Fixed_Point_Type visible, for use in
+ sem_attr.
+
+2001-12-12 Robert Dewar <dewar@gnat.com>
+
+ * impunit.adb: Add entry for GNAT.Directory_Operations.Iteration
+
+2001-12-12 Emmanuel Briot <briot@gnat.com>
+
+ * g-regexp.adb: Remove all debug code, since it isn't required anymore,
+ and it adds dependencies to system.io.
+
+2001-12-12 Pascal Obry <obry@gnat.com>
+
+ * g-dirope.adb (Expand_Path.Var): Correctly detect end of
+ variable name.
+
+*** s-stalib.adb 2001/09/03 15:24:33 1.17
+--- s-stalib.adb 2001/10/16 13:14:46 1.18
+***************
+*** 46,59 ****
+ -- elaboration circularities with Ada.Exceptions if polling is on.
+
+ with System.Soft_Links;
+! -- Referenced directly from generated code
+! -- Also referenced from exception handling routines.
+ -- This is needed for programs that don't use exceptions explicitely but
+ -- direct calls to Ada.Exceptions are generated by gigi (for example,
+ -- by calling __gnat_raise_constraint_error directly).
+
+ with System.Memory;
+! -- Referenced directly from generated code
+
+ package body System.Standard_Library is
+
+--- 46,62 ----
+ -- elaboration circularities with Ada.Exceptions if polling is on.
+
+ with System.Soft_Links;
+! -- Referenced directly from generated code using external symbols so it
+! -- must always be present in a build, even if no unit has a direct with
+! -- of this unit. Also referenced from exception handling routines.
+ -- This is needed for programs that don't use exceptions explicitely but
+ -- direct calls to Ada.Exceptions are generated by gigi (for example,
+ -- by calling __gnat_raise_constraint_error directly).
+
+ with System.Memory;
+! -- Referenced directly from generated code using external symbols, so it
+! -- must always be present in a build, even if no unit has a direct with
+! -- of this unit.
+
+ package body System.Standard_Library is
+
+
+*** par-ch12.adb 2001/10/19 15:22:18 1.48
+--- par-ch12.adb 2001/10/19 15:24:48 1.49
+***************
+*** 452,466 ****
+ if Def_Node /= Error then
+ Set_Formal_Type_Definition (Decl_Node, Def_Node);
+ TF_Semicolon;
+ else
+ Decl_Node := Error;
+
+ if Token = Tok_Semicolon then
+- -- Avoid further cascaded errors.
+ Scan;
+ end if;
+ end if;
+-
+
+ return Decl_Node;
+ end P_Formal_Type_Declaration;
+--- 452,467 ----
+ if Def_Node /= Error then
+ Set_Formal_Type_Definition (Decl_Node, Def_Node);
+ TF_Semicolon;
++
+ else
+ Decl_Node := Error;
+
++ -- If we have semicolon, skip it to avoid cascaded errors
++
+ if Token = Tok_Semicolon then
+ Scan;
+ end if;
+ end if;
+
+ return Decl_Node;
+ end P_Formal_Type_Declaration;
+
+*** prj-dect.ads 2001/10/20 10:28:13 1.4
+--- prj-dect.ads 2001/10/20 11:43:56 1.5
+***************
+*** 8,14 ****
+ -- --
+ -- $Revision$
+ -- --
+! -- Copyright (C) 2000-2001 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- --
+--- 8,14 ----
+ -- --
+ -- $Revision$
+ -- --
+! -- Copyright (C) 2001 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- --
+
+*** s-arit64.adb 2001/02/09 15:10:29 1.16
+--- s-arit64.adb 2001/10/20 14:50:39 1.17
+***************
+*** 325,337 ****
+ T2 := Xhi * Ylo;
+ end if;
+
+! else
+! if Yhi /= 0 then
+! T2 := Xlo * Yhi;
+! else
+! return X * Y;
+! end if;
+ end if;
+
+ T1 := Xlo * Ylo;
+ T2 := T2 + Hi (T1);
+--- 325,339 ----
+ T2 := Xhi * Ylo;
+ end if;
+
+! elsif Yhi /= 0 then
+! T2 := Xlo * Yhi;
+!
+! else -- Yhi = Xhi = 0
+! T2 := 0;
+ end if;
++
++ -- Here we have T2 set to the contribution to the upper half
++ -- of the result from the upper halves of the input values.
+
+ T1 := Xlo * Ylo;
+ T2 := T2 + Hi (T1);
+
+*** s-fatgen.ads 2001/07/20 00:59:34 1.9
+--- s-fatgen.ads 2001/10/20 18:37:39 1.10
+***************
+*** 89,97 ****
+
+ function Unbiased_Rounding (X : T) return T;
+
+! function Valid (X : access T) return Boolean;
+! -- The argument must be passed by reference here, as T may be
+! -- an abnormal value that can be passed in a floating point register.
+
+ private
+ pragma Inline (Machine);
+--- 89,100 ----
+
+ function Unbiased_Rounding (X : T) return T;
+
+! function Valid (X : access T) return Boolean;
+! -- This function checks if the object of type T referenced by X
+! -- is valid, and returns True/False accordingly. The parameter is
+! -- passed by reference (access) here, as the object of type T may
+! -- be an abnormal value that cannot be passed in a floating-point
+! -- register, and the whole point of 'Valid is to prevent exceptions.
+
+ private
+ pragma Inline (Machine);
+
+*** sem_ch4.adb 2001/09/24 22:32:31 1.511
+--- sem_ch4.adb 2001/10/21 17:41:52 1.512
+***************
+*** 2691,2696 ****
+--- 2691,2708 ----
+
+ Check_Misspelled_Selector (Entity_List, Sel);
+
++ elsif Is_Generic_Type (Prefix_Type)
++ and then Ekind (Prefix_Type) = E_Record_Type_With_Private
++ and then Is_Record_Type (Etype (Prefix_Type))
++ then
++ -- If this is a derived formal type, the parent may have a
++ -- different visibility at this point. Try for an inherited
++ -- component before reporting an error.
++
++ Set_Etype (Prefix (N), Etype (Prefix_Type));
++ Analyze_Selected_Component (N);
++ return;
++
+ else
+ if Ekind (Prefix_Type) = E_Record_Subtype then
+
+
+*** checks.ads 2001/07/16 01:26:04 1.55
+--- checks.ads 2001/10/28 15:13:02 1.56
+***************
+*** 83,88 ****
+--- 83,95 ----
+ -- the object denoted by the access parameter is not deeper than the
+ -- level of the type Typ. Program_Error is raised if the check fails.
+
++ procedure Apply_Alignment_Check (E : Entity_Id; N : Node_Id);
++ -- E is the entity for an object. If there is an address clause for
++ -- this entity, and checks are enabled, then this procedure generates
++ -- a check that the specified address has an alignment consistent with
++ -- the alignment of the object, raising PE if this is not the case. The
++ -- resulting check (if one is generated) is inserted before node N.
++
+ procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id);
+ -- N is the node for an object declaration that declares an object of
+ -- array type Typ. This routine generates, if necessary, a check that
+
+*** exp_ch13.adb 2001/07/16 21:21:29 1.76
+--- exp_ch13.adb 2001/10/28 15:13:25 1.77
+***************
+*** 27,32 ****
+--- 27,33 ----
+ ------------------------------------------------------------------------------
+
+ with Atree; use Atree;
++ with Checks; use Checks;
+ with Einfo; use Einfo;
+ with Exp_Ch3; use Exp_Ch3;
+ with Exp_Ch6; use Exp_Ch6;
+***************
+*** 236,245 ****
+ Decl : Node_Id;
+
+ begin
+! if not Is_Type (E) and then not Is_Subprogram (E) then
+ return;
+ end if;
+
+ E_Scope := Scope (E);
+
+ -- If we are freezing entities defined in protected types, they
+--- 237,256 ----
+ Decl : Node_Id;
+
+ begin
+! -- For object, with address clause, check alignment is OK
+!
+! if Is_Object (E) then
+! Apply_Alignment_Check (E, N);
+!
+! -- Only other items requiring any front end action are
+! -- types and subprograms.
+!
+! elsif not Is_Type (E) and then not Is_Subprogram (E) then
+ return;
+ end if;
+
++ -- Here E is a type or a subprogram
++
+ E_Scope := Scope (E);
+
+ -- If we are freezing entities defined in protected types, they
+***************
+*** 304,314 ****
+
+ elsif Is_Subprogram (E) then
+ Freeze_Subprogram (N);
+-
+- -- No other entities require any front end freeze actions
+-
+- else
+- null;
+ end if;
+
+ -- Analyze actions generated by freezing. The init_proc contains
+--- 315,320 ----
+
+*** exp_util.ads 2001/07/23 10:05:17 1.112
+--- exp_util.ads 2001/10/28 15:14:04 1.113
+***************
+*** 372,386 ****
+ -- routine is to help avoid generating troublesome temporaries that
+ -- intefere with the stack checking mechanism.
+
+- function Must_Be_Aligned (Obj : Node_Id) return Boolean;
+- -- Given an object reference, determines whether or not the object
+- -- is required to be aligned according to its type'alignment value.
+- -- Normally, objects are required to be aligned, and the result will
+- -- be True. The situation in which this is not the case is if the
+- -- object reference involves a component of a packed array, where
+- -- the type of the component is not required to have strict alignment.
+- -- In this case, false will be returned.
+-
+ procedure Remove_Side_Effects
+ (Exp : Node_Id;
+ Name_Req : Boolean := False;
+--- 372,377 ----
+
+*** mdllfile.ads 2001/10/29 02:06:24 1.2
+--- mdllfile.ads 2001/10/29 02:50:12 1.3
+***************
+*** 26,52 ****
+ -- --
+ ------------------------------------------------------------------------------
+
+! -- Simple services used by GNATDLL to deal with Filename extension.
+
+ package MDLL.Files is
+
+ No_Ext : constant String := "";
+
+! function Get_Ext (Filename : in String)
+! return String;
+! -- return filename's extension.
+!
+! function Is_Ali (Filename : in String)
+! return Boolean;
+! -- test if Filename is an Ada library file (.ali).
+!
+! function Is_Obj (Filename : in String)
+! return Boolean;
+! -- test if Filename is an object file (.o or .obj).
+!
+! function Ext_To (Filename : in String;
+! New_Ext : in String := No_Ext)
+! return String;
+! -- return Filename with the extension change to New_Ext.
+
+ end MDLL.Files;
+--- 26,51 ----
+ -- --
+ ------------------------------------------------------------------------------
+
+! -- Simple services used by GNATDLL to deal with Filename extension
+
+ package MDLL.Files is
+
+ No_Ext : constant String := "";
++ -- Used to mark the absence of an extension
+
+! function Get_Ext (Filename : String) return String;
+! -- Return extension of Filename
+!
+! function Is_Ali (Filename : String) return Boolean;
+! -- Test if Filename is an Ada library file (.ali).
+!
+! function Is_Obj (Filename : String) return Boolean;
+! -- Test if Filename is an object file (.o or .obj)
+!
+! function Ext_To
+! (Filename : String;
+! New_Ext : String := No_Ext)
+! return String;
+! -- Return Filename with the extension change to New_Ext
+
+ end MDLL.Files;
+
+*** mlib-fil.ads 2001/10/29 02:06:26 1.3
+--- mlib-fil.ads 2001/10/29 02:51:28 1.4
+***************
+*** 36,51 ****
+ return String;
+ -- Return Filename with the extension change to New_Ext.
+
+! function Get_Ext (Filename : in String) return String;
+ -- Return extension of filename.
+
+ function Is_Archive (Filename : String) return Boolean;
+ -- Test if filename is an archive
+
+! function Is_C (Filename : in String) return Boolean;
+ -- Test if Filename is a C file
+
+! function Is_Obj (Filename : in String) return Boolean;
+ -- Test if Filename is an object file
+
+ end MLib.Fil;
+--- 36,51 ----
+ return String;
+ -- Return Filename with the extension change to New_Ext.
+
+! function Get_Ext (Filename : String) return String;
+ -- Return extension of filename.
+
+ function Is_Archive (Filename : String) return Boolean;
+ -- Test if filename is an archive
+
+! function Is_C (Filename : String) return Boolean;
+ -- Test if Filename is a C file
+
+! function Is_Obj (Filename : String) return Boolean;
+ -- Test if Filename is an object file
+
+ end MLib.Fil;
+
+*** exp_ch8.adb 2001/10/03 02:17:32 1.30
+--- exp_ch8.adb 2001/10/29 17:32:24 1.31
+***************
+*** 59,65 ****
+ -- of the renamed object. The cases in which this is not true are when
+ -- this address is not computable, since it involves extraction of a
+ -- packed array element, or of a record component to which a component
+! -- clause applies (that can specify an arbitrary bit boundary).
+
+ -- In these two cases, we pre-evaluate the renaming expression, by
+ -- extracting and freezing the values of any subscripts, and then we
+--- 59,66 ----
+ -- of the renamed object. The cases in which this is not true are when
+ -- this address is not computable, since it involves extraction of a
+ -- packed array element, or of a record component to which a component
+! -- clause applies (that can specify an arbitrary bit boundary), or where
+! -- the enclosing record itself has a non-standard representation.
+
+ -- In these two cases, we pre-evaluate the renaming expression, by
+ -- extracting and freezing the values of any subscripts, and then we
+***************
+*** 211,228 ****
+ end if;
+
+ elsif Nkind (Nam) = N_Selected_Component then
+! if Present (Component_Clause (Entity (Selector_Name (Nam)))) then
+! return True;
+
+! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
+! and then Is_Record_Type (Etype (Prefix (Nam)))
+! and then not Is_Concurrent_Record_Type (Etype (Prefix (Nam)))
+! then
+! return True;
+
+! else
+! return Evaluation_Required (Prefix (Nam));
+! end if;
+
+ else
+ return False;
+--- 212,236 ----
+ end if;
+
+ elsif Nkind (Nam) = N_Selected_Component then
+! declare
+! Rec_Type : Entity_Id := Etype (Prefix (Nam));
+
+! begin
+! if Present (Component_Clause (Entity (Selector_Name (Nam))))
+! or else Has_Non_Standard_Rep (Rec_Type)
+! then
+! return True;
+!
+! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
+! and then Is_Record_Type (Rec_Type)
+! and then not Is_Concurrent_Record_Type (Rec_Type)
+! then
+! return True;
+
+! else
+! return Evaluation_Required (Prefix (Nam));
+! end if;
+! end;
+
+ else
+ return False;
+
+*** g-dirope.ads 2001/08/27 09:48:38 1.12
+--- g-dirope.ads 2001/10/29 19:18:13 1.13
+***************
+*** 38,43 ****
+--- 38,47 ----
+ -- can be treated as a file, using open and close routines, and a scanning
+ -- routine is provided for iterating through the entries in a directory.
+
++ -- See also child package GNAT.Directory_Operations.Iteration
++
++ with Ada.Strings.Maps;
++
+ package GNAT.Directory_Operations is
+
+ subtype Dir_Name_Str is String;
+***************
+*** 187,248 ****
+ -- returned in target-OS form. Raises Directory_Error if Dir has not
+ -- be opened (Dir = Null_Dir).
+
+- generic
+- with procedure Action
+- (Item : String;
+- Index : Positive;
+- Quit : in out Boolean);
+- procedure Wildcard_Iterator (Path : Path_Name);
+- -- Calls Action for each path matching Path. Path can include wildcards '*'
+- -- and '?' and [...]. The rules are:
+- --
+- -- * can be replaced by any sequence of characters
+- -- ? can be replaced by a single character
+- -- [a-z] match one character in the range 'a' through 'z'
+- -- [abc] match either character 'a', 'b' or 'c'
+- --
+- -- Item is the filename that has been matched. Index is set to one for the
+- -- first call and is incremented by one at each call. The iterator's
+- -- termination can be controlled by setting Quit to True. It is by default
+- -- set to False.
+- --
+- -- For example, if we have the following directory structure:
+- -- /boo/
+- -- foo.ads
+- -- /sed/
+- -- foo.ads
+- -- file/
+- -- foo.ads
+- -- /sid/
+- -- foo.ads
+- -- file/
+- -- foo.ads
+- -- /life/
+- --
+- -- A call with expression "/s*/file/*" will call Action for the following
+- -- items:
+- -- /sed/file/foo.ads
+- -- /sid/file/foo.ads
+-
+- generic
+- with procedure Action
+- (Item : String;
+- Index : Positive;
+- Quit : in out Boolean);
+- procedure Find
+- (Root_Directory : Dir_Name_Str;
+- File_Pattern : String);
+- -- Recursively searches the directory structure rooted at Root_Directory.
+- -- This provides functionality similar to the UNIX 'find' command.
+- -- Action will be called for every item matching the regular expression
+- -- File_Pattern (see GNAT.Regexp). Item is the full pathname to the file
+- -- starting with Root_Directory that has been matched. Index is set to one
+- -- for the first call and is incremented by one at each call. The iterator
+- -- will pass in the value False on each call to Action. The iterator will
+- -- terminate after passing the last matched path to Action or after
+- -- returning from a call to Action which sets Quit to True.
+- -- Raises GNAT.Regexp.Error_In_Regexp if File_Pattern is ill formed.
+-
+ function Read_Is_Thread_Safe return Boolean;
+ -- Indicates if procedure Read is thread safe. On systems where the
+ -- target system supports this functionality, Read is thread safe,
+--- 191,196 ----
+***************
+*** 259,263 ****
+--- 207,215 ----
+ Null_Dir : constant Dir_Type := null;
+
+ pragma Import (C, Dir_Separator, "__gnat_dir_separator");
++
++ Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
++ Ada.Strings.Maps.To_Set ("/\");
++ -- UNIX and DOS style directory separators.
+
+ end GNAT.Directory_Operations;
+
+*** freeze.ads 2001/10/29 02:06:04 1.15
+--- freeze.ads 2001/10/30 01:36:24 1.16
+***************
+*** 205,210 ****
+--- 205,215 ----
+ -- so need to be similarly treated. Freeze_Expression takes care of
+ -- determining the proper insertion point for generated freeze actions.
+
++ procedure Freeze_Fixed_Point_Type (Typ : Entity_Id);
++ -- Freeze fixed point type. For fixed-point types, we have to defer
++ -- setting the size and bounds till the freeze point, since they are
++ -- potentially affected by the presence of size and small clauses.
++
+ procedure Freeze_Itype (T : Entity_Id; N : Node_Id);
+ -- This routine is called when an Itype is created and must be frozen
+ -- immediately at the point of creation (for the sake of the expansion
+
+*** impunit.adb 2001/09/26 07:14:11 1.14
+--- impunit.adb 2001/10/30 04:33:45 1.15
+***************
+*** 195,200 ****
+--- 195,201 ----
+ "g-curexc", -- GNAT.Current_Exception
+ "g-debpoo", -- GNAT.Debug_Pools
+ "g-debuti", -- GNAT.Debug_Utilities
++ "g-diopit", -- GNAT.Directory_Operations.Iteration
+ "g-dirope", -- GNAT.Directory_Operations
+ "g-dyntab", -- GNAT.Dynamic_Tables
+ "g-exctra", -- GNAT.Exception_Traces
+
+*** g-regexp.adb 2001/10/21 11:04:16 1.28
+--- g-regexp.adb 2001/10/30 15:25:04 1.29
+***************
+*** 32,38 ****
+ -- --
+ ------------------------------------------------------------------------------
+
+- with System.IO;
+ with Unchecked_Deallocation;
+ with Ada.Exceptions;
+ with GNAT.Case_Util;
+--- 32,37 ----
+***************
+*** 73,82 ****
+ end record;
+ -- Deterministic finite-state machine
+
+- Debug : constant Boolean := False;
+- -- When True, the primary and secondary tables will be printed.
+- -- Gnat does not generate any code if this variable is False;
+-
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+--- 72,77 ----
+***************
+*** 188,199 ****
+ pragma No_Return (Raise_Exception);
+ -- Raise an exception, indicating an error at character Index in S.
+
+- procedure Print_Table
+- (Table : Regexp_Array;
+- Num_States : State_Index;
+- Is_Primary : Boolean := True);
+- -- Print a table for debugging purposes
+-
+ --------------------
+ -- Create_Mapping --
+ --------------------
+--- 183,188 ----
+***************
+*** 1225,1309 ****
+ end loop;
+ end loop;
+
+- if Debug then
+- System.IO.New_Line;
+- System.IO.Put_Line ("Secondary table : ");
+- Print_Table (R.States, Nb_State, False);
+- end if;
+-
+ return (Ada.Finalization.Controlled with R => R);
+ end;
+ end Create_Secondary_Table;
+
+- -----------------
+- -- Print_Table --
+- -----------------
+-
+- procedure Print_Table
+- (Table : Regexp_Array;
+- Num_States : State_Index;
+- Is_Primary : Boolean := True)
+- is
+- function Reverse_Mapping (N : Column_Index) return Character;
+- -- Return the character corresponding to a column in the mapping
+-
+- ---------------------
+- -- Reverse_Mapping --
+- ---------------------
+-
+- function Reverse_Mapping (N : Column_Index) return Character is
+- begin
+- for Column in Map'Range loop
+- if Map (Column) = N then
+- return Column;
+- end if;
+- end loop;
+-
+- return ' ';
+- end Reverse_Mapping;
+-
+- -- Start of processing for Print_Table
+-
+- begin
+- -- Print the header line
+-
+- System.IO.Put (" [*] ");
+-
+- for Column in 1 .. Alphabet_Size loop
+- System.IO.Put
+- (String'(1 .. 1 => Reverse_Mapping (Column)) & " ");
+- end loop;
+-
+- if Is_Primary then
+- System.IO.Put ("closure....");
+- end if;
+-
+- System.IO.New_Line;
+-
+- -- Print every line
+-
+- for State in 1 .. Num_States loop
+- System.IO.Put (State'Img);
+-
+- for K in 1 .. 3 - State'Img'Length loop
+- System.IO.Put (" ");
+- end loop;
+-
+- for K in 0 .. Alphabet_Size loop
+- System.IO.Put (Table (State, K)'Img & " ");
+- end loop;
+-
+- for K in Alphabet_Size + 1 .. Table'Last (2) loop
+- if Table (State, K) /= 0 then
+- System.IO.Put (Table (State, K)'Img & ",");
+- end if;
+- end loop;
+-
+- System.IO.New_Line;
+- end loop;
+-
+- end Print_Table;
+-
+ ---------------------
+ -- Raise_Exception --
+ ---------------------
+--- 1214,1223 ----
+***************
+*** 1345,1356 ****
+ (Table, Num_States, Start_State, End_State);
+ end if;
+
+- if Debug then
+- Print_Table (Table.all, Num_States);
+- System.IO.Put_Line ("Start_State : " & Start_State'Img);
+- System.IO.Put_Line ("End_State : " & End_State'Img);
+- end if;
+-
+ -- Creates the secondary table
+
+ R := Create_Secondary_Table
+--- 1259,1264 ----
+***************
+*** 1451,1467 ****
+ New_Table := new Regexp_Array (Table'First (1) .. New_Lines,
+ Table'First (2) .. New_Columns);
+ New_Table.all := (others => (others => 0));
+-
+- if Debug then
+- System.IO.Put_Line ("Reallocating table: Lines from "
+- & State_Index'Image (Table'Last (1))
+- & " to "
+- & State_Index'Image (New_Lines));
+- System.IO.Put_Line (" and columns from "
+- & Column_Index'Image (Table'Last (2))
+- & " to "
+- & Column_Index'Image (New_Columns));
+- end if;
+
+ for J in Table'Range (1) loop
+ for K in Table'Range (2) loop
+--- 1359,1364 ----
+
+*** g-dirope.adb 2001/10/31 21:36:04 1.20
+--- g-dirope.adb 2001/11/01 16:39:33 1.21
+***************
+*** 371,387 ****
+ E := E + 1;
+
+ Var_Name : loop
+! exit Var_Name when E = Path'Last;
+
+ if Characters.Handling.Is_Letter (Path (E))
+ or else Characters.Handling.Is_Digit (Path (E))
+ then
+ E := E + 1;
+ else
+- E := E - 1;
+ exit Var_Name;
+ end if;
+ end loop Var_Name;
+
+ declare
+ Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
+--- 371,388 ----
+ E := E + 1;
+
+ Var_Name : loop
+! exit Var_Name when E > Path'Last;
+
+ if Characters.Handling.Is_Letter (Path (E))
+ or else Characters.Handling.Is_Digit (Path (E))
+ then
+ E := E + 1;
+ else
+ exit Var_Name;
+ end if;
+ end loop Var_Name;
++
++ E := E - 1;
+
+ declare
+ Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
2001-12-11 Ed Schonberg <schonber@gnat.com>
* sem_ch10.adb (Install_Withed_Unit): If the unit is a generic instance
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index d265ae8..711bd48 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.55 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
@@ -83,6 +83,13 @@ package Checks is
-- the object denoted by the access parameter is not deeper than the
-- level of the type Typ. Program_Error is raised if the check fails.
+ procedure Apply_Alignment_Check (E : Entity_Id; N : Node_Id);
+ -- E is the entity for an object. If there is an address clause for
+ -- this entity, and checks are enabled, then this procedure generates
+ -- a check that the specified address has an alignment consistent with
+ -- the alignment of the object, raising PE if this is not the case. The
+ -- resulting check (if one is generated) is inserted before node N.
+
procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id);
-- N is the node for an object declaration that declares an object of
-- array type Typ. This routine generates, if necessary, a check that
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 6e57f3b..bbc8458 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- $Revision: 1.76 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
@@ -27,6 +27,7 @@
------------------------------------------------------------------------------
with Atree; use Atree;
+with Checks; use Checks;
with Einfo; use Einfo;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
@@ -236,10 +237,20 @@ package body Exp_Ch13 is
Decl : Node_Id;
begin
- if not Is_Type (E) and then not Is_Subprogram (E) then
+ -- For object, with address clause, check alignment is OK
+
+ if Is_Object (E) then
+ Apply_Alignment_Check (E, N);
+
+ -- Only other items requiring any front end action are
+ -- types and subprograms.
+
+ elsif not Is_Type (E) and then not Is_Subprogram (E) then
return;
end if;
+ -- Here E is a type or a subprogram
+
E_Scope := Scope (E);
-- If we are freezing entities defined in protected types, they
@@ -304,11 +315,6 @@ package body Exp_Ch13 is
elsif Is_Subprogram (E) then
Freeze_Subprogram (N);
-
- -- No other entities require any front end freeze actions
-
- else
- null;
end if;
-- Analyze actions generated by freezing. The init_proc contains
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index e59b17f..0670362 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.adb
@@ -59,7 +59,8 @@ package body Exp_Ch8 is
-- of the renamed object. The cases in which this is not true are when
-- this address is not computable, since it involves extraction of a
-- packed array element, or of a record component to which a component
- -- clause applies (that can specify an arbitrary bit boundary).
+ -- clause applies (that can specify an arbitrary bit boundary), or where
+ -- the enclosing record itself has a non-standard representation.
-- In these two cases, we pre-evaluate the renaming expression, by
-- extracting and freezing the values of any subscripts, and then we
@@ -211,18 +212,25 @@ package body Exp_Ch8 is
end if;
elsif Nkind (Nam) = N_Selected_Component then
- if Present (Component_Clause (Entity (Selector_Name (Nam)))) then
- return True;
+ declare
+ Rec_Type : Entity_Id := Etype (Prefix (Nam));
- elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
- and then Is_Record_Type (Etype (Prefix (Nam)))
- and then not Is_Concurrent_Record_Type (Etype (Prefix (Nam)))
- then
- return True;
+ begin
+ if Present (Component_Clause (Entity (Selector_Name (Nam))))
+ or else Has_Non_Standard_Rep (Rec_Type)
+ then
+ return True;
- else
- return Evaluation_Required (Prefix (Nam));
- end if;
+ elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
+ and then Is_Record_Type (Rec_Type)
+ and then not Is_Concurrent_Record_Type (Rec_Type)
+ then
+ return True;
+
+ else
+ return Evaluation_Required (Prefix (Nam));
+ end if;
+ end;
else
return False;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 2af5b80..4bbaeb8 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.112 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
@@ -372,15 +372,6 @@ package Exp_Util is
-- routine is to help avoid generating troublesome temporaries that
-- intefere with the stack checking mechanism.
- function Must_Be_Aligned (Obj : Node_Id) return Boolean;
- -- Given an object reference, determines whether or not the object
- -- is required to be aligned according to its type'alignment value.
- -- Normally, objects are required to be aligned, and the result will
- -- be True. The situation in which this is not the case is if the
- -- object reference involves a component of a packed array, where
- -- the type of the component is not required to have strict alignment.
- -- In this case, false will be returned.
-
procedure Remove_Side_Effects
(Exp : Node_Id;
Name_Req : Boolean := False;
diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads
index 9f24a68..b6205e2 100644
--- a/gcc/ada/freeze.ads
+++ b/gcc/ada/freeze.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.1 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2000, Free Software Foundation, Inc. --
-- --
@@ -205,6 +205,11 @@ package Freeze is
-- so need to be similarly treated. Freeze_Expression takes care of
-- determining the proper insertion point for generated freeze actions.
+ procedure Freeze_Fixed_Point_Type (Typ : Entity_Id);
+ -- Freeze fixed point type. For fixed-point types, we have to defer
+ -- setting the size and bounds till the freeze point, since they are
+ -- potentially affected by the presence of size and small clauses.
+
procedure Freeze_Itype (T : Entity_Id; N : Node_Id);
-- This routine is called when an Itype is created and must be frozen
-- immediately at the point of creation (for the sake of the expansion
diff --git a/gcc/ada/g-dirope.adb b/gcc/ada/g-dirope.adb
index 4755584..38fd695 100644
--- a/gcc/ada/g-dirope.adb
+++ b/gcc/ada/g-dirope.adb
@@ -371,18 +371,19 @@ package body GNAT.Directory_Operations is
E := E + 1;
Var_Name : loop
- exit Var_Name when E = Path'Last;
+ exit Var_Name when E > Path'Last;
if Characters.Handling.Is_Letter (Path (E))
or else Characters.Handling.Is_Digit (Path (E))
then
E := E + 1;
else
- E := E - 1;
exit Var_Name;
end if;
end loop Var_Name;
+ E := E - 1;
+
declare
Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
diff --git a/gcc/ada/g-dirope.ads b/gcc/ada/g-dirope.ads
index 8e6d005..6e0e988d 100644
--- a/gcc/ada/g-dirope.ads
+++ b/gcc/ada/g-dirope.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.12 $
+-- $Revision$
-- --
-- Copyright (C) 1998-2001 Ada Core Technologies, Inc. --
-- --
@@ -38,6 +38,10 @@
-- can be treated as a file, using open and close routines, and a scanning
-- routine is provided for iterating through the entries in a directory.
+-- See also child package GNAT.Directory_Operations.Iteration
+
+with Ada.Strings.Maps;
+
package GNAT.Directory_Operations is
subtype Dir_Name_Str is String;
@@ -187,62 +191,6 @@ package GNAT.Directory_Operations is
-- returned in target-OS form. Raises Directory_Error if Dir has not
-- be opened (Dir = Null_Dir).
- generic
- with procedure Action
- (Item : String;
- Index : Positive;
- Quit : in out Boolean);
- procedure Wildcard_Iterator (Path : Path_Name);
- -- Calls Action for each path matching Path. Path can include wildcards '*'
- -- and '?' and [...]. The rules are:
- --
- -- * can be replaced by any sequence of characters
- -- ? can be replaced by a single character
- -- [a-z] match one character in the range 'a' through 'z'
- -- [abc] match either character 'a', 'b' or 'c'
- --
- -- Item is the filename that has been matched. Index is set to one for the
- -- first call and is incremented by one at each call. The iterator's
- -- termination can be controlled by setting Quit to True. It is by default
- -- set to False.
- --
- -- For example, if we have the following directory structure:
- -- /boo/
- -- foo.ads
- -- /sed/
- -- foo.ads
- -- file/
- -- foo.ads
- -- /sid/
- -- foo.ads
- -- file/
- -- foo.ads
- -- /life/
- --
- -- A call with expression "/s*/file/*" will call Action for the following
- -- items:
- -- /sed/file/foo.ads
- -- /sid/file/foo.ads
-
- generic
- with procedure Action
- (Item : String;
- Index : Positive;
- Quit : in out Boolean);
- procedure Find
- (Root_Directory : Dir_Name_Str;
- File_Pattern : String);
- -- Recursively searches the directory structure rooted at Root_Directory.
- -- This provides functionality similar to the UNIX 'find' command.
- -- Action will be called for every item matching the regular expression
- -- File_Pattern (see GNAT.Regexp). Item is the full pathname to the file
- -- starting with Root_Directory that has been matched. Index is set to one
- -- for the first call and is incremented by one at each call. The iterator
- -- will pass in the value False on each call to Action. The iterator will
- -- terminate after passing the last matched path to Action or after
- -- returning from a call to Action which sets Quit to True.
- -- Raises GNAT.Regexp.Error_In_Regexp if File_Pattern is ill formed.
-
function Read_Is_Thread_Safe return Boolean;
-- Indicates if procedure Read is thread safe. On systems where the
-- target system supports this functionality, Read is thread safe,
@@ -260,4 +208,8 @@ private
pragma Import (C, Dir_Separator, "__gnat_dir_separator");
+ Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
+ Ada.Strings.Maps.To_Set ("/\");
+ -- UNIX and DOS style directory separators.
+
end GNAT.Directory_Operations;
diff --git a/gcc/ada/g-regexp.adb b/gcc/ada/g-regexp.adb
index 360badc..5a5e39b 100644
--- a/gcc/ada/g-regexp.adb
+++ b/gcc/ada/g-regexp.adb
@@ -32,7 +32,6 @@
-- --
------------------------------------------------------------------------------
-with System.IO;
with Unchecked_Deallocation;
with Ada.Exceptions;
with GNAT.Case_Util;
@@ -73,10 +72,6 @@ package body GNAT.Regexp is
end record;
-- Deterministic finite-state machine
- Debug : constant Boolean := False;
- -- When True, the primary and secondary tables will be printed.
- -- Gnat does not generate any code if this variable is False;
-
-----------------------
-- Local Subprograms --
-----------------------
@@ -188,12 +183,6 @@ package body GNAT.Regexp is
pragma No_Return (Raise_Exception);
-- Raise an exception, indicating an error at character Index in S.
- procedure Print_Table
- (Table : Regexp_Array;
- Num_States : State_Index;
- Is_Primary : Boolean := True);
- -- Print a table for debugging purposes
-
--------------------
-- Create_Mapping --
--------------------
@@ -1225,85 +1214,10 @@ package body GNAT.Regexp is
end loop;
end loop;
- if Debug then
- System.IO.New_Line;
- System.IO.Put_Line ("Secondary table : ");
- Print_Table (R.States, Nb_State, False);
- end if;
-
return (Ada.Finalization.Controlled with R => R);
end;
end Create_Secondary_Table;
- -----------------
- -- Print_Table --
- -----------------
-
- procedure Print_Table
- (Table : Regexp_Array;
- Num_States : State_Index;
- Is_Primary : Boolean := True)
- is
- function Reverse_Mapping (N : Column_Index) return Character;
- -- Return the character corresponding to a column in the mapping
-
- ---------------------
- -- Reverse_Mapping --
- ---------------------
-
- function Reverse_Mapping (N : Column_Index) return Character is
- begin
- for Column in Map'Range loop
- if Map (Column) = N then
- return Column;
- end if;
- end loop;
-
- return ' ';
- end Reverse_Mapping;
-
- -- Start of processing for Print_Table
-
- begin
- -- Print the header line
-
- System.IO.Put (" [*] ");
-
- for Column in 1 .. Alphabet_Size loop
- System.IO.Put
- (String'(1 .. 1 => Reverse_Mapping (Column)) & " ");
- end loop;
-
- if Is_Primary then
- System.IO.Put ("closure....");
- end if;
-
- System.IO.New_Line;
-
- -- Print every line
-
- for State in 1 .. Num_States loop
- System.IO.Put (State'Img);
-
- for K in 1 .. 3 - State'Img'Length loop
- System.IO.Put (" ");
- end loop;
-
- for K in 0 .. Alphabet_Size loop
- System.IO.Put (Table (State, K)'Img & " ");
- end loop;
-
- for K in Alphabet_Size + 1 .. Table'Last (2) loop
- if Table (State, K) /= 0 then
- System.IO.Put (Table (State, K)'Img & ",");
- end if;
- end loop;
-
- System.IO.New_Line;
- end loop;
-
- end Print_Table;
-
---------------------
-- Raise_Exception --
---------------------
@@ -1345,12 +1259,6 @@ package body GNAT.Regexp is
(Table, Num_States, Start_State, End_State);
end if;
- if Debug then
- Print_Table (Table.all, Num_States);
- System.IO.Put_Line ("Start_State : " & Start_State'Img);
- System.IO.Put_Line ("End_State : " & End_State'Img);
- end if;
-
-- Creates the secondary table
R := Create_Secondary_Table
@@ -1452,17 +1360,6 @@ package body GNAT.Regexp is
Table'First (2) .. New_Columns);
New_Table.all := (others => (others => 0));
- if Debug then
- System.IO.Put_Line ("Reallocating table: Lines from "
- & State_Index'Image (Table'Last (1))
- & " to "
- & State_Index'Image (New_Lines));
- System.IO.Put_Line (" and columns from "
- & Column_Index'Image (Table'Last (2))
- & " to "
- & Column_Index'Image (New_Columns));
- end if;
-
for J in Table'Range (1) loop
for K in Table'Range (2) loop
New_Table (J, K) := Table (J, K);
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index ae10ab2..b7242d2 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -195,6 +195,7 @@ package body Impunit is
"g-curexc", -- GNAT.Current_Exception
"g-debpoo", -- GNAT.Debug_Pools
"g-debuti", -- GNAT.Debug_Utilities
+ "g-diopit", -- GNAT.Directory_Operations.Iteration
"g-dirope", -- GNAT.Directory_Operations
"g-dyntab", -- GNAT.Dynamic_Tables
"g-exctra", -- GNAT.Exception_Traces
diff --git a/gcc/ada/mdllfile.ads b/gcc/ada/mdllfile.ads
index 9f2bb2a..84b4291 100644
--- a/gcc/ada/mdllfile.ads
+++ b/gcc/ada/mdllfile.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.1 $ --
+-- $Revision$ --
-- --
-- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
-- --
@@ -26,27 +26,26 @@
-- --
------------------------------------------------------------------------------
--- Simple services used by GNATDLL to deal with Filename extension.
+-- Simple services used by GNATDLL to deal with Filename extension
package MDLL.Files is
No_Ext : constant String := "";
+ -- Used to mark the absence of an extension
- function Get_Ext (Filename : in String)
- return String;
- -- return filename's extension.
+ function Get_Ext (Filename : String) return String;
+ -- Return extension of Filename
- function Is_Ali (Filename : in String)
- return Boolean;
- -- test if Filename is an Ada library file (.ali).
+ function Is_Ali (Filename : String) return Boolean;
+ -- Test if Filename is an Ada library file (.ali).
- function Is_Obj (Filename : in String)
- return Boolean;
- -- test if Filename is an object file (.o or .obj).
+ function Is_Obj (Filename : String) return Boolean;
+ -- Test if Filename is an object file (.o or .obj)
- function Ext_To (Filename : in String;
- New_Ext : in String := No_Ext)
- return String;
- -- return Filename with the extension change to New_Ext.
+ function Ext_To
+ (Filename : String;
+ New_Ext : String := No_Ext)
+ return String;
+ -- Return Filename with the extension change to New_Ext
end MDLL.Files;
diff --git a/gcc/ada/mlib-fil.ads b/gcc/ada/mlib-fil.ads
index 474aaff..8f9dec9 100644
--- a/gcc/ada/mlib-fil.ads
+++ b/gcc/ada/mlib-fil.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.1 $
+-- $Revision$
-- --
-- Copyright (C) 2001, Ada Core Technologies, Inc. --
-- --
@@ -36,16 +36,16 @@ package MLib.Fil is
return String;
-- Return Filename with the extension change to New_Ext.
- function Get_Ext (Filename : in String) return String;
+ function Get_Ext (Filename : String) return String;
-- Return extension of filename.
function Is_Archive (Filename : String) return Boolean;
-- Test if filename is an archive
- function Is_C (Filename : in String) return Boolean;
+ function Is_C (Filename : String) return Boolean;
-- Test if Filename is a C file
- function Is_Obj (Filename : in String) return Boolean;
+ function Is_Obj (Filename : String) return Boolean;
-- Test if Filename is an object file
end MLib.Fil;
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 5a8b9e3..6e85c20 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -452,16 +452,17 @@ package body Ch12 is
if Def_Node /= Error then
Set_Formal_Type_Definition (Decl_Node, Def_Node);
TF_Semicolon;
+
else
Decl_Node := Error;
+ -- If we have semicolon, skip it to avoid cascaded errors
+
if Token = Tok_Semicolon then
- -- Avoid further cascaded errors.
Scan;
end if;
end if;
-
return Decl_Node;
end P_Formal_Type_Declaration;
diff --git a/gcc/ada/prj-dect.ads b/gcc/ada/prj-dect.ads
index be3dbb0..78afb8f 100644
--- a/gcc/ada/prj-dect.ads
+++ b/gcc/ada/prj-dect.ads
@@ -8,7 +8,7 @@
-- --
-- $Revision$
-- --
--- Copyright (C) 2000-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 2001 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- --
diff --git a/gcc/ada/s-arit64.adb b/gcc/ada/s-arit64.adb
index f4c8532..dff290c 100644
--- a/gcc/ada/s-arit64.adb
+++ b/gcc/ada/s-arit64.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- $Revision: 1.16 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
@@ -325,14 +325,16 @@ package body System.Arith_64 is
T2 := Xhi * Ylo;
end if;
- else
- if Yhi /= 0 then
- T2 := Xlo * Yhi;
- else
- return X * Y;
- end if;
+ elsif Yhi /= 0 then
+ T2 := Xlo * Yhi;
+
+ else -- Yhi = Xhi = 0
+ T2 := 0;
end if;
+ -- Here we have T2 set to the contribution to the upper half
+ -- of the result from the upper halves of the input values.
+
T1 := Xlo * Ylo;
T2 := T2 + Hi (T1);
diff --git a/gcc/ada/s-fatgen.ads b/gcc/ada/s-fatgen.ads
index 0ad0d68..2e70d9d 100644
--- a/gcc/ada/s-fatgen.ads
+++ b/gcc/ada/s-fatgen.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- $Revision: 1.9 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
@@ -89,9 +89,12 @@ pragma Pure (Fat_Gen);
function Unbiased_Rounding (X : T) return T;
- function Valid (X : access T) return Boolean;
- -- The argument must be passed by reference here, as T may be
- -- an abnormal value that can be passed in a floating point register.
+ function Valid (X : access T) return Boolean;
+ -- This function checks if the object of type T referenced by X
+ -- is valid, and returns True/False accordingly. The parameter is
+ -- passed by reference (access) here, as the object of type T may
+ -- be an abnormal value that cannot be passed in a floating-point
+ -- register, and the whole point of 'Valid is to prevent exceptions.
private
pragma Inline (Machine);
diff --git a/gcc/ada/s-stalib.adb b/gcc/ada/s-stalib.adb
index 71fb5cc..189cfa1 100644
--- a/gcc/ada/s-stalib.adb
+++ b/gcc/ada/s-stalib.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- $Revision: 1.17 $
+-- $Revision$
-- --
-- Copyright (C) 1995-2001 Free Software Foundation, Inc. --
-- --
@@ -46,14 +46,17 @@ pragma Polling (Off);
-- elaboration circularities with Ada.Exceptions if polling is on.
with System.Soft_Links;
--- Referenced directly from generated code
--- Also referenced from exception handling routines.
+-- Referenced directly from generated code using external symbols so it
+-- must always be present in a build, even if no unit has a direct with
+-- of this unit. Also referenced from exception handling routines.
-- This is needed for programs that don't use exceptions explicitely but
-- direct calls to Ada.Exceptions are generated by gigi (for example,
-- by calling __gnat_raise_constraint_error directly).
with System.Memory;
--- Referenced directly from generated code
+-- Referenced directly from generated code using external symbols, so it
+-- must always be present in a build, even if no unit has a direct with
+-- of this unit.
package body System.Standard_Library is
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 31f244d..bdb2c8b 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- $Revision: 1.511 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
@@ -2691,6 +2691,18 @@ package body Sem_Ch4 is
Check_Misspelled_Selector (Entity_List, Sel);
+ elsif Is_Generic_Type (Prefix_Type)
+ and then Ekind (Prefix_Type) = E_Record_Type_With_Private
+ and then Is_Record_Type (Etype (Prefix_Type))
+ then
+ -- If this is a derived formal type, the parent may have a
+ -- different visibility at this point. Try for an inherited
+ -- component before reporting an error.
+
+ Set_Etype (Prefix (N), Etype (Prefix_Type));
+ Analyze_Selected_Component (N);
+ return;
+
else
if Ekind (Prefix_Type) = E_Record_Subtype then
generated by cgit v1.1 at 2024-10-03 20:06:18 +0000