+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.
+
2001-12-16 Joseph S. Myers <jsm28@cam.ac.uk>
* ChangeLog: Remove piece of diff output.
#if defined (linux) && !defined (__vxworks)
return mkstemp (path);
-
+#elif defined (__Lynx__)
+ mktemp (path);
#else
if (mktemp (path) == NULL)
return -1;
Xref_Section.Increment_Last;
- declare
+ Read_Refs_For_One_File : declare
XS : Xref_Section_Record renames
Xref_Section.Table (Xref_Section.Last);
while C /= 'X' and then C /= EOF loop
Xref_Entity.Increment_Last;
- declare
+ 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;
XR.Line := N;
XR.Rtype := Getc;
XR.Col := Get_Nat;
+
+ if Nextc = '[' then
+ Read_Instantiation_Reference;
+ end if;
end;
end loop;
XE.Last_Xref := Xref.Last;
C := Nextc;
- end;
+
+ end Read_Refs_For_One_Entity;
end loop;
-- Record last entity
XS.Last_Entity := Xref_Entity.Last;
- end;
+
+ end Read_Refs_For_One_File;
C := Getc;
end loop;
-- i = implicit reference
-- See description in lib-xref.ads for further details
- Col : Pos;
+ 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 (
Write_Str ("mation");
Write_Eol;
- -- Line for -I switch
+ -- Lines 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");
Write_Str (" in default directory");
-- --
-- B o d y --
-- --
--- $Revision: 1.25 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
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) --
--------------------------------------------
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;
-- --
-- S p e c --
-- --
--- $Revision: 1.16 $ --
+-- $Revision$
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- 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- --
-- '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)
"-gnati3 " &
"4 " &
"-gnati4 " &
+ "5 " &
+ "-gnati5 " &
"PC " &
"-gnatip " &
"PC850 " &
Crloc := No_Location;
for Refno in 1 .. Nrefs loop
- declare
+
+ Output_One_Ref : declare
+
XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
-- The current entry to be accessed
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));
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;
+ end Output_One_Ref;
<<Continue>>
null;
--
-- There may be zero or more ref entries on each line
--
- -- file | line type col
+ -- 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
-- 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 5r23 6m45 3|9r35 11r56
+ -- 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
-- 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
-- continuing from the previous line. The references are sorted first
* *
* C Implementation File *
* *
- * $Revision: 1.14 $
+ * $Revision$
* *
* Copyright (C) 1992-2001 Free Software Foundation, Inc. *
* *
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. */
+ 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))
+ 1)
+ && TREE_CODE (TREE_OPERAND (exp, 0)) != CONSTRUCTOR)
return TREE_OPERAND (exp, 0);
return exp;
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
+
+ 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);
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'
+ 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;
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'
+ 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;
* *
* C Implementation File *
* *
- * $Revision: 1.6 $
+ * $Revision$
* *
* Copyright (C) 1992-2001, Free Software Foundation, Inc. *
* *
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)));
- 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
here anyway. */
-- Line for -gnati switch
Write_Switch_Char ("i?");
- Write_Line ("Identifier char set (?=1/2/3/4/8/p/f/n/w)");
+ Write_Line ("Identifier char set (?=1/2/3/4/5/8/p/f/n/w)");
-- Line for -gnatk switch
* *
* C Implementation File *
* *
- * $Revision: 1.4 $
+ * $Revision$
* *
* Copyright (C) 1992-2001, Free Software Foundation, Inc. *
* *
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. */
+ 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)
+ 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)
projects / thirdparty / gcc.git / commitdiff
