This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Reflect ACT changes from 2001-11-02
- From: Geert Bosch <bosch at darwin dot gnat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 15 Dec 2001 19:56:24 -0500 (EST)
- Subject: [Ada] Reflect ACT changes from 2001-11-02
2001-12-14 Vincent Celier <celier@gnat.com>
* osint.adb(Create_Debug_File): When an object file is specified,
put the .dg file in the same directory as the object file.
2001-12-14 Robert Dewar <dewar@gnat.com>
* osint.adb: Minor reformatting
* lib-xref.adb (Output_Instantiation): New procedure to generate
instantiation references.
* lib-xref.ads: Add documentation of handling of generic references.
* ali.adb (Read_Instantiation_Ref): New procedure to read
instantiation references
* ali.ads: Add spec for storing instantiation references
* bindusg.adb: Minor reformatting
* switch.adb: Add entry for Latin-5 (Cyrillic ISO-8859-5)
* usage.adb: Add entry for Latin-5 (Cyrillic ISO-8859-5)
* gnatcmd.adb: Add entry for Latin-5 (Cyrillic ISO-8859-5)
* csets.adb: Add entry for Latin-5 (Cyrillic ISO-8859-5)
* csets.ads:
Fix header format
Add 2001 to copyright date
Add entry for Latin-5 (Cyrillic ISO-8859-5)
2001-12-14 Matt Gingell <gingell@gnat.com>
* adaint.c: mktemp is a macro on Lynx and can not be used as an
expression.
2001-12-14 Richard Kenner <kenner@gnat.com>
* misc.c (gnat_expand_constant): Do not strip UNCHECKED_CONVERT_EXPR
if operand is CONSTRUCTOR.
2001-12-14 Ed Schonberg <schonber@gnat.com>
* trans.c (tree_transform, case N_Assignment_Statement): Set lineno
before emiting check on right-hand side, so that exception information
is correct.
2001-12-14 Richard Kenner <kenner@gnat.com>
* utils.c (create_var_decl): Throw away initializing expression
if just annotating types and non-constant.
2001-12-14 Vincent Celier <celier@gnat.com>
* prj-nmsc.adb: (Ada_Check): Migrate drom Ada_Default_... to
Default_Ada_...
* prj.adb: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
Remove functions.
(Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Move to spec.
* prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
Remove functions.
(Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Move from body.
*** osint.adb 2001/10/05 08:58:00 1.261
--- osint.adb 2001/11/02 00:02:11 1.262
***************
*** 731,736 ****
--- 731,762 ----
Name_Buffer (Name_Len + 1 .. Name_Len + 3) := ".dg";
end if;
Name_Len := Name_Len + 3;
+
+ if Output_Object_File_Name /= null then
+
+ for Index in reverse Output_Object_File_Name'Range loop
+
+ if Output_Object_File_Name (Index) = Directory_Separator then
+ declare
+ File_Name : constant String := Name_Buffer (1 .. Name_Len);
+ begin
+ Name_Len := Index - Output_Object_File_Name'First + 1;
+ Name_Buffer (1 .. Name_Len) :=
+ Output_Object_File_Name
+ (Output_Object_File_Name'First .. Index);
+ Name_Buffer (Name_Len + 1 .. Name_Len + File_Name'Length) :=
+ File_Name;
+ Name_Len := Name_Len + File_Name'Length;
+ end;
+
+ exit;
+
+ end if;
+
+ end loop;
+
+ end if;
+
Result := Name_Find;
Name_Buffer (Name_Len + 1) := ASCII.NUL;
Create_File_And_Check (Output_FD, Text);
*** osint.adb 2001/11/02 00:02:11 1.262
--- osint.adb 2001/11/02 03:32:54 1.263
***************
*** 725,735 ****
--- 725,737 ----
begin
Get_Name_String (Src);
+
if Hostparm.OpenVMS then
Name_Buffer (Name_Len + 1 .. Name_Len + 3) := "_dg";
else
Name_Buffer (Name_Len + 1 .. Name_Len + 3) := ".dg";
end if;
+
Name_Len := Name_Len + 3;
if Output_Object_File_Name /= null then
***************
*** 739,760 ****
if Output_Object_File_Name (Index) = Directory_Separator then
declare
File_Name : constant String := Name_Buffer (1 .. Name_Len);
begin
Name_Len := Index - Output_Object_File_Name'First + 1;
Name_Buffer (1 .. Name_Len) :=
! Output_Object_File_Name
! (Output_Object_File_Name'First .. Index);
Name_Buffer (Name_Len + 1 .. Name_Len + File_Name'Length) :=
File_Name;
Name_Len := Name_Len + File_Name'Length;
end;
exit;
-
end if;
-
end loop;
-
end if;
Result := Name_Find;
--- 741,760 ----
if Output_Object_File_Name (Index) = Directory_Separator then
declare
File_Name : constant String := Name_Buffer (1 .. Name_Len);
+
begin
Name_Len := Index - Output_Object_File_Name'First + 1;
Name_Buffer (1 .. Name_Len) :=
! Output_Object_File_Name
! (Output_Object_File_Name'First .. Index);
Name_Buffer (Name_Len + 1 .. Name_Len + File_Name'Length) :=
File_Name;
Name_Len := Name_Len + File_Name'Length;
end;
exit;
end if;
end loop;
end if;
Result := Name_Find;
*** lib-xref.adb 2001/10/30 06:11:43 1.59
--- lib-xref.adb 2001/11/02 13:33:10 1.60
***************
*** 481,487 ****
Crloc := No_Location;
for Refno in 1 .. Nrefs loop
! declare
XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
-- The current entry to be accessed
--- 481,489 ----
Crloc := No_Location;
for Refno in 1 .. Nrefs loop
!
! Output_One_Ref : declare
!
XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
-- The current entry to be accessed
***************
*** 498,503 ****
--- 500,556 ----
Right : Character;
-- Used for {} or <> for type reference
+ procedure Output_Instantiation_Refs (Loc : Source_Ptr);
+ -- Recursive procedure to output instantiation references for
+ -- the given source ptr in [file|line[...]] form. No output
+ -- if the given location is not a generic template reference.
+
+ -------------------------------
+ -- Output_Instantiation_Refs --
+ -------------------------------
+
+ procedure Output_Instantiation_Refs (Loc : Source_Ptr) is
+ Iloc : constant Source_Ptr := Instantiation_Location (Loc);
+ Lun : Unit_Number_Type;
+
+ begin
+ -- Nothing to do if this is not an instantiation
+
+ if Iloc = No_Location then
+ return;
+ end if;
+
+ -- For now, nothing to do unless special debug flag set
+
+ if not Debug_Flag_MM then
+ return;
+ end if;
+
+ -- Output instantiation reference
+
+ Write_Info_Char ('[');
+ Lun := Get_Source_Unit (Iloc);
+
+ if Lun /= Curru then
+ Curru := XE.Lun;
+ Write_Info_Nat (Dependency_Num (Curru));
+ Write_Info_Char ('|');
+ end if;
+
+ Write_Info_Nat (Int (Get_Logical_Line_Number (Iloc)));
+
+ -- Recursive call to get nested instantiations
+
+ Output_Instantiation_Refs (Iloc);
+
+ -- Output final ] after call to get proper nesting
+
+ Write_Info_Char (']');
+ return;
+ end Output_Instantiation_Refs;
+
+ -- Start of processing for Output_One_Ref
+
begin
Ent := XE.Ent;
Ctyp := Xref_Entity_Letters (Ekind (Ent));
***************
*** 841,849 ****
Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Loc)));
Write_Info_Char (XE.Typ);
Write_Info_Nat (Int (Get_Column_Number (XE.Loc)));
end if;
end if;
! end;
<<Continue>>
null;
--- 894,904 ----
Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Loc)));
Write_Info_Char (XE.Typ);
Write_Info_Nat (Int (Get_Column_Number (XE.Loc)));
+
+ Output_Instantiation_Refs (Sloc (XE.Ent));
end if;
end if;
! end Output_One_Ref;
<<Continue>>
null;
*** lib-xref.ads 2001/10/28 15:14:22 1.32
--- lib-xref.ads 2001/11/02 13:33:14 1.33
***************
*** 101,107 ****
--
-- There may be zero or more ref entries on each line
--
! -- file | line type col
--
-- file is the dependency number of the file with the reference.
-- It and the following vertical bar are omitted if the file is
--- 101,107 ----
--
-- There may be zero or more ref entries on each line
--
! -- file | line type col [...]
--
-- file is the dependency number of the file with the reference.
-- It and the following vertical bar are omitted if the file is
***************
*** 173,181 ****
-- Note that in the case of accept statements, there can
-- be multiple b and T/t entries for the same entity.
--
-- Examples:
--
! -- 44B5*Flag_Type 5r23 6m45 3|9r35 11r56
--
-- This line gives references for the publicly visible Boolean
-- type Flag_Type declared on line 44, column 5. There are four
--- 173,193 ----
-- Note that in the case of accept statements, there can
-- be multiple b and T/t entries for the same entity.
--
+ -- [..] is used for generic instantiation references. These
+ -- references are present only if the entity in question is
+ -- a generic entity, and in that case the [..] contains the
+ -- reference for the instantiation. In the case of nested
+ -- instantiations, this can be nested [...[...[...]]] etc.
+ -- The reference is of the form [file|line] no column is
+ -- present since it is assumed that only one instantiation
+ -- appears on a single source line. Note that the appearence
+ -- of file numbers in such references follows the normal
+ -- rules (present only if needed, and resets the current
+ -- file for subsequent references).
+ --
-- Examples:
--
! -- 44B5*Flag_Type{boolean} 5r23 6m45 3|9r35 11r56
--
-- This line gives references for the publicly visible Boolean
-- type Flag_Type declared on line 44, column 5. There are four
***************
*** 215,220 ****
--- 227,239 ----
--
-- a reference (e.g. a variable declaration) at line 18 column
-- 4 of the current file.
+ --
+ -- 10I3*Genv{integer} 3|4I10[6|12]
+ --
+ -- This line gives a reference for the entity Genv in a generic
+ -- package. The reference in file 3, line 4, col 10, refers to
+ -- an instance of the generic where the instantiation can be
+ -- found in file 6 at line 12.
--
-- Continuation lines are used if the reference list gets too long,
-- a continuation line starts with a period, and then has references
*** ali.adb 2001/10/28 15:03:10 1.128
--- ali.adb 2001/11/02 13:33:17 1.129
***************
*** 1218,1224 ****
Xref_Section.Increment_Last;
! declare
XS : Xref_Section_Record renames
Xref_Section.Table (Xref_Section.Last);
--- 1218,1224 ----
Xref_Section.Increment_Last;
! Read_Refs_For_One_File : declare
XS : Xref_Section_Record renames
Xref_Section.Table (Xref_Section.Last);
***************
*** 1240,1251 ****
while C /= 'X' and then C /= EOF loop
Xref_Entity.Increment_Last;
! declare
XE : Xref_Entity_Record renames
Xref_Entity.Table (Xref_Entity.Last);
N : Nat;
begin
XE.Line := Get_Nat;
XE.Etype := Getc;
--- 1240,1303 ----
while C /= 'X' and then C /= EOF loop
Xref_Entity.Increment_Last;
! Read_Refs_For_One_Entity : declare
!
XE : Xref_Entity_Record renames
Xref_Entity.Table (Xref_Entity.Last);
N : Nat;
+ procedure Read_Instantiation_Reference;
+ -- Acquire instantiation reference. Caller has checked
+ -- that current character is '[' and on return the cursor
+ -- is skipped past the corresponding closing ']'.
+
+ ----------------------------------
+ -- Read_Instantiation_Reference --
+ ----------------------------------
+
+ procedure Read_Instantiation_Reference is
+ begin
+ Xref.Increment_Last;
+
+ declare
+ XR : Xref_Record renames Xref.Table (Xref.Last);
+
+ begin
+ P := P + 1; -- skip [
+ N := Get_Nat;
+
+ if Nextc = '|' then
+ XR.File_Num :=
+ Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
+ Current_File_Num := XR.File_Num;
+ P := P + 1;
+ N := Get_Nat;
+
+ else
+ XR.File_Num := Current_File_Num;
+ end if;
+
+ XR.Line := N;
+ XR.Rtype := ' ';
+ XR.Col := 0;
+
+ -- Recursive call for next reference
+
+ if Nextc = '[' then
+ pragma Warnings (Off); -- kill recursion warning
+ Read_Instantiation_Reference;
+ pragma Warnings (On);
+ end if;
+
+ -- Skip closing bracket after recursive call
+
+ P := P + 1;
+ end;
+ end Read_Instantiation_Reference;
+
+ -- Start of processing for Read_Refs_For_One_Entity
+
begin
XE.Line := Get_Nat;
XE.Etype := Getc;
***************
*** 1343,1348 ****
--- 1395,1404 ----
XR.Line := N;
XR.Rtype := Getc;
XR.Col := Get_Nat;
+
+ if Nextc = '[' then
+ Read_Instantiation_Reference;
+ end if;
end;
end loop;
***************
*** 1350,1362 ****
XE.Last_Xref := Xref.Last;
C := Nextc;
! end;
end loop;
-- Record last entity
XS.Last_Entity := Xref_Entity.Last;
! end;
C := Getc;
end loop;
--- 1406,1420 ----
XE.Last_Xref := Xref.Last;
C := Nextc;
!
! end Read_Refs_For_One_Entity;
end loop;
-- Record last entity
XS.Last_Entity := Xref_Entity.Last;
!
! end Read_Refs_For_One_File;
C := Getc;
end loop;
*** ali.ads 2001/10/28 15:03:16 1.74
--- ali.ads 2001/11/02 13:33:22 1.75
***************
*** 687,694 ****
-- i = implicit reference
-- See description in lib-xref.ads for further details
! Col : Pos;
-- Column number for the reference
end record;
package Xref is new Table.Table (
--- 687,697 ----
-- i = implicit reference
-- See description in lib-xref.ads for further details
! Col : Nat;
-- Column number for the reference
+
+ -- Note: for instantiation references, Rtype is set to ' ', and Col is
+ -- set to zero. One or more such entries can follow any other reference.
end record;
package Xref is new Table.Table (
*** bindusg.adb 2001/10/14 19:29:19 1.53
--- bindusg.adb 2001/11/02 15:13:08 1.54
***************
*** 110,122 ****
Write_Str ("mation");
Write_Eol;
! -- Line for -I switch
Write_Switch_Char;
Write_Str ("Idir Specify library and source files search path");
Write_Eol;
-
- -- Line for -I- switch
Write_Switch_Char;
Write_Str ("I- Don't look for sources & library files");
--- 110,120 ----
Write_Str ("mation");
Write_Eol;
! -- Lines for -I switch
Write_Switch_Char;
Write_Str ("Idir Specify library and source files search path");
Write_Eol;
Write_Switch_Char;
Write_Str ("I- Don't look for sources & library files");
*** switch.adb 2001/10/24 22:50:45 1.195
--- switch.adb 2001/11/02 15:13:25 1.196
***************
*** 255,269 ****
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
! if C = '1' or else
! C = '2' or else
! C = '3' or else
! C = '4' or else
! C = '8' or else
! C = 'p' or else
! C = 'f' or else
! C = 'n' or else
! C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
--- 255,266 ----
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
! if C in '1' .. '5'
! or else C = '8'
! or else C = 'p'
! or else C = 'f'
! or else C = 'n'
! or else C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
***************
*** 681,695 ****
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
! if C = '1' or else
! C = '2' or else
! C = '3' or else
! C = '4' or else
! C = '8' or else
! C = 'p' or else
! C = 'f' or else
! C = 'n' or else
! C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
--- 678,689 ----
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
! if C in '1' .. '5'
! or else C = '8'
! or else C = 'p'
! or else C = 'f'
! or else C = 'n'
! or else C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
*** usage.adb 2001/10/13 17:08:52 1.118
--- usage.adb 2001/11/02 15:13:42 1.119
***************
*** 188,194 ****
-- Line for -gnati switch
Write_Switch_Char ("i?");
! Write_Line ("Identifier char set (?=1/2/3/4/8/p/f/n/w)");
-- Line for -gnatk switch
--- 188,194 ----
-- Line for -gnati switch
Write_Switch_Char ("i?");
! Write_Line ("Identifier char set (?=1/2/3/4/5/8/p/f/n/w)");
-- Line for -gnatk switch
*** gnatcmd.adb 2001/10/26 03:50:36 1.90
--- gnatcmd.adb 2001/11/02 15:13:55 1.91
***************
*** 464,469 ****
--- 464,471 ----
"-gnati3 " &
"4 " &
"-gnati4 " &
+ "5 " &
+ "-gnati5 " &
"PC " &
"-gnatip " &
"PC850 " &
*** csets.adb 2001/02/07 04:13:19 1.25
--- csets.adb 2001/11/02 15:14:37 1.26
***************
*** 468,473 ****
--- 468,548 ----
others => ' ');
+ ---------------------------------------------------
+ -- Definitions for Latin-5 (Cyrillic ISO-8859-5) --
+ ---------------------------------------------------
+
+ Fold_Latin_5 : Translate_Table := Translate_Table'(
+
+ 'a' => 'A', X_D0 => X_B0, X_E0 => X_C0,
+ 'b' => 'B', X_D1 => X_B1, X_E1 => X_C1, X_F1 => X_A1,
+ 'c' => 'C', X_D2 => X_B2, X_E2 => X_C2, X_F2 => X_A2,
+ 'd' => 'D', X_D3 => X_B3, X_E3 => X_C3, X_F3 => X_A3,
+ 'e' => 'E', X_D4 => X_B4, X_E4 => X_C4, X_F4 => X_A4,
+ 'f' => 'F', X_D5 => X_B5, X_E5 => X_C5, X_F5 => X_A5,
+ 'g' => 'G', X_D6 => X_B6, X_E6 => X_C6, X_F6 => X_A6,
+ 'h' => 'H', X_D7 => X_B7, X_E7 => X_C7, X_F7 => X_A7,
+ 'i' => 'I', X_D8 => X_B8, X_E8 => X_C8, X_F8 => X_A8,
+ 'j' => 'J', X_D9 => X_B9, X_E9 => X_C9, X_F9 => X_A9,
+ 'k' => 'K', X_DA => X_BA, X_EA => X_CA, X_FA => X_AA,
+ 'l' => 'L', X_DB => X_BB, X_EB => X_CB, X_FB => X_AB,
+ 'm' => 'M', X_DC => X_BC, X_EC => X_CC, X_FC => X_AC,
+ 'n' => 'N', X_DD => X_BD, X_ED => X_CD,
+ 'o' => 'O', X_DE => X_BE, X_EE => X_CE, X_FE => X_AE,
+ 'p' => 'P', X_DF => X_BF, X_EF => X_CF, X_FF => X_AF,
+ 'q' => 'Q',
+ 'r' => 'R',
+ 's' => 'S',
+ 't' => 'T',
+ 'u' => 'U',
+ 'v' => 'V',
+ 'w' => 'W',
+ 'x' => 'X',
+ 'y' => 'Y',
+ 'z' => 'Z',
+
+ 'A' => 'A', X_B0 => X_B0, X_C0 => X_C0,
+ 'B' => 'B', X_B1 => X_B1, X_C1 => X_C1, X_A1 => X_A1,
+ 'C' => 'C', X_B2 => X_B2, X_C2 => X_C2, X_A2 => X_A2,
+ 'D' => 'D', X_B3 => X_B3, X_C3 => X_C3, X_A3 => X_A3,
+ 'E' => 'E', X_B4 => X_B4, X_C4 => X_C4, X_A4 => X_A4,
+ 'F' => 'F', X_B5 => X_B5, X_C5 => X_C5, X_A5 => X_A5,
+ 'G' => 'G', X_B6 => X_B6, X_C6 => X_C6, X_A6 => X_A6,
+ 'H' => 'H', X_B7 => X_B7, X_C7 => X_C7, X_A7 => X_A7,
+ 'I' => 'I', X_B8 => X_B8, X_C8 => X_C8, X_A8 => X_A8,
+ 'J' => 'J', X_B9 => X_B9, X_C9 => X_C9, X_A9 => X_A9,
+ 'K' => 'K', X_BA => X_BA, X_CA => X_CA, X_AA => X_AA,
+ 'L' => 'L', X_BB => X_BB, X_CB => X_CB, X_AB => X_AB,
+ 'M' => 'M', X_BC => X_BC, X_CC => X_CC, X_AC => X_AC,
+ 'N' => 'N', X_BD => X_BD, X_CD => X_CD,
+ 'O' => 'O', X_BE => X_BE, X_CE => X_CE, X_AE => X_AE,
+ 'P' => 'P', X_BF => X_BF, X_CF => X_CF, X_AF => X_AF,
+ 'Q' => 'Q',
+ 'R' => 'R',
+ 'S' => 'S',
+ 'T' => 'T',
+ 'U' => 'U',
+ 'V' => 'V',
+ 'W' => 'W',
+ 'X' => 'X',
+ 'Y' => 'Y',
+ 'Z' => 'Z',
+
+ '0' => '0',
+ '1' => '1',
+ '2' => '2',
+ '3' => '3',
+ '4' => '4',
+ '5' => '5',
+ '6' => '6',
+ '7' => '7',
+ '8' => '8',
+ '9' => '9',
+
+ '_' => '_',
+
+ others => ' ');
+
--------------------------------------------
-- Definitions for IBM PC (Code Page 437) --
--------------------------------------------
***************
*** 965,970 ****
--- 1040,1048 ----
elsif Identifier_Character_Set = '4' then
Fold_Upper := Fold_Latin_4;
+
+ elsif Identifier_Character_Set = '5' then
+ Fold_Upper := Fold_Latin_5;
elsif Identifier_Character_Set = 'p' then
Fold_Upper := Fold_IBM_PC_437;
*** csets.ads 1997/03/27 04:46:04 1.16
--- csets.ads 2001/11/02 15:14:40 1.17
***************
*** 6,14 ****
-- --
-- S p e c --
-- --
! -- $Revision$ --
-- --
! -- Copyright (C) 1992-1997 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- --
--- 6,14 ----
-- --
-- S p e c --
-- --
! -- $Revision$
-- --
! -- Copyright (C) 1992-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- --
***************
*** 68,73 ****
--- 68,74 ----
-- '2' Latin-2
-- '3' Latin-3
-- '4' Latin-4
+ -- '5' Latin-5 (Cyrillic ISO-8859-5)
-- 'p' IBM PC (code page 437)
-- '8' IBM PC (code page 850)
-- 'f' Full upper set (all distinct)
*** adaint.c 2001/10/07 12:18:50 1.6
--- adaint.c 2001/11/02 17:34:59 1.7
***************
*** 622,628 ****
#if defined (linux) && !defined (__vxworks)
return mkstemp (path);
!
#else
if (mktemp (path) == NULL)
return -1;
--- 622,629 ----
#if defined (linux) && !defined (__vxworks)
return mkstemp (path);
! #elif defined (__Lynx__)
! mktemp (path);
#else
if (mktemp (path) == NULL)
return -1;
*** misc.c 2001/10/29 20:07:20 1.11
--- misc.c 2001/11/02 17:35:01 1.12
***************
*** 687,698 ****
tree exp;
{
/* If this is an unchecked conversion that does not change the size of the
! object, return the operand since the underlying constant is still
! the same. Otherwise, return our operand. */
if (TREE_CODE (exp) == UNCHECKED_CONVERT_EXPR
&& operand_equal_p (TYPE_SIZE_UNIT (TREE_TYPE (exp)),
TYPE_SIZE_UNIT (TREE_TYPE (TREE_OPERAND (exp, 0))),
! 1))
return TREE_OPERAND (exp, 0);
return exp;
--- 687,699 ----
tree exp;
{
/* If this is an unchecked conversion that does not change the size of the
! object and the object is not a CONSTRUCTOR return the operand since the
! underlying constant is still the same. Otherwise, return our operand. */
if (TREE_CODE (exp) == UNCHECKED_CONVERT_EXPR
&& operand_equal_p (TYPE_SIZE_UNIT (TREE_TYPE (exp)),
TYPE_SIZE_UNIT (TREE_TYPE (TREE_OPERAND (exp, 0))),
! 1)
! && TREE_CODE (TREE_OPERAND (exp, 0)) != CONSTRUCTOR)
return TREE_OPERAND (exp, 0);
return exp;
*** trans.c 2001/10/27 21:34:32 1.5
--- trans.c 2001/11/02 17:35:04 1.6
***************
*** 2049,2059 ****
gnu_rhs
= maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node)));
/* If range check is needed, emit code to generate it */
if (Do_Range_Check (Expression (gnat_node)))
gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)));
-
- set_lineno (gnat_node, 1);
/* If either side's type has a size that overflows, convert this
into raise of Storage_Error: execution shouldn't have gotten
--- 2049,2059 ----
gnu_rhs
= maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node)));
+ set_lineno (gnat_node, 1);
+
/* If range check is needed, emit code to generate it */
if (Do_Range_Check (Expression (gnat_node)))
gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)));
/* If either side's type has a size that overflows, convert this
into raise of Storage_Error: execution shouldn't have gotten
*** utils.c 2001/10/20 18:05:34 1.5
--- utils.c 2001/11/02 17:35:06 1.6
***************
*** 1320,1328 ****
any variable elaborations for the elaboration routine. Otherwise, if
the initializing expression is not the same as TYPE, generate the
initialization with an assignment statement, since it knows how
! to do the required adjustents. */
! if (extern_flag && TREE_CODE (var_decl) != CONST_DECL)
var_init = 0;
if (global_bindings_p () && var_init != 0 && ! init_const)
--- 1320,1330 ----
any variable elaborations for the elaboration routine. Otherwise, if
the initializing expression is not the same as TYPE, generate the
initialization with an assignment statement, since it knows how
! to do the required adjustents. If we are just annotating types,
! throw away the initialization if it isn't a constant. */
! if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
! || (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
var_init = 0;
if (global_bindings_p () && var_init != 0 && ! init_const)
*** prj-nmsc.adb 2001/10/23 17:52:03 1.32
--- prj-nmsc.adb 2001/11/02 21:56:08 1.33
***************
*** 638,644 ****
Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix;
else
! Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix;
end if;
end;
--- 638,644 ----
Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix;
else
! Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
end if;
end;
***************
*** 662,668 ****
Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix;
else
! Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix;
end if;
end;
--- 662,668 ----
Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix;
else
! Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
end if;
end;
***************
*** 713,721 ****
Check_Ada_Naming_Scheme (Data.Naming);
else
! Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix;
! Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix;
! Data.Naming.Separate_Suffix := Ada_Default_Impl_Suffix;
end if;
end;
--- 713,721 ----
Check_Ada_Naming_Scheme (Data.Naming);
else
! Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
! Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
! Data.Naming.Separate_Suffix := Default_Ada_Impl_Suffix;
end if;
end;
*** prj.adb 2001/10/20 04:14:25 1.18
--- prj.adb 2001/11/02 21:56:09 1.19
***************
*** 43,51 ****
The_Empty_String : String_Id;
- Default_Ada_Spec_Suffix : Name_Id := No_Name;
- Default_Ada_Impl_Suffix : Name_Id := No_Name;
-
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
The_Casing_Images : array (Known_Casing) of String_Access :=
--- 43,48 ----
***************
*** 107,130 ****
Seen => False,
Flag1 => False,
Flag2 => False);
-
- -----------------------------
- -- Ada_Default_Spec_Suffix --
- -----------------------------
-
- function Ada_Default_Spec_Suffix return Name_Id is
- begin
- return Default_Ada_Spec_Suffix;
- end Ada_Default_Spec_Suffix;
-
- -----------------------------
- -- Ada_Default_Impl_Suffix --
- -----------------------------
-
- function Ada_Default_Impl_Suffix return Name_Id is
- begin
- return Default_Ada_Impl_Suffix;
- end Ada_Default_Impl_Suffix;
-------------------
-- Empty_Project --
--- 104,109 ----
*** prj.ads 2001/10/30 16:45:36 1.24
--- prj.ads 2001/11/02 21:56:11 1.25
***************
*** 40,45 ****
--- 40,53 ----
package Prj is
+ Default_Ada_Spec_Suffix : Name_Id := No_Name;
+ -- The Name_Id for the standard GNAT suffix for Ada spec source file
+ -- name ".ads". Initialized by Prj.Initialize.
+
+ Default_Ada_Impl_Suffix : Name_Id := No_Name;
+ -- The Name_Id for the standard GNAT suffix for Ada body source file
+ -- name ".adb". Initialized by Prj.Initialize.
+
type Put_Line_Access is access procedure (Line : String);
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc.
***************
*** 465,478 ****
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
-
- function Ada_Default_Spec_Suffix return Name_Id;
- -- Return the Name_Id for the standard GNAT suffix for Ada spec source
- -- file name ".ads".
-
- function Ada_Default_Impl_Suffix return Name_Id;
- -- Return the Name_Id for the standard GNAT suffix for Ada body source
- -- file name ".adb".
private
--- 473,478 ----