* synchronized with trunk

git-svn-id: branches/wasm@46366 -

.gitattributes

@@ -18444,6 +18444,7 @@ tests/webtbs/tw37400.pp svneol=native#text/pascal
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw37423.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal
+tests/webtbs/tw37428.pp svneol=native#text/pascal
 tests/webtbs/tw37449.pp svneol=native#text/pascal
 tests/webtbs/tw37468.pp svneol=native#text/pascal
 tests/webtbs/tw37477.pp svneol=native#text/pascal

compiler/nutils.pas

@@ -886,7 +886,8 @@ implementation
               addn,subn,orn,andn,xorn,muln,divn,modn,symdifn,
               shln,shrn,
               equaln,unequaln,gtn,gten,ltn,lten,
-              assignn:
+              assignn,
+              slashn:
                 begin
 {$ifdef CPU64BITALU}
                   correction:=1;
@@ -894,8 +895,10 @@ implementation
                   correction:=2;
 {$endif CPU64BITALU}
                   inc(result,node_complexity(tbinarynode(p).left)+1*correction);
-                  if (p.nodetype in [muln,divn,modn]) then
-                    inc(result,5*correction*correction);
+                  if (p.nodetype in [divn,modn,slashn]) then
+                    inc(result,10*correction*correction)
+                  else if p.nodetype=muln then
+                    inc(result,4*correction*correction);
                   if (result >= NODE_COMPLEXITY_INF) then
                     begin
                       result := NODE_COMPLEXITY_INF;

compiler/pdecl.pas

@@ -390,7 +390,7 @@ implementation
                   begin
                     { strip leading 0's in iso mode }
                     if (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) then
-                      while pattern[1]='0' do
+                      while (length(pattern)>1) and (pattern[1]='0') do
                         delete(pattern,1,1);
                     labelsym:=clabelsym.create(pattern);
                   end;

compiler/pstatmnt.pas

@@ -1168,7 +1168,7 @@ implementation
 
                         { strip leading 0's in iso mode }
                         if (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) then
-                          while pattern[1]='0' do
+                          while (length(pattern)>1) and (pattern[1]='0') do
                             delete(pattern,1,1);
 
                         searchsym(pattern,srsym,srsymtable);

packages/fcl-db/src/base/fields.inc

@@ -177,7 +177,8 @@ end;
 function TFieldDef.GetCharSize: Word;
 begin
   case FDataType of
-   ftGUID: Result:=1;
+   ftGuid:
+     Result := 1;
    ftString, ftFixedChar:
      case FCodePage of
        CP_UTF8: Result := 4;
@@ -3349,11 +3350,6 @@ begin
   SetAsString(GuidToString(AValue));
 end;
 
-function TVariantField.GetDefaultWidth: Integer;
-begin
-  Result := 15;
-end;
-
 { TVariantField }
 
 constructor TVariantField.Create(AOwner: TComponent);
@@ -3367,6 +3363,11 @@ begin
   { empty }
 end;
 
+function TVariantField.GetDefaultWidth: Integer;
+begin
+  Result := 15;
+end;
+
 function TVariantField.GetAsBoolean: Boolean;
 begin
   Result := GetAsVariant;

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -876,6 +876,11 @@ begin
     ftGuid:
       begin
       desttype:=SQLCHAR;
+      dest[ 0]:=Ord('{');
+      dest[37]:=Ord('}');
+      dest[38]:=0; //strings must be null-terminated
+      Inc(dest);
+      destlen:=36;
       end;
     ftMemo,
     ftBlob:
@@ -892,7 +897,7 @@ begin
 
   case FieldDef.DataType of
     ftString, ftFixedChar:
-      PAnsiChar(dest + datalen)^ := #0; //strings must be null-terminated
+      dest[datalen] := 0; //strings must be null-terminated
     ftDate, ftTime, ftDateTime:
       if desttype = SYBMSDATETIME2 then
         PDateTime(buffer)^ := dbdatetimeallcrack(@dbdta)

packages/fcl-db/tests/dbtestframework.lpi

@@ -121,7 +121,7 @@
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../units/x86_64-linux"/>
+      <OtherUnitFiles Value="../src/base;../src/dbase;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mssql;../src/sqldb/mysql;../src/sqldb/odbc;../src/sqldb/oracle;../src/sqldb/postgres;../src/sqldb/sqlite;../src/memds;../src/sdf;../src/export"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -257,6 +257,7 @@ begin
       FieldtypeDefinitions[ftBlob]    := 'IMAGE';
       FieldtypeDefinitions[ftMemo]    := 'TEXT';
       FieldtypeDefinitions[ftGraphic] := '';
+      FieldtypeDefinitions[ftGuid]    := 'UNIQUEIDENTIFIER';
       FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)';
       FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)';
       //FieldtypeDefinitions[ftWideMemo] := 'NTEXT'; // Sybase has UNITEXT?

packages/fcl-db/tests/testfieldtypes.pas

@@ -53,6 +53,7 @@ type
     procedure TestSQLInterval;
     procedure TestSQLIdentity;
     procedure TestSQLReal;
+    procedure TestSQLUUID;
 
     procedure TestStringLargerThen8192;
     procedure TestInsertLargeStrFields; // bug 9600
@@ -133,8 +134,8 @@ type
     procedure TestQueryAfterReconnect; // bug 16438
 
     procedure TestStringsReplace;
-    // Test SQLIte3 AlwaysUseBigInt, introduced after bug ID 36486.
-    Procedure TestAlwaysUseBigint;
+    // Test SQLite3 AlwaysUseBigInt, introduced after bug ID 36486.
+    Procedure TestSQLite3AlwaysUseBigint;
   end;
 
 
@@ -732,7 +733,7 @@ begin
     Open;
     for i := 0 to testValuesCount-1 do
       begin
-      ACheckFieldValueProc(fields[0],i);
+      ACheckFieldValueProc(Fields[0],i);
       Next;
       end;
     close;
@@ -931,6 +932,30 @@ begin
 end;
 
 
+const testUUIDValues: array[0..2] of shortstring = ('{00000000-0000-0000-0000-000000000000}','{A972C577-DFB0-064E-1189-0154C99310DA}','{A0EEBC99-9C0B-4EF8-BB6D-6BB9BD380A11}');
+// Placed here, as long as bug 18702 is not solved
+function TestSQLUUID_GetSQLText(const i: integer) : string;
+begin
+  if i < Length(testUUIDValues) then
+    Result := QuotedStr(Copy(testUUIDValues[i],2,36))
+  else
+    Result := 'NULL';
+end;
+procedure TTestFieldTypes.TestSQLUUID;
+  procedure CheckFieldValue(AField:TField; i: integer);
+  begin
+    if i < Length(testUUIDValues) then
+      AssertEquals(testUUIDValues[i], AField.AsString)
+    else
+      AssertTrue(AField.IsNull);
+  end;
+begin
+  if FieldtypeDefinitions[ftGuid] = '' then
+    Ignore(STestNotApplicable);
+  TestSQLFieldType(ftGuid, FieldtypeDefinitions[ftGuid], 39, @TestSQLUUID_GetSQLText, @CheckFieldValue);
+end;
+
+
 procedure TTestFieldTypes.TestStringLargerThen8192;
 // See also: TestInsertLargeStrFields
 var
@@ -1501,7 +1526,7 @@ begin
   TestXXParamQuery(ftFMTBcd, FieldtypeDefinitions[ftFMTBcd], testValuesCount, testFmtBCDValues);
 end;
 
-Procedure TTestFieldTypes.TestFmtBCDParamQuery2;
+procedure TTestFieldTypes.TestFmtBCDParamQuery2;
 begin
   // This test tests FmtBCD params with smaller precision, which fits into INT32
   // TestFmtBCDParamQuery tests FmtBCD params with bigger precision, which fits into INT64
@@ -2429,7 +2454,7 @@ begin
     inherited RunTest;
 end;
 
-Procedure TTestFieldTypes.TestAlwaysUseBigint;
+procedure TTestFieldTypes.TestSQLite3AlwaysUseBigint;
 
 var
   I : byte;

packages/fcl-passrc/src/paswrite.pp

@@ -38,7 +38,8 @@ type
                       woForceOverload,     // Force 'overload;' on overloads that are not marked as such.
                       woNoAsm,         // Do not allow asm block
                       woSkipPrivateExternals,  // Skip generation of external procedure declaration in implementation section
-                      woAlwaysRecordHelper     // Force use of record helper for type helper
+                      woAlwaysRecordHelper,     // Force use of record helper for type helper
+                      woSkipHints          // Do not add identifier hints
                       );
   TPasWriterOptions = Set of TPasWriterOption;
 
@@ -717,9 +718,54 @@ end;
 
 procedure TPasWriter.WriteConst(AConst: TPasConst);
 
+Const
+  Seps : Array[Boolean] of Char = ('=',':');
+
+Var
+  Vart,Decl : String;
+
 begin
   PrepareDeclSection('const');
-  AddLn(AConst.GetDeclaration(True)+';');
+  Decl:='';
+  With AConst do
+    begin
+    If Assigned(VarType) then
+      begin
+      If VarType.Name='' then
+        Vart:=VarType.GetDeclaration(False)
+      else
+        Vart:=VarType.SafeName;
+      Decl:=Vart+Modifiers;
+      Vart:=LowerCase(Vart);
+      if (Value<>'') then
+         Decl:=Decl+' = '+Value
+      else if (ExportName<>Nil) or ((Parent is TPasClassType) and (TPasClassType(Parent).ExternalName<>'')) then // external name
+        case VarT of
+          'integer',
+          'byte',
+          'word',
+          'smallint',
+          'int64',
+          'nativeint',
+          'shortint',
+          'longint' : Decl:=Decl+' = 0';
+          'double',
+          'single',
+          'extended' : Decl:=Decl+' = 0.0';
+          'string' : Decl:=Decl+' = ''''';
+        else
+          if Pos('array',Vart)>0 then
+            Decl:=Decl+' = []';
+        end;
+      end
+    else
+      Decl:=Value;
+
+    Decl:=SafeName+' '+Seps[Assigned(VarType)]+' '+Decl;
+    if NotOption(woSkipHints) then
+      Decl:=Decl+HintsString;
+    end;
+  AddLn(Decl+';');
 end;
 
 procedure TPasWriter.WriteVariable(aVar: TPasVariable);
@@ -862,7 +908,7 @@ begin
     PrepareDeclSection('');
   if Not IsImpl then
     IsImpl:=FInImplementation;
-  if FInImplementation and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
+  if FInImplementation and not forcebody and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
     Exit;
   Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
   if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then

tests/webtbs/tw37428.pp

@@ -0,0 +1,8 @@
+{$mode iso}
+label
+  0;
+
+begin
+  0:
+    writeln('ok');
+end.

utils/pas2js/stubcreator.pp

@@ -204,9 +204,12 @@ end;
 
 procedure TStubCreator.Execute;
 
+
 begin
   FLastErrorClass:='';
   FLastError:='';
+  if Defines.IndexOf('MakeStub')=-1 then
+
   Try
     DoExecute;
   except
@@ -307,6 +310,8 @@ begin
     SCanner.OnLog:=SE.Onlog;
     For S in FDefines do
       Scanner.AddDefine(S);
+    if FDefines.IndexOf('MAKESTUB')=-1 then
+      Scanner.AddDefine('MAKESTUB');
     Scanner.OpenFile(InputFilename);
     // Parser
     Parser:=TPasParser.Create(Scanner, FileResolver, SE);
@@ -340,7 +345,7 @@ begin
   FLineNumberWidth:=4;
   FIndentSize:=2;
   FExtraUnits:='';
-  FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc,woNoAsm,woSkipPrivateExternals,woAlwaysRecordHelper];
+  FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc,woNoAsm,woSkipPrivateExternals,woAlwaysRecordHelper,woSkipHints];
 end;
 
 destructor TStubCreator.Destroy;